Added /connect and included filling.

[lurk.git] / lirc.el

diff --git a/lirc.el b/lirc.el
index 9b64811..a5a0500 100644 (file)
--- a/lirc.el
+++ b/lirc.el
@@ -43,10 +43,12 @@
   "Default full name.")
 (defcustom lirc-user-name "plugd"
   "Default user name.")
-(defcustom lirc-host "irc.libera.chat"
-  "Default server.")
-(defcustom lirc-port 6697
-  "Default port.")
+
+(defcustom lirc-networks
+  '(("libera" "irc.libera.chat" 6697)
+    ("freenode" "chat.freenode.net" 6697)
+    ("local" "localhost" 6697))
+  "IRC networks.")
 
 (defcustom lirc-prompt-string "> "
   "Prompt.")
@@ -72,11 +74,15 @@
 
 (defface lirc-faded
   '((t :inherit font-lock-preprocessor-face))
-  "Face used for Lirc text.")
+  "Face used for faded Lirc text.")
 
 (defface lirc-bold
   '((t :inherit font-lock-function-name-face))
-  "Face used for Lirc text.")
+  "Face used for bold Lirc text.")
+
+(defface lirc-error
+  '((t :inherit font-lock-regexp-grouping-construct))
+  "Face used for Lirc error text.")
 
 ;;; Global variables
 ;;
@@ -91,7 +97,9 @@
     "!" 'face 'lirc-bold)
    (propertize
     "-" 'face 'lirc-faded)))
-   
+
+(defvar lirc-error-prompt
+  (propertize "!!!" 'face 'lirc-error))
 
 ;;; Network process
 ;;
@@ -104,20 +112,38 @@
         (lirc-eval-msg-string (string-trim line))
       (setq lirc-response line))))
 
-(defun lirc-get-process ()
+(defun lirc-sentinel (proc string)
+  (message string))
+
+(defun lirc-start-process (network)
+  (let* ((row (assoc network lirc-networks))
+         (host (elt row 1))
+         (port (elt row 2)))
+    (make-network-process :name "lirc"
+                          :host host
+                          :service port
+                          :filter #'lirc-filter
+                          :nowait nil
+                          :tls-parameters (cons 'gnutls-x509pki
+                                                (gnutls-boot-parameters
+                                                 :type 'gnutls-x509pki
+                                                 :hostname host))
+                          :buffer "*lirc*")))
+
+
+(defun lirc-connect (network)
+  (setq lirc-channel-list nil)
+  (setq lirc-current-channel nil)
+  (lirc-start-process network)
+  (lirc-send-msg (lirc-msg nil nil "USER" lirc-user-name 0 "*" lirc-full-name))
+  (lirc-send-msg (lirc-msg nil nil "NICK" lirc-nick)))
+
+(defun lirc-send-msg (msg)
   (let ((proc (get-process "lirc")))
     (if (and proc (eq (process-status proc) 'open))
-        proc
-      (make-network-process :name "lirc"
-                            :host lirc-host
-                            :service lirc-port
-                            :filter #'lirc-filter
-                            :nowait nil
-                            :tls-parameters (cons 'gnutls-x509pki
-                                                  (gnutls-boot-parameters
-                                                   :type 'gnutls-x509pki
-                                                   :hostname lirc-host))
-                            :buffer "*lirc*"))))
+        (process-send-string proc (concat (lirc-msg->string msg) "\r\n"))
+      (lirc-display-error "No server connection established.")
+      (error "No server connection established"))))
 
 ;;; Messages
 ;;
