X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=lirc.el;h=5244c2fb24a2f8d2a16037f5fd243304f077f235;hb=49da19f67a7d502563af92f60a43af846b69112f;hp=e6f47fb921f8b2153884f0b4f5cea719003d06a5;hpb=b37326a2c75f1296109c1a1574aac74eaaf419a4;p=lurk.git diff --git a/lirc.el b/lirc.el index e6f47fb..5244c2f 100644 --- 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 "> " @@ -70,11 +70,35 @@ '((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 faded Lirc text.") + +(defface lirc-bold + '((t :inherit font-lock-function-name-face)) + "Face used for bold Lirc text.") + +(defface lirc-error + '((t :inherit font-lock-regexp-grouping-construct)) + "Face used for Lirc error 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))) + +(defvar lirc-error-prompt + (propertize "!!!" 'face 'lirc-error)) + ;;; Network process ;; @@ -87,16 +111,23 @@ (lirc-eval-msg-string (string-trim line)) (setq lirc-response line)))) -(defun lirc-get-process () +(defun lirc-get-process (&optional connect) (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 t - :buffer "*lirc*")))) + (if connect + (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*") + (lirc-display-error "No server connection established.") + (error "No server connection established"))))) ;;; Messages ;; @@ -203,6 +234,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 ;; @@ -220,6 +263,7 @@ portion of the source component of the message, as LIRC doesn't use this.") 'read-only t)))))) (defun lirc-connect () + (lirc-get-process t) (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))) @@ -229,9 +273,9 @@ portion of the source component of the message, as LIRC doesn't use this.") (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) @@ -244,8 +288,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.") @@ -287,7 +331,12 @@ 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))) + +(defun lirc-display-error (&rest messages) + (lirc-display-string lirc-error-prompt " " + (propertize (apply #'concat messages) + 'face 'lirc-error))) ;;; Message evaluation ;; @@ -306,6 +355,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)) " "))) @@ -314,18 +368,23 @@ 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" (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)))) - (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))) @@ -344,6 +403,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 +417,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)) @@ -405,8 +472,19 @@ 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))) + " " + (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)))))) @@ -416,8 +494,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."