X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=lirc.el;h=ad1a8faca0aaa5e5b2880803962d3b59dd2ab380;hb=ecc4dd4e33a620a6d365b1b433d92d66642ecf84;hp=e33f6cf8c4b544708a03e97de96d47672a9c217f;hpb=03b441c5ba7075419f91a84427b1afa1093f5d22;p=lurk.git diff --git a/lirc.el b/lirc.el index e33f6cf..ad1a8fa 100644 --- 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 "") 'lirc-cycle-channels) + (define-key map (kbd "") 'lirc-cycle-contexts-forward) + (define-key map (kbd "") 'lirc-cycle-contexts-reverse) map)) (define-derived-mode lirc-mode text-mode "lirc"