@@ -244,27 +270,22 @@ portion of the source component of the message, as LIRC doesn't use this.")
   (with-current-buffer (get-buffer-create "*lirc*")
     (save-excursion
       (goto-char lirc-prompt-marker)
-      (let ((inhibit-read-only t))
+      (let ((inhibit-read-only t)
+            (old-pos (marker-position lirc-prompt-marker))
+            (adaptive-fill-regexp (rx (= 6 anychar))))
         (insert-before-markers
          (propertize (concat (format-time-string "%H:%M") " ")
                      'face 'lirc-text
                      'read-only t)
          (propertize (concat (apply #'concat strings) "\n")
-                     'read-only t))))))
-
-(defun lirc-connect ()
-  (lirc-send-msg (lirc-msg nil nil "USER" lirc-user-name 0 "*" lirc-full-name))
-  (lirc-send-msg (lirc-msg nil nil "NICK" lirc-nick)))
-
-(defun lirc-send-msg (msg)
-  (let ((proc (lirc-get-process)))
-    (process-send-string proc (concat (lirc-msg->string msg) "\r\n"))))
+                     'read-only t))
+        (fill-region old-pos lirc-prompt-marker)))))
 
 (defun lirc-render-prompt ()
   (with-current-buffer "*lirc*"
-    (set-marker-insertion-type lirc-prompt-marker nil)
-    (set-marker-insertion-type lirc-input-marker t)
     (save-excursion
+      (set-marker-insertion-type lirc-prompt-marker nil)
+      (set-marker-insertion-type lirc-input-marker t)
       (let ((inhibit-read-only t))
         (delete-region lirc-prompt-marker lirc-input-marker)
         (goto-char lirc-prompt-marker)
@@ -277,8 +298,8 @@ portion of the source component of the message, as LIRC doesn't use this.")
          (propertize lirc-prompt-string
                      'face 'lirc-prompt
                      'read-only t
-                     'rear-nonsticky t)))))
-  (set-marker-insertion-type lirc-input-marker nil))
+                     'rear-nonsticky t)))
+      (set-marker-insertion-type lirc-input-marker nil))))
   
 (defvar lirc-prompt-marker nil
   "Marker for prompt position in LIRC buffer.")
@@ -322,6 +343,11 @@ portion of the source component of the message, as LIRC doesn't use this.")
 (defun lirc-display-notice (&rest notices)
   (lirc-display-string lirc-notice-prompt " " (apply #'concat notices)))
 
+(defun lirc-display-error (&rest messages)
+  (lirc-display-string lirc-error-prompt " "
+                       (propertize (apply #'concat messages)
+                                   'face 'lirc-error)))
+
 ;;; Message evaluation
 ;;
 
@@ -331,7 +357,8 @@ portion of the source component of the message, as LIRC doesn't use this.")
     (pcase (lirc-msg-cmd msg)
       ("PING"
        (lirc-send-msg
-        (lirc-msg nil nil "PONG" (lirc-msg-params msg))))
+        (lirc-msg nil nil "PONG" (lirc-msg-params msg)))
+       (lirc-display-notice "ping-pong"))
 
       ("353" ; NAMEREPLY
        (let* ((params (lirc-msg-params msg))
@@ -352,6 +379,7 @@ portion of the source component of the message, as LIRC doesn't use this.")
        (let ((channel (car (lirc-msg-params msg))))
          (setq lirc-current-channel channel)
          (lirc-add-channel channel)
+         (lirc-display-notice "Joining channel " channel)
          (lirc-render-prompt)))
 
       ("JOIN"
@@ -362,9 +390,12 @@ portion of the source component of the message, as LIRC doesn't use this.")
 
       ((and "PART"
             (guard (equal lirc-nick (lirc-msg-src msg))))
-       (setq lirc-current-channel nil)
-       (lirc-del-channel (car (lirc-msg-params msg)))
-       (lirc-render-prompt))
+       (let ((channel (car (lirc-msg-params msg))))
+         (lirc-display-notice "Left channel " channel)
+         (lirc-del-channel (car (lirc-msg-params msg)))
+         (when (equal lirc-current-channel channel)
+           (setq lirc-current-channel nil)
+           (lirc-render-prompt))))
 
       ("PART"
        (let ((channel (car (lirc-msg-params msg)))
@@ -438,10 +469,14 @@ portion of the source component of the message, as LIRC doesn't use this.")
 (defun lirc-enter-string (string)
   (if (string-prefix-p "/" string)
       (pcase (substring string 1)
-        ((rx (: "TOPIC" " " (let new-topic (* not-newline))))
+        ((rx (: "CONNECT " (let network (* not-newline))))
+         (lirc-display-notice "Connecting to " network "...")
+         (lirc-connect network))
+
+        ((rx (: "TOPIC " (let new-topic (* not-newline))))
          (lirc-send-msg (lirc-msg nil nil "TOPIC" lirc-current-channel new-topic)))
 
-        ((rx (: "me" " " (let action (* not-newline))))
+        ((rx (: "ME " (let action (* not-newline))))
          (lirc-send-msg (lirc-msg nil nil "PRIVMSG"
                                   (list lirc-current-channel
                                         (concat "\01ACTION " action "\01"))))
@@ -452,8 +487,12 @@ portion of the source component of the message, as LIRC doesn't use this.")
                                   (list nick "\01VERSION\01")))
          (lirc-display-notice "CTCP version request sent to " nick))
 
-        ((rx "PART")
-         (lirc-send-msg (lirc-msg nil nil "PART" lirc-current-channel)))
+        ((rx "PART" (opt (: " " (let channel (* not-newline)))))
+         (if (or lirc-current-channel channel)
+             (lirc-send-msg (lirc-msg nil nil "PART" (if channel
+                                                         channel
+                                                       lirc-current-channel)))
+           (lirc-display-error "No current channel to leave.")))
 
         ((rx "MSG "
              (let target (* (not whitespace)))
@@ -470,8 +509,11 @@ portion of the source component of the message, as LIRC doesn't use this.")
                                     nil)))))
 
     (unless (string-empty-p string)
-      (lirc-send-msg (lirc-msg nil nil "PRIVMSG" lirc-current-channel string))
-      (lirc-display-message lirc-current-channel lirc-nick string))))
+      (if lirc-current-channel
+          (progn
+            (lirc-send-msg (lirc-msg nil nil "PRIVMSG" lirc-current-channel string))
+            (lirc-display-message lirc-current-channel lirc-nick string))
+        (lirc-display-error "No current channel.")))))
 
 (defun lirc-enter ()
   "Enter current contents of line after prompt."
@@ -509,7 +551,6 @@ portion of the source component of the message, as LIRC doesn't use this.")
     (switch-to-buffer "*lirc*"))
   (lirc-mode)
   (lirc-setup-buffer)
-  (lirc-connect)
   "Started LIRC.")