X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=lurk.el;h=95632371867dd1d3b68651fb03a67d2787b0a531;hb=048ab640e5a9df999fdaf3e50dca3f2e6bd1a171;hp=b22ca8514a860349ae41112939a0c475aadd057d;hpb=28b4ff917a9d70cc7cfec9e4773a05d512df158a;p=lurk.git diff --git a/lurk.el b/lurk.el index b22ca85..9563237 100644 --- a/lurk.el +++ b/lurk.el @@ -77,21 +77,29 @@ '((t :inherit org-agenda-dimmed-todo-face)) "Face used for faded Lurk text.") +(defface lurk-timestamp + '((t :inherit org-agenda-dimmed-todo-face)) + "Face used for timestamps.") + (defface lurk-error '((t :inherit font-lock-regexp-grouping-construct)) "Face used for Lurk error text.") +(defface lurk-notice + '((t :inherit org-upcoming-deadline)) + "Face used for Lurk notice text.") + ;;; Global variables ;; -(defvar lurk-version "Lurk v0.1") +(defvar lurk-version "Lurk v0.1" + "Value of this string is used in response to CTCP version queries.") (defvar lurk-notice-prefix "-!-") (defvar lurk-error-prefix "!!!") -(defvar lurk-prompt-string - (propertize "> " 'face 'lurk-prompt)) +(defvar lurk-prompt-string ">") (defvar lurk-debug nil "If non-nil, enable debug mode.") @@ -160,7 +168,7 @@ (defun lurk-send-msg (msg) (if lurk-debug - (lurk-display-string nil (lurk-msg->string msg))) + (lurk-display-string nil nil (lurk-msg->string msg))) (let ((proc (get-process "lurk"))) (if (and proc (eq (process-status proc) 'open)) (process-send-string proc (concat (lurk-msg->string msg) "\r\n")) @@ -339,7 +347,7 @@ portion of the source component of the message, as LURK doesn't use this.") "") 'face 'lurk-context 'read-only t) - (propertize lurk-prompt-string + (propertize (concat lurk-prompt-string " ") 'face 'lurk-prompt 'read-only t 'rear-nonsticky t))) @@ -397,18 +405,27 @@ portion of the source component of the message, as LURK doesn't use this.") (puthash context facelist lurk-context-facelists)) facelist)) -(defun lurk-display-string (context &rest strings) +(defun lurk-display-string (context prefix &rest strings) (with-current-buffer (get-buffer-create "*lurk*") (save-excursion (goto-char lurk-prompt-marker) - (let ((inhibit-read-only t) - (old-pos (marker-position lurk-prompt-marker)) - (adaptive-fill-regexp (rx (= 6 anychar))) - (fill-column 80) - (context-atom (if context (intern context) nil))) + (let* ((inhibit-read-only t) + (old-pos (marker-position lurk-prompt-marker)) + (padded-timestamp (concat (format-time-string "%H:%M "))) + (padded-prefix (if prefix (concat prefix " ") "")) + (adaptive-fill-regexp (rx-to-string + `(= ,(+ (length padded-timestamp) + (length padded-prefix)) + anychar))) + (fill-column 80) + (context-atom (if context (intern context) nil))) (insert-before-markers - (propertize (concat (format-time-string "%H:%M") " ") - 'face (lurk-get-context-facelist context) + (propertize padded-timestamp + 'face 'lurk-timestamp + 'read-only t + 'context context + 'invisible context-atom) + (propertize padded-prefix 'read-only t 'context context 'invisible context-atom) @@ -426,8 +443,8 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-display-string context (pcase (lurk-get-context-type to) - ('channel (concat to " <" from "> ")) - ('nick (concat "[" from " -> " to "] ")) + ('channel (concat to " <" from ">")) + ('nick (concat "[" from " -> " to "]")) (_ (error "Unsupported context type"))) text))) @@ -438,19 +455,19 @@ portion of the source component of the message, as LURK doesn't use this.") (if (equal to lurk-nick) from to)))) (lurk-display-string context - "* " from " " action-text))) - + (concat "* " from) + action-text))) (defun lurk-display-notice (context &rest notices) (lurk-display-string context - lurk-notice-prefix " " + (propertize lurk-notice-prefix 'face 'lurk-notice) (apply #'concat notices))) (defun lurk-display-error (&rest messages) (lurk-display-string nil - lurk-error-prefix " " + (propertize lurk-error-prefix 'face 'lurk-error) (apply #'concat messages))) (defun lurk-highlight-context (context) @@ -520,7 +537,7 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-eval-msg-string (string) (if lurk-debug - (lurk-display-string nil string)) + (lurk-display-string nil nil string)) (let* ((msg (lurk-string->msg string))) (pcase (lurk-msg-cmd msg) ("PING" @@ -738,15 +755,42 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-display-message lurk-nick lurk-current-context string)) (lurk-display-error "No current context."))))) +(defvar lurk-history nil + "Commands and messages sent in current session.") + + (defun lurk-enter () "Enter current contents of line after prompt." (interactive) (with-current-buffer "*lurk*" (let ((line (buffer-substring lurk-input-marker (point-max)))) + (push line lurk-history) + (setq lurk-history-index nil) (let ((inhibit-read-only t)) (delete-region lurk-input-marker (point-max))) (lurk-enter-string line)))) +(defvar lurk-history-index nil) + +(defun lurk-history-cycle (delta) + (when lurk-history + (with-current-buffer "*lurk*" + (if lurk-history-index + (setq lurk-history-index + (max 0 + (min (- (length lurk-history) 1) + (+ delta lurk-history-index)))) + (setq lurk-history-index 0)) + (delete-region lurk-input-marker (point-max)) + (insert (elt lurk-history lurk-history-index))))) + +(defun lurk-history-next () + (interactive) + (lurk-history-cycle -1)) + +(defun lurk-history-prev () + (interactive) + (lurk-history-cycle +1)) ;;; Interactive functions ;; @@ -779,6 +823,7 @@ portion of the source component of the message, as LURK doesn't use this.") (unless (string-prefix-p "/" (buffer-substring start end)) (completion-in-region start end (lurk-get-context-users lurk-current-context)))))) + ;;; Mode ;; @@ -789,8 +834,16 @@ portion of the source component of the message, as LURK doesn't use this.") (define-key map (kbd "C-c C-z") 'lurk-toggle-zoom) (define-key map (kbd "") 'lurk-cycle-contexts-forward) (define-key map (kbd "") 'lurk-cycle-contexts-reverse) + (define-key map (kbd "") 'lurk-history-prev) + (define-key map (kbd "") 'lurk-history-next) + ;; (when (fboundp 'evil-define-key*) + ;; (evil-define-key* 'insert map + ;; (kbd "") 'lurk-history-prev + ;; (kbd "") 'lurk-history-next)) map)) +(defvar lurk-mode-map) + (define-derived-mode lurk-mode text-mode "lurk" "Major mode for LURK.")