Added license.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index e2d175e..52ee3b6 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -45,11 +45,7 @@
   "Default quit message when none supplied.")
 
 (defcustom lurk-networks
   "Default quit message when none supplied.")
 
 (defcustom lurk-networks

-  '(("libera" "irc.libera.chat" 6697)
-    ("freenode" "chat.freenode.net" 6697)
-    ("tilde" "tilde.chat" 6697)
-    ("mbr" "mbrserver.com" 6667 :notls)
-    ("local" "localhost" 6697))
+  '(("libera" "irc.libera.chat" 6697))

   "IRC networks.")
 
 (defcustom lurk-allow-ipv6 nil
   "IRC networks.")
 
 (defcustom lurk-allow-ipv6 nil


@@ -69,27 +65,27 @@
   "Face used for Lurk text.")
 
 (defface lurk-prompt
   "Face used for Lurk text.")
 
 (defface lurk-prompt

-  '((t :inherit org-priority))
+  '((t :inherit font-lock-keyword-face))

   "Face used for the prompt.")
 
 (defface lurk-context
   "Face used for the prompt.")
 
 (defface lurk-context

-  '((t :inherit org-tag))
+  '((t :inherit lurk-context))

   "Face used for the context name in the prompt.")
 
 (defface lurk-faded
   "Face used for the context name in the prompt.")
 
 (defface lurk-faded

-  '((t :inherit org-agenda-dimmed-todo-face))
+  '((t :inherit shadow))

   "Face used for faded Lurk text.")
 
 (defface lurk-timestamp
   "Face used for faded Lurk text.")
 
 (defface lurk-timestamp

-  '((t :inherit org-agenda-dimmed-todo-face))
+  '((t :inherit shadow))

   "Face used for timestamps.")
 
 (defface lurk-error
   "Face used for timestamps.")
 
 (defface lurk-error

-  '((t :inherit font-lock-regexp-grouping-construct))
+  '((t :inherit error))

   "Face used for Lurk error text.")
 
 (defface lurk-notice
   "Face used for Lurk error text.")
 
 (defface lurk-notice

-  '((t :inherit org-upcoming-deadline))
+  '((t :inherit warning))

   "Face used for Lurk notice text.")
 
 ;;; Global variables
   "Face used for Lurk notice text.")
 
 ;;; Global variables


@@ -107,6 +103,19 @@
 (defvar lurk-debug nil
   "If non-nil, enable debug mode.")
 
 (defvar lurk-debug nil
   "If non-nil, enable debug mode.")
 

+
+;;; Utility procedures
+;;
+
+(defun lurk--filtered-join (&rest args)
+  (string-join (seq-filter (lambda (el) el) args) " "))
+
+(defun lurk--as-string (obj)
+  (if obj
+      (with-output-to-string (princ obj))
+    nil))
+
+

 ;;; Network process
 ;;
 
 ;;; Network process
 ;;
 


@@ -182,11 +191,6 @@
 ;;; Server messages
 ;;
 
 ;;; Server messages
 ;;
 

