From: Tim Vaughan Date: Tue, 6 Jul 2021 09:10:56 +0000 (+0200) Subject: Prefixes now have their own colours. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=lurk.git;a=commitdiff_plain;h=ba7686b1a43e46df7a790e7f546a0cd7ef7d6dfa Prefixes now have their own colours. --- diff --git a/lurk.el b/lurk.el index cad38b9..9563237 100644 --- a/lurk.el +++ b/lurk.el @@ -85,17 +85,21 @@ '((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.") @@ -343,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))) @@ -405,17 +409,26 @@ portion of the source component of the message, as LURK doesn't use this.") (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") " ") + (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) (propertize (concat (lurk-buttonify-urls (apply #'concat strings)) "\n") 'face (lurk-get-context-facelist context) 'read-only t @@ -428,10 +441,10 @@ portion of the source component of the message, as LURK doesn't use this.") to (if (equal to lurk-nick) from to)))) (lurk-display-string - context nil + 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))) @@ -441,20 +454,20 @@ portion of the source component of the message, as LURK doesn't use this.") to (if (equal to lurk-nick) from to)))) (lurk-display-string - context nil - "* " from " " action-text))) - + context + (concat "* " from) + action-text))) (defun lurk-display-notice (context &rest notices) (lurk-display-string - context nil - lurk-notice-prefix " " + context + (propertize lurk-notice-prefix 'face 'lurk-notice) (apply #'concat notices))) (defun lurk-display-error (&rest messages) (lurk-display-string - nil nil - lurk-error-prefix " " + nil + (propertize lurk-error-prefix 'face 'lurk-error) (apply #'concat messages))) (defun lurk-highlight-context (context)