Allowed forcing of ipv4.

[lurk.git] / lirc.el

diff --git a/lirc.el b/lirc.el
index e33f6cf..ad1a8fa 100644 (file)
--- a/lirc.el
+++ b/lirc.el
@@ -51,6 +51,9 @@
     ("local" "localhost" 6697))
   "IRC networks.")
 
+(defcustom lirc-allow-ipv6 nil
+  "Set to non-nil to allow use of IPv6.")
+
 ;;; Faces
 ;;
 
@@ -66,9 +69,9 @@
   '((t :inherit org-level-2))
   "Face used for the prompt.")
 
-(defface lirc-channel
+(defface lirc-context
   '((t :inherit org-list-dt))
-  "Face used for the channel name in the prompt.")
+  "Face used for the context name in the prompt.")
 
 (defface lirc-faded
   '((t :inherit font-lock-preprocessor-face))
@@ -115,31 +118,53 @@
         (lirc-eval-msg-string (string-trim line))
       (setq lirc-response line))))
 
+(defun lirc-sentinel (proc string)
+  (unless (equal "open" (string-trim string))
+    (lirc-display-error "Disconnected from server.")
+    (clrhash lirc-contexts)
+    (setq lirc-current-context nil)
+    (lirc-render-prompt)
+    (cancel-timer lirc-ping-timer)))
 
 (defun lirc-start-process (network)
   (let* ((row (assoc network lirc-networks))
          (host (elt row 1))
-         (port (elt row 2)))
+         (port (elt row 2))
+         (flags (seq-drop row 3)))
     (make-network-process :name "lirc"
                           :host host
                           :service port
+                          :family (if lirc-allow-ipv6 nil 'ipv4)
                           :filter #'lirc-filter
+                          :sentinel #'lirc-sentinel
                           :nowait nil
-                          :tls-parameters (cons 'gnutls-x509pki
-                                                (gnutls-boot-parameters
-                                                 :type 'gnutls-x509pki
-                                                 :hostname host))
+                          :tls-parameters (if (memq :notls flags)
+                                              nil
+                                            (cons 'gnutls-x509pki
+                                                  (gnutls-boot-parameters
+                                                   :type 'gnutls-x509pki
+                                                   :hostname host)))
                           :buffer "*lirc*")))
 
+(defvar lirc-ping-timer nil)
+(defvar lirc-ping-period 60)
+
+(defun lirc-ping-function ()
+  (lirc-send-msg (lirc-msg nil nil "PING" (car (process-contact (get-process "lirc")))))
+  (setq lirc-ping-timer (run-with-timer lirc-ping-period nil #'lirc-ping-function)))
 
 (defun lirc-connect (network)
   (if (get-process "lirc")
       (lirc-display-error "Already connected.  Disconnect first.")
-    (setq lirc-current-context nil)
-    (clrhash lirc-contexts)
-    (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))))
+    (if (not (assoc network lirc-networks))
+        (lirc-display-error "Network '" network "' is unknown.")
+      (clrhash lirc-contexts)
+      (setq lirc-current-context 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))
+      (setq lirc-ping-timer (run-with-timer lirc-ping-period nil #'lirc-ping-function)))))
+
 
 (defun lirc-send-msg (msg)
   (let ((proc (get-process "lirc")))
@@ -273,24 +298,31 @@ portion of the source component of the message, as LIRC doesn't use this.")
              lirc-contexts)
     res))
 
-(defun lirc-get-next-context ()
+(defun lirc-get-next-context (&optional prev)
   (if lirc-current-context
-      (let* ((context-list (lirc-get-context-list))
+      (let* ((context-list (if prev
+                               (reverse (lirc-get-context-list))
+                             (lirc-get-context-list)))
              (context-list* (member lirc-current-context context-list)))
         (if (> (length context-list*) 1)
             (cadr context-list*)
           (car context-list)))
     nil))
-    
 
-(defun lirc-cycle-contexts ()
-  (interactive)
-  (if lirc-current-channel
+(defun lirc-cycle-contexts (&optional rev)
+  (if lirc-current-context
       (progn
-        (setq lirc-current-channel (lirc-get-channel-next lirc-current-channel))
+        (setq lirc-current-context (lirc-get-next-context rev))
         (lirc-render-prompt))
     (lirc-display-error "No channels joined.")))
 
+(defun lirc-cycle-contexts-forward ()
+  (interactive)
+  (lirc-cycle-contexts))
+
+(defun lirc-cycle-contexts-reverse ()
+  (interactive)
+  (lirc-cycle-contexts t))
 
 ;;; Buffer
 ;;
@@ -417,7 +449,7 @@ portion of the source component of the message, as LIRC doesn't use this.")
 
       ("366" ; ENDOFNAMES
        (lirc-display-notice
-        (lirc-as-string (length (lirc-get-context-users lirc-current-context)))
+        (lirc--as-string (length (lirc-get-context-users lirc-current-context)))
         " users in " lirc-current-context))
 
       ((rx (= 3 (any digit)))
@@ -515,7 +547,7 @@ portion of the source component of the message, as LIRC doesn't use this.")
   (if (string-prefix-p "/" string)
       (pcase (substring string 1)
         ((rx (: "CONNECT " (let network (* not-newline))))
-         (lirc-display-notice "Connecting to " network "...")
+         (lirc-display-notice "Attempting to connect to " network "...")
          (lirc-connect network))
 
         ((rx (: "TOPIC " (let new-topic (* not-newline))))
@@ -543,8 +575,8 @@ portion of the source component of the message, as LIRC doesn't use this.")
              (let to (* (not whitespace)))
              " "
              (let text (* not-newline)))
-         (lirc-send-msg (lirc-msg nil nil "PRIVMSG" target text))
-         (lirc-display-message lirc-nick target text))
+         (lirc-send-msg (lirc-msg nil nil "PRIVMSG" to text))
+         (lirc-display-message lirc-nick to text))
 
         ((rx (: (let cmd-str (+ (not whitespace)))
                 (opt (: " " (let params-str (* not-newline))))))
@@ -578,7 +610,8 @@ portion of the source component of the message, as LIRC doesn't use this.")
 (defvar lirc-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") 'lirc-enter)
-    ;; (define-key map (kbd "<C-tab>") 'lirc-cycle-channels)
+    (define-key map (kbd "<C-tab>") 'lirc-cycle-contexts-forward)
+    (define-key map (kbd "<C-S-tab>") 'lirc-cycle-contexts-reverse)
     map))
 
 (define-derived-mode lirc-mode text-mode "lirc"