Zooming roughly works.

diff --git a/murk.el b/murk.el
index 1014c1e..2b21449 100644 (file)
--- a/murk.el
+++ b/murk.el
@@ -170,6 +170,7 @@ This includes the process and the response string.")
       (murk-display-error "Disconnected from server.")
       (murk-connection-remove server)
       (murk-remove-server-contexts server)
+      (murk-highlight-current-context)
       (murk-render-prompt))))
 
 (defun murk-start-process (server)
@@ -206,6 +207,7 @@ This includes the process and the response string.")
       (murk-send-msg server (murk-msg nil nil "USER" murk-default-nick 0 "*" murk-default-nick))
       (murk-send-msg server (murk-msg nil nil "NICK" murk-default-nick))
       (murk-add-context (list server))
+      (murk-highlight-current-context)
       (murk-render-prompt))))
 
 (defun murk-send-msg (server msg)
@@ -359,7 +361,7 @@ The head of this list is always the current context.")
       (murk-get-context server channel))))
 
 (defun murk-get-context (server &optional channel)
-  (if channel
+  (if (and channel (string-prefix-p "#" channel))
       (let ((test-ctx (list server channel)))
         (seq-find (lambda (ctx)
                     (equal (seq-take ctx 2) test-ctx))
@@ -394,7 +396,8 @@ The head of this list is always the current context.")
 
 (defun murk-del-server-user (server user)
   (dolist (ctx murk-contexts)
-    (if (equal (murk-context-server ctx) server)
+    (if (and (equal (murk-context-server ctx) server)
+             (not (murk-server-context-p ctx)))
         (murk-del-context-user ctx user))))
 
 (defun murk-rename-server-user (server old-nick new-nick)
@@ -477,6 +480,7 @@ The head of this list is always the current context.")
         (set-marker murk-input-marker (point-max))
       (setq murk-input-marker (point-max-marker)))
     (goto-char (point-max))
+    (murk-highlight-current-context)
     (murk-render-prompt)
     (if murk-display-header
         (murk-setup-header))))
@@ -491,6 +495,31 @@ The head of this list is always the current context.")
 ;;; Output formatting and highlighting
 ;;
 
+;; Idea: the face text property can be a list of faces, applied in
+;; order.  By assigning each context a unique list and keeping track
+;; of these in a hash table, we can easily switch the face
+;; corresponding to a particular context by modifying the elements of
+;; this list.
+;;
+;; More subtly, we make only the cdrs of this list shared among
+;; all text of a given context, allowing the cars to be different
+;; and for different elements of the context-specific text to have
+;; different styling.
+
+;; Additionally, we allow selective hiding of contexts via
+;; the buffer-invisibility-spec.
+
+(defvar murk-context-facelists (make-hash-table :test 'equal)
+  "List of seen contexts and associated face lists.")
+
+(defun murk-get-context-facelist (context)
+  (let* ((short-ctx (take 2 context))
+         (facelist (gethash short-ctx murk-context-facelists)))
+    (unless facelist
+      (setq facelist (list 'murk-text))
+      (puthash short-ctx facelist murk-context-facelists))
+    facelist))
+
 (defun murk--fill-strings (col indent &rest strings)
   (with-temp-buffer
     (setq buffer-invisibility-spec nil)
@@ -508,7 +537,11 @@ The head of this list is always the current context.")
              (old-pos (marker-position murk-prompt-marker))
              (padded-timestamp (concat (format-time-string "%H:%M ")))
              (padded-prefix (if prefix (concat prefix " ") ""))
-             (context-atom (if context (intern (murk-context->string context)) nil)))
+             (short-ctx (take 2 context))
+             (context-atom (if short-ctx
+                               (intern (murk-context->string short-ctx))
+                             nil))
+             (context-face (murk-get-context-facelist short-ctx)))
         (insert-before-markers
          (murk--fill-strings
           80
@@ -517,16 +550,17 @@ The head of this list is always the current context.")
           (propertize padded-timestamp
                       'face 'murk-timestamp
                       'read-only t
-                      'context context
+                      'context short-ctx
                       'invisible context-atom)
           (propertize padded-prefix
                       'read-only t
-                      'context context
+                      'context short-ctx
                       'invisible context-atom)
           (murk-add-formatting
            (propertize (concat (apply #'murk-buttonify-urls strings) "\n")
+                       'face context-face
                        'read-only t
-                       'context context
+                       'context short-ctx
                        'invisible context-atom)))))))
   (murk-scroll-windows-to-last-line))
 
@@ -536,9 +570,11 @@ The head of this list is always the current context.")
                    (murk-get-context server))))
     (murk-display-string
      context
-     (if (murk-server-context-p context)
-         (concat "[" from " -> " to "]")
-       (concat (murk-context->string context) " <" from ">"))
+     (propertize
+      (if (murk-server-context-p context)
+          (concat "[" from "->" to "]")
+        (concat (murk-context->string context) " <" from ">"))
+      'face (murk-get-context-facelist context))
      text)))
 
 (defun murk-display-action (server from to action-text)
@@ -562,6 +598,42 @@ The head of this list is always the current context.")
    (propertize murk-error-prefix 'face 'murk-error)
    (apply #'concat messages)))
 
+(defun murk-highlight-current-context ()
+  (maphash
+   (lambda (this-context facelist)
+     (if (equal (take 2 this-context) (take 2 (murk-current-context)))
+         (setcar facelist 'murk-text)
+       (setcar facelist 'murk-faded)))
+   murk-context-facelists)
+  (force-window-update "*murk*"))
+
+(defun murk-zoom-in (context)
+  (with-current-buffer "*murk*"
+    (maphash
+     (lambda (this-context _)
+       (when this-context
+         (let ((this-context-atom
+                (intern (murk-context->string this-context))))
+           (if (equal this-context (take 2 context))
+               (remove-from-invisibility-spec this-context-atom)
+             (add-to-invisibility-spec this-context-atom)))))
+     murk-context-facelists)
+    (force-window-update "*murk*"))
+  (murk-scroll-windows-to-last-line))
+
+(defun murk-zoom-out ()
+  (with-current-buffer "*murk*"
+    (maphash
+     (lambda (this-context _)
+       (let ((this-context-atom
+              (if this-context
+                  (intern (murk-context->string this-context))
+                nil)))
+         (remove-from-invisibility-spec this-context-atom)))
+     murk-context-facelists)
+    (force-window-update "*murk*"))
+  (murk-scroll-windows-to-last-line))
+
 (defun murk--start-of-final-line ()
   (with-current-buffer "*murk*"
     (save-excursion
@@ -617,7 +689,7 @@ The head of this list is always the current context.")
           (strikethrough nil)
           (prev-point (point)))
       (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F")
-                                        (: "\x03" (+ digit) (opt "," (* digit)))))
+                                        (: "\x03" (* digit) (opt "," (* digit)))))
                                 nil t)
         (let ((beg (+ (match-beginning 0) 1)))
           (if bold
@@ -663,7 +735,7 @@ The head of this list is always the current context.")
               (nick (elt params 0))
               (text (string-join (seq-drop params 1) " ")))
          (murk-set-connection-nick server nick)
-         (murk-display-notice nil text)))
+         (murk-display-notice (murk-get-context server) text)))
 
       ("353" ; NAMEREPLY
        (let* ((params (murk-msg-params msg))
@@ -700,7 +772,8 @@ The head of this list is always the current context.")
          (murk-display-notice ctx "Topic: " topic)))
 
       ((rx (= 3 (any digit)))
-       (murk-display-notice nil (mapconcat 'identity (cdr (murk-msg-params msg)) " ")))
+       (murk-display-notice (murk-get-context server)
+                            (mapconcat 'identity (cdr (murk-msg-params msg)) " ")))
 
       ((and "JOIN"
             (guard (equal (murk-connection-nick server)
@@ -709,6 +782,7 @@ The head of this list is always the current context.")
          (murk-add-context (list server channel nil))
          (murk-display-notice (murk-current-context)
                               "Joining channel " channel " on " server)
+         (murk-highlight-current-context)
          (murk-render-prompt)))
 
       ("JOIN"
@@ -726,6 +800,7 @@ The head of this list is always the current context.")
        (let ((channel (car (murk-msg-params msg))))
          (murk-display-notice (murk-current-context) "Left channel " channel)
          (murk-remove-context (list server channel))
+         (murk-highlight-current-context)
          (murk-render-prompt)))
 
       ("PART"
@@ -744,7 +819,8 @@ The head of this list is always the current context.")
              (old-nick (murk-connection-nick server)))
          (murk-set-connection-nick server new-nick)
          (murk-rename-server-user server old-nick new-nick)
-         (murk-display-notice nil "Nick set to " new-nick " on " server)))
+         (murk-display-notice (murk-get-context server)
+                              "Nick set to " new-nick " on " server)))
 
       ("NICK"
        (let ((old-nick (murk-msg-src msg))
@@ -765,7 +841,8 @@ The head of this list is always the current context.")
              (reason (mapconcat 'identity (murk-msg-params msg) " ")))
          (murk-del-server-user server nick)
          (if murk-show-joins
-             (murk-display-notice nil nick " quit: " reason))))
+             (murk-display-notice (murk-get-context server)
+                                  nick " quit: " reason))))
 
       ("NOTICE"
        (let ((nick (murk-msg-src msg))
@@ -778,7 +855,7 @@ The head of this list is always the current context.")
             (murk-display-notice (murk-get-context server)
                                  "CTCP version reply from " nick ": " version))
            (_
-            (murk-display-notice nil text)))))
+            (murk-display-notice (murk-get-context server channel) text)))))
 
       ("PRIVMSG"
        (let* ((from (murk-msg-src msg))
@@ -793,19 +870,23 @@ The head of this list is always the current context.")
                                        (list from (concat "\01VERSION "
                                                           version-string
                                                           "\01")))))
-            (murk-display-notice nil "CTCP version request received from "
+            (murk-display-notice (murk-get-context server)
+                                 "CTCP version request received from "
                                  from " on " server))
 
            ((rx (let ping (: "\01PING " (* (not "\01")) "\01")))
             (murk-send-msg server (murk-msg nil nil "NOTICE" (list from ping)))
-            (murk-display-notice nil "CTCP ping received from " from " on " server))
+            (murk-display-notice (murk-get-context server)
+                                 "CTCP ping received from " from " on " server))
 
            ("\01USERINFO\01"
-            (murk-display-notice nil "CTCP userinfo request from " from
+            (murk-display-notice (murk-get-context server)
+                                 "CTCP userinfo request from " from
                                  " on " server " (no response sent)"))
 
            ("\01CLIENTINFO\01"
-            (murk-display-notice nil "CTCP clientinfo request from " from
+            (murk-display-notice (murk-get-context server)
+                                 "CTCP clientinfo request from " from
                                  " on " server " (no response sent)"))
 
            ((rx (: "\01ACTION " (let action-text (* (not "\01"))) "\01"))
@@ -815,7 +896,8 @@ The head of this list is always the current context.")
             (murk-display-message server from to text)))))
 
       (_
-       (murk-display-notice nil (murk-msg->string msg))))))
+       (murk-display-notice (murk-get-context server)
+                            (murk-msg->string msg))))))
 
 ;;; Commands
 ;;
@@ -1100,12 +1182,29 @@ The head of this list is always the current context.")
 (defun murk-cycle-contexts-forward ()
   (interactive)
   (murk-cycle-contexts)
-  (murk-render-prompt))
+  (murk-highlight-current-context)
+  (murk-render-prompt)
+  (if murk-zoomed
+      (murk-zoom-in (murk-current-context))))
 
 (defun murk-cycle-contexts-reverse ()
   (interactive)
   (murk-cycle-contexts t)
-  (murk-render-prompt))
+  (murk-highlight-current-context)
+  (murk-render-prompt)
+  (if murk-zoomed
+      (murk-zoom-in (murk-current-context))))
+
+(defvar murk-zoomed nil
+  "Keeps track of zoom status.")
+
+(defun murk-toggle-zoom ()
+  (interactive)
+  (if murk-zoomed
+      (murk-zoom-out)
+    (murk-zoom-in (murk-current-context)))
+  (setq murk-zoomed (not murk-zoomed)))
+
 
 (defun murk-complete-input ()
   (interactive)
@@ -1144,6 +1243,7 @@ The head of this list is always the current context.")
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") 'murk-enter)
     (define-key map (kbd "TAB") 'murk-complete-input)
+    (define-key map (kbd "C-c C-z") 'murk-toggle-zoom)
     (define-key map (kbd "<C-up>") 'murk-history-prev)
     (define-key map (kbd "<C-down>") 'murk-history-next)
     (define-key map (kbd "<C-tab>") 'murk-cycle-contexts-forward)