-(defun lurk--as-string (obj)
-  (if obj
-      (with-output-to-string (princ obj))
-    nil))
-

 (defun lurk-msg (tags src cmd &rest params)
   (list (lurk--as-string tags)
         (lurk--as-string src)
 (defun lurk-msg (tags src cmd &rest params)
   (list (lurk--as-string tags)
         (lurk--as-string src)


@@ -235,9 +239,6 @@ portion of the source component of the message, as LURK doesn't use this.")
         (apply #'lurk-msg (append (list tags src cmd) params)))
     (error "Failed to parse string " string)))
 
         (apply #'lurk-msg (append (list tags src cmd) params)))
     (error "Failed to parse string " string)))
 

-(defun lurk--filtered-join (&rest args)
-  (string-join (seq-filter (lambda (el) el) args) " "))
-

 (defun lurk-msg->string (msg)
   (let ((tags (lurk-msg-tags msg))
         (src (lurk-msg-src msg))
 (defun lurk-msg->string (msg)
   (let ((tags (lurk-msg-tags msg))
         (src (lurk-msg-src msg))


@@ -270,10 +271,13 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defun lurk-get-context-users (name)
   (gethash name lurk-contexts))
 
 (defun lurk-get-context-users (name)
   (gethash name lurk-contexts))
 

+(defun lurk-context-known-p (name)
+  (not (eq (gethash name lurk-contexts 0) 0)))
+

 (defun lurk-add-context-users (context users)
   (puthash context
 (defun lurk-add-context-users (context users)
   (puthash context

-           (append users
-                   (gethash context lurk-contexts))
+           (cl-union users
+                     (gethash context lurk-contexts))

            lurk-contexts))
 
 (defun lurk-del-context-user (context user)
            lurk-contexts))
 
 (defun lurk-del-context-user (context user)


@@ -317,14 +321,13 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defun lurk-set-current-context (context)
   (setq lurk-current-context context)
   (lurk-highlight-context context)
 (defun lurk-set-current-context (context)
   (setq lurk-current-context context)
   (lurk-highlight-context context)

+  (lurk-render-prompt)

   (if lurk-zoomed
       (lurk-zoom-in lurk-current-context)))
 
 (defun lurk-cycle-contexts (&optional rev)
   (if lurk-current-context
   (if lurk-zoomed
       (lurk-zoom-in lurk-current-context)))
 
 (defun lurk-cycle-contexts (&optional rev)
   (if lurk-current-context

-      (progn
-        (lurk-set-current-context (lurk-get-next-context rev))
-        (lurk-render-prompt))
+      (lurk-set-current-context (lurk-get-next-context rev))

     (lurk-display-error "No channels joined.")))
 
 
     (lurk-display-error "No channels joined.")))
 
 


@@ -350,8 +353,10 @@ portion of the source component of the message, as LURK doesn't use this.")
                          "")
                        'face 'lurk-context
                        'read-only t)
                          "")
                        'face 'lurk-context
                        'read-only t)

-           (propertize (concat lurk-prompt-string " ")
+           (propertize lurk-prompt-string

                        'face 'lurk-prompt
                        'face 'lurk-prompt

+                       'read-only t)
+           (propertize " " ; Need this to be separate to mark it as rear-nonsticky

                        'read-only t
                        'rear-nonsticky t)))
         (set-marker-insertion-type lurk-input-marker nil))
                        'read-only t
                        'rear-nonsticky t)))
         (set-marker-insertion-type lurk-input-marker nil))


@@ -368,22 +373,25 @@ portion of the source component of the message, as LURK doesn't use this.")
   "Marker for prompt position in LURK buffer.")
 
 (defun lurk-setup-header ()
   "Marker for prompt position in LURK buffer.")
 
 (defun lurk-setup-header ()

-  (setq-local header-line-format
-              '(:eval
-                (let ((proc (get-process "lurk")))
-                  (if proc
-                      (concat
-                       "Host: " (car (process-contact proc))
-                       ", Context: "
-                       (if lurk-current-context
-                           (concat
-                            lurk-current-context
-                            " ("
-                            (number-to-string
-                             (length (lurk-get-context-users lurk-current-context)))
-                            " users)")
-                         "Server"))
-                    "No connection")))))
+  (with-current-buffer "*lurk*"
+    (setq-local header-line-format
+                '((:eval
+                   (let ((proc (get-process "lurk")))
+                     (if proc
+                         (concat
+                          "Host: " (car (process-contact proc))
+                          ", Context: "
+                          (if lurk-current-context
+                              (concat
+                               lurk-current-context
+                               " ("
+                               (number-to-string
+                                (length (lurk-get-context-users lurk-current-context)))
+                               " users)")
+                            "Server"))
+                       "No connection")))
+                  (:eval
+                   (if lurk-zoomed " [ZOOMED]" ""))))))

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


@@ -400,6 +408,11 @@ portion of the source component of the message, as LURK doesn't use this.")
     (if lurk-display-header
         (lurk-setup-header))))
 
     (if lurk-display-header
         (lurk-setup-header))))
 

+(defun lurk-clear-buffer ()
+  "Completely erase all non-prompt and non-input text from lurk buffer."
+  (with-current-buffer "*lurk*"
+    (let ((inhibit-read-only t))
+      (delete-region (point-min) lurk-prompt-marker))))

 
 ;;; Output formatting and highlighting
 ;;
 
 ;;; Output formatting and highlighting
 ;;


@@ -437,8 +450,35 @@ portion of the source component of the message, as LURK doesn't use this.")
       (fill-region (point-min) (point-max) nil t)
       (buffer-string))))
 
       (fill-region (point-min) (point-max) nil t)
       (buffer-string))))
 

