From 2e610b17a9e80e721575f6a9118920b64e2443a7 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Wed, 23 Jun 2021 09:15:11 +0200 Subject: [PATCH] Switched to alternative data structure for channels. --- lirc.el | 193 +++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 134 insertions(+), 59 deletions(-) diff --git a/lirc.el b/lirc.el index a5a0500..9a5f681 100644 --- a/lirc.el +++ b/lirc.el @@ -112,8 +112,6 @@ (lirc-eval-msg-string (string-trim line)) (setq lirc-response line)))) -(defun lirc-sentinel (proc string) - (message string)) (defun lirc-start-process (network) (let* ((row (assoc network lirc-networks)) @@ -221,47 +219,108 @@ portion of the source component of the message, as LIRC doesn't use this.") nil)))) -;;; Channels +;;; Channels and users ;; (defvar lirc-current-channel nil) -(defvar lirc-channel-list nil) -(defun lirc-add-channel (channel-name) - (add-to-list 'lirc-channel-list - (list channel-name))) - -(defun lirc-del-channel (channel-name) - (setq lirc-channel-list - (assoc-delete-all channel-name lirc-channel-list))) - -(defun lirc-get-channel-users (channel-name) - (cdr (assoc channel-name lirc-channel-list))) +(defun lirc-channel (name next prev users) + (list name prev next users)) + +(defun lirc-get-channel-name (channel) + (elt channel 0)) +(defun lirc-get-channel-next (channel) + (elt channel 1)) +(defun lirc-get-channel-prev (channel) + (elt channel 2)) +(defun lirc-get-channel-users (channel) + (elt channel 3)) + +(defun lirc-set-channel-name (channel name) + (setf (elt channel 0) name)) +(defun lirc-set-channel-next (channel next) + (setf (elt channel 1) next)) +(defun lirc-set-channel-prev (channel prev) + (setf (elt channel 2) prev)) +(defun lirc-set-channel-users (channel users) + (setf (elt channel 3) users)) + +(defun lirc-add-channel (new-channel) + (if lirc-current-channel + (let* ((prev lirc-current-channel) + (next (lirc-get-channel-next lirc-current-channel))) + (lirc-set-channel-next new-channel prev) + (lirc-set-channel-prev new-channel next)) + (lirc-set-channel-next new-channel new-channel) + (lirc-set-channel-prev new-channel new-channel)) + (setq lirc-current-channel new-channel)) + +(defun lirc-del-channel (channel) + (let ((prev (lirc-get-channel-prev channel)) + (next (lirc-get-channel-next channel))) + (if (and prev next) + (if (eq prev next) + (progn + (lirc-set-channel-next prev nil) + (lirc-set-channel-prev prev nil) + (setq lirc-current-channel prev)) + (lirc-set-channel-next prev next) + (lirc-set-channel-prev next prev) + (if (eq channel lirc-current-channel) + (setq lirc-current-channel prev))) + (setq lirc-current-channel nil)))) + +(defun lirc-channel-do (proc) + (if lirc-current-channel + (let ((channel lirc-current-channel)) + (funcall proc lirc-current-channel) + (while (not (eq (lirc-get-channel-next channel) lirc-current-channel)) + (setq channel (lirc-get-channel-next channel)) + (funcall proc channel))))) + +(defun lirc-get-channel-with-name (channel-name) + (if lirc-current-channel + (let ((channel lirc-current-channel)) + (while (and (not (equal (lirc-get-channel-name channel) channel-name)) + (not (eq (lirc-get-channel-next channel) lirc-current-channel))) + (setq channel (lirc-get-channel-next channel))) + (if (equal (lirc-get-channel-name channel) channel-name) + channel + nil)) + nil)) -(defun lirc-set-channel-users (channel-name users) - (setcdr (assoc channel-name lirc-channel-list) users)) +(defun lirc-add-channel-with-name (channel-name) + (lirc-add-channel (lirc-channel channel-name nil nil nil))) -(defun lirc-add-channel-users (channel-name &rest users) - (let ((current-users (lirc-get-channel-users channel-name))) - (lirc-set-channel-users channel-name (append users current-users)))) +(defun lirc-add-channel-users (channel &rest users) + (lirc-set-channel-users channel (append users (lirc-get-channel-users channel)))) -(defun lirc-del-channel-users (channel-name &rest users) - (let ((current-users (lirc-get-channel-users channel-name))) - (lirc-set-channel-users channel-name - (cl-set-difference current-users users :test #'equal)))) +(defun lirc-del-channel-users (channel &rest users) + (lirc-set-channel-users channel (cl-set-difference (lirc-get-channel-users channel) users))) (defun lirc-del-users (&rest users) - (dolist (channel lirc-channel-list) - (apply #'lirc-del-channel-users (cons (car channel) users)))) + (lirc-channel-do + (lambda (channel) + (lirc-set-channel-users + channel + (cl-set-difference + (lirc-get-channel-users channel) + users + :test #'equal))))) (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))))) + (lirc-channel-do + (lambda (channel) + (lirc-set-channel-users + (cons new-nick (delete old-nick (lirc-get-channel-users channel))))))) +(defun lirc-cycle-channels () + (interactive) + (if lirc-current-channel + (progn + (setq lirc-current-channel (lirc-get-channel-next lirc-current-channel)) + (lirc-render-prompt)) + (lirc-display-error "No channels joined."))) ;;; Buffer ;; @@ -291,7 +350,7 @@ portion of the source component of the message, as LIRC doesn't use this.") (goto-char lirc-prompt-marker) (insert (propertize (if lirc-current-channel - lirc-current-channel + (lirc-get-channel-name lirc-current-channel) "[no channel]") 'face 'lirc-channel 'read-only t) @@ -323,15 +382,28 @@ portion of the source component of the message, as LIRC doesn't use this.") ;;; Output formatting ;; -(defun lirc-display-action (channel nick action) - (lirc-display-string (concat " * " +(defun lirc-display-action (channel-name nick action) + (lirc-display-string (concat channel-name + " * " (propertize (concat nick " " action) 'face 'lirc-text)))) +(defun lirc-display-private-message (target nick message) + (lirc-display-string + (concat + (propertize + (concat "[P]" + (if (equal target lirc-nick) + "<- " + "-> ")) + 'face 'lirc-bold) + (propertize (concat "<" nick "> " message) 'face 'lirc-text)))) + + (defun lirc-display-message (channel nick message) (lirc-display-string (concat - (propertize (concat channel " ") + (propertize (concat (lirc-get-channel-name channel) " ") 'face 'lirc-text) (propertize (concat "<" nick "> ") 'face @@ -362,46 +434,44 @@ portion of the source component of the message, as LIRC doesn't use this.") ("353" ; NAMEREPLY (let* ((params (lirc-msg-params msg)) - (channel (elt params 2)) + (channel-name (elt params 2)) (names (split-string (elt params 3)))) - (apply #'lirc-add-channel-users (cons channel names)))) + (apply #'lirc-add-channel-users + (cons (lirc-get-channel-with-name channel-name) names)))) ("366" ; ENDOFNAMES (lirc-display-notice (lirc-as-string (length (lirc-get-channel-users lirc-current-channel))) - " users in " lirc-current-channel)) + " users in " (lirc-get-channel-name lirc-current-channel))) ((rx (= 3 (any digit))) (lirc-display-notice (mapconcat 'identity (cdr (lirc-msg-params msg)) " "))) ((and "JOIN" (guard (equal lirc-nick (lirc-msg-src msg)))) - (let ((channel (car (lirc-msg-params msg)))) - (setq lirc-current-channel channel) - (lirc-add-channel channel) - (lirc-display-notice "Joining channel " channel) + (let ((channel-name (car (lirc-msg-params msg)))) + (lirc-add-channel-with-name channel-name) + (lirc-display-notice "Joining channel " channel-name) (lirc-render-prompt))) ("JOIN" - (let ((channel (car (lirc-msg-params msg))) + (let ((channel-name (car (lirc-msg-params msg))) (nick (lirc-msg-src msg))) - (lirc-add-channel-users channel nick) - (lirc-display-notice nick " joined channel " channel))) + (lirc-add-channel-users (lirc-get-channel-with-name channel-name) nick) + (lirc-display-notice nick " joined channel " channel-name))) ((and "PART" (guard (equal lirc-nick (lirc-msg-src msg)))) - (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)))) + (let ((channel-name (car (lirc-msg-params msg)))) + (lirc-display-notice "Left channel " channel-name) + (lirc-del-channel (lirc-get-channel-with-name channel-name)) + (lirc-render-prompt))) ("PART" - (let ((channel (car (lirc-msg-params msg))) + (let ((channel-name (car (lirc-msg-params msg))) (nick (lirc-msg-src msg))) - (lirc-del-channel-users channel nick) - (lirc-display-notice nick " left channel " channel))) + (lirc-del-channel-users (lirc-get-channel channel-name) nick) + (lirc-display-notice nick " left channel " channel-name))) ("QUIT" (let ((nick (lirc-msg-src msg)) @@ -434,13 +504,13 @@ portion of the source component of the message, as LIRC doesn't use this.") ("PRIVMSG" (let ((nick (lirc-msg-src msg)) - (channel (car (lirc-msg-params msg))) + (channel (lirc-get-channel-with-name (car (lirc-msg-params msg)))) (text (cadr (lirc-msg-params msg)))) (pcase text ((rx (: "\01ACTION " (let action (* (not "\01"))) "\01")) - (lirc-display-action nick action)) + (lirc-display-action channel nick action)) ("\01VERSION\01" (let ((version-string (concat lirc-version " - running on GNU Emacs " emacs-version))) @@ -458,7 +528,9 @@ portion of the source component of the message, as LIRC doesn't use this.") (lirc-display-notice "CTCP userinfo request from " nick " (no response sent)")) (_ - (lirc-display-message channel nick text))))) + (if channel + (lirc-display-message channel nick text) + (lirc-display-private-message (car (lirc-msg-params msg)) nick text)))))) (_ (lirc-display-string (lirc-msg->string msg)))))) @@ -499,7 +571,7 @@ portion of the source component of the message, as LIRC doesn't use this.") " " (let text (* not-newline))) (lirc-send-msg (lirc-msg nil nil "PRIVMSG" target text)) - (lirc-display-message target lirc-nick text)) + (lirc-display-private-message target lirc-nick text)) ((rx (: (let cmd-str (+ (not whitespace))) (opt (: " " (let params-str (* not-newline)))))) @@ -511,7 +583,9 @@ portion of the source component of the message, as LIRC doesn't use this.") (unless (string-empty-p string) (if lirc-current-channel (progn - (lirc-send-msg (lirc-msg nil nil "PRIVMSG" lirc-current-channel string)) + (lirc-send-msg (lirc-msg nil nil "PRIVMSG" + (lirc-get-channel-name lirc-current-channel) + string)) (lirc-display-message lirc-current-channel lirc-nick string)) (lirc-display-error "No current channel."))))) @@ -532,6 +606,7 @@ 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) map)) (define-derived-mode lirc-mode text-mode "lirc" -- 2.20.1