Prefixes now have their own colours.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 0c9c31b..9563237 100644 (file)
--- 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"