+(defun lurk--start-of-final-line ()
+  (with-current-buffer "*lurk*"
+    (save-excursion
+      (goto-char (point-max))
+      (line-beginning-position))))
+
+(defun lurk-scroll-windows-to-last-line ()
+  (with-current-buffer "*lurk*"
+    (dolist (window (get-buffer-window-list))
+      (if (>= (window-point window) (lurk--start-of-final-line))
+          (with-selected-window window
+            (recenter -1))))))
+
+(defun lurk-make-context-button (context &optional label)
+  (with-temp-buffer
+    (insert-text-button (or label context)
+                        'action #'lurk--context-button-action
+                        'follow-link t
+                        'help-echo "Switch context.")
+    (buffer-string)))
+
+(defun lurk--context-button-action (button)
+  (let ((context (button-get button 'context)))
+    (if (eq lurk-current-context context)
+        (lurk-toggle-zoom)
+      (lurk-set-current-context context))))
+

 (defun lurk-display-string (context prefix &rest strings)
 (defun lurk-display-string (context prefix &rest strings)

-  (with-current-buffer (get-buffer-create "*lurk*")
+  (with-current-buffer "*lurk*"

     (save-excursion
       (goto-char lurk-prompt-marker)
       (let* ((inhibit-read-only t)
     (save-excursion
       (goto-char lurk-prompt-marker)
       (let* ((inhibit-read-only t)


@@ -465,7 +505,8 @@ portion of the source component of the message, as LURK doesn't use this.")
                        'face (lurk-get-context-facelist context)
                        'read-only t
                        'context context
                        'face (lurk-get-context-facelist context)
                        'read-only t
                        'context context

-                       'invisible context-atom))))))))
+                       'invisible context-atom)))))))
+  (lurk-scroll-windows-to-last-line))

 
 (defun lurk-display-message (from to text)
   (let ((context (if (eq 'channel (lurk-get-context-type to))
 
 (defun lurk-display-message (from to text)
   (let ((context (if (eq 'channel (lurk-get-context-type to))


@@ -475,8 +516,10 @@ portion of the source component of the message, as LURK doesn't use this.")
      context
      (propertize
       (pcase (lurk-get-context-type to)
      context
      (propertize
       (pcase (lurk-get-context-type to)

-        ('channel (concat to " <" from ">"))
-        ('nick (concat "[" from " -> " to "]"))
+        ('channel (concat
+                   (lurk-make-context-button to)
+                   " <" from ">"))
+        ('nick (lurk-make-context-button context (concat "[" from " -> " to "]")))

         (_
          (error "Unsupported context type")))
       'face (lurk-get-context-facelist context))
         (_
          (error "Unsupported context type")))
       'face (lurk-get-context-facelist context))


@@ -489,7 +532,7 @@ portion of the source component of the message, as LURK doesn't use this.")
     (lurk-display-string
      context
      (propertize
     (lurk-display-string
      context
      (propertize

-      (concat context " * " from)
+      (concat (lurk-make-context-button context) " * " from)

       'face (lurk-get-context-facelist context))
      action-text)))
 
       'face (lurk-get-context-facelist context))
      action-text)))
 


@@ -524,7 +567,8 @@ portion of the source component of the message, as LURK doesn't use this.")
                (remove-from-invisibility-spec this-context-atom)
              (add-to-invisibility-spec this-context-atom)))))
      lurk-context-facelists)
                (remove-from-invisibility-spec this-context-atom)
              (add-to-invisibility-spec this-context-atom)))))
      lurk-context-facelists)

-    (force-window-update "*lurk*")))
+    (force-window-update "*lurk*"))
+  (lurk-scroll-windows-to-last-line))

 
 (defun lurk-zoom-out ()
   (with-current-buffer "*lurk*"
 
 (defun lurk-zoom-out ()
   (with-current-buffer "*lurk*"


@@ -533,7 +577,18 @@ portion of the source component of the message, as LURK doesn't use this.")
        (let ((this-context-atom (if this-context (intern this-context) nil)))
          (remove-from-invisibility-spec this-context-atom)))
      lurk-context-facelists)
        (let ((this-context-atom (if this-context (intern this-context) nil)))
          (remove-from-invisibility-spec this-context-atom)))
      lurk-context-facelists)

-    (force-window-update "*lurk*")))
+    (force-window-update "*lurk*"))
+  (lurk-scroll-windows-to-last-line))
+
+(defun lurk-clear-context (context)
+  (with-current-buffer "*lurk*"
+    (save-excursion
+      (goto-char (point-min))
+      (let ((inhibit-read-only t)
+            (match nil))
+        (while (setq match (text-property-search-forward 'context context t))
+          (delete-region (prop-match-beginning match)
+                         (prop-match-end match)))))))

 
 (defconst lurk-url-regex
   (rx (:
 
 (defconst lurk-url-regex
   (rx (:


@@ -544,8 +599,8 @@ portion of the source component of the message, as LURK doesn't use this.")
        (opt (group (: ":" (+ digit))))
        (opt (group (: "/"
                       (opt
        (opt (group (: ":" (+ digit))))
        (opt (group (: "/"
                       (opt

-                       (* (any alnum "-/.,#:%=&_?~@"))
-                       (any alnum "-/#:%=&_~@")))))))
+                       (* (any alnum "-/.,#:%=&_?~@+"))
+                       (any alnum "-/#:%=&_~@+")))))))

   "Imperfect regex used to find URLs in plain text.")
 
 (defun lurk-click-url (button)
   "Imperfect regex used to find URLs in plain text.")
 
 (defun lurk-click-url (button)


@@ -576,7 +631,9 @@ portion of the source component of the message, as LURK doesn't use this.")
           (underline nil)
           (strikethrough nil)
           (prev-point (point)))
           (underline nil)
           (strikethrough nil)
           (prev-point (point)))

-      (while (re-search-forward (rx (any "\x02\x1D\x1F\x1E")) nil t)
+      (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)))
         (let ((beg (+ (match-beginning 0) 1)))
           (if bold
               (add-face-text-property prev-point beg '(:weight bold)))


@@ -590,7 +647,13 @@ portion of the source component of the message, as LURK doesn't use this.")
             ("\x02" (setq bold (not bold)))
             ("\x1D" (setq italics (not italics)))
             ("\x1F" (setq underline (not underline)))
             ("\x02" (setq bold (not bold)))
             ("\x1D" (setq italics (not italics)))
             ("\x1F" (setq underline (not underline)))

-            ("\x1E" (setq strikethrough (not strikethrough))))
+            ("\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)))
           (delete-region (match-beginning 0) (match-end 0))
           (setq prev-point (point)))))
     (buffer-string)))


@@ -603,6 +666,7 @@ portion of the source component of the message, as LURK doesn't use this.")
   (if lurk-debug
       (lurk-display-string nil nil string))
   (let* ((msg (lurk-string->msg string)))
   (if lurk-debug
       (lurk-display-string nil nil string))
   (let* ((msg (lurk-string->msg string)))

+    (lurk-process-autoreplies msg)

     (pcase (lurk-msg-cmd msg)
       ("PING"
        (lurk-send-msg
     (pcase (lurk-msg-cmd msg)
       ("PING"
        (lurk-send-msg


@@ -621,15 +685,19 @@ portion of the source component of the message, as LURK doesn't use this.")
        (let* ((params (lurk-msg-params msg))
               (channel (elt params 2))
               (names (split-string (elt params 3))))
        (let* ((params (lurk-msg-params msg))
               (channel (elt params 2))
               (names (split-string (elt params 3))))

-         (lurk-add-context-users channel names)))
+         (if (lurk-context-known-p channel)
+             (lurk-add-context-users channel names)
+           (lurk-display-notice nil "Users in " channel ": " (string-join names " ")))))

 
       ("366" ; ENDOFNAMES
        (let* ((params (lurk-msg-params msg))
               (channel (elt params 1)))
 
       ("366" ; ENDOFNAMES
        (let* ((params (lurk-msg-params msg))
               (channel (elt params 1)))

-         (lurk-display-notice
-          channel
-          (lurk--as-string (length (lurk-get-context-users channel)))
-          " users in " channel)))
+         (if (lurk-context-known-p channel)
+             (lurk-display-notice
+              channel
+              (lurk--as-string (length (lurk-get-context-users channel)))
+              " users in " channel)
+           (lurk-display-notice nil "End of " channel " names list."))))

 
       ("331"
        (let* ((params (lurk-msg-params msg))
 
       ("331"
        (let* ((params (lurk-msg-params msg))


@@ -755,82 +823,244 @@ portion of the source component of the message, as LURK doesn't use this.")
        (lurk-display-notice nil (lurk-msg->string msg))))))
 
 
        (lurk-display-notice nil (lurk-msg->string msg))))))
 
 

+;;; User-defined responses
+
+
+(defvar lurk-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.")
+
+(defun lurk--lists-equal (l1 l2)
+    (if (and l1 l2)
+        (if (or (not (and (car l1) (car l2)))
+                (string-match (car l1) (car l2)))
+            (lurk--lists-equal (cdr l1) (cdr l2))
+          nil)
+      t))
+
+(defun lurk-process-autoreply (msg autoreply)
+  (let ((matcher (car autoreply))
+        (reply (cadr autoreply)))
+    (let ((network (car matcher)))
+      (when (and (or (not network)
+                     (and (get-process "lurk")
+                          (equal (car (process-contact (get-process "lurk")))
+                                 (cadr (assoc network lurk-networks)))))
+                 (lurk--lists-equal (cdr matcher)
+                                    (append (list (lurk-msg-src msg)
+                                                  (lurk-msg-cmd msg))
+                                            (lurk-msg-params msg))))
+        (lurk-send-msg
+         (lurk-msg nil nil (car reply) (cdr reply)))))))
+
+(defun lurk-process-autoreplies (msg)
+  (mapc
+   (lambda (autoreply)
+     (lurk-process-autoreply msg autoreply))
+   lurk-autoreply-table))
+
+
+;;; Commands
+;;
+
+(defvar lurk-command-table
+  '(("DEBUG" "Toggle debug mode on/off." lurk-command-debug lurk-boolean-completions)
+    ("HEADER" "Toggle display of header." lurk-command-header lurk-boolean-completions)
+    ("CONNECT" "Connect to an IRC network." lurk-command-connect lurk-network-completions)
+    ("NETWORKS" "List known IRC networks." lurk-command-networks)
+    ("JOIN" "Join one or more channels." lurk-command-join)
+    ("TOPIC" "Set topic for current channel." lurk-command-topic)
+    ("ME" "Display action." lurk-command-me)
+    ("VERSION" "Request version of another user's client via CTCP." lurk-command-version lurk-nick-completions)
+    ("PART" "Leave channel." lurk-command-part lurk-context-completions)
+    ("QUIT" "Disconnect from current network." lurk-command-quit)
+    ("NICK" "Change nick." lurk-command-nick)
+    ("LIST" "Display details of one or more channels." lurk-command-list)
+    ("WHOIS" "Ask server for details of nick." nil lurk-nick-completions)
+    ("USERS" "List nicks of users in current context." lurk-command-users)
+    ("MSG" "Send private message to user." lurk-command-msg lurk-nick-completions)
+    ("CLEAR" "Clear buffer text." lurk-command-clear lurk-context-completions)
+    ("HELP" "Display help on client commands." lurk-command-help lurk-help-completions))
+  "Table of commands explicitly supported by Lurk.")
+
+(defun lurk-boolean-completions ()
+  '("on" "off"))
+
+(defun lurk-network-completions ()
+  (mapcar (lambda (row) (car row)) lurk-networks))
+
+(defun lurk-nick-completions ()
+  (lurk-get-context-users lurk-current-context))
+
+(defun lurk-context-completions ()
+  (lurk-get-context-list))
+
+(defun lurk-help-completions ()
+  (mapcar (lambda (row) (car row)) lurk-command-table))
+
+(defun lurk-command-help (params)
+  (if params
+      (let* ((cmd-str (upcase (car params)))
+             (row (assoc cmd-str lurk-command-table #'equal)))
+        (if row
+            (progn
+              (lurk-display-notice nil "Help for \x02" cmd-str "\x02:")
+              (lurk-display-notice nil "  " (elt row 1)))
+          (lurk-display-notice nil "No such (client-interpreted) command.")))
+    (lurk-display-notice nil "Client-interpreted commands:")
+    (dolist (row lurk-command-table)
+      (lurk-display-notice nil "  \x02" (elt row 0) "\x02: " (elt row 1)))
+    (lurk-display-notice nil "Use /HELP COMMAND to display information about a specific command.")))
+
+(defun lurk-command-debug (params)
+  (setq lurk-debug 
+        (if params
+            (if (equal (upcase (car params)) "ON")
+                t
+              nil)
+          (not lurk-debug)))
+  (lurk-display-notice nil "Debug mode now " (if lurk-debug "on" "off") "."))
+
+(defun lurk-command-header (params)
+  (if
+      (if params
+          (equal (upcase (car params)) "ON")
+        (not header-line-format))
+      (progn
+        (lurk-setup-header)
+        (lurk-display-notice nil "Header enabled."))
+    (setq-local header-line-format nil)
+    (lurk-display-notice nil "Header disabled.")))
+
+(defun lurk-command-connect (params)
+  (if params
+      (let ((network (car params)))
+        (lurk-display-notice nil "Attempting to connect to " network "...")
+        (lurk-connect network))
+    (lurk-display-notice nil "Usage: /connect <network>")))
+
+(defun lurk-command-networks (params)
+  (lurk-display-notice nil "Currently-known networks:")
+  (dolist (row lurk-networks)
+    (seq-let (network server port &rest others) row
+      (lurk-display-notice nil "\t" network
+                           " [" server
+                           " " (number-to-string port) "]")))
+  (lurk-display-notice nil "(Modify the `lurk-networks' variable to add more.)"))
+
+(defun lurk-command-join (params)
+  (if params
+      (dolist (channel params)
+        (lurk-send-msg (lurk-msg nil nil "JOIN" channel)))
+    (lurk-display-notice nil "Usage: /join channel [channel2 ...]")))
+
+(defun lurk-command-part (params)
+  (let ((channel (if params (car params) lurk-current-context)))
+    (if channel
+        (lurk-send-msg (lurk-msg nil nil "PART" channel))
+      (lurk-display-error "No current channel to leave."))))
+
+(defun lurk-command-version (params)
+  (if params
+      (let ((nick (car params)))
+        (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
+                                 (list nick "\01VERSION\01")))
+        (lurk-display-notice nil "CTCP version request sent to " nick))
+    (lurk-display-notice nil "Usage: /version <nick>")))
+
+(defun lurk-command-quit (params)
+  (let ((quit-msg (if params (string-join params " ") lurk-default-quit-msg)))
+    (lurk-send-msg (lurk-msg nil nil "QUIT" quit-msg))))
+
+(defun lurk-command-nick (params)
+  (let ((new-nick (if params (string-join params " ") nil)))
+    (if new-nick
+        (if (lurk-connected-p)
+            (lurk-send-msg (lurk-msg nil nil "NICK" new-nick))
+          (setq lurk-nick new-nick)
+          (lurk-display-notice nil "Set default nick to '" lurk-nick "'."))
+      (lurk-display-notice nil "Current nick: " lurk-nick))))
+
+(defun lurk-command-me (params)
+  (if lurk-current-context
+      (if params
+          (let* ((action (string-join params " "))
+                 (ctcp-text (concat "\01ACTION " action "\01")))
+            (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
+                                     (list lurk-current-context ctcp-text)))
+            (lurk-display-action lurk-nick lurk-current-context action))
+        (lurk-display-notice nil "Usage: /me <action>"))
+    (lurk-display-notice nil "No current channel.")))
+
+(defun lurk-command-list (params)
+  (if (not params)
+      (lurk-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.")
+    (if (equal (upcase (car params)) "-YES")
+        (lurk-send-msg (lurk-msg nil nil "LIST"))
+      (lurk-send-msg (lurk-msg nil nil "LIST" (car params))))))
+
+(defun lurk-command-topic (params)
+  (if lurk-current-context
+      (if params
+          (lurk-send-msg (lurk-msg nil nil "TOPIC" lurk-current-context (string-join params " ")))
+        (lurk-display-notice nil "Usage: /topic <new topic>"))
+    (lurk-display-notice nil "No current channel.")))
+
+(defun lurk-command-msg (params)
+  (if (and params (>= (length params) 2))
+      (let ((to (car params))
+            (text (string-join (cdr params) " ")))
+        (lurk-send-msg (lurk-msg nil nil "PRIVMSG" to text))
+        (lurk-display-message lurk-nick to text))
+    (lurk-display-notice nil "Usage: /msg <nick> <message>")))
+
+(defun lurk-command-clear (params)
+  (if (not params)
+      (lurk-clear-buffer)
+    (dolist (context params)
+      (lurk-clear-context context))))
+
+(defun lurk-command-users (params)
+  (if lurk-current-context
+      (progn
+        (lurk-display-notice lurk-current-context "Users in " lurk-current-context ":")
+        (lurk-display-notice
+         lurk-current-context
+         (string-join (lurk-get-context-users lurk-current-context) " ")))
+    (lurk-display-notice nil "No current channel.")))
+

 ;;; Command entering
 ;;
 
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)
 ;;; Command entering
 ;;
 
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)

-      (pcase (substring string 1)
-        ((rx "DEBUG")
-         (setq lurk-debug (not lurk-debug))
-         (lurk-display-notice nil "Debug mode now " (if lurk-debug "on" "off") "."))
-
-        ((rx "HEADER")
-         (if header-line-format
-           (progn
-             (setq-local header-line-format nil)
-             (lurk-display-notice nil "Header disabled."))
-           (lurk-setup-header)
-           (lurk-display-notice nil "Header enabled.")))
-
-        ((rx (: "CONNECT " (let network (* not-newline))))
-         (lurk-display-notice nil "Attempting to connect to " network "...")
-         (lurk-connect network))
-
-        ((rx (: "TOPIC " (let new-topic (* not-newline))))
-         (lurk-send-msg (lurk-msg nil nil "TOPIC" lurk-current-context new-topic)))
-
-        ((rx (: "ME " (let action (* not-newline))))
-         (let ((ctcp-text (concat "\01ACTION " action "\01")))
-           (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
-                                    (list lurk-current-context ctcp-text)))
-           (lurk-display-action lurk-nick lurk-current-context action)))
-
-        ((rx (: "VERSION" " " (let nick (+ (not whitespace)))))
-         (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
-                                  (list nick "\01VERSION\01")))
-         (lurk-display-notice nil "CTCP version request sent to " nick))
-
-        ((rx "PART" (opt (: " " (let channel (* not-newline)))))
-         (if (or lurk-current-context channel)
-             (lurk-send-msg (lurk-msg nil nil "PART" (if channel
-                                                         channel
-                                                       lurk-current-context)))
-           (lurk-display-error "No current channel to leave.")))
-
-        ((rx "QUIT" (opt (: " " (let quit-msg (* not-newline)))))
-         (lurk-send-msg (lurk-msg nil nil "QUIT"
-                                  (or quit-msg lurk-default-quit-msg))))
-
-        ((rx (: "NICK" (* whitespace) string-end))
-         (lurk-display-notice nil "Current nick: " lurk-nick))
-
-        ((rx (: "NICK" (+ whitespace) (let nick (+ (not whitespace)))))
-         (if (lurk-connected-p)
-             (lurk-send-msg (lurk-msg nil nil "NICK" nick))
-           (setq lurk-nick nick)
-           (lurk-display-notice nil "Set default nick to '" nick "'")))
-
-        ((rx (: "LIST" (* whitespace) string-end))
-         (lurk-display-notice nil "This command can generate lots of output. Use `LIST -yes' if you're sure."))
-
-        ((rx (: "LIST" (+ whitespace) "-YES" (* whitespace) string-end))
-         (lurk-send-msg (lurk-msg nil nil "LIST")))
-
-        ((rx "MSG "
-             (let to (* (not whitespace)))
-             " "
-             (let text (* not-newline)))
-         (lurk-send-msg (lurk-msg nil nil "PRIVMSG" to text))
-         (lurk-display-message lurk-nick to text))
-
-        ((rx (: (let cmd-str (+ (not whitespace)))
-                (opt (: " " (let params-str (* not-newline))))))
-         (lurk-send-msg (lurk-msg nil nil (upcase cmd-str)
-                                  (if params-str
-                                      (split-string params-str)
-                                    nil)))))
-
+      (pcase string
+        ((rx (: "/" (let cmd-str (+ (not whitespace)))
+                (opt (+ whitespace)
+                     (let params-str (+ anychar))
+                     string-end)))
+         (let ((command-row (assoc (upcase  cmd-str) lurk-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)
+             (lurk-send-msg (lurk-msg nil nil (upcase cmd-str) params)))))
+        (_
+         (lurk-display-error "Badly formed command.")))

     (unless (string-empty-p string)
       (if lurk-current-context
           (progn
     (unless (string-empty-p string)
       (if lurk-current-context
           (progn


@@ -840,20 +1070,12 @@ 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.")))))
 
             (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.")

 
 

+;;; Command history
+;;

 
 

-(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 nil
+  "Commands and messages sent in current session.")

 
 (defvar lurk-history-index nil)
 
 
 (defvar lurk-history-index nil)
 


@@ -869,13 +1091,6 @@ portion of the source component of the message, as LURK doesn't use this.")
       (delete-region lurk-input-marker (point-max))
       (insert (elt lurk-history lurk-history-index)))))
 
       (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
 ;;
 
 ;;; Interactive functions
 ;;


@@ -898,16 +1113,54 @@ portion of the source component of the message, as LURK doesn't use this.")
     (lurk-zoom-in lurk-current-context))
   (setq lurk-zoomed (not lurk-zoomed)))
 
     (lurk-zoom-in lurk-current-context))
   (setq lurk-zoomed (not lurk-zoomed)))
 

-(defun lurk-complete-nick ()
+(defun lurk-history-next ()
+  (interactive)
+  (lurk-history-cycle -1))
+
+(defun lurk-history-prev ()

   (interactive)
   (interactive)

-  (when (and (>= (point) lurk-input-marker) lurk-current-context)
-    (let* ((end (max lurk-input-marker (point)))
-           (space-idx (save-excursion
-                        (re-search-backward " " lurk-input-marker t)))
-           (start (if space-idx (+ 1 space-idx) lurk-input-marker))
-           (completion-ignore-case t))
-      (unless (string-prefix-p "/" (buffer-substring start end))
-        (completion-in-region start end (lurk-get-context-users lurk-current-context))))))
+  (lurk-history-cycle +1))
+
+(defun lurk-complete-input ()
+  (interactive)
+  (let ((completion-ignore-case t))
+    (when (>= (point) lurk-input-marker)
+      (pcase (buffer-substring lurk-input-marker (point))
+        ((rx (: "/" (let cmd-str (+ (not whitespace))) (+ " ") (* (not whitespace)) string-end))
+         (let ((space-idx (save-excursion
+                            (re-search-backward " " lurk-input-marker t)))
+               (table-row (assoc (upcase cmd-str) lurk-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 lurk-input-marker (point)))
+         (completion-in-region lurk-input-marker (point)
+                               (mapcar (lambda (row) (concat "/" (car row) " "))
+                                       lurk-command-table)))
+        (_
+         (let* ((end (max lurk-input-marker (point)))
+                (space-idx (save-excursion
+                             (re-search-backward " " lurk-input-marker t)))
+                (start (if space-idx (+ 1 space-idx) lurk-input-marker)))
+           (unless (string-prefix-p "/" (buffer-substring start end))
+             (let* ((users (lurk-get-context-users lurk-current-context))
+                    (users-no@ (mapcar
+                                (lambda (u) (car (split-string u "@" t)))
+                                users)))
+               (completion-in-region start end users-no@)))))))))
+
+(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))))

 
 
 ;;; Mode
 
 
 ;;; Mode


@@ -916,37 +1169,38 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defvar lurk-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") 'lurk-enter)
 (defvar lurk-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") 'lurk-enter)

-    (define-key map (kbd "<tab>") 'lurk-complete-nick)
+    (define-key map (kbd "TAB") 'lurk-complete-input)

     (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)
     (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))
+    (when (fboundp 'evil-define-key*)
+      (evil-define-key* 'motion map
+        (kbd "TAB") 'lurk-complete-input))

     map))
 
     map))
 

-(defvar lurk-mode-map)
-

 (define-derived-mode lurk-mode text-mode "lurk"
   "Major mode for LURK.")
 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'lurk-mode 'insert))
 
 (define-derived-mode lurk-mode text-mode "lurk"
   "Major mode for LURK.")
 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'lurk-mode 'insert))
 

+

 ;;; Main start procedure
 ;;
 
 ;;; Main start procedure
 ;;
 

-(defun lurk ()
-  "Switch to *lurk* buffer."
+(defun lurk (&optional network)
+  "Start lurk or just switch to the lurk buffer if one already exists.
+Also connect to NETWORK if non-nil."

   (interactive)
   (if (get-buffer "*lurk*")
       (switch-to-buffer "*lurk*")
     (switch-to-buffer "*lurk*")
     (lurk-mode)
   (interactive)
   (if (get-buffer "*lurk*")
       (switch-to-buffer "*lurk*")
     (switch-to-buffer "*lurk*")
     (lurk-mode)

-    (lurk-setup-buffer))
+    (lurk-setup-buffer)
+    (if network
+        (lurk-command-connect (list network))))

   "Started LURK.")
 
 
   "Started LURK.")