Now using TLS, improved handling of joins/quits.
authorTim Vaughan <plugd@thelambdalab.xyz>
Mon, 21 Jun 2021 08:50:45 +0000 (10:50 +0200)
committerTim Vaughan <plugd@thelambdalab.xyz>
Mon, 21 Jun 2021 08:50:45 +0000 (10:50 +0200)
lirc.el

diff --git a/lirc.el b/lirc.el
index e6f47fb..9b64811 100644 (file)
--- a/lirc.el
+++ b/lirc.el
@@ -43,9 +43,9 @@
   "Default full name.")
 (defcustom lirc-user-name "plugd"
   "Default user name.")
-(defcustom lirc-host "localhost"
+(defcustom lirc-host "irc.libera.chat"
   "Default server.")
-(defcustom lirc-port 6667
+(defcustom lirc-port 6697
   "Default port.")
 
 (defcustom lirc-prompt-string "> "
   '((t :inherit org-list-dt))
   "Face used for the channel name in the prompt.")
 
+(defface lirc-faded
+  '((t :inherit font-lock-preprocessor-face))
+  "Face used for Lirc text.")
+
+(defface lirc-bold
+  '((t :inherit font-lock-function-name-face))
+  "Face used for Lirc text.")
+
 ;;; Global variables
 ;;
 
 (defvar lirc-version "Lirc v0.1")
 
+(defvar lirc-notice-prompt
+  (concat
+   (propertize
+    "-" 'face 'lirc-faded)
+   (propertize
+    "!" 'face 'lirc-bold)
+   (propertize
+    "-" 'face 'lirc-faded)))
+   
 
 ;;; Network process
 ;;
                             :host lirc-host
                             :service lirc-port
                             :filter #'lirc-filter
-                            :nowait t
+                            :nowait nil
+                            :tls-parameters (cons 'gnutls-x509pki
+                                                  (gnutls-boot-parameters
+                                                   :type 'gnutls-x509pki
+                                                   :hostname lirc-host))
                             :buffer "*lirc*"))))
 
 ;;; Messages
@@ -203,6 +224,18 @@ portion of the source component of the message, as LIRC doesn't use this.")
     (lirc-set-channel-users channel-name
                             (cl-set-difference current-users users :test #'equal))))
 
+(defun lirc-del-users (&rest users)
+  (dolist (channel lirc-channel-list)
+    (apply #'lirc-del-channel-users (cons (car channel) users))))
+
+(defun lirc-rename-user (old-nick new-nick)
+  (dolist (channel lirc-channel-list)
+    (let ((channel-name (car channel))
+          (channel-users (cdr channel)))
+      (when (memq old-nick channel-users)
+        (lirc-del-channel-users old-nick)
+        (lirc-add-channel-users new-nick)))))
+
 
 ;;; Buffer
 ;;
@@ -287,7 +320,7 @@ portion of the source component of the message, as LIRC doesn't use this.")
     (propertize message 'face 'lirc-text))))
 
 (defun lirc-display-notice (&rest notices)
-  (lirc-display-string "*** " (apply #'concat notices)))
+  (lirc-display-string lirc-notice-prompt " " (apply #'concat notices)))
 
 ;;; Message evaluation
 ;;
@@ -306,6 +339,11 @@ portion of the source component of the message, as LIRC doesn't use this.")
               (names (split-string (elt params 3))))
          (apply #'lirc-add-channel-users (cons channel names))))
 
+      ("366" ; ENDOFNAMES
+       (lirc-display-notice
+        (lirc-as-string (length (lirc-get-channel-users lirc-current-channel)))
+        " users in " lirc-current-channel))
+
       ((rx (= 3 (any digit)))
        (lirc-display-notice (mapconcat 'identity (cdr (lirc-msg-params msg)) " ")))
 
@@ -319,7 +357,8 @@ portion of the source component of the message, as LIRC doesn't use this.")
       ("JOIN"
        (let ((channel (car (lirc-msg-params msg)))
              (nick (lirc-msg-src msg)))
-         (lirc-add-channel-users channel nick)))
+         (lirc-add-channel-users channel nick)
+         (lirc-display-notice nick " joined channel " channel)))
 
       ((and "PART"
             (guard (equal lirc-nick (lirc-msg-src msg))))
@@ -344,6 +383,12 @@ portion of the source component of the message, as LIRC doesn't use this.")
        (setq lirc-nick (car (lirc-msg-params msg)))
        (lirc-display-notice "Set nick to " lirc-nick))
 
+      ("NICK"
+       (let ((old-nick (lirc-msg-src msg))
+             (new-nick (car (lirc-msg-params msg))))
+         (lirc-display-notice nick " is now known as " new-nick)
+         (lirc-rename-user nick new-nick)))
+
       ("NOTICE"
        (let ((nick (lirc-msg-src msg))
              (channel (car (lirc-msg-params msg)))
@@ -352,7 +397,9 @@ portion of the source component of the message, as LIRC doesn't use this.")
            ((rx (: "\01VERSION "
                    (let version (* (not "\01")))
                    "\01"))
-            (lirc-display-notice "CTCP version reply from " nick ": " version)))))
+            (lirc-display-notice "CTCP version reply from " nick ": " version))
+           (_
+            (lirc-display-notice text)))))
 
       ("PRIVMSG"
        (let ((nick (lirc-msg-src msg))
@@ -408,6 +455,13 @@ portion of the source component of the message, as LIRC doesn't use this.")
         ((rx "PART")
          (lirc-send-msg (lirc-msg nil nil "PART" lirc-current-channel)))
 
+        ((rx "MSG "
+             (let target (* (not whitespace)))
+             " "
+             (let text (* not-newline)))
+         (lirc-send-msg (lirc-msg nil nil "PRIVMSG" target text))
+         (lirc-display-message target lirc-nick text))
+
         ((rx (: (let cmd-str (+ (not whitespace)))
                 (opt (: " " (let params-str (* not-newline))))))
          (lirc-send-msg (lirc-msg nil nil (upcase cmd-str)