From: plugd <plugd@thelambdalab.xyz>
Date: Wed, 14 Jul 2021 09:47:44 +0000 (+0200)
Subject: Made command list queriable and extensible.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=02e82379f7523230282017c092755ac56feec659;p=lurk.git

Made command list queriable and extensible.
---

diff --git a/lurk.el b/lurk.el
index 085a8ed..2a95e48 100644
--- a/lurk.el
+++ b/lurk.el
@@ -809,87 +809,41 @@ in which case they match anything.")
      (lurk-process-autoreply msg autoreply))
    lurk-autoreply-table))
 
+
 ;;; Command entering
 ;;
 
+(defvar lurk-command-table
+  '(("DEBUG" "Toggle debug mode on/off." lurk-command-debug)
+    ("HEADER" "Toggle display of header." lurk-command-header)
+    ("CONNECT" "Connect to an IRC network." lurk-command-connect)
+    ("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)
+    ("PART" "Leave channel." lurk-command-part)
+    ("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)
+    ("MSG" "Send private message to user." lurk-command-msg))
+  "Table of commands explicitly supported by Lurk.")
+
+
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)
-      (pcase (substring string 1)
-        ((rx (: "DEBUG" (opt (: " " (let setting (or "ON" "OFF"))))))
-         (setq lurk-debug
-               (if setting
-                   (if (equal (upcase setting) "ON")
-                       t
-                     nil)
-                 (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 command-row
+               (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
@@ -899,6 +853,97 @@ in which case they match anything.")
             (lurk-display-message lurk-nick lurk-current-context string))
         (lurk-display-error "No current context.")))))
 
+(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-quit (params)
+  (let ((quit-msg (if params (string-join params " ") nil)))
+    (lurk-send-msg (lurk-msg nil nil "QUIT" quit-msg))))
+
+(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 parms " ") 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 nick)
+          (lurk-display-notice nil "Set default nick to '" 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 (>= 2 (length params)))
+      (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>")))
+
 (defvar lurk-history nil
   "Commands and messages sent in current session.")
 
@@ -959,29 +1004,28 @@ in which case they match anything.")
 
 (defun lurk-complete-input ()
   (interactive)
-  (when (and (>= (point) lurk-input-marker))
-    (pcase (buffer-substring lurk-input-marker (point))
-      ((rx (: "/connect" (+ " ") (* (not whitespace)) string-end))
-       (let ((space-idx (save-excursion
-                          (re-search-backward " " lurk-input-marker t))))
-         (completion-in-region (+ 1 space-idx)
-                               (point)
-                               (mapcar (lambda (row) (car row)) lurk-networks))))
-      ((rx (: "/" (* (not whitespace)) string-end))
-       (message (buffer-substring lurk-input-marker (point)))
-       (completion-in-region lurk-input-marker (point)
-                             '("/connect"
-                               "/join"
-                               "/part"
-                               "/quit")))
-      (_
-       (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))))))))
+  (let ((completion-ignore-case t))
+    (when (and (>= (point) lurk-input-marker))
+      (pcase (buffer-substring lurk-input-marker (point))
+        ((rx (: "/connect" (+ " ") (* (not whitespace)) string-end))
+         (let ((space-idx (save-excursion
+                            (re-search-backward " " lurk-input-marker t))))
+           (completion-in-region (+ 1 space-idx)
+                                 (point)
+                                 (mapcar (lambda (row) (car row)) lurk-networks))))
+        ((rx (: "/" (* (not whitespace)) string-end))
+         (message (buffer-substring lurk-input-marker (point)))
+         (completion-in-region lurk-input-marker (point)
+                               (mapcar (lambda (row) (string-join (list "/" (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))
+                (completion-ignore-case t))
+           (unless (string-prefix-p "/" (buffer-substring start end))
+             (completion-in-region start end (lurk-get-context-users lurk-current-context)))))))))
 
 
 ;;; Mode
@@ -996,10 +1040,6 @@ in which case they match anything.")
     (define-key map (kbd "<C-S-tab>") 'lurk-cycle-contexts-reverse)
     (define-key map (kbd "<C-up>") 'lurk-history-prev)
     (define-key map (kbd "<C-down>") 'lurk-history-next)
-    ;; (when (fboundp 'evil-define-key*)
-    ;;   (evil-define-key* 'insert map
-    ;;                     (kbd "<C-Up>") 'lurk-history-prev
-    ;;                     (kbd "<C-Down>") 'lurk-history-next))
     map))
 
 (defvar lurk-mode-map)