Added autoload to main start procedure.

[lurk.git] / murk.el

diff --git a/murk.el b/murk.el
index 1cab898..373b7c1 100644 (file)
--- a/murk.el
+++ b/murk.el
@@ -1,13 +1,13 @@
-;;; MURK --- Multiserver Unibuffer iRc Klient -*- lexical-binding:t -*-
+;;; murk.el --- Multiserver Unibuffer iRc Klient -*- lexical-binding:t -*-

 
 ;; Copyright (C) 2024 plugd
 
 ;; Author: plugd <plugd@thelambdalab.xyz>
 ;; Created: 11 May 2024
 ;; Version: 0.0
 
 ;; Copyright (C) 2024 plugd
 
 ;; Author: plugd <plugd@thelambdalab.xyz>
 ;; Created: 11 May 2024
 ;; Version: 0.0

-;; Keywords: network

 ;; Homepage: http://thelambdalab.xyz/murk
 ;; Homepage: http://thelambdalab.xyz/murk

-;; Package-Requires: ((emacs "26"))
+;; Keywords: comm
+;; Package-Requires: ((emacs "26.1"))

 
 ;; This file is not part of GNU Emacs.
 
 
 ;; This file is not part of GNU Emacs.
 


@@ -26,10 +26,14 @@
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

