Added user-defined responses.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index e2d175e..72d18cf 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -107,6 +107,19 @@
 (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
 ;;
 
@@ -182,11 +195,6 @@
 ;;; 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)
@@ -235,9 +243,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)))
 
-(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))
@@ -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 ()
-  (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*")
@@ -544,8 +552,8 @@ portion of the source component of the message, as LURK doesn't use this.")
        (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)
@@ -603,6 +611,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)))
+    (lurk-process-autoreplies msg)
     (pcase (lurk-msg-cmd msg)
       ("PING"
        (lurk-send-msg
@@ -755,14 +764,68 @@ portion of the source component of the message, as LURK doesn't use this.")
        (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))
+
 ;;; Command entering
 ;;
 
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)
       (pcase (substring string 1)
-        ((rx "DEBUG")
-         (setq lurk-debug (not lurk-debug))
+        ((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")