Prefixes now have their own colours.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index b22ca85..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"
@@ -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 "<C-tab>") 'lurk-cycle-contexts-forward)
     (define-key map (kbd "<C-S-tab>") 'lurk-cycle-contexts-reverse)
+    (define-key map (kbd "<C-up>") 'lurk-history-prev)
+    (define-key map (kbd "<C-down>") 'lurk-history-next)
+    ;; (when (fboundp 'evil-define-key*)
+    ;;   (evil-define-key* 'insert map
+    ;;                     (kbd "<C-Up>") 'lurk-history-prev
+    ;;                     (kbd "<C-Down>") 'lurk-history-next))
     map))
 
+(defvar lurk-mode-map)
+
 (define-derived-mode lurk-mode text-mode "lurk"
   "Major mode for LURK.")