Bugfixes, and allowed suppression of join messages.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 82a43f2..28fe5c6 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -40,20 +40,24 @@
 
 (defcustom lurk-nick "plugd"
   "Default nick.")
-(defcustom lurk-full-name "plugd"
-  "Default full name.")
-(defcustom lurk-user-name "plugd"
-  "Default user name.")
+
+(defcustom lurk-default-quit-msg "Bye"
+  "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))
   "IRC networks.")
 
 (defcustom lurk-allow-ipv6 nil
   "Set to non-nil to allow use of IPv6.")
 
+(defcustom lurk-show-joins nil
+  "Set to non-nil to be notified of joins, parts and quits.")
+
 ;;; Faces
 ;;
 
@@ -102,7 +106,6 @@
 (defvar lurk-error-prefix
   (propertize "!!!" 'face 'lurk-error))
 
-
 (defvar lurk-prompt-string
   (propertize "> " 'face 'lurk-prompt))
 
@@ -161,10 +164,13 @@
       (clrhash lurk-contexts)
       (setq lurk-current-context nil)
       (lurk-start-process network)
-      (lurk-send-msg (lurk-msg nil nil "USER" lurk-user-name 0 "*" lurk-full-name))
+      (lurk-send-msg (lurk-msg nil nil "USER" lurk-nick 0 "*" lurk-nick))
       (lurk-send-msg (lurk-msg nil nil "NICK" lurk-nick))
       (setq lurk-ping-timer (run-with-timer lurk-ping-period nil #'lurk-ping-function)))))
 
+(defun lurk-connected-p ()
+  (let ((proc (get-process "lurk")))
+    (and proc (eq (process-status proc) 'open))))
 
 (defun lurk-send-msg (msg)
   (let ((proc (get-process "lurk")))
@@ -280,6 +286,11 @@ portion of the source component of the message, as LURK doesn't use this.")
   (dolist (context (lurk-get-context-list))
     (lurk-del-context-user context user)))
 
+(defun lurk-rename-user (old-nick new-nick)
+  (dolist (context (lurk-get-context-list))
+    (lurk-del-context-user context old-nick)
+    (lurk-add-context-users context (list new-nick))))
+
 (defun lurk-get-context-type (name)
   (cond
    ((string-prefix-p "#" name) 'channel)
@@ -329,14 +340,15 @@ portion of the source component of the message, as LURK doesn't use this.")
       (goto-char lurk-prompt-marker)
       (let ((inhibit-read-only t)
             (old-pos (marker-position lurk-prompt-marker))
-            (adaptive-fill-regexp (rx (= 6 anychar))))
+            (adaptive-fill-regexp (rx (= 6 anychar)))
+            (fill-column 80))
         (insert-before-markers
          (propertize (concat (format-time-string "%H:%M") " ")
                      'face 'lurk-text
                      'read-only t)
          (propertize (concat (apply #'concat strings) "\n")
                      'read-only t))
-        (fill-region old-pos lurk-prompt-marker)))))
+        (fill-region old-pos lurk-prompt-marker nil t)))))
 
 (defun lurk-render-prompt ()
   (with-current-buffer "*lurk*"
@@ -391,7 +403,9 @@ portion of the source component of the message, as LURK doesn't use this.")
 ;;
 
 (defun lurk-display-message (from to text)
-  (let ((context (if (equal from lirc-nick) to from)))
+  (let ((context (if (eq 'channel (lurk-get-context-type to))
+                     to
+                   (if (equal to lurk-nick) from to))))
     (lurk-display-string
      (propertize
       (pcase (lurk-get-context-type to)
@@ -400,13 +414,15 @@ portion of the source component of the message, as LURK doesn't use this.")
         (_
          (error "Unsupported context type")))
       'face 'lurk-text
-      'help-echo (concat "Context: " to)))))
+      'help-echo (concat "Context: " context)
+      'context context))))
 
 (defun lurk-display-notice (context &rest notices)
   (lurk-display-string
    (propertize
     (concat lurk-notice-prefix " " (apply #'concat notices))
-    'help-echo (concat "Context: " (or context "none")))))
+    'help-echo (concat "Context: " (or context "none"))
+    'context context)))
 
 (defun lurk-display-error (&rest messages)
   (lurk-display-string
@@ -414,12 +430,32 @@ portion of the source component of the message, as LURK doesn't use this.")
            (propertize (apply #'concat messages)
                        'face 'lurk-error))))
 
+(defun lurk-highlight-context (context)
+  (with-current-buffer "*lurk*"
+    (let* ((pos lurk-prompt-marker)
+           (nextpos (previous-single-property-change pos 'context))
+           (inhibit-read-only t))
+      (while (> pos nextpos)
+        (let ((thiscontext (get-text-property nextpos 'context)))
+          (if thiscontext
+              (if (equal context thiscontext)
+                  (add-text-properties nextpos pos
+                                       '(face (foreground-color . "green")))
+                (add-text-properties nextpos pos
+                                     '(face (foreground-color . "blue"))))
+            (add-text-properties nextpos pos
+                                 '(face lurk-text)))
+          thiscontext
+          (setq pos nextpos)
+          (setq nextpos (previous-single-property-change pos 'context nil 1)))))))
+
 ;;; Message evaluation
 ;;
 
 (defun lurk-eval-msg-string (string)
   ;; (lurk-display-string string)
   (let* ((msg (lurk-string->msg string)))
+    ;; (message (pp msg))
     (pcase (lurk-msg-cmd msg)
       ("PING"
        (lurk-send-msg
@@ -429,6 +465,13 @@ portion of the source component of the message, as LURK doesn't use this.")
       ("PONG")
        ;; (lurk-display-notice nil "ping-pong (client initiated)"))
 
+      ("001"
+       (let* ((params (lurk-msg-params msg))
+              (nick (elt params 0))
+              (text (string-join (seq-drop params 1) " ")))
+         (setq lurk-nick nick)
+         (lurk-display-notice nil text)))
+
       ("353" ; NAMEREPLY
        (let* ((params (lurk-msg-params msg))
               (channel (elt params 2))
@@ -436,9 +479,12 @@ portion of the source component of the message, as LURK doesn't use this.")
          (lurk-add-context-users channel names)))
 
       ("366" ; ENDOFNAMES
-       (lurk-display-notice nil
-        (lurk--as-string (length (lurk-get-context-users lurk-current-context)))
-        " users in " lurk-current-context))
+       (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)))
 
       ((rx (= 3 (any digit)))
        (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " ")))
@@ -448,7 +494,7 @@ portion of the source component of the message, as LURK doesn't use this.")
        (let ((channel (car (lurk-msg-params msg))))
          (lurk-add-context channel)
          (setq lurk-current-context channel)
-         (lurk-display-notice nil "Joining channel " channel)
+         (lurk-display-notice channel "Joining channel " channel)
          (lurk-render-prompt)))
 
       ("JOIN"
@@ -486,8 +532,8 @@ portion of the source component of the message, as LURK doesn't use this.")
       ("NICK"
        (let ((old-nick (lurk-msg-src msg))
              (new-nick (car (lurk-msg-params msg))))
-         (lurk-display-notice nil nick " is now known as " new-nick)
-         (lurk-rename-user nick new-nick)))
+         (lurk-display-notice nil old-nick " is now known as " new-nick)
+         (lurk-rename-user old-nick new-nick)))
 
       ("NOTICE"
        (let ((nick (lurk-msg-src msg))
@@ -547,7 +593,7 @@ portion of the source component of the message, as LURK doesn't use this.")
                                         (concat "\01ACTION " action "\01"))))
          (lurk-display-action lurk-nick action))
 
-        ((rx (: "VERSION" " " (let nick (* (not whitespace)))))
+        ((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))
@@ -559,6 +605,19 @@ portion of the source component of the message, as LURK doesn't use this.")
                                                        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 "MSG "
              (let to (* (not whitespace)))
              " "
@@ -586,10 +645,10 @@ portion of the source component of the message, as LURK doesn't use this.")
   "Enter current contents of line after prompt."
   (interactive)
   (with-current-buffer "*lurk*"
-    (lurk-enter-string
-     (buffer-substring lurk-input-marker (point-max)))
-    (let ((inhibit-read-only t))
-      (delete-region lurk-input-marker (point-max)))))
+    (let ((line (buffer-substring lurk-input-marker (point-max))))
+      (let ((inhibit-read-only t))
+        (delete-region lurk-input-marker (point-max)))
+      (lurk-enter-string line))))
 
 
 ;;; Mode