Multi-target buffers
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
Some clients are capable of displaying messages for multiple targets in
a single buffer. I see two basic approaches to achieving this in ERC.
The first involves making our buffer-vs-target model more "polymorphic"
so it can accommodate both one-to-one and one-to-many relations. All
things being equal, this would be my preference. However, much work
would be needed to ensure existing infrastructure can detect when a
context is "multi-target" and tailor operations accordingly.
The second approach comes down to devising some kind of hack to
approximate the effect. It would likely involve a separate "ERC
adjacent" major mode that replicates certain conveniences available in
actual target buffers. A POC for doing this via the match-log facility
is attached. This particular implementation papers over a host of
familiar problems, such as the age old configuration-granularity
conundrum. To try it out, apply the attached patch, and do:
(require 'erc-match)
(setopt erc-log-matches-flag t
erc-log-match-format erc-match-marquee-log-format-flush-string
erc-keyword-highlight-type nil
erc-keywords '("."))
(erc :server "localhost")
This will route all messages to an enhanced match-log buffer that
supports limited interactivity. You can <TAB> around between buttons and
cycle targets with C-c C-n/C-p. <TAB> completion at the prompt for the
selected target also works.
Unfortunately, seeing your own messages currently requires the patch set
from #49860. If going that way, don't forget to add `v3' to
`erc-modules' before connecting.
If anyone out there wants something like this eventually, please open a
feature request with M-x erc-bug RET and add the pseudo header
"Severity: wishlist".
Thanks.
Screenshot: https://debbugs.gnu.org/cgi/bugreport.cgi?msg=160;att=1;filename=erc-multi-target-match-hack.png;bug=60936
0001-POC-Give-erc-match-log-its-own-major-mode.patch
(text/x-patch, 11.5 KB)
From f72d7843a52fa95b937b8d8e42a3ecdea0ddfb92 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 26 Oct 2023 20:02:18 -0700 Subject: [PATCH] [POC] Give erc-match-log its own major mode --- lisp/erc/erc-match.el | 228 ++++++++++++++++++++++++++++++++++++++---- 1 file changed, 210 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 8644e61106f..2acaefcfd1c 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -219,7 +219,12 @@ erc-log-match-format %u Nickname!user@host of sender %c Channel in which this was received %m Message" - :type 'string) + :type '(choice (const :tag "Traditional" "%t<%n:%c> %m") + (variable-item :tag "Own line, indented, stamps left" + erc-match-marquee-log-format-string) + (variable-item :tag "Own line, stamps right" + erc-match-marquee-log-format-flush-string) + string)) (defcustom erc-beep-match-types '(current-nick) "Types of matches to beep for when a match occurs. @@ -575,6 +580,36 @@ erc-match-message (append to-match-nick-dep to-match-nick-indep) to-match-nick-indep))))) +(defvar erc-match--log-format-nick-function nil) + +(defvar erc-match-marquee-log-format-string + #("%t %n %b\n%m" + 0 2 (font-lock-face erc-timestamp-face) + 5 6 (display (space :align-to (- right 10))) + 6 8 (font-lock-face erc-notice-face) + 9 11 ( line-prefix (space :width 8) + wrap-prefix (space :width 8)))) + +(defvar erc-match-marquee-log-format-flush-string + #("<%n·%b> %t\n%m" + 4 6 (font-lock-face erc-notice-face) + 7 8 (display (space :align-to (- right 10))) + 8 10 (font-lock-face erc-timestamp-face) + 11 13 ( line-prefix (space :width 1) + wrap-prefix (space :width 1)))) + +(defvar-local erc-match--log-channels-seen nil + "Ring of all channels represented in match-log buffer.") + +(defvar erc-match-log-line-spacing 0.5 + "Line spacing begween log items on graphical displays.") + +(declare-function ring-member "ring" (ring item)) +(declare-function ring-insert "ring" (ring item)) +(declare-function ring-insert-at-beginning "ring" (ring item)) +(declare-function ring-ref "ring" (ring index)) +(declare-function ring-remove "ring" (ring &optional index)) + (defun erc-log-matches (match-type nickuserhost message) "Log matches in a separate buffer, determined by MATCH-TYPE. The behavior of this function is controlled by the variables @@ -584,38 +619,195 @@ erc-log-matches See `erc-log-match-format'." (let ((match-buffer-name (cdr (assq match-type erc-log-matches-types-alist))) - (nick (nth 0 (erc-parse-user nickuserhost)))) + (nick (nth 0 (erc-parse-user nickuserhost))) + (spec (if (and (symbolp erc-log-match-format) + (special-variable-p erc-log-match-format)) + (symbol-value erc-log-match-format) + erc-log-match-format))) (when (and (or (eq erc-log-matches-flag t) (and (eq erc-log-matches-flag 'away) (erc-away-time))) match-buffer-name) + (remove-text-properties 0 (length message) + '(keymap nil erc-parsed nil) message) (let ((line (format-spec - erc-log-match-format - `((?n . ,nick) + spec + `((?n . ,(if erc-match--log-format-nick-function + (funcall erc-match--log-format-nick-function + nick) + nick)) (?t . ,(format-time-string (or (bound-and-true-p erc-timestamp-format) "[%Y-%m-%d %H:%M] "))) (?c . ,(or (erc-default-target) "")) + (?b . ,(buffer-name)) (?m . ,message) - (?u . ,nickuserhost))))) + (?u . ,nickuserhost)))) + (buffer (current-buffer))) + (let* ((erc--msg-props (and erc--msg-props + (copy-hash-table erc--msg-props))) + (props `(erc-buffer ,buffer + ,@(if erc--msg-props + (erc--order-text-properties-from-hash + erc--msg-props) + '(erc-msg unknown))))) + (add-text-properties 0 1 props line)) (with-current-buffer (erc-log-matches-make-buffer match-buffer-name) - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert line))))))) + (unless (ring-member erc-match--log-channels-seen buffer) + (ring-insert erc-match--log-channels-seen buffer)) + (with-silent-modifications + (let ((at-max-p (eobp))) + (save-excursion + (goto-char erc-insert-marker) + (insert-before-markers line) + (put-text-property (- (point) (length line)) (point) + 'read-only t) + (when erc-match-log-line-spacing + (put-text-property (1- (point)) (point) 'line-spacing + erc-match-log-line-spacing))) + (when at-max-p + (goto-char (point-max)) + (when (eq (selected-window) (get-buffer-window)) + (recenter -1)))))))))) + +(defvar erc-nicks-mode) +(defvar erc-button-keymap) +(defvar erc-button-nickname-face) +(defvar erc-button--nick-popup-alist) +(declare-function erc-nicks--highlight "erc-nicks" (nickname &optional face)) +(declare-function erc-button--perform-nick-popup "erc-button" (nick &rest _)) + +(defun erc-match--send-channel-message (nick) + (when-let ((target erc--target)) + (let ((msg (read-from-minibuffer + (concat "Message to " (erc--target-string target) ": ") + (concat nick ": ") nil nil nil))) + (erc-cmd-MSG (concat (erc--target-string target) " " msg))))) + +(defun erc-match--log-apply-nicks-face (nick) + "Ask module `nicks' for NICK's face." + (require 'erc-nicks) + (if-let ((erc-nicks-mode) + (erc--target) + ((erc-get-channel-user nick)) + (face (erc-nicks--highlight nick)) + ((not (eq face erc-button-nickname-face)))) + (propertize nick + 'font-lock-face face + 'keymap erc-button-keymap + ;; FIXME this is leaky, use obj from button cache + 'erc-data (list nick) + 'erc-callback #'erc-button--perform-nick-popup) + nick)) + +(declare-function pcomplete-erc-setup "erc-pcomplete" ()) +(declare-function erc-pcompletions-at-point "erc-pcomplete" ()) + +(defvar-local erc-match--current-target (list "unknown")) + +(defun erc-match--press-button () + (when-let ((buffer (erc--get-inserted-msg-prop 'erc-buffer)) + (data (get-text-property (point) 'erc-data)) + (fun (get-text-property (point) 'erc-callback))) + (unless fun + (message "No button at point")) + (with-current-buffer buffer + ;; This may have a local binding in `buffer'. + (let ((erc-button--nick-popup-alist + `(("Channel Message" . erc-match--send-channel-message) + ,@erc-button--nick-popup-alist))) + (apply fun data))))) + +(defun erc-match--target-previous () + (interactive) + (let ((ring erc-match--log-channels-seen)) + (ring-insert-at-beginning ring (ring-remove ring 0)) + (erc-match--swap-target))) + +(defun erc-match--target-next () + (interactive) + (let ((ring erc-match--log-channels-seen)) + (ring-insert ring (ring-remove ring -1)) + (erc-match--swap-target))) + +(defun erc-match--swap-target (&optional buffer) + (unless buffer + (setq buffer (get-buffer (ring-ref erc-match--log-channels-seen -1)))) + (setcar erc-match--current-target (buffer-name buffer)) + (setq erc-channel-users (buffer-local-value 'erc-channel-users buffer) + erc-server-process (buffer-local-value 'erc-server-process buffer)) + (buffer-name buffer)) + +(defun erc-match--press-button-eobp () + (let* ((buffer-name (car erc-match--current-target)) + (buffer (or (get-buffer buffer-name) + (get-buffer (setq buffer-name (erc-match--swap-target))))) + (input (delete-and-extract-region erc-input-marker (point-max)))) + (when (and (bound-and-true-p erc-ring-mode) + (fboundp 'erc-add-to-input-ring)) + (erc-add-to-input-ring input)) + (with-current-buffer buffer + (let ((existing (delete-and-extract-region erc-input-marker + (point-max)))) + (save-excursion + (goto-char (point-max)) + (insert input) + (erc-send-current-line) + (insert existing)))))) + +(defun erc-match--ret () + (interactive) + (cond ((eobp) (erc-match--press-button-eobp)) + ((>= (point) erc-input-marker) (newline)) + ((bound-and-true-p erc-button-mode) (erc-match--press-button)))) + +(defvar erc-match--initializing-buffer nil) + +(defun erc-match--tab () + (interactive) + (if (>= (point) erc-input-marker) + (completion-at-point) + (when (fboundp 'erc-button-next) + (erc-button-next)))) + +(define-derived-mode erc-match-log-view-mode fundamental-mode "Match-View" + "Major mode for viewing `erc-log-matches'." + :interactive nil + (require 'ring) + (let ((erc-prompt (concat (propertize " " 'display erc-match--current-target) + ">"))) + (erc--initialize-markers (point-max) nil)) + (pcomplete-erc-setup) + (add-hook 'completion-at-point-functions #'erc-pcompletions-at-point nil t) + (when erc-match--initializing-buffer + (erc-match--swap-target erc-match--initializing-buffer)) + (visual-line-mode) + (keymap-set erc-match-log-view-mode-map "<return>" #'erc-match--ret) + (keymap-set erc-match-log-view-mode-map "C-c C-p" + #'erc-match--target-previous) + (keymap-set erc-match-log-view-mode-map "C-c C-n" + #'erc-match--target-next) + (when (memq 'button erc-modules) + (keymap-set erc-match-log-view-mode-map "<tab>" 'erc-match--tab) + (keymap-set erc-match-log-view-mode-map "<backtab>" 'erc-button-previous)) + (when (memq 'ring erc-modules) + (keymap-set erc-match-log-view-mode-map "M-p" 'erc-previous-command) + (keymap-set erc-match-log-view-mode-map "M-n" 'erc-next-command)) + (when (memq 'nicks erc-modules) + (setq erc-match--log-format-nick-function + #'erc-match--log-apply-nicks-face)) + (setq erc-match--log-channels-seen (make-ring 10)) + (setq-local read-minibuffer-restore-windows nil) + (setq-local scroll-conservatively 101)) (defun erc-log-matches-make-buffer (name) "Create or get a log-matches buffer named NAME and return it." - (let* ((buffer-already (get-buffer name)) - (buffer (or buffer-already - (get-buffer-create name)))) - (with-current-buffer buffer - (unless buffer-already - (insert " == Type \"q\" to dismiss messages ==\n") - (view-mode-enter nil (lambda (buffer) - (when (y-or-n-p "Discard messages? ") - (kill-buffer buffer))))) - buffer))) + (or (get-buffer name) + (let ((erc-match--initializing-buffer (current-buffer))) + (with-current-buffer (get-buffer-create name) + (erc-match-log-view-mode) + (current-buffer))))) (defun erc-log-matches-come-back (_proc _parsed) "Display a notice that messages were logged while away." -- 2.41.0