+;; A very simple IRC server which uses only a single buffer.
+

 ;;; Code:
 
 (provide 'murk)
 
 ;;; Code:
 
 (provide 'murk)
 

+(require 'cl-lib)
+

 
 ;;; Customizations
 
 
 ;;; Customizations
 


@@ -37,24 +41,81 @@
   "Multiserver Unibuffer iRc Klient"
   :group 'network)
 
   "Multiserver Unibuffer iRc Klient"
   :group 'network)
 

-(defcustom murk-nick "plugd"
-  "Default nick.")
+(defcustom murk-default-nick "plugd"
+  "Default nick."
+  :type '(string))

 
 (defcustom murk-default-quit-msg "Bye"
 
 (defcustom murk-default-quit-msg "Bye"

-  "Default quit message when none supplied.")
+  "Default quit message when none supplied."
+  :type '(string))

 
 (defcustom murk-networks
 
 (defcustom murk-networks

-  '(("libera" "irc.libera.chat" 6697)
-    ("tilde" "tilde.chat" 6697))
-  "IRC networks.")
+  '(("debug" "localhost" 6697)
+    ("libera" "irc.libera.chat" 6697)
+    ("tilde" "tilde.chat" 6697)
+    ("sdf" "irc.sdf.org" 6697)
+    ("freenode" "chat.freenode.net" 6697)
+    ("mbr" "mbrserver.com" 6667 :notls))
+  "IRC networks."
+  :type '(alist :key-type string))
+
+(defcustom murk-show-joins nil
+  "Set to non-nil to be notified of joins, parts and quits.")

 
 (defcustom murk-display-header t
 
 (defcustom murk-display-header t

-  "If non-nil, use buffer header to display information on current host and channel.")
+  "If non-nil, use buffer header to display current host and channel."
+  :type '(boolean))
+
+(defcustom murk-autoreply-table nil
+  "Table of autoreply messages.
+
+Each autoreply is a list of two elements: (matcher reply)
+
+Here matcher is a list:
+
+(network src cmd params ...)
+
+and reply is another list:
+
+ (cmd params ...)
+
+Each entry in the matcher list is a regular expression tested against the
+corresponding values in the incomming message.  Entries can be nil,
+in which case they match anything."
+  :type '(list (list) (list)))

 
 
 ;;; Faces
 ;;
 
 
 
 ;;; Faces
 ;;
 

+(defface murk-text
+  '((t :inherit default))
+  "Face used for murk text.")
+
+(defface murk-prompt
+  '((t :inherit font-lock-keyword-face))
+  "Face used for the prompt.")
+
+(defface murk-context
+  '((t :inherit murk-context))
+  "Face used for the context name in the prompt.")
+
+(defface murk-faded
+  '((t :inherit shadow))
+  "Face used for faded murk text.")
+
+(defface murk-timestamp
+  '((t :inherit shadow))
+  "Face used for timestamps.")
+
+(defface murk-error
+  '((t :inherit error))
+  "Face used for murk error text.")
+
+(defface murk-notice
+  '((t :inherit warning))
+  "Face used for murk notice text.")
+

 
 ;;; Global variables
 ;;
 
 ;;; Global variables
 ;;


@@ -66,6 +127,10 @@
 (defvar murk-error-prefix "!!!")
 (defvar murk-prompt-string ">")
 
 (defvar murk-error-prefix "!!!")
 (defvar murk-prompt-string ">")
 

+(defvar murk-debug nil
+  "If non-nil, enable debug mode.")
+
+

 ;;; Utility procedures
 ;;
 
 ;;; Utility procedures
 ;;
 


@@ -77,6 +142,7 @@
       (with-output-to-string (princ obj))
     nil))
 
       (with-output-to-string (princ obj))
     nil))
 

+

 ;;; Network processes
 ;;
 
 ;;; Network processes
 ;;
 


@@ -87,30 +153,43 @@ This includes the process and the response string.")
 (defun murk-connection-process (server)
   (elt (assoc server murk-connection-table) 1))
 
 (defun murk-connection-process (server)
   (elt (assoc server murk-connection-table) 1))
 

-(defun murk-connection-response (server)
+(defun murk-connection-nick (server)

   (elt (assoc server murk-connection-table) 2))
 
   (elt (assoc server murk-connection-table) 2))
 

+(defun murk-set-connection-nick (server nick)
+  (setf (elt (assoc server murk-connection-table) 2) nick))
+
+(defun murk-connection-response (server)
+  (elt (assoc server murk-connection-table) 3))
+

 (defun murk-set-connection-response (server string)
 (defun murk-set-connection-response (server string)

-  (setf (elt (assoc server murk-connection-table) 2) string))
+  (setf (elt (assoc server murk-connection-table) 3) string))

 
 

-(defun murk-connection-close (server)
-  (setq murk-connection-table (assoc-delete-all server murk-connection-table)))
+(defun murk-connection-new (server process nick)
+  (add-to-list 'murk-connection-table
+               (list server process nick "")))
+
+(defun murk-connection-remove (server)
+  (setq murk-connection-table
+        (seq-remove (lambda (row) (equal (car row) server))
+                    murk-connection-table)))

 
 (defun murk-make-server-filter (server)
 
 (defun murk-make-server-filter (server)

-  (lambda (proc string)
+  (lambda (_proc string)

     (dolist (line (split-string (concat (murk-connection-response server) string)
                                 "\n"))
       (if (string-suffix-p "\r" line)
           (murk-eval-msg-string server (string-trim line))
     (dolist (line (split-string (concat (murk-connection-response server) string)
                                 "\n"))
       (if (string-suffix-p "\r" line)
           (murk-eval-msg-string server (string-trim line))

-        (murk-set-connection-response line)))))
+        (murk-set-connection-response server line)))))

 
 (defun murk-make-server-sentinel (server)
 
 (defun murk-make-server-sentinel (server)

-  (lambda (proc string)
+  (lambda (_proc string)

     (unless (equal "open" (string-trim string))
       (murk-display-error "Disconnected from server.")
     (unless (equal "open" (string-trim string))
       (murk-display-error "Disconnected from server.")

-      (murk-remove-contexts-for-server server)
-      (murk-render-prompt)
-      (murk-connection-close server))))
+      (murk-connection-remove server)
+      (murk-remove-server-contexts server)
+      (murk-highlight-current-context)
+      (murk-render-prompt))))

 
 (defun murk-start-process (server)
   (let* ((row (assoc server murk-networks))
 
 (defun murk-start-process (server)
   (let* ((row (assoc server murk-networks))


@@ -138,14 +217,16 @@ This includes the process and the response string.")
 
 (defun murk-connect (server)
   (if (assoc server murk-connection-table)
 
 (defun murk-connect (server)
   (if (assoc server murk-connection-table)

-      (murk-display-error "Already connected to this network.")
+      (murk-display-error "Already connected to this network")

     (if (not (assoc server murk-networks))
         (murk-display-error "Network '" server "' is unknown.")
       (let ((proc (murk-start-process server)))
     (if (not (assoc server murk-networks))
         (murk-display-error "Network '" server "' is unknown.")
       (let ((proc (murk-start-process server)))

-        (add-to-list murk-connection-table
-                     (list server proc "")))
-      (murk-send-msg server (murk-msg nil nil "USER" murk-nick 0 "*" murk-nick))
-      (murk-send-msg server (murk-msg nil nil "NICK" murk-nick)))))
+        (murk-connection-new server proc murk-default-nick))
+      (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)
   (if murk-debug
 
 (defun murk-send-msg (server msg)
   (if murk-debug


@@ -153,8 +234,8 @@ This includes the process and the response string.")
   (let ((proc (murk-connection-process server)))
     (if (and proc (eq (process-status proc) 'open))
         (process-send-string proc (concat (murk-msg->string msg) "\r\n"))
   (let ((proc (murk-connection-process server)))
     (if (and proc (eq (process-status proc) 'open))
         (process-send-string proc (concat (murk-msg->string msg) "\r\n"))

-      (murk-display-error "No server connection established.")
-      (error "No server connection established"))))
+      (murk-display-error "No server connection established"))))
+

 
 ;;; Server messages
 ;;
 
 ;;; Server messages
 ;;


@@ -199,13 +280,13 @@ portion of the source component of the message, as mURK doesn't use this.")
              (params-str (match-string 4 string))
              (params
               (if params-str
              (params-str (match-string 4 string))
              (params
               (if params-str

-                  (let* ((idx (cl-search ":" params-str))
+                  (let* ((idx (seq-position params-str ?:))

                          (l (split-string (string-trim (substring params-str 0 idx))))
                          (r (if idx (list (substring params-str (+ 1 idx))) nil)))
                     (append l r))
                 nil)))
         (apply #'murk-msg (append (list tags src cmd) params)))
                          (l (split-string (string-trim (substring params-str 0 idx))))
                          (r (if idx (list (substring params-str (+ 1 idx))) nil)))
                     (append l r))
                 nil)))
         (apply #'murk-msg (append (list tags src cmd) params)))

-    (error "Failed to parse string " string)))
+    (error "Failed to parse string %s" string)))

 
 (defun murk-msg->string (msg)
   (let ((tags (murk-msg-tags msg))
 
 (defun murk-msg->string (msg)
   (let ((tags (murk-msg-tags msg))


@@ -224,12 +305,12 @@ portion of the source component of the message, as mURK doesn't use this.")
        nil))))
 
 
        nil))))
 
 

-;;; Contexts and Servers
+;;; Contexts

 ;;
 
 ;;
 

-;; A context is a list (server name ...) where name is a string
-;; representing either a channel name or nick, and server is a symbol
-;; identifying the server.
+;; A context is a list (server channel users) identifying the server
+;; and channel.  The tail of the list contains the nicks of users
+;; present in the channel.

 ;;
 ;; Each server has a special context (server) used for messages
 ;; to/from the server itself.
 ;;
 ;; Each server has a special context (server) used for messages
 ;; to/from the server itself.


@@ -239,17 +320,120 @@ portion of the source component of the message, as mURK doesn't use this.")
 The head of this list is always the current context.")
 
 (defun murk-current-context ()
 The head of this list is always the current context.")
 
 (defun murk-current-context ()

-  "Returns the current context."
+  "Return the current context."

   (if murk-contexts
       (car murk-contexts)
     nil))
 
   (if murk-contexts
       (car murk-contexts)
     nil))
 

-(defun murk-context-server (ctx) (elt ctx 0))
-(defun murk-context-name (ctx) (elt ctx 1))
+(defun murk-contexts-equal (c1 c2)
+  (if (murk-server-context-p c1)
+      (and (murk-server-context-p c2)
+           (equal (murk-context-server c1)
+                  (murk-context-server c2)))
+    (and (not (murk-server-context-p c2))
+         (equal (seq-take c1 2)
+                (seq-take c2 2)))))
+
+(defun murk-context-server (ctx)
+  (elt ctx 0))
+
+(defun murk-context-channel (ctx)
+  (elt ctx 1))
+
+(defun murk-context-users (ctx)
+  (elt ctx 2))
+
+(defun murk-set-context-users (ctx users)
+  (setcar (cddr ctx) users))
+
+(defun murk-server-context-p (ctx)
+  (not (cdr ctx)))
+
+(defun murk-add-context (ctx)
+  (add-to-list 'murk-contexts ctx))
+
+(defun murk-remove-context (ctx)
+  (setq murk-contexts
+        (seq-remove
+         (lambda (this-ctx)
+           (murk-contexts-equal this-ctx ctx))
+         murk-contexts)))
+
+(defun murk-remove-server-contexts (server)
+  (setq murk-contexts
+        (seq-remove (lambda (row) (equal (car row) server))
+                    murk-contexts)))
+
+(defun murk-context->string (ctx)
+   (if (murk-server-context-p ctx)
+       (concat "[" (murk-context-server ctx) "]")
+     (concat (murk-context-channel ctx) "@"
+             (murk-context-server ctx))))
+
+(defun murk-string->context (string)
+  (if (not (string-prefix-p "#" string))
+      (murk-get-context string)
+    (let* ((parts (string-split string "@"))
+           (channel (elt parts 0))
+           (server (elt parts 1)))
+      (murk-get-context server channel))))
+
+(defun murk-get-context (server &optional 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))
+                  murk-contexts))
+    (car (member (list server) murk-contexts))))
+
+(defun murk-cycle-contexts (&optional reverse)
+  (setq murk-contexts
+        (if reverse
+            (let ((nminus1 (- (length murk-contexts) 1)))
+              (cons
+               (elt murk-contexts nminus1)
+               (seq-take murk-contexts nminus1)))
+          (append (cdr murk-contexts) (list (car murk-contexts))))))
+
+(defun murk-switch-to-context (ctx)
+  (setq murk-contexts
+        (let* ((new-head (memq ctx murk-contexts))
+               (new-tail (take (- (length murk-contexts)
+                                  (length new-head)))))
+          (append new-head new-tail))))
+
+(defun murk-add-context-users (ctx users)
+  (murk-set-context-users
+   ctx
+   (cl-union users (murk-context-users ctx))))
+
+(defun murk-del-context-user (ctx user)
+  (murk-set-context-users
+   ctx
+   (delete user (murk-context-users ctx))))
+
+(defun murk-del-server-user (server user)
+  (dolist (ctx murk-contexts)
+    (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)
+  (dolist (ctx murk-contexts)
+    (when (and (equal (murk-context-server ctx) server)
+               (member old-nick (murk-context-users ctx)))
+      (murk-del-context-user ctx old-nick)
+      (murk-add-context-users ctx (list new-nick)))))

 
 ;;; Buffer
 ;;
 
 
 ;;; Buffer
 ;;
 

+(defvar murk-prompt-marker nil
+  "Marker for prompt position in murk buffer.")
+
+(defvar murk-input-marker nil
+  "Marker for prompt position in murk buffer.")
+

 (defun murk-render-prompt ()
   (with-current-buffer "*murk*"
     (let ((update-point (= murk-input-marker (point)))
 (defun murk-render-prompt ()
   (with-current-buffer "*murk*"
     (let ((update-point (= murk-input-marker (point)))


@@ -266,8 +450,8 @@ The head of this list is always the current context.")
           (insert
            (propertize (let ((ctx (murk-current-context)))
                          (if ctx
           (insert
            (propertize (let ((ctx (murk-current-context)))
                          (if ctx

-                           (concat (murk-context-name) "@" (murk-context-server ctx))
-                         ""))
+                             (murk-context->string ctx)
+                           ""))

                        'face 'murk-context
                        'read-only t)
            (propertize murk-prompt-string
                        'face 'murk-context
                        'read-only t)
            (propertize murk-prompt-string


@@ -283,15 +467,25 @@ The head of this list is always the current context.")
         (if (car v)
             (set-window-point (cadr v) murk-input-marker))))))
   
         (if (car v)
             (set-window-point (cadr v) murk-input-marker))))))
   

-(defvar murk-prompt-marker nil
-  "Marker for prompt position in murk buffer.")
-
-(defvar murk-input-marker nil
-  "Marker for prompt position in murk buffer.")
-

 (defun murk-setup-header ()
 (defun murk-setup-header ()

-  ;; To do
-  )
+  (with-current-buffer "*murk*"
+    (setq-local header-line-format
+                '((:eval
+                   (let* ((ctx (murk-current-context)))
+                     (if ctx
+                         (let ((server (murk-context-server ctx)))
+                           (concat
+                            "Network: " server ", "
+                            (if (murk-server-context-p ctx)
+                                "Server"
+                              (concat
+                               "Channel: "
+                               (murk-context-channel ctx)
+                               " ("
+                               (number-to-string
+                                (length (murk-context-users ctx)))
+                               ")"))))
+                       "No connection")))))))

 
 (defun murk-setup-buffer ()
   (with-current-buffer (get-buffer-create "*murk*")
 
 (defun murk-setup-buffer ()
   (with-current-buffer (get-buffer-create "*murk*")


@@ -304,6 +498,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))
         (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))))
     (murk-render-prompt)
     (if murk-display-header
         (murk-setup-header))))


@@ -318,6 +513,31 @@ The head of this list is always the current context.")
 ;;; Output formatting and highlighting
 ;;
 
 ;;; 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)
 (defun murk--fill-strings (col indent &rest strings)
   (with-temp-buffer
     (setq buffer-invisibility-spec nil)


@@ -327,12 +547,6 @@ The head of this list is always the current context.")
       (fill-region (point-min) (point-max) nil t)
       (buffer-string))))
 
       (fill-region (point-min) (point-max) nil t)
       (buffer-string))))
 

-(defun murk-context->string (context)
-  (if context
-      (concat (murk-context-name) "@" (murk-context-server context))
-    nil))
-
-

 (defun murk-display-string (context prefix &rest strings)
   (with-current-buffer "*murk*"
     (save-excursion
 (defun murk-display-string (context prefix &rest strings)
   (with-current-buffer "*murk*"
     (save-excursion


@@ -341,7 +555,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 " ") ""))
              (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
         (insert-before-markers
          (murk--fill-strings
           80


@@ -350,13 +568,90 @@ The head of this list is always the current context.")
           (propertize padded-timestamp
                       'face 'murk-timestamp
                       'read-only t
           (propertize padded-timestamp
                       'face 'murk-timestamp
                       'read-only t

-                      'context context
+                      'context short-ctx

                       'invisible context-atom)
           (propertize padded-prefix
                       'read-only t
                       'invisible context-atom)
           (propertize padded-prefix
                       'read-only t

-                      'context context
+                      'context short-ctx

                       'invisible context-atom)
                       'invisible context-atom)

-          (concat (apply #'murk-buttonify-urls strings) "\n"))))))
+          (murk-add-formatting
+           (propertize (concat (apply #'murk-buttonify-urls strings) "\n")
+                       'face context-face
+                       'read-only t
+                       'context short-ctx
+                       'invisible context-atom)))))))
+  (murk-scroll-windows-to-last-line))
+
+(defun murk-display-message (server from to text)
+  (let ((context (if (string-prefix-p "#" to)
+                     (murk-get-context server to)
+                   (murk-get-context server))))
+    (murk-display-string
+     context
+     (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)
+  (let ((context (if (string-prefix-p "#" to)
+                     (murk-get-context server to)
+                   (murk-get-context server))))
+    (murk-display-string
+     context
+     (propertize
+      (concat (murk-context->string context) " *")
+      'face (murk-get-context-facelist context))
+     from " " action-text)))
+
+(defun murk-display-notice (context &rest notices)
+  (murk-display-string
+   context
+   (propertize murk-notice-prefix 'face 'murk-notice)
+   (apply #'concat notices)))
+
+(defun murk-display-error (&rest messages)
+  (murk-display-string
+   nil
+   (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 ()
   (murk-scroll-windows-to-last-line))
 
 (defun murk--start-of-final-line ()


@@ -404,6 +699,595 @@ The head of this list is always the current context.")
                           'help-echo "Open URL in browser.")))
     (buffer-string)))
 
                           'help-echo "Open URL in browser.")))
     (buffer-string)))
 

+(defun murk-add-formatting (string)
+  (with-temp-buffer
+    (insert string)
+    (goto-char (point-min))
+    (let ((bold nil)
+          (italics nil)
+          (underline nil)
+          (strikethrough nil)
+          (prev-point (point)))
+      (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F")
+                                        (: "\x03" (* digit) (opt "," (* digit)))))
+                                nil t)
+        (let ((beg (+ (match-beginning 0) 1)))
+          (if bold
+              (add-face-text-property prev-point beg '(:weight bold)))
+          (if italics
+              (add-face-text-property prev-point beg '(:slant italic)))
+          (if underline
+              (add-face-text-property prev-point beg '(:underline t)))
+          (if strikethrough
+              (add-face-text-property prev-point beg '(:strike-through t)))
+          (pcase (match-string 0)
+            ("\x02" (setq bold (not bold)))
+            ("\x1D" (setq italics (not italics)))
+            ("\x1F" (setq underline (not underline)))
+            ("\x1E" (setq strikethrough (not strikethrough)))
+            ("\x0F" ; Reset
+             (setq bold nil)
+             (setq italics nil)
+             (setq underline nil)
+             (setq strikethrough nil))
+            (_))
+          (delete-region (match-beginning 0) (match-end 0))
+          (setq prev-point (point)))))
+    (buffer-string)))
+
+
+;;; Message evaluation
+;;
+
+(defun murk-eval-msg-string (server string)
+  (if murk-debug
+      (murk-display-string nil nil string))
+  (let* ((msg (murk-string->msg string)))
+    (murk-process-autoreplies server msg)
+    (pcase (murk-msg-cmd msg)
+      ("PING"
+       (murk-send-msg server
+        (murk-msg nil nil "PONG" (murk-msg-params msg))))
+
+      ("PONG")
+
+      ("001" ; RPL_WELCOME
+       (let* ((params (murk-msg-params msg))
+              (nick (elt params 0))
+              (text (string-join (seq-drop params 1) " ")))
+         (murk-set-connection-nick server nick)
+         (murk-display-notice (murk-get-context server) text)))
+
+      ("353" ; NAMEREPLY
+       (let* ((params (murk-msg-params msg))
+              (channel (elt params 2))
+              (names (split-string (elt params 3)))
+              (ctx (murk-get-context server channel)))
+         (if ctx
+             (murk-add-context-users ctx names)
+           (murk-display-notice nil "Users in " channel
+                                ": " (string-join names " ")))))
+
+      ("366" ; ENDOFNAMES
+       (let* ((params (murk-msg-params msg))
+              (channel (elt params 1))
+              (ctx (murk-get-context server channel)))
+         (if ctx
+             (murk-display-notice
+              ctx
+              (murk--as-string (length (murk-context-users ctx)))
+              " users in " channel)
+           (murk-display-notice nil "End of " channel " names list."))))
+
+      ("331" ; RPL_NOTOPIC
+       (let* ((params (murk-msg-params msg))
+              (channel (elt params 1))
+              (ctx (murk-get-context server channel)))
+         (murk-display-notice ctx "No topic set.")))
+
+      ("332" ; RPL_TOPIC
+       (let* ((params (murk-msg-params msg))
+              (channel (elt params 1))
+              (topic (elt params 2))
+              (ctx (murk-get-context server channel)))
+         (murk-display-notice ctx "Topic: " topic)))
+
+      ((rx (= 3 (any digit)))
+       (murk-display-notice (murk-get-context server)
+                            (mapconcat 'identity (cdr (murk-msg-params msg)) " ")))
+
+      ((and "JOIN"
+            (guard (equal (murk-connection-nick server)
+                          (murk-msg-src msg))))
+       (let ((channel (car (murk-msg-params msg))))
+         (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"
+       (let* ((channel (car (murk-msg-params msg)))
+              (nick (murk-msg-src msg))
+              (ctx (murk-get-context server channel)))
+         (murk-add-context-users ctx (list nick))
+         (if murk-show-joins
+             (murk-display-notice ctx nick " joined channel " channel
+                                  " on " server))))
+
+      ((and "PART"
+            (guard (equal (murk-connection-nick server)
+                          (murk-msg-src msg))))
+       (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"
+       (let* ((channel (car (murk-msg-params msg)))
+              (nick (murk-msg-src msg))
+              (ctx (murk-get-context server channel)))
+         (murk-del-context-user ctx nick)
+         (if murk-show-joins
+             (murk-display-notice ctx nick " left channel " channel
+                                  " on " server))))
+
+      ((and "NICK"
+            (guard (equal (murk-connection-nick server)
+                          (murk-msg-src msg))))
+       (let ((new-nick (car (murk-msg-params msg)))
+             (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 (murk-get-context server)
+                              "Nick set to " new-nick " on " server)))
+
+      ("NICK"
+       (let ((old-nick (murk-msg-src msg))
+             (new-nick (car (murk-msg-params msg))))
+         (murk-display-notice nil old-nick " is now known as " new-nick
+                              " on " server)
+         (murk-rename-server-user server old-nick new-nick)))
+
+      ("TOPIC"
+       (let ((channel (car (murk-msg-params msg)))
+             (nick (murk-msg-src msg))
+             (topic (cadr (murk-msg-params msg))))
+         (murk-display-notice (murk-get-context server channel)
+                              nick " set the topic: " topic)))
+
+      ("QUIT"
+       (let ((nick (murk-msg-src msg))
+             (reason (mapconcat 'identity (murk-msg-params msg) " ")))
+         (murk-del-server-user server nick)
+         (if murk-show-joins
+             (murk-display-notice (murk-get-context server)
+                                  nick " quit: " reason))))
+
+      ("NOTICE"
+       (let ((nick (murk-msg-src msg))
+             (channel (car (murk-msg-params msg)))
+             (text (cadr (murk-msg-params msg))))
+         (pcase text
+           ((rx (: "\01VERSION "
+                   (let version (* (not "\01")))
+                   "\01"))
+            (murk-display-notice (murk-get-context server)
+                                 "CTCP version reply from " nick ": " version))
+           (_
+            (murk-display-notice (murk-get-context server channel) text)))))
+
+      ("PRIVMSG"
+       (let* ((from (murk-msg-src msg))
+              (params (murk-msg-params msg))
+              (to (car params))
+              (text (cadr params)))
+         (pcase text
+           ("\01VERSION\01"
+            (let ((version-string (concat murk-version " - running on GNU Emacs " emacs-version)))
+              (murk-send-msg server
+                             (murk-msg nil nil "NOTICE"
+                                       (list from (concat "\01VERSION "
+                                                          version-string
+                                                          "\01")))))
+            (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 (murk-get-context server)
+                                 "CTCP ping received from " from " on " server))
+
+           ("\01USERINFO\01"
+            (murk-display-notice (murk-get-context server)
+                                 "CTCP userinfo request from " from
+                                 " on " server " (no response sent)"))
+
+           ("\01CLIENTINFO\01"
+            (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"))
+            (murk-display-action server from to action-text))
+
+           (_
+            (murk-display-message server from to text)))))
+
+      (_
+       (murk-display-notice (murk-get-context server)
+                            (murk-msg->string msg))))))
+
+
+;;; User-defined responses
+;;
+
+(defun murk--lists-equal (l1 l2)
+    (if (and l1 l2)
+        (if (or (not (and (car l1) (car l2)))
+                (string-match (car l1) (car l2)))
+            (murk--lists-equal (cdr l1) (cdr l2))
+          nil)
+      t))
+
+(defun murk-process-autoreply (server msg autoreply)
+  (let ((matcher (car autoreply))
+        (reply (cadr autoreply)))
+    (let ((target-server (car matcher)))
+      (when (and (or (not target-server)
+                     (and (equal server target-server)))
+                 (murk--lists-equal (cdr matcher)
+                                    (append (list (murk-msg-src msg)
+                                                  (murk-msg-cmd msg))
+                                            (murk-msg-params msg))))
+        (murk-send-msg server
+         (murk-msg nil nil (car reply) (cdr reply)))))))
+
+(defun murk-process-autoreplies (server msg)
+  (mapc
+   (lambda (autoreply)
+     (murk-process-autoreply server msg autoreply))
+   murk-autoreply-table))
+
+
+;;; Commands
+;;
+
+(defvar murk-command-table
+  '(("DEBUG" "Toggle debug mode on/off." murk-command-debug murk-boolean-completions)
+    ("HEADER" "Toggle display of header." murk-command-header murk-boolean-completions)
+    ("SHOWJOINS" "Toggles display of joins/parts." murk-command-showjoins murk-boolean-completions)
+    ("NETWORKS" "List known IRC networks." murk-command-networks)
+    ("CONNECT" "Connect to an IRC network." murk-command-connect murk-network-completions)
+    ("QUIT" "Disconnect from current network." murk-command-quit)
+    ("JOIN" "Join one or more channels." murk-command-join)
+    ("PART" "Leave channel." murk-command-part murk-context-completions)
+    ("NICK" "Change nick." murk-command-nick)
+    ("LIST" "Display details of one or more channels." murk-command-list)
+    ("TOPIC" "Set/query topic for current channel." murk-command-topic)
+    ("USERS" "List nicks of users in current context." murk-command-users)
+    ("MSG" "Send private message to user." murk-command-msg murk-nick-completions)
+    ("ME" "Display action." murk-command-me)
+    ("VERSION" "Request version of another user's client via CTCP." murk-command-version murk-nick-completions)
+    ("CLEAR" "Clear buffer text." murk-command-clear murk-context-completions)
+    ("HELP" "Display help on client commands." murk-command-help murk-help-completions))
+  "Table of commands explicitly supported by murk.")
+
+(defun murk-boolean-completions ()
+  '("on" "off"))
+
+(defun murk-network-completions ()
+  (mapcar (lambda (row) (car row)) murk-networks))
+
+(defun murk-command-help (params)
+  (if params
+      (let* ((cmd-str (upcase (car params)))
+             (row (assoc cmd-str murk-command-table #'equal)))
+        (if row
+            (progn
+              (murk-display-notice nil "Help for \x02" cmd-str "\x02:")
+              (murk-display-notice nil "  " (elt row 1)))
+          (murk-display-notice nil "No such (client-interpreted) command.")))
+    (murk-display-notice nil "Client-interpreted commands:")
+    (dolist (row murk-command-table)
+      (murk-display-notice nil "  \x02" (elt row 0) "\x02: " (elt row 1)))
+    (murk-display-notice nil "Use /HELP COMMAND to display information about a specific command.")))
+
+(defun murk-command-debug (params)
+  (setq murk-debug 
+        (if params
+            (if (equal (upcase (car params)) "ON")
+                t
+              nil)
+          (not murk-debug)))
+  (murk-display-notice nil "Debug mode now " (if murk-debug "on" "off") "."))
+
+(defun murk-command-header (params)
+  (if
+      (if params
+          (equal (upcase (car params)) "ON")
+        (not header-line-format))
+      (progn
+        (murk-setup-header)
+        (murk-display-notice nil "Header enabled."))
+    (setq-local header-line-format nil)
+    (murk-display-notice nil "Header disabled.")))
+
+(defun murk-command-showjoins (params)
+  (setq murk-show-joins 
+        (if params
+            (if (equal (upcase (car params)) "ON")
+                t
+              nil)
+          (not murk-show-joins)))
+  (murk-display-notice nil "Joins/parts will now be "
+                       (if murk-show-joins "shown" "hidden") "."))
+
+(defun murk-command-connect (params)
+  (if params
+      (let ((network (car params)))
+        (murk-display-notice nil "Attempting to connect to " network "...")
+        (murk-connect network))
+    (murk-display-notice nil "Usage: /connect <network>")))
+
+(defun murk-command-networks (_params)
+  (murk-display-notice nil "Currently-known networks:")
+  (dolist (row murk-networks)
+    (seq-let (network server port &rest _others) row
+      (murk-display-notice nil "\t" network
+                           " [" server
+                           " " (number-to-string port) "]")))
+  (murk-display-notice nil "(Modify the `murk-networks' variable to add more.)"))
+
+(defun murk-command-quit (params)
+  (let ((ctx (murk-current-context)))
+    (if (not ctx)
+        (murk-display-error "No current server")
+      (let ((quit-msg (if params (string-join params " ") murk-default-quit-msg)))
+        (murk-send-msg
+         (murk-context-server ctx)
+         (murk-msg nil nil "QUIT" quit-msg))))))
+
+(defun murk-command-join (params)
+  (if params
+      (let ((server (murk-context-server (murk-current-context))))
+        (dolist (channel params)
+          (murk-send-msg server (murk-msg nil nil "JOIN" channel))))
+    (murk-display-notice nil "Usage: /join channel [channel2 ...]")))
+
+(defun murk-command-part (params)
+  (let* ((server (murk-context-server (murk-current-context)))
+         (channel (if params
+                      (car params)
+                    (murk-context-channel (murk-current-context)))))
+    (if channel
+        (murk-send-msg server (murk-msg nil nil "PART" channel))
+      (murk-display-error "No current channel to leave"))))
+
+(defun murk-command-nick (params)
+  (if params
+      (let ((new-nick (string-join params " "))
+            (ctx (murk-current-context)))
+        (if ctx
+            (murk-send-msg (murk-context-server ctx)
+                           (murk-msg nil nil "NICK" new-nick))
+          (murk-display-error "No current connection")))
+    (murk-display-notice nil "Usage: /nick <new-nick>")))
+
+(defun murk-command-list (params)
+  (let ((ctx (murk-current-context)))
+    (if ctx
+        (if (not params)
+            (murk-display-notice nil "This command can generate lots of output. Use `/LIST -yes' if you really want this, or `/LIST <channel_regexp>' to reduce the output.")
+          (let ((server (murk-context-server ctx)))
+            (if (equal (upcase (car params)) "-YES")
+                (murk-send-msg server (murk-msg nil nil "LIST"))
+              (murk-send-msg server (murk-msg nil nil "LIST"
+                                              (car params))))))
+      (murk-display-error "No current connection"))))
+
+(defun murk-command-topic (params)
+  (let ((ctx (murk-current-context)))
+    (if (and ctx (not (murk-server-context-p ctx)))
+        (let ((server (murk-context-server ctx))
+              (channel (murk-context-channel ctx)))
+          (if params
+              (murk-send-msg server
+                             (murk-msg nil nil "TOPIC" channel
+                                       (string-join params " ")))
+            (murk-send-msg server
+                           (murk-msg nil nil "TOPIC" channel))))
+      (murk-display-notice nil "No current channel."))))
+
+(defun murk-command-msg (params)
+  (let ((server (murk-context-server (murk-current-context))))
+    (if (and params (>= (length params) 2))
+        (let ((to (car params))
+              (text (string-join (cdr params) " ")))
+          (murk-send-msg server (murk-msg nil nil "PRIVMSG" to text))
+          (murk-display-message server
+                                (murk-connection-nick server)
+                                to text))
+      (murk-display-notice nil "Usage: /msg <nick> <message>"))))
+
+(defun murk-command-me (params)
+  (let* ((ctx (murk-current-context))
+         (server (murk-context-server ctx)))
+    (if (and ctx (not (murk-server-context-p ctx)))
+        (if params
+            (let* ((channel (murk-context-channel ctx))
+                   (my-nick (murk-connection-nick server))
+                   (action (string-join params " "))
+                   (ctcp-text (concat "\01ACTION " action "\01")))
+              (murk-send-msg server
+                             (murk-msg nil nil "PRIVMSG"
+                                       (list channel ctcp-text)))
+              (murk-display-action server my-nick channel action))
+          (murk-display-notice nil "Usage: /me <action>"))
+      (murk-display-notice nil "No current channel."))))
+
+(defun murk-command-version (params)
+  (let ((ctx (murk-current-context)))
+    (if ctx
+        (if params
+            (let ((server (murk-context-server ctx))
+                  (nick (car params)))
+              (murk-send-msg server
+                             (murk-msg nil nil "PRIVMSG"
+                                       (list nick "\01VERSION\01")))
+              (murk-display-notice ctx "CTCP version request sent to "
+                                   nick " on " server))
+          (murk-display-notice ctx "Usage: /version <nick>"))
+      (murk-display-notice nil "No current channel."))))
+
+(defun murk-command-users (_params)
+  (let ((ctx (murk-current-context)))
+    (if (and ctx (not (murk-server-context-p ctx)))
+        (let ((channel (murk-context-channel ctx))
+              (server (murk-context-server ctx))
+              (users (murk-context-users ctx)))
+          (murk-display-notice ctx "Users in " channel " on " server ":")
+          (murk-display-notice ctx (string-join users " ")))
+      (murk-display-notice nil "No current channel."))))
+
+
+;;; Command entering
+;;
+
+(defun murk-enter-string (string)
+  (if (string-prefix-p "/" string)
+      (pcase string
+        ((rx (: "/" (let cmd-str (+ (not whitespace)))
+                (opt (+ whitespace)
+                     (let params-str (+ anychar))
+                     string-end)))
+         (let ((command-row (assoc (upcase  cmd-str) murk-command-table #'equal))
+               (params (if params-str
+                           (split-string params-str nil t)
+                         nil)))
+           (if (and command-row (elt command-row 2))
+               (funcall (elt command-row 2) params)
+             (murk-send-msg
+              (murk-context-server (murk-current-context))
+              (murk-msg nil nil (upcase cmd-str) params)))))
+        (_
+         (murk-display-error "Badly formed command")))
+    (unless (string-empty-p string)
+      (let ((ctx (murk-current-context)))
+        (if ctx
+            (if (not (murk-server-context-p ctx))
+                (let ((server (murk-context-server ctx))
+                      (channel (murk-context-channel ctx)))
+                  (murk-send-msg server
+                                 (murk-msg nil nil "PRIVMSG" channel string))
+                  (murk-display-message server
+                                        (murk-connection-nick server)
+                                        channel string))
+              (murk-display-error "No current channel"))
+          (murk-display-error "No current context"))))))
+
+
+;;; Command history
+;;
+
+(defvar murk-history nil
+  "Commands and messages sent in current session.")
+
+(defvar murk-history-index nil)
+
+(defun murk-history-cycle (delta)
+  (when murk-history
+    (with-current-buffer "*murk*"
+      (if murk-history-index
+          (setq murk-history-index
+                (max 0
+                     (min (- (length murk-history) 1)
+                          (+ delta murk-history-index))))
+        (setq murk-history-index 0))
+      (delete-region murk-input-marker (point-max))
+      (insert (elt murk-history murk-history-index)))))
+
+
+;;; Interactive commands
+;;
+
+(defun murk-enter ()
+  "Enter current contents of line after prompt."
+  (interactive)
+  (with-current-buffer "*murk*"
+    (let ((line (buffer-substring murk-input-marker (point-max))))
+      (push line murk-history)
+      (setq murk-history-index nil)
+      (let ((inhibit-read-only t))
+        (delete-region murk-input-marker (point-max)))
+      (murk-enter-string line))))
+
+(defun murk-history-next ()
+  (interactive)
+  (murk-history-cycle -1))
+
+(defun murk-history-prev ()
+  (interactive)
+  (murk-history-cycle +1))
+
+(defun murk-cycle-contexts-forward ()
+  (interactive)
+  (murk-cycle-contexts)
+  (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-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)
+  (let ((completion-ignore-case t))
+    (when (>= (point) murk-input-marker)
+      (pcase (buffer-substring murk-input-marker (point))
+        ((rx (: "/" (let cmd-str (+ (not whitespace))) (+ " ") (* (not whitespace)) string-end))
+         (let ((space-idx (save-excursion
+                            (re-search-backward " " murk-input-marker t)))
+               (table-row (assoc (upcase cmd-str) murk-command-table #'equal)))
+           (if (and table-row (elt table-row 3))
+               (let* ((completions-nospace (funcall (elt table-row 3)))
+                      (completions (mapcar (lambda (el) (concat el " ")) completions-nospace)))
+                 (completion-in-region (+ 1 space-idx) (point) completions)))))
+        ((rx (: "/" (* (not whitespace)) string-end))
+         (message (buffer-substring murk-input-marker (point)))
+         (completion-in-region murk-input-marker (point)
+                               (mapcar (lambda (row) (concat "/" (car row) " "))
+                                       murk-command-table)))
+        (_
+         (let* ((end (max murk-input-marker (point)))
+                (space-idx (save-excursion
+                             (re-search-backward " " murk-input-marker t)))
+                (start (if space-idx (+ 1 space-idx) murk-input-marker)))
+           (unless (string-prefix-p "/" (buffer-substring start end))
+             (let* ((users (murk-context-users (murk-current-context)))
+                    (users-no@ (mapcar
+                                (lambda (u) (car (split-string u "@" t)))
+                                users)))
+               (completion-in-region start end users-no@)))))))))

 
 ;;; Mode
 ;;
 
 ;;; Mode
 ;;


@@ -412,6 +1296,12 @@ 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)
   (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)
+    (define-key map (kbd "<C-S-iso-lefttab>") 'murk-cycle-contexts-reverse)
+    (define-key map (kbd "<C-S-tab>") 'murk-cycle-contexts-reverse)

     (when (fboundp 'evil-define-key*)
       (evil-define-key* 'motion map
         (kbd "TAB") 'murk-complete-input))
     (when (fboundp 'evil-define-key*)
       (evil-define-key* 'motion map
         (kbd "TAB") 'murk-complete-input))


@@ -426,6 +1316,7 @@ The head of this list is always the current context.")
 ;;; Main start procedure
 ;;
 
 ;;; Main start procedure
 ;;
 

+;;;###autoload

 (defun murk ()
   "Start murk or just switch to the murk buffer if one already exists."
   (interactive)
 (defun murk ()
   "Start murk or just switch to the murk buffer if one already exists."
   (interactive)


@@ -436,5 +1327,4 @@ The head of this list is always the current context.")
     (murk-setup-buffer))
   "Started murk.")
 
     (murk-setup-buffer))
   "Started murk.")
 

-

 ;;; murk.el ends here
 ;;; murk.el ends here