From 8a2b414e30ba6325e9d716b5d7b09db31b6cad75 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 7 Oct 2021 14:26:36 +0200 Subject: [PATCH 5/5] [5.6] Optionally allow substitution patterns in erc-prompt * etc/ERC-NEWS: Add entry for `erc-prompt-format'. * lisp/erc/erc-compat.el (erc-compat--defer-format-spec-in-buffer): New macro to wrap `format-spec' specification values in functions that run in the current buffer and fall back to the empty string. * lisp/erc/erc.el (erc-prompt): Add predefined choice for function `erc-prompt-format'. (erc-prompt-format-face-example): New example value for option `erc-prompt-format'. (erc-prompt-format): New companion option for `erc-prompt' choice `erc-prompt-format'. New function of the same name to perform format substitutions and serve as a Custom choice value for `erc-prompt'. (erc--away-indicator, erc-away-status-indicator, erc--format-away-indicator): New formatting function for away status and helper variables. (erc--user-modes-indicator): New variable. (erc--format-user-modes): New function. (erc--format-channel-status-prefix): New function. (erc--format-modes): New function. * test/lisp/erc/erc-scenarios-prompt-format.el: New file. (Bug#51082) Co-authored-by: Stefan Kangas --- etc/ERC-NEWS | 10 ++ lisp/erc/erc-compat.el | 20 +++ lisp/erc/erc.el | 125 ++++++++++++++++++- test/lisp/erc/erc-scenarios-prompt-format.el | 117 +++++++++++++++++ 4 files changed, 271 insertions(+), 1 deletion(-) create mode 100644 test/lisp/erc/erc-scenarios-prompt-format.el diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3bb9a30cfb2..9b3e62120fe 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -191,6 +191,16 @@ been restored with a slightly revised role contingent on a few assumptions explained in its doc string. For clarity, it has been renamed 'erc-ensure-target-buffer-on-privmsg'. +** A smarter, more responsive prompt. +ERC's prompt can be told to respond dynamically to incoming and +outgoing messages by leveraging the familiar function variant of the +option 'erc-prompt'. With this release, only predefined functions can +take full advantage of this new dynamism, but an interface to empower +third parties with the same possibilities may follow suit. To get +started, customize 'erc-prompt' to 'erc-prompt-format', and see the +option of the same name ('erc-prompt-format') for a rudimentary +templating facility reminiscent of 'erc-mode-line-format'. + ** Module 'scrolltobottom' now optionally more aggressive. Enabling the experimental option 'erc-scrolltobottom-all' makes ERC more vigilant about staking down the input area in all ERC windows. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 4c376cfbc22..e0f6e9b5134 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -459,6 +459,26 @@ erc-compat--current-lisp-time '(let (current-time-list) (current-time)) '(current-time))) +(defmacro erc-compat--defer-format-spec-in-buffer (&rest spec) + "Transform SPEC forms into functions that run in the current buffer. +For convenience, ensure function wrappers return \"\" as a +fallback." + (cl-check-type (car spec) cons) + (let ((buffer (make-symbol "buffer"))) + `(let ((,buffer (current-buffer))) + ,(list '\` + (mapcar + (pcase-lambda (`(,k . ,v)) + (cons k + (list '\,(if (>= emacs-major-version 29) + `(lambda () + (or (if (eq ,buffer (current-buffer)) + ,v + (with-current-buffer ,buffer + ,v)) + "")) + `(or ,v ""))))) + spec))))) (provide 'erc-compat) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index aefa9e0fc3f..780ae343d95 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -751,7 +751,74 @@ erc-string-no-properties (defcustom erc-prompt "ERC>" "Prompt used by ERC. Trailing whitespace is not required." :group 'erc-display - :type '(choice string function)) + :type '(choice string + (function-item :tag "Interpret format specifiers" + erc-prompt-format) + function)) + +(defvar erc--prompt-format-face-example + #("%p%m%a\u00b7%b>" + 0 2 (font-lock-face erc-my-nick-prefix-face) + 2 4 (font-lock-face font-lock-keyword-face) + 4 6 (font-lock-face erc-error-face) + 6 7 (font-lock-face shadow) + 7 9 (font-lock-face font-lock-constant-face) + 9 10 (font-lock-face shadow)) + "An example value for option `erc-prompt-format' with faces.") + +(defcustom erc-prompt-format erc--prompt-format-face-example + "Format string when `erc-prompt' is `erc-prompt-format'. +ERC recognizes these substitution specifiers: + + %a - away indicator + %b - buffer name + %t - channel or query target, server domain, or dialed address + %S - target@network or buffer name + %s - target@server or server + %N - current network, like Libera.Chat + %p - channel membership prefix, like @ or + + %n - current nickname + %c - channel modes, including parameters for select modes + %C - channel modes, including all parameters + %u - user modes + %m - channel modes in channel buffers and user modes elsewhere + %M - channel modes in channels and user modes in server buffers + +To pick your own colors, do something like: + + (setopt erc-prompt-format + (concat + (propertize \"%b\" \\='font-lock-face \\='erc-input-face) + (propertize \"%a\" \\='font-lock-face \\='erc-error-face))) + +Please remember that ERC ignores this option completely unless +the \"parent\" option `erc-prompt' is set to `erc-prompt-format'." + :package-version '(ERC . "5.6") + :group 'erc-display + :type `(choice (const :tag "{Prefix}{Mode}{Away}{MIDDLE DOT}{Buffer}>" + ,erc--prompt-format-face-example) + string)) + +(defun erc-prompt-format () + "Make predefined `format-spec' substitutions. + +See option `erc-prompt-format' and option `erc-prompt'." + (format-spec erc-prompt-format + (erc-compat--defer-format-spec-in-buffer + (?C erc--channel-modes 4) + (?M erc--format-modes 'no-query-p) + (?N erc-format-network) + (?S erc-format-target-and/or-network) + (?a erc--format-away-indicator) + (?b buffer-name) + (?c erc-format-channel-modes) + (?m erc--format-modes) + (?n erc-current-nick) + (?p erc--format-channel-status-prefix) + (?s erc-format-target-and/or-server) + (?t erc-format-target) + (?u erc--format-user-modes)) + 'ignore-missing)) ; formerly `only-present' (defun erc-prompt () "Return the input prompt as a string. @@ -8292,6 +8359,62 @@ erc-format-away-status (format-time-string erc-mode-line-away-status-format a) ""))) +(defvar-local erc--away-indicator nil + "Cons containing an away indicator for the connection.") + +(defvar erc-away-status-indicator "A" + "String shown by various formatting facilities to indicate away status. +Currently only used by the option `erc-prompt-format'.") + +(defun erc--format-away-indicator () + "Return char with `display' property of `erc--away-indicator'." + (and-let* ((indicator (erc-with-server-buffer + (or erc--away-indicator + (setq erc--away-indicator (list ""))))) + (newcar (if (erc-away-time) erc-away-status-indicator ""))) + ;; Inform other buffers of the change when necessary. + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (eq newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(away?)" 'display indicator) + newcar)))) + +(defvar-local erc--user-modes-indicator nil + "Cons containing connection-wide indicator for user modes.") + +;; If adding more of these functions, should factor out commonalities. +;; As of ERC 5.6, this is identical to the away variant aside from +;; the var names and `eq', which isn't important. +(defun erc--format-user-modes () + "Return server's user modes as a string" + (and-let* ((indicator (erc-with-server-buffer + (or erc--user-modes-indicator + (setq erc--user-modes-indicator (list ""))))) + (newcar (erc--user-modes 'string))) + (let ((dispp (not erc--inhibit-prompt-display-property-p))) + (unless (string= newcar (car indicator)) + (erc--refresh-prompt-continue (and dispp 'hooks-only-p)) + (setcar indicator newcar)) + (if dispp + (propertize "(user-modes?)" 'display indicator) + newcar)))) + +(defun erc--format-channel-status-prefix () + "Return the current channel membership prefix." + (and (erc--target-channel-p erc--target) + (erc-get-user-mode-prefix (erc-current-nick)))) + +(defun erc--format-modes (&optional no-query-p) + "Return a string of channel modes in channels and user modes elsewhere. +With NO-QUERY-P, return nil instead of user modes in query +buffers. Also return nil when mode information is unavailable." + (cond ((erc--target-channel-p erc--target) + (erc--channel-modes 'string)) + ((not (and erc--target no-query-p)) + (erc--format-user-modes)))) + (defun erc-format-channel-modes () "Return the current channel's modes." (concat (apply #'concat diff --git a/test/lisp/erc/erc-scenarios-prompt-format.el b/test/lisp/erc/erc-scenarios-prompt-format.el new file mode 100644 index 00000000000..7eccb859dbc --- /dev/null +++ b/test/lisp/erc/erc-scenarios-prompt-format.el @@ -0,0 +1,117 @@ +;;; erc-scenarios-prompt-format.el --- erc-prompt-format-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(defvar erc-fill-wrap-align-prompt) +(defvar erc-fill-wrap-use-pixels) + +(defun erc-scenarios-prompt-format--assert (needle &rest props) + (save-excursion + (goto-char erc-insert-marker) + (should (search-forward needle nil t)) + (pcase-dolist (`(,k . ,v) props) + (should (equal (get-text-property (point) k) v))))) + +;; This makes assertions about the option `erc-fill-wrap-align-prompt' +;; as well as the standard value of `erc-prompt-format'. One minor +;; omission is that this doesn't check behavior in query buffers. +(ert-deftest erc-scenarios-prompt-format () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/modes") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'chan-changed)) + (erc-modules (cons 'fill-wrap erc-modules)) + (erc-fill-wrap-align-prompt t) + (erc-fill-wrap-use-pixels nil) + (erc-prompt #'erc-prompt-format) + (erc-autojoin-channels-alist '((Libera.Chat "#chan"))) + (expect (erc-d-t-make-expecter)) + ;; Collect samples of `line-prefix' to verify deltas as the + ;; prompt grows and shrinks. + (line-prefixes nil) + (stash-pfx (lambda () + (pcase (get-text-property erc-insert-marker 'line-prefix) + (`(space :width (- erc-fill--wrap-value ,n)) + (car (push n line-prefixes))))))) + + (ert-info ("Connect to Libera.Chat") + (with-current-buffer (erc :server "127.0.0.1" + :port (process-contact dumb-server :service) + :nick "tester" + :full-name "tester") + (funcall expect 5 "Welcome to the Libera.Chat") + (funcall stash-pfx) + (funcall expect 5 "changed mode") + ;; New prompt is shorter than default with placeholders, like + ;; "(foo?)(bar?)" (assuming we win the inherent race). + (should (>= (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "user-" '(display . ("Ziw"))))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (should-not erc-channel-key) + (should-not erc-channel-user-limit) + + (ert-info ("Receive notice that mode has changed") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))) + (funcall stash-pfx) + (erc-scenarios-common-say "ready before") + (funcall expect 10 " has changed mode for #chan to +Qu") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u"))) + ;; Prompt is longer now, so too is the `line-prefix' subtrahend. + (should (< (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "Qntu") + (erc-scenarios-prompt-format--assert "#chan>")) + + (ert-info ("Key stored locally") + (erc-scenarios-common-say "ready key") + (funcall expect 10 " has changed mode for #chan to +k hunter2") + ;; Prompt has grown by 1. + (should (< (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "Qkntu")) + + (ert-info ("Limit stored locally") + (erc-scenarios-common-say "ready limit") + (funcall expect 10 " has changed mode for #chan to +l 3") + (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3)) + (should (equal erc-channel-modes '("Q" "n" "t" "u"))) + ;; Prompt has grown by 1 again. + (should (< (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "Qklntu")) + + (ert-info ("Modes removed and local state deletion succeeds") + (erc-scenarios-common-say "ready drop") + (funcall expect 10 " has changed mode for #chan to -lu") + (funcall expect 10 " has changed mode for #chan to -Qk *") + (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))) + ;; Prompt has shrunk. + (should (> (car line-prefixes) (funcall stash-pfx))) + (erc-scenarios-prompt-format--assert "nt")) + + (should-not erc-channel-key) + (should-not erc-channel-user-limit) + (funcall expect 10 " after")))) + +;;; erc-scenarios-prompt-format.el ends here -- 2.41.0