From b0fd29a0bc378d473ede724d8226ac988c3d5627 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Tue, 29 Jun 2021 23:05:42 +0200 Subject: [PATCH] Told display-notice about the current context. --- lurk.el | 116 +++++++++++++++++++++++++------------------------------- 1 file changed, 52 insertions(+), 64 deletions(-) diff --git a/lurk.el b/lurk.el index 06df515..82a43f2 100644 --- a/lurk.el +++ b/lurk.el @@ -6,7 +6,7 @@ ;; Created: 14 June 2021 ;; Version: 1.0 ;; Keywords: network -;; Homepage: http://thelambdalab.xyz/erc +;; Homepage: http://thelambdalab.xyz/lurk ;; Package-Requires: ((emacs "26")) ;; This file is not part of GNU Emacs. @@ -250,14 +250,9 @@ portion of the source component of the message, as LURK doesn't use this.") nil)))) -;;; Contexts and users +;;; Contexts ;; -(defvar lurk-context-table - '((channel lurk-display-channel-message) - (nick lurk-display-private-message) - (host lurk-diaplay-server-message))) - (defvar lurk-current-context nil) (defvar lurk-contexts (make-hash-table :test #'equal)) @@ -324,6 +319,7 @@ portion of the source component of the message, as LURK doesn't use this.") (interactive) (lurk-cycle-contexts t)) + ;;; Buffer ;; @@ -380,6 +376,7 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-setup-buffer () (with-current-buffer (get-buffer-create "*lurk*") + (setq-local scroll-conservatively 1) (if (markerp lurk-prompt-marker) (set-marker lurk-prompt-marker (point-max)) (setq lurk-prompt-marker (point-max-marker))) @@ -394,40 +391,28 @@ portion of the source component of the message, as LURK doesn't use this.") ;; (defun lurk-display-message (from to text) - (let* ((to-type (lurk-get-context-type to)) - (display-fun (cadr (assoc to-type lurk-context-table)))) - (funcall display-fun from to text))) - -(defun lurk-display-channel-message (from to text) - (lurk-display-string - (propertize (concat to - " <" from "> " - text) - 'face 'lurk-text))) - - -(defun lurk-display-action (channel-name nick action) - (lurk-display-string (concat channel-name - " * " - (propertize (concat nick " " action) - 'face 'lurk-text)))) - -(defun lurk-display-private-message (from to text) + (let ((context (if (equal from lirc-nick) to from))) + (lurk-display-string + (propertize + (pcase (lurk-get-context-type to) + ('channel (concat to " <" from "> " text)) + ('nick (concat "[" from " -> " to "] " text)) + (_ + (error "Unsupported context type"))) + 'face 'lurk-text + 'help-echo (concat "Context: " to))))) + +(defun lurk-display-notice (context &rest notices) (lurk-display-string - (concat - (propertize - (concat "[" from " -> " to "] " - text) - 'face 'lurk-text)))) - - -(defun lurk-display-notice (&rest notices) - (lurk-display-string lurk-notice-prefix " " (apply #'concat notices))) + (propertize + (concat lurk-notice-prefix " " (apply #'concat notices)) + 'help-echo (concat "Context: " (or context "none"))))) (defun lurk-display-error (&rest messages) - (lurk-display-string lurk-error-prefix " " - (propertize (apply #'concat messages) - 'face 'lurk-error))) + (lurk-display-string + (concat lurk-error-prefix " " + (propertize (apply #'concat messages) + 'face 'lurk-error)))) ;;; Message evaluation ;; @@ -438,8 +423,11 @@ portion of the source component of the message, as LURK doesn't use this.") (pcase (lurk-msg-cmd msg) ("PING" (lurk-send-msg - (lurk-msg nil nil "PONG" (lurk-msg-params msg))) - (lurk-display-notice "ping-pong")) + (lurk-msg nil nil "PONG" (lurk-msg-params msg)))) + ;; (lurk-display-notice nil "ping-pong (server initiated)")) + + ("PONG") + ;; (lurk-display-notice nil "ping-pong (client initiated)")) ("353" ; NAMEREPLY (let* ((params (lurk-msg-params msg)) @@ -448,57 +436,57 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-add-context-users channel names))) ("366" ; ENDOFNAMES - (lurk-display-notice + (lurk-display-notice nil (lurk--as-string (length (lurk-get-context-users lurk-current-context))) " users in " lurk-current-context)) ((rx (= 3 (any digit))) - (lurk-display-notice (mapconcat 'identity (cdr (lurk-msg-params msg)) " "))) + (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " "))) ((and "JOIN" (guard (equal lurk-nick (lurk-msg-src msg)))) - (let ((channel-name (car (lurk-msg-params msg)))) - (lurk-add-context channel-name) - (setq lurk-current-context channel-name) - (lurk-display-notice "Joining channel " channel-name) + (let ((channel (car (lurk-msg-params msg)))) + (lurk-add-context channel) + (setq lurk-current-context channel) + (lurk-display-notice nil "Joining channel " channel) (lurk-render-prompt))) ("JOIN" - (let ((channel-name (car (lurk-msg-params msg))) + (let ((channel (car (lurk-msg-params msg))) (nick (lurk-msg-src msg))) - (lurk-add-context-users channel-name (list nick)) - (lurk-display-notice nick " joined channel " channel-name))) + (lurk-add-context-users channel (list nick)) + (lurk-display-notice channel nick " joined channel " channel))) ((and "PART" (guard (equal lurk-nick (lurk-msg-src msg)))) - (let ((channel-name (car (lurk-msg-params msg)))) - (lurk-display-notice "Left channel " channel-name) - (lurk-del-context channel-name) - (if (equal channel-name lurk-current-context) + (let ((channel (car (lurk-msg-params msg)))) + (lurk-display-notice channel "Left channel " channel) + (lurk-del-context channel) + (if (equal channel lurk-current-context) (setq lurk-current-context (lurk-get-next-context))) (lurk-render-prompt))) ("PART" - (let ((channel-name (car (lurk-msg-params msg))) + (let ((channel (car (lurk-msg-params msg))) (nick (lurk-msg-src msg))) - (lurk-del-context-user channel-name nick) - (lurk-display-notice nick " left channel " channel-name))) + (lurk-del-context-user channel nick) + (lurk-display-notice channel nick " left channel " channel))) ("QUIT" (let ((nick (lurk-msg-src msg)) (reason (mapconcat 'identity (lurk-msg-params msg) " "))) (lurk-del-user nick) - (lurk-display-notice nick " quit: " reason))) + (lurk-display-notice nil nick " quit: " reason))) ((and "NICK" (guard (equal lurk-nick (lurk-msg-src msg)))) (setq lurk-nick (car (lurk-msg-params msg))) - (lurk-display-notice "Set nick to " lurk-nick)) + (lurk-display-notice nil "Set nick to " lurk-nick)) ("NICK" (let ((old-nick (lurk-msg-src msg)) (new-nick (car (lurk-msg-params msg)))) - (lurk-display-notice nick " is now known as " new-nick) + (lurk-display-notice nil nick " is now known as " new-nick) (lurk-rename-user nick new-nick))) ("NOTICE" @@ -509,9 +497,9 @@ portion of the source component of the message, as LURK doesn't use this.") ((rx (: "\01VERSION " (let version (* (not "\01"))) "\01")) - (lurk-display-notice "CTCP version reply from " nick ": " version)) + (lurk-display-notice nil "CTCP version reply from " nick ": " version)) (_ - (lurk-display-notice text))))) + (lurk-display-notice nil text))))) ("PRIVMSG" (let* ((from (lurk-msg-src msg)) @@ -525,7 +513,7 @@ portion of the source component of the message, as LURK doesn't use this.") (list from (concat "\01VERSION " version-string "\01"))))) - (lurk-display-notice "CTCP version request received from " from)) + (lurk-display-notice nil "CTCP version request received from " from)) ((rx (let ping (: "\01PING " (* (not "\01")) "\01"))) (lurk-send-msg (lurk-msg nil nil "NOTICE" (list from ping))) @@ -547,7 +535,7 @@ portion of the source component of the message, as LURK doesn't use this.") (if (string-prefix-p "/" string) (pcase (substring string 1) ((rx (: "CONNECT " (let network (* not-newline)))) - (lurk-display-notice "Attempting to connect to " network "...") + (lurk-display-notice nil "Attempting to connect to " network "...") (lurk-connect network)) ((rx (: "TOPIC " (let new-topic (* not-newline)))) @@ -562,7 +550,7 @@ portion of the source component of the message, as LURK doesn't use this.") ((rx (: "VERSION" " " (let nick (* (not whitespace))))) (lurk-send-msg (lurk-msg nil nil "PRIVMSG" (list nick "\01VERSION\01"))) - (lurk-display-notice "CTCP version request sent to " nick)) + (lurk-display-notice nil "CTCP version request sent to " nick)) ((rx "PART" (opt (: " " (let channel (* not-newline))))) (if (or lurk-current-context channel) -- 2.20.1