Told display-notice about the current context.

diff --git a/lurk.el b/lurk.el
index 06df515..82a43f2 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -6,7 +6,7 @@
 ;; Created: 14 June 2021
 ;; Version: 1.0
 ;; Keywords: network
-;; Homepage: http://thelambdalab.xyz/erc
+;; Homepage: http://thelambdalab.xyz/lurk
 ;; Package-Requires: ((emacs "26"))
 
 ;; This file is not part of GNU Emacs.
@@ -250,14 +250,9 @@ portion of the source component of the message, as LURK doesn't use this.")
        nil))))
 
 
-;;; Contexts and users
+;;; Contexts
 ;;
 
-(defvar lurk-context-table
-  '((channel lurk-display-channel-message)
-    (nick lurk-display-private-message)
-    (host lurk-diaplay-server-message)))
-
 (defvar lurk-current-context nil)
 (defvar lurk-contexts (make-hash-table :test #'equal))
 
@@ -324,6 +319,7 @@ portion of the source component of the message, as LURK doesn't use this.")
   (interactive)
   (lurk-cycle-contexts t))
 
+
 ;;; Buffer
 ;;
 
@@ -380,6 +376,7 @@ portion of the source component of the message, as LURK doesn't use this.")
 
 (defun lurk-setup-buffer ()
   (with-current-buffer (get-buffer-create "*lurk*")
+    (setq-local scroll-conservatively 1)
     (if (markerp lurk-prompt-marker)
         (set-marker lurk-prompt-marker (point-max))
       (setq lurk-prompt-marker (point-max-marker)))
@@ -394,40 +391,28 @@ portion of the source component of the message, as LURK doesn't use this.")
 ;;
 
 (defun lurk-display-message (from to text)
-  (let* ((to-type (lurk-get-context-type to))
-         (display-fun (cadr (assoc to-type lurk-context-table))))
-    (funcall display-fun from to text)))
-
-(defun lurk-display-channel-message (from to text)
-  (lurk-display-string
-   (propertize (concat to
-                       " <" from "> "
-                       text)
-               'face 'lurk-text)))
-               
-
-(defun lurk-display-action (channel-name nick action)
-  (lurk-display-string (concat channel-name
-                               " * "
-                               (propertize (concat nick " " action)
-                                           'face 'lurk-text))))
-
-(defun lurk-display-private-message (from to text)
+  (let ((context (if (equal from lirc-nick) to from)))
+    (lurk-display-string
+     (propertize
+      (pcase (lurk-get-context-type to)
+        ('channel (concat to " <" from "> " text))
+        ('nick (concat "[" from " -> " to "] " text))
+        (_
+         (error "Unsupported context type")))
+      'face 'lurk-text
+      'help-echo (concat "Context: " to)))))
+
+(defun lurk-display-notice (context &rest notices)
   (lurk-display-string
-   (concat
-    (propertize
-     (concat "[" from " -> " to "] "
-             text)
-     'face 'lurk-text))))
-        
-
-(defun lurk-display-notice (&rest notices)
-  (lurk-display-string lurk-notice-prefix " " (apply #'concat notices)))
+   (propertize
+    (concat lurk-notice-prefix " " (apply #'concat notices))
+    'help-echo (concat "Context: " (or context "none")))))
 
 (defun lurk-display-error (&rest messages)
-  (lurk-display-string lurk-error-prefix " "
-                       (propertize (apply #'concat messages)
-                                   'face 'lurk-error)))
+  (lurk-display-string
+   (concat lurk-error-prefix " "
+           (propertize (apply #'concat messages)
+                       'face 'lurk-error))))
 
 ;;; Message evaluation
 ;;
@@ -438,8 +423,11 @@ portion of the source component of the message, as LURK doesn't use this.")
     (pcase (lurk-msg-cmd msg)
       ("PING"
        (lurk-send-msg
-        (lurk-msg nil nil "PONG" (lurk-msg-params msg)))
-       (lurk-display-notice "ping-pong"))
+        (lurk-msg nil nil "PONG" (lurk-msg-params msg))))
+       ;; (lurk-display-notice nil "ping-pong (server initiated)"))
+
+      ("PONG")
+       ;; (lurk-display-notice nil "ping-pong (client initiated)"))
 
       ("353" ; NAMEREPLY
        (let* ((params (lurk-msg-params msg))
@@ -448,57 +436,57 @@ portion of the source component of the message, as LURK doesn't use this.")
          (lurk-add-context-users channel names)))
 
       ("366" ; ENDOFNAMES
-       (lurk-display-notice
+       (lurk-display-notice nil
         (lurk--as-string (length (lurk-get-context-users lurk-current-context)))
         " users in " lurk-current-context))
 
       ((rx (= 3 (any digit)))
-       (lurk-display-notice (mapconcat 'identity (cdr (lurk-msg-params msg)) " ")))
+       (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " ")))
 
       ((and "JOIN"
             (guard (equal lurk-nick (lurk-msg-src msg))))
-       (let ((channel-name (car (lurk-msg-params msg))))
-         (lurk-add-context channel-name)
-         (setq lurk-current-context channel-name)
-         (lurk-display-notice "Joining channel " channel-name)
+       (let ((channel (car (lurk-msg-params msg))))
+         (lurk-add-context channel)
+         (setq lurk-current-context channel)
+         (lurk-display-notice nil "Joining channel " channel)
          (lurk-render-prompt)))
 
       ("JOIN"
-       (let ((channel-name (car (lurk-msg-params msg)))
+       (let ((channel (car (lurk-msg-params msg)))
              (nick (lurk-msg-src msg)))
-         (lurk-add-context-users channel-name (list nick))
-         (lurk-display-notice nick " joined channel " channel-name)))
+         (lurk-add-context-users channel (list nick))
+         (lurk-display-notice channel nick " joined channel " channel)))
 
       ((and "PART"
             (guard (equal lurk-nick (lurk-msg-src msg))))
-       (let ((channel-name (car (lurk-msg-params msg))))
-         (lurk-display-notice "Left channel " channel-name)
-         (lurk-del-context channel-name)
-         (if (equal channel-name lurk-current-context)
+       (let ((channel (car (lurk-msg-params msg))))
+         (lurk-display-notice channel "Left channel " channel)
+         (lurk-del-context channel)
+         (if (equal channel lurk-current-context)
              (setq lurk-current-context (lurk-get-next-context)))
          (lurk-render-prompt)))
 
       ("PART"
-       (let ((channel-name (car (lurk-msg-params msg)))
+       (let ((channel (car (lurk-msg-params msg)))
              (nick (lurk-msg-src msg)))
-         (lurk-del-context-user channel-name nick)
-         (lurk-display-notice nick " left channel " channel-name)))
+         (lurk-del-context-user channel nick)
+         (lurk-display-notice channel nick " left channel " channel)))
 
       ("QUIT"
        (let ((nick (lurk-msg-src msg))
              (reason (mapconcat 'identity (lurk-msg-params msg) " ")))
          (lurk-del-user nick)
-         (lurk-display-notice nick " quit: " reason)))
+         (lurk-display-notice nil nick " quit: " reason)))
 
       ((and "NICK"
             (guard (equal lurk-nick (lurk-msg-src msg))))
        (setq lurk-nick (car (lurk-msg-params msg)))
-       (lurk-display-notice "Set nick to " lurk-nick))
+       (lurk-display-notice nil "Set nick to " lurk-nick))
 
       ("NICK"
        (let ((old-nick (lurk-msg-src msg))
              (new-nick (car (lurk-msg-params msg))))
-         (lurk-display-notice nick " is now known as " new-nick)
+         (lurk-display-notice nil nick " is now known as " new-nick)
          (lurk-rename-user nick new-nick)))
 
       ("NOTICE"
@@ -509,9 +497,9 @@ portion of the source component of the message, as LURK doesn't use this.")
            ((rx (: "\01VERSION "
                    (let version (* (not "\01")))
                    "\01"))
-            (lurk-display-notice "CTCP version reply from " nick ": " version))
+            (lurk-display-notice nil "CTCP version reply from " nick ": " version))
            (_
-            (lurk-display-notice text)))))
+            (lurk-display-notice nil text)))))
 
       ("PRIVMSG"
        (let* ((from (lurk-msg-src msg))
@@ -525,7 +513,7 @@ portion of the source component of the message, as LURK doesn't use this.")
                                        (list from (concat "\01VERSION "
                                                           version-string
                                                           "\01")))))
-            (lurk-display-notice "CTCP version request received from " from))
+            (lurk-display-notice nil "CTCP version request received from " from))
 
            ((rx (let ping (: "\01PING " (* (not "\01")) "\01")))
             (lurk-send-msg (lurk-msg nil nil "NOTICE" (list from ping)))
@@ -547,7 +535,7 @@ portion of the source component of the message, as LURK doesn't use this.")
   (if (string-prefix-p "/" string)
       (pcase (substring string 1)
         ((rx (: "CONNECT " (let network (* not-newline))))
-         (lurk-display-notice "Attempting to connect to " network "...")
+         (lurk-display-notice nil "Attempting to connect to " network "...")
          (lurk-connect network))
 
         ((rx (: "TOPIC " (let new-topic (* not-newline))))
@@ -562,7 +550,7 @@ portion of the source component of the message, as LURK doesn't use this.")
         ((rx (: "VERSION" " " (let nick (* (not whitespace)))))
          (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
                                   (list nick "\01VERSION\01")))
-         (lurk-display-notice "CTCP version request sent to " nick))
+         (lurk-display-notice nil "CTCP version request sent to " nick))
 
         ((rx "PART" (opt (: " " (let channel (* not-newline)))))
          (if (or lurk-current-context channel)