From 8a2b414e30ba6325e9d716b5d7b09db31b6cad75 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 22 Nov 2023 06:53:45 -0800 Subject: [PATCH 0/5] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (5): [5.6] Don't associate type D channel modes with args in ERC [5.6] Don't inherit properties when refreshing ERC's prompt [5.6] Use overlay instead of text prop to hide ERC's prompt [5.6] Optionally align prompt to prefix in erc-fill-wrap [5.6] Optionally allow substitution patterns in erc-prompt etc/ERC-NEWS | 10 + lisp/erc/erc-backend.el | 21 +- lisp/erc/erc-compat.el | 20 ++ lisp/erc/erc-fill.el | 47 +++- lisp/erc/erc-stamp.el | 38 ++- lisp/erc/erc.el | 279 ++++++++++++++++--- test/lisp/erc/erc-scenarios-prompt-format.el | 117 ++++++++ test/lisp/erc/erc-tests.el | 94 +++++-- 8 files changed, 542 insertions(+), 84 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-prompt-format.el Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 04e9e99a0fd..9b3e62120fe 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -196,7 +196,7 @@ 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 +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'. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index fe1fc328c7d..e0f6e9b5134 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -459,30 +459,26 @@ erc-compat--current-lisp-time '(let (current-time-list) (current-time)) '(current-time))) -(defmacro erc-compat--format-spec-function-values-in-current-buffer - (format specification &rest rest) - "Call `format-spec' with SPECIFICATION function values in current buffer. -For simplicity, expect the SPECIFICATION alist (1) to only have -function values and (2) to be quoted, so the entire form looks -like a normal `format-spec' function call, with FORMAT and REST -being passed along unmolested. For convenience, ensure functions -return \"\" as a fallback and that each runs in the current -buffer when deferred for lazy invocation on Emacs 29 and greater." - (cl-check-type (car specification) symbol) - (cl-check-type (cadr specification) cons) - (cl-check-type (nth 2 specification) null) - (let* ((buffer (make-symbol "buffer")) - (specs (mapcar (pcase-lambda (`(,k . ,v)) - (cons k (list '\, (if (>= emacs-major-version 29) - `(lambda () - (with-current-buffer ,buffer - (or (,v) ""))) - `(or (,v) ""))))) - (cadr specification)))) - `(format-spec ,format - (let ((,buffer (current-buffer))) - ,(list '\` specs)) - ,@rest))) +(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-fill.el b/lisp/erc/erc-fill.el index adbe1c4e5f2..50b5aefd27a 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -228,13 +228,11 @@ erc-fill-variable (defvar-local erc-fill--wrap-value nil) (defvar-local erc-fill--wrap-visual-keys nil) -(defcustom erc-fill-wrap-use-pixels t +(defvar erc-fill-wrap-use-pixels t "Whether to calculate padding in pixels when possible. A value of nil means ERC should use columns, which may happen regardless, depending on the Emacs version. This option only -matters when `erc-fill-wrap-mode' is enabled." - :package-version '(ERC . "5.6") - :type 'boolean) +matters when `erc-fill-wrap-mode' is enabled.") (defcustom erc-fill-wrap-visual-keys 'non-input "Whether to retain keys defined by `visual-line-mode'. @@ -534,14 +532,16 @@ erc-fill--wrap-measure Expect the target region to be free of `line-prefix' and `wrap-prefix' properties, and expect `display-line-numbers-mode' to be disabled." - (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size)) + (if (fboundp 'buffer-text-pixel-size) ;; `buffer-text-pixel-size' can move point! (save-excursion (save-restriction (narrow-to-region beg end) (let* ((buffer-invisibility-spec) (rv (car (buffer-text-pixel-size)))) - (if (zerop rv) 0 (list rv))))) + (if erc-fill-wrap-use-pixels + (if (zerop rv) 0 (list rv)) + (/ rv (frame-char-width)))))) (- end beg))) ;; An escape hatch for third-party code expecting speakers of ACTION diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 64179cd3408..780ae343d95 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -756,8 +756,8 @@ erc-prompt erc-prompt-format) function)) -(defvar erc-prompt-format-face-example - #("%p%u%a\u00b7%b>" +(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) @@ -766,61 +766,59 @@ erc-prompt-format-face-example 9 10 (font-lock-face shadow)) "An example value for option `erc-prompt-format' with faces.") -(defcustom erc-prompt-format "%p[%b]%a" +(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 - %T - target@network or buffer name + %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 traditional + %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 \"%p\" \\='font-lock-face \\='erc-notice-face) (propertize \"%b\" \\='font-lock-face \\='erc-input-face) (propertize \"%a\" \\='font-lock-face \\='erc-error-face))) -For a quick preview of this effect, try setting this option to -`erc-prompt-format-face-example' and loading a theme that sets -`erc-prompt-face' to a light or unspecified background. Lastly, -please remember that ERC ignores this option completely unless +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[buffer]away" "%p[%b]%a") - (variable-item :tag "Example with varied faces" - erc-prompt-format-face-example) + :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'." - (erc-compat--format-spec-function-values-in-current-buffer - (if (and (symbolp erc-prompt-format) - (special-variable-p erc-prompt-format)) - (symbol-value erc-prompt-format) - erc-prompt-format) - '((?N . erc-format-network) - (?T . erc-format-target-and/or-network) - (?a . erc--format-away-indicator) - (?b . buffer-name) - (?c . erc-format-channel-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' + (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. @@ -6800,7 +6798,8 @@ erc--process-channel-modes (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) (erc--handle-channel-mode group c +p - (and (or (/= group ?c) +p) + (and (/= group ?d) + (or (/= group ?c) +p) (pop args))) t)) ((not fallbackp) @@ -6817,16 +6816,52 @@ erc--user-modes "Return user \"MODE\" letters in a form described by AS-TYPE. When AS-TYPE is the symbol `strings' (plural), return a list of strings. When it's `string' (singular), return the same list -concatenated into a single string. When it's a single char, like -?+, return the same value as `string' but with AS-TYPE prepended. -When AS-TYPE is nil, return a list of chars." +concatenated into a single string. When AS-TYPE is nil, return a +list of chars." (let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes)))) (pcase as-type ('strings (mapcar #'char-to-string modes)) ('string (apply #'string modes)) - ((and (pred characterp) c) (apply #'string (cons c modes))) (_ modes)))) +(defun erc--channel-modes (&optional as-type sep) + "Return channel \"MODE\" settings in a form described by AS-TYPE. +When AS-TYPE is the symbol `strings' (plural), return letter keys +as a list of sorted string. When it's `string' (singular), +return keys as a single string. When it's a number N, return a +single string consisting of the concatenated and sorted keys +followed by a space and then their corresponding args, each +truncated to N chars max. ERC joins these args together with +SEP, which defaults to a single space. Otherwise, return a +sorted alist of letter and arg pairs. In all cases that include +values, respect `erc-show-channel-key-p' and optionally omit the +secret key associated with the letter k." + (and-let* ((modes erc--channel-modes) + (types (erc--channel-mode-types-table (erc--channel-mode-types)))) + (let (out) + (maphash (lambda (k v) + (unless (eq ?a (aref types k)) + (push (cons k + (and (not (eq t v)) + (not (and (eq k ?k) + (not (bound-and-true-p + erc-show-channel-key-p)))) + v)) + out))) + modes) + (setq out (cl-sort out #'< :key #'car)) + (pcase as-type + ('strings (mapcar (lambda (o) (char-to-string (car o))) out)) + ('string (apply #'string (mapcar #'car out))) + ((and (pred natnump) c) + (let (keys vals) + (pcase-dolist (`(,k . ,v) out) + (when v (push (truncate-string-to-width v c 0 nil t) vals)) + (push k keys)) + (concat (apply #'string (nreverse keys)) (and vals " ") + (string-join (nreverse vals) (or sep " "))))) + (_ out))))) + (defun erc--parse-user-modes (string &optional current extrap) "Return lists of chars from STRING to add to and drop from CURRENT. Expect STRING to be a so-called \"modestring\", the second @@ -6905,14 +6940,24 @@ erc--handle-channel-mode (erc-log (format "Channel-mode %c (type %s, arg %S) %s" letter type arg (if state 'enabled 'disabled)))) -(cl-defmethod erc--handle-channel-mode :before (_ c state arg) - "Record STATE change and ARG, if enabling, for mode letter C." +(cl-defmethod erc--handle-channel-mode :before (type c state arg) + "Record STATE change for mode letter C. +When STATE is non-nil, add or update C's mapping in +`erc--channel-modes', associating it with ARG if C takes a +parameter and t otherwise. When STATE is nil, forget the +mapping. For type A, add up update a permanent mapping for C, +associating it with an integer indicating a running total of +STATE changes since joining the channel. In most cases, this +won't match the number known to the server." (unless erc--channel-modes (cl-assert (erc--target-channel-p erc--target)) (setq erc--channel-modes (make-hash-table))) - (if state - (puthash c (or arg t) erc--channel-modes) - (remhash c erc--channel-modes))) + (if (= type ?a) + (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1))) + (gethash c erc--channel-modes)) + (if state + (puthash c (or arg t) erc--channel-modes) + (remhash c erc--channel-modes)))) (cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _) "Update `erc-channel-modes' for any character C of nullary type D. @@ -8361,6 +8406,15 @@ erc--format-channel-status-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 diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2782460eec8..06485bafabc 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -796,13 +796,42 @@ erc--update-channel-modes (erc--update-channel-modes "+qu" "fool!*@*") (should (equal (pop calls) '(?d ?u t nil))) (should (equal (pop calls) '(?a ?q t "fool!*@*"))) - (should (equal "fool!*@*" (gethash ?q erc--channel-modes))) + (should (equal 1 (gethash ?q erc--channel-modes))) (should (eq t (gethash ?u erc--channel-modes))) (should (equal erc-channel-modes '("u"))) - (should-not (erc-channel-user-owner-p "bob"))) + (should-not (erc-channel-user-owner-p "bob")) + + ;; Remove fool!*@* from list mode "q". + (erc--update-channel-modes "-uq" "fool!*@*") + (should (equal (pop calls) '(?a ?q nil "fool!*@*"))) + (should (equal (pop calls) '(?d ?u nil nil))) + (should-not (gethash ?u erc--channel-modes)) + (should-not erc-channel-modes) + (should (equal 0 (gethash ?q erc--channel-modes)))) (should-not calls)))) +(ert-deftest erc--channel-modes () + (setq erc--isupport-params (make-hash-table) + erc--target (erc--target-from-string "#test") + erc-server-parameters + '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) + + (erc-tests--set-fake-server-process "sleep" "1") + + (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) + (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) + + (should (equal (erc--channel-modes 'string) "klt")) + (should (equal (erc--channel-modes 'strings) '("k" "l" "t"))) + (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t)))) + (should (equal (erc--channel-modes 3 ",") "klt h2,3")) + (should (equal (erc--channel-modes 1 ",") "klt h,3")) + (should (equal (erc--channel-modes 0 ",") "klt ,")) + (should (equal (erc--channel-modes 2) "klt h2 3")) + (should (equal (erc--channel-modes 1) "klt h 3")) + (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces + (ert-deftest erc--update-user-modes () (let ((erc--user-modes (list ?a))) (should (equal (erc--update-user-modes "+a") '(?a))) @@ -818,8 +847,7 @@ erc--user-modes (let ((erc--user-modes '(?a ?b))) (should (equal (erc--user-modes) '(?a ?b))) (should (equal (erc--user-modes 'string) "ab")) - (should (equal (erc--user-modes 'strings) '("a" "b"))) - (should (equal (erc--user-modes '?+) "+ab")))) + (should (equal (erc--user-modes 'strings) '("a" "b"))))) (ert-deftest erc--parse-user-modes () (should (equal (erc--parse-user-modes "a" '(?a)) '(() ()))) -- 2.41.0