commit 775bd4b631e9303c20e4ebddd179960276065448 (HEAD, refs/remotes/origin/master) Author: F. Jason Park Date: Wed Dec 27 18:44:29 2023 -0800 Sideline implied invisible-intangible coupling in ERC * etc/ERC-NEWS: Add entry explaining removal of automatic `intangible' propertizing of t-valued `invisible' messages. * lisp/erc/erc.el (erc--insert-invisible-as-intangible-p): New flag variable, a temporary escape hatch to regain pre-5.6 behavior involving the modification of certain `invisible' messages. (erc--insert-line): Gate unfavorable behavior behind `erc--insert-invisible-as-intangible-p' flag. Add comment clarifying deferred initialization of `insert-position', which was part of the many changes introduced as part of bug#60936. diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index c883f575c15..6dc8af3c514 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -438,6 +438,17 @@ those folded onto the next line. Such inconsistency made stamp detection overly complex and produced uneven results when toggling stamp visibility. +*** Invisible message insertions not automatically made 'intangible'. +Previously, when 'erc-display-message' and friends spotted the +'invisible' text property with a value of t anywhere in text to be +inserted, it would apply that property to the entire message, along +with a t-valued 'intangible' property. Beginning with ERC 5.6, users +expecting this behavior will have to instead perform the treatment +themselves. To help with the transition, a temporary escape hatch has +been made available to regain this behavior, but its existence is only +guaranteed for this one minor version alone. See source code in the +vicinity of 'erc-insert-line' for more. + *** Date stamps have become independent messages. ERC now inserts "date stamps" generated from the option 'erc-timestamp-format-left' as separate, standalone messages. This diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 02bfda143bc..f6962910da0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3282,6 +3282,21 @@ erc--traverse-inserted (unless (eq end erc-insert-marker) (set-marker end nil))) +(defvar erc--insert-invisible-as-intangible-p nil + "When non-nil, ensure certain invisible messages are also intangible. +That is, single out any message inserted via `erc-insert-line' +that lacks a trailing newline but has a t-valued `invisible' +property anywhere along its length, and ensure it's both +`invisible' t and `intangible' t throughout. Note that this is +merely an escape hatch for accessing aberrant pre-5.6 behavior +that ERC considers a bug because it applies a practice described +as obsolete in the manual, and it does so heavy-handedly. That +the old behavior only acted when the input lacked a trailing +newline was likely accidental but is ultimately incidental. See +info node `(elisp) Special Properties' for specifics. Beware +that this flag and the behavior it restores may disappear at any +time, so if you need them, please let ERC know with \\[erc-bug].") + (defvar erc--insert-line-function nil "When non-nil, an alterntive to `insert' for inserting messages.") @@ -3310,13 +3325,15 @@ erc-insert-line modification hooks)." (when string (with-current-buffer (or buffer (process-buffer erc-server-process)) - (let ((insert-position (marker-position erc-insert-marker))) - (let ((string string) ;; FIXME! Can this be removed? - (buffer-undo-list t) + (let (insert-position) + ;; Initialize ^ below to thwart rogue `erc-insert-pre-hook' + ;; members that dare to modify the buffer's length. + (let ((buffer-undo-list t) (inhibit-read-only t)) - (unless (string-match "\n$" string) + (unless (string-suffix-p "\n" string) (setq string (concat string "\n")) - (when (erc-string-invisible-p string) + (when (and erc--insert-invisible-as-intangible-p + (erc-string-invisible-p string)) (erc-put-text-properties 0 (length string) '(invisible intangible) string))) (erc-log (concat "erc-display-message: " string commit 7097be8ef601a20cdcd5d3a2bf2b1e33f2124981 Author: F. Jason Park Date: Sun Dec 24 12:21:49 2023 -0800 Move ERC test utilities to common file * lisp/erc/erc-common.el (erc--define-catalog): Update name of reference to convenience command now located in `erc-tests-common'. * test/lisp/erc/erc-button-tests.el: Require common test-util library `erc-tests-common', located under test/lisp/erc/resources. ; (erc-button-alist--url, ; erc-button-tests--erc-button-alist--function-as-form, ; erc-button-tests--erc-button-alist--nil-form, ; erc-button--display-error-notice-with-keys): Use common helper ; `erc-tests-common-init-server-proc' from test-utils library. * test/lisp/erc/erc-fill-tests.el: Require `erc-tests-common'. (erc-fill-tests--wrap-populate): Use helper `erc-tests-common-init-server-proc'. (erc-fill-tests--save-p): Remove. See replacement `erc-tests-common-snapshot-save-p' in erc-tests-common. (erc-fill-tests--graphic-dir): Add trailing slash. (erc-fill-tests--compare): Move body to generalized utility `erc-tests-common-snapshot-compare' in erc-tests-common. * test/lisp/erc/erc-goodies-tests.el: Require `erc-tests-common'. (erc--get-inserted-msg-beg/readonly, erc--get-inserted-msg-end/readonly, erc--get-inserted-msg-bounds/readonly): Move here from erc-tests.el. * test/lisp/erc/erc-networks-tests.el: Load `erc-tests-common'. (erc-networks-tests--create-live-proc): Defer to `erc-tests-common-init-server-proc' and drop optional buffer param. (erc-networks-tests--clean-bufs): Defer to `erc-tests-common-kill-buffers'. (erc-networks--rename-server-buffer--existing--live): Call `erc-networks-tests--create-live-proc' in server buffer. * test/lisp/erc/erc-scenarios-internal.el: Load `erc-tests-common'. (erc-scenarios-internal--run-graphical-all): Use `erc-tests-common-create-subprocess' to create process. * test/lisp/erc/erc-scenarios-sasl.el (erc-scenarios-sasl--plain-fail): Silence error message. * test/lisp/erc/erc-stamp-tests.el: Require `erc-tests-common'. (erc-stamp-tests--insert-right, erc-timestamp-intangible--left): Use `erc-tests-common-init-server-proc'. (erc-tests--assert-get-inserted-msg/stamp, erc-stamp-tests--assert-get-inserted-msg/stamp): Move from erc-tests.el, renaming to latter. (erc--get-inserted-msg-beg/stamp, erc--get-inserted-msg-beg/readonly/stamp, erc--get-inserted-msg-end/stamp, erc--get-inserted-msg-end/readonly/stamp, erc--get-inserted-msg-bounds/stamp, erc--get-inserted-msg-bounds/readonly/stamp): Move here from erc-tests.el. * test/lisp/erc/erc-tests.el: Require `erc-tests-common'. (erc-with-server-buffer): Use renamed test-helper utility `erc-tests-common-init-server-proc'. (erc-tests--send-prep, erc-tests--set-fake-server-process): Move to `erc-tests-common' library and rename to `erc-tests-common-prep-for-insertion' and `erc-tests-common-init-server-proc', respectively. ; (erc-hide-prompt, erc--refresh-prompt, ; erc-setup-buffer--custom-action, erc--parsed-prefix, ; erc--update-channel-modes, erc--channel-modes, ; erc--channel-modes/graphic-p, erc-ring-previous-command): Use ; `erc-tests-common-prep-for-insertion' instead of ; `erc-tests--send-prep', and use `erc-tests-common-init-server-proc' ; instead of `erc-tests--set-fake-server-process'. (erc-tests--with-process-input-spy): Move to `erc-tests-common' and rename `erc-tests-common-with-process-input-spy'. ; (erc--check-prompt-input-functions, erc-send-current-line, ; erc--check-prompt-input-for-multiline-blanks, ; erc-send-whitespace-lines): Use renamed ; `erc-tests-common-with-process-input-spy' and ; `erc-tests-common-init-server-proc'. ; (erc-process-input-line): Use renamed ; `erc-tests-common-init-server-proc'. (erc-tests--get-inserted-msg-setup, erc-tests--assert-get-inserted-msg, erc-tests--assert-get-inserted-msg/basic, erc-tests--assert-get-inserted-msg-readonly-with): Move to `erc-tests-common' and rename with "common" prefix, using single instead of double hyphen. (erc-tests--assert-get-inserted-msg/stamp): Move to `erc-stamp-tests' and rename with "stamp" prefix. (erc--get-inserted-msg-beg/stamp, erc--get-inserted-msg-beg/readonly/stamp, erc--get-inserted-msg-end/stamp, erc--get-inserted-msg-end/readonly/stamp, erc--get-inserted-msg-bounds/stamp, erc--get-inserted-msg-bounds/readonly/stamp): Move to `erc-stamp-tests'. (erc--get-inserted-msg-beg/readonly, erc--get-inserted-msg-end/readonly, erc--get-inserted-msg-bounds/readonly): Move to `erc-goodies-tests'. ; (erc--get-inserted-msg-beg/basic, ; erc--get-inserted-msg-end/basic, ; erc--get-inserted-msg-bounds/basic): Use common helpers. ; (erc--route-insertion): Use renamed helper functions ; `erc-tests-common-with-process-input-spy' and ; `erc-tests-common-init-server-proc'. (erc-tests--make-server-buf): Move to `erc-common-tests' and rename with "common" prefix. (erc-tests--make-client-buf): Remove unused function without supplying replacement. ; (erc-handle-irc-url): Use renamed `erc-tests-common-make-server-buf' ; utility function. ; (erc-tests--assert-printed-in-subprocess): Use helper from common lib ; `erc-tests-common-create-subprocess code' to do the heavy lifting. (erc-tests--string-to-propertized-parts, erc-tests-pp-propertized-parts): Move to `erc-tests-common' and rename with "common" prefix. * test/lisp/erc/resources/erc-tests-common.el: New file containing helper utilities and fixtures used by multiple files in test/lisp/erc. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 64312e51f41..6c101dea4e3 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -551,10 +551,10 @@ erc--define-catalog "Define `erc-display-message' formatting templates for NAME, a symbol. See `erc-define-message-format-catalog' for the meaning of -ENTRIES, an alist. Also see `erc-tests-pp-propertized-parts' in +ENTRIES, an alist, and `erc-tests-common-pp-propertized-parts' in tests/lisp/erc/erc-tests.el for a convenience command to convert -a literal string into a sequence of `propertize' forms, which -are much easier to review and edit." +a literal string into a sequence of `propertize' forms, which are +much easier to review and edit." (declare (indent 1)) (let (out) (dolist (e entries (cons 'progn (nreverse out))) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index 34ad06b7eb8..be11b76bd2e 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -21,12 +21,15 @@ ;;; Code: +(require 'ert-x) ; cl-lib +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-button) (ert-deftest erc-button-alist--url () - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") (let ((verify (lambda (p url) @@ -65,9 +68,7 @@ erc-button-tests--form (apply #'erc-button-add-button rest)) (defun erc-button-tests--erc-button-alist--function-as-form (func) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") (let* ((erc-button-tests--form nil) @@ -102,9 +103,7 @@ erc-button-alist--function-as-form (apply #'erc-button-add-button r)))) (defun erc-button-tests--erc-button-alist--nil-form (form) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (with-current-buffer (erc--open-target "#chan") (let* ((erc-button-tests--form nil) @@ -228,11 +227,9 @@ erc-button--display-error-notice-with-keys (inhibit-message noninteractive) erc-modules erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (erc-mode) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) - (erc--initialize-markers (point) nil) + (erc-tests-common-prep-for-insertion) + (erc-tests-common-init-server-proc "sleep" "1") + (erc-button-mode +1) (should (equal (erc-button--display-error-notice-with-keys "If \\[erc-bol] fails, " diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 5e5b1d332ac..df83466cbc3 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -24,6 +24,10 @@ ;;; Code: (require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-fill) (defvar erc-fill-tests--buffers nil) @@ -58,9 +62,7 @@ erc-fill-tests--wrap-populate erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (cl-letf (((symbol-function 'erc-server-connect) (lambda (&rest _) - (setq erc-server-process - (start-process "sleep" (current-buffer) "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil)))) + (erc-tests-common-init-server-proc "sleep" "1")))) (with-current-buffer (car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect nil nil nil nil nil "tester" 'foonet) @@ -106,10 +108,9 @@ erc-fill-tests--wrap-populate (when set-transient-map-timer (timer-event-handler set-transient-map-timer)) (set-window-buffer (selected-window) original-window-buffer) - (when noninteractive - (while-let ((buf (pop erc-fill-tests--buffers))) - (kill-buffer buf)) - (kill-buffer)))))))) + (when (or noninteractive (getenv "ERC_TESTS_GRAPHICAL")) + (erc-tests-common-kill-buffers erc-fill-tests--buffers) + (setq erc-fill-tests--buffers nil)))))))) (defun erc-fill-tests--wrap-check-prefixes (&rest prefixes) ;; Check that prefix props are applied over correct intervals. @@ -134,74 +135,21 @@ erc-fill-tests--wrap-check-prefixes (should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix) '(space :width erc-fill--wrap-value)))))) -;; Use this variable to generate new snapshots after carefully -;; reviewing the output of *each* snapshot (not just first and last). -;; Obviously, only run one test at a time. -(defvar erc-fill-tests--save-p (getenv "ERC_TESTS_FILL_SAVE")) - ;; On graphical displays, echo .graphic >> .git/info/exclude -(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic") +(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic/") (defun erc-fill-tests--compare (name) - (let* ((dir (expand-file-name (if (display-graphic-p) - erc-fill-tests--graphic-dir - "fill/snapshots/") - (ert-resource-directory))) - (expect-file (file-name-with-extension (expand-file-name name dir) - "eld")) - (erc--own-property-names - (seq-difference `(font-lock-face ,@erc--own-property-names) - `(field display wrap-prefix line-prefix - erc--msg erc--cmd erc--spkr erc--ts erc--ctcp - erc--ephemeral) - #'eq)) - (print-circle t) - (print-escape-newlines t) - (print-escape-nonascii t) - (got (erc--remove-text-properties - (buffer-substring (point-min) erc-insert-marker))) - (repr (string-replace "erc-fill--wrap-value" - (number-to-string erc-fill--wrap-value) - (prin1-to-string got)))) - (with-current-buffer (generate-new-buffer name) - (push (current-buffer) erc-fill-tests--buffers) - (with-silent-modifications - (insert (setq got (read repr)))) - (erc-mode)) - ;; LHS is a string, RHS is a symbol. - (if (string= erc-fill-tests--save-p (ert-test-name (ert-running-test))) - (let (inhibit-message) - (with-temp-file expect-file - (insert repr)) - ;; Limit writing snapshots to one test at a time. - (message "erc-fill-tests--compare: wrote %S" expect-file)) - (if (file-exists-p expect-file) - ;; Ensure string-valued properties, like timestamps, aren't - ;; recursive (signals `max-lisp-eval-depth' exceeded). - (named-let assert-equal - ((latest (read repr)) - (expect (read (with-temp-buffer - (insert-file-contents-literally expect-file) - (buffer-string))))) - (pcase latest - ((or "" 'nil) t) - ((pred stringp) - (should (equal-including-properties latest expect)) - (let ((latest-intervals (object-intervals latest)) - (expect-intervals (object-intervals expect))) - (while-let ((l-iv (pop latest-intervals)) - (x-iv (pop expect-intervals)) - (l-tab (map-into (nth 2 l-iv) 'hash-table)) - (x-tab (map-into (nth 2 x-iv) 'hash-table))) - (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab)) - (assert-equal l-v (gethash l-k x-tab)) - (remhash l-k x-tab)) - (should (zerop (hash-table-count x-tab)))))) - ((pred sequencep) - (assert-equal (seq-first latest) (seq-first expect)) - (assert-equal (seq-rest latest) (seq-rest expect))) - (_ (should (equal latest expect))))) - (message "Snapshot file missing: %S" expect-file))))) + (let ((dir (expand-file-name (if (display-graphic-p) + erc-fill-tests--graphic-dir + "fill/snapshots/" ) + (ert-resource-directory))) + (transform-fn (lambda (got) + (string-replace "erc-fill--wrap-value" + (number-to-string erc-fill--wrap-value) + got))) + (buffer-setup-fn (lambda () + (push (current-buffer) erc-fill-tests--buffers)))) + (erc-tests-common-snapshot-compare name dir transform-fn buffer-setup-fn))) ;; To inspect variable pitch, set `erc-mode-hook' to ;; diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index ca02089eb7c..bdd197fa5cb 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -20,6 +20,10 @@ ;;; Commentary: ;;; Code: (require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-goodies) (defun erc-goodies-tests--assert-face (beg end-str present &optional absent) @@ -420,4 +424,21 @@ erc-keep-place-indicator-mode--global (goto-char (overlay-start erc--keep-place-indicator-overlay)) (should (looking-at (rx "*** This buffer is for text"))))))) +(ert-deftest erc--get-inserted-msg-beg/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/basic + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-end/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/basic + (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/readonly () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-tests-common-assert-get-inserted-msg/basic + (lambda (arg) + (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) + + ;;; erc-goodies-tests.el ends here diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index d0f1dddf6b3..7d9424d7430 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -20,25 +20,21 @@ ;;; Code: (require 'ert-x) ; cl-lib -(require 'erc) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) (defun erc-networks-tests--create-dead-proc (&optional buf) (let ((p (start-process "true" (or buf (current-buffer)) "true"))) (while (process-live-p p) (sit-for 0.1)) p)) -(defun erc-networks-tests--create-live-proc (&optional buf) - (let ((proc (start-process "sleep" (or buf (current-buffer)) "sleep" "1"))) - (set-process-query-on-exit-flag proc nil) - proc)) +(defun erc-networks-tests--create-live-proc () + (erc-tests-common-init-server-proc "sleep" "1")) ;; When we drop 27, call `get-buffer-create with INHIBIT-BUFFER-HOOKS. (defun erc-networks-tests--clean-bufs () - (let (erc-kill-channel-hook - erc-kill-server-hook - erc-kill-buffer-hook) - (dolist (buf (erc-buffer-list)) - (kill-buffer buf)))) + (erc-tests-common-kill-buffers)) (defun erc-networks-tests--bufnames (prefix) (let* ((case-fold-search) @@ -1442,10 +1438,12 @@ erc-networks--rename-server-buffer--existing--live (let* (erc-kill-server-hook erc-insert-modify-hook (old-buf (get-buffer-create "FooNet")) - (old-proc (erc-networks-tests--create-live-proc old-buf))) ; live + ;; + old-proc) ; live (with-current-buffer old-buf (erc-mode) + (setq old-proc (erc-networks-tests--create-live-proc)) (erc--initialize-markers (point) nil) (insert "*** Old buf") (setq erc-network 'FooNet diff --git a/test/lisp/erc/erc-scenarios-internal.el b/test/lisp/erc/erc-scenarios-internal.el index 4ec94cedf0e..b6c4d1ba27f 100644 --- a/test/lisp/erc/erc-scenarios-internal.el +++ b/test/lisp/erc/erc-scenarios-internal.el @@ -24,9 +24,12 @@ (when (and (getenv "EMACS_TEST_DIRECTORY") (getenv "EMACS_TEST_JUNIT_REPORT")) (setq ert-load-file-name (or (macroexp-file-name) buffer-file-name))) - (let ((load-path (cons (expand-file-name "erc-d" (ert-resource-directory)) - load-path))) - (load "erc-d-tests" nil 'silent))) + (let ((load-path `(,(expand-file-name "erc-d" (ert-resource-directory)) + ,(ert-resource-directory) + ,@load-path))) + ;; Run all tests in ./resources/erc-d/erc-d-tests.el. + (load "erc-d-tests" nil 'silent) + (require 'erc-tests-common))) ;; Run all tests tagged `:erc--graphical' in an "interactive" ;; subprocess. Time out after 90 seconds. @@ -45,13 +48,9 @@ erc-scenarios-internal--run-graphical-all (with-current-buffer ert--output-buffer-name (kill-emacs (ert--stats-failed-unexpected ert--results-stats))))) - (args `("erc-interactive-all" ,(current-buffer) - ,(concat invocation-directory invocation-name) - "-Q" "-L" "." "-l" "ert" - ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o) - "-eval" ,(format "%S" program))) - (proc (apply #'start-process args))) - (set-process-query-on-exit-flag proc nil) + (proc (erc-tests-common-create-subprocess program + '( "-L" "." "-l" "ert") + libs))) (erc-d-t-wait-for 90 "interactive tests to complete" (not (process-live-p proc))) diff --git a/test/lisp/erc/erc-scenarios-sasl.el b/test/lisp/erc/erc-scenarios-sasl.el index 74075b1aaf3..ecabc365adb 100644 --- a/test/lisp/erc/erc-scenarios-sasl.el +++ b/test/lisp/erc/erc-scenarios-sasl.el @@ -151,6 +151,7 @@ erc-scenarios-sasl--plain-fail (erc-sasl-mechanism 'plain) (erc--warnings-buffer-name "*ERC test warnings*") (warnings-buffer (get-buffer-create erc--warnings-buffer-name)) + (inhibit-message noninteractive) (expect (erc-d-t-make-expecter))) (with-current-buffer (erc :server "127.0.0.1" diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index fd2e7000c0e..3f17e36e002 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -21,6 +21,10 @@ ;;; Code: (require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-stamp) (require 'erc-goodies) ; for `erc-make-read-only' @@ -44,9 +48,7 @@ erc-stamp-tests--insert-right (erc-mode) (erc-munge-invisibility-spec) (erc--initialize-markers (point) nil) - (setq erc-server-process (start-process "p" (current-buffer) - "sleep" "1")) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-tests-common-init-server-proc "sleep" "1") (funcall test) @@ -223,13 +225,13 @@ erc-timestamp-intangible--left (erc-timestamp-intangible t) ; default changed to nil in 2014 (erc-hide-timestamps t) (erc-insert-timestamp-function 'erc-insert-timestamp-left) - (erc-server-process (start-process "true" (current-buffer) "true")) (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp)) msg erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (should (not cursor-sensor-inhibit)) - (set-process-query-on-exit-flag erc-server-process nil) + (erc-mode) + (erc-tests-common-init-server-proc "true") (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") (erc-mode) (erc--initialize-markers (point) nil) @@ -307,4 +309,44 @@ erc-echo-timestamp (should (equal (call-interactively #'erc-echo-timestamp) "1983-09-26 21:00:00 -07"))))) +(defun erc-stamp-tests--assert-get-inserted-msg/stamp (test-fn) + (let ((erc-insert-modify-hook erc-insert-modify-hook) + (erc-insert-timestamp-function 'erc-insert-timestamp-right) + (erc-timestamp-use-align-to 0) + (erc-timestamp-format "[00:00]")) + (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook) + (erc-tests-common-get-inserted-msg-setup)) + (goto-char 19) + (should (looking-back (rx " hi [00:00]"))) + (erc-tests-common-assert-get-inserted-msg 3 19 test-fn)) + +(ert-deftest erc--get-inserted-msg-beg/stamp () + (erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-beg/readonly/stamp () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-end/stamp () + (erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-end/readonly/stamp () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/stamp () + (erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) + (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp () + (erc-tests-common-assert-get-inserted-msg-readonly-with + #'erc-stamp-tests--assert-get-inserted-msg/stamp + (lambda (arg) + (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) + ;;; erc-stamp-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index ffc96eb4f1d..2d6eda6a24c 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -22,7 +22,10 @@ ;;; Code: (require 'ert-x) -(require 'erc) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + (require 'erc-ring) (ert-deftest erc--read-time-period () @@ -113,7 +116,7 @@ erc-with-all-buffers-of-server (ert-deftest erc-with-server-buffer () (setq erc-away 1) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (let (mockingp calls) (advice-add 'buffer-local-value :after @@ -155,34 +158,22 @@ erc--doarray (when (cl-evenp c) (push c out))))) (should (equal out '(?f ?d ?b))))) -(defun erc-tests--send-prep () - ;; Caller should probably shadow `erc-insert-modify-hook' or - ;; populate user tables for erc-button. - (erc-mode) - (erc--initialize-markers (point) nil) - (should (= (point) erc-input-marker))) - -(defun erc-tests--set-fake-server-process (&rest args) - (setq erc-server-process - (apply #'start-process (car args) (current-buffer) args)) - (set-process-query-on-exit-flag erc-server-process nil)) - (ert-deftest erc-hide-prompt () (let ((erc-hide-prompt erc-hide-prompt) ;; erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (with-current-buffer (get-buffer-create "ServNet") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p (regexp-quote erc-prompt))) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (set-process-sentinel erc-server-process #'ignore) (setq erc-network 'ServNet) (set-process-query-on-exit-flag erc-server-process nil)) (with-current-buffer (get-buffer-create "#chan") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p (regexp-quote erc-prompt))) (setq erc-server-process (buffer-local-value 'erc-server-process @@ -190,7 +181,7 @@ erc-hide-prompt erc--target (erc--target-from-string "#chan"))) (with-current-buffer (get-buffer-create "bob") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p (regexp-quote erc-prompt))) (setq erc-server-process (buffer-local-value 'erc-server-process @@ -318,10 +309,10 @@ erc--refresh-prompt (ert-info ("Server buffer") (with-current-buffer (get-buffer-create "ServNet") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p "ServNet 3>")) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (set-process-sentinel erc-server-process #'ignore) (setq erc-network 'ServNet erc-server-current-nick "tester" @@ -353,7 +344,7 @@ erc--refresh-prompt (ert-info ("Channel buffer") (with-current-buffer (get-buffer-create "#chan") - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (goto-char erc-insert-marker) (should (looking-at-p "#chan 9>")) (goto-char erc-input-marker) @@ -546,7 +537,7 @@ erc--switch-to-buffer (ert-deftest erc-setup-buffer--custom-action () (erc-mode) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq erc--server-last-reconnect-count 0) (let ((owin (selected-window)) (obuf (window-buffer)) @@ -677,7 +668,7 @@ erc--parse-nuh (ert-deftest erc--parsed-prefix () (erc-mode) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table)) ;; Uses fallback values when no PREFIX parameter yet received, thus @@ -755,7 +746,7 @@ erc--update-channel-modes erc-server-users (make-hash-table :test #'equal) erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test")) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) calls) @@ -845,7 +836,7 @@ erc--channel-modes erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) @@ -890,7 +881,7 @@ erc--channel-modes/graphic-p '(:erc--graphical))) (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant")) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") erc-server-parameters @@ -1200,7 +1191,7 @@ erc-ring-previous-command-base-case (ert-deftest erc-ring-previous-command () (with-current-buffer (get-buffer-create "*#fake*") (erc-mode) - (erc-tests--send-prep) + (erc-tests-common-prep-for-insertion) (setq erc-server-current-nick "tester") (setq-local erc-last-input-time 0) (should-not (local-variable-if-set-p 'erc-send-completed-hook)) @@ -1381,29 +1372,8 @@ erc--input-line-delim-regexp (should (equal '("" "" "") (split-string "\n\n" p))) (should (equal '("" "" "") (split-string "\n\r" p))))) -(defun erc-tests--with-process-input-spy (test) - (with-current-buffer (get-buffer-create "FakeNet") - (let* ((erc--input-review-functions - (remove #'erc-add-to-input-ring erc--input-review-functions)) - (erc-pre-send-functions - (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now - (inhibit-message noninteractive) - (erc-server-current-nick "tester") - (erc-last-input-time 0) - erc-accidental-paste-threshold-seconds - erc-send-modify-hook - ;; - calls) - (cl-letf (((symbol-function 'erc-process-input-line) - (lambda (&rest r) (push r calls))) - ((symbol-function 'erc-server-buffer) - (lambda () (current-buffer)))) - (erc-tests--send-prep) - (funcall test (lambda () (pop calls))))) - (when noninteractive (kill-buffer)))) - (ert-deftest erc--check-prompt-input-functions () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) (ert-info ("Errors when point not in prompt area") ; actually just dings @@ -1438,9 +1408,9 @@ erc--check-prompt-input-functions ;; These also indirectly tests `erc-send-input' (ert-deftest erc-send-current-line () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (should (= 0 erc-last-input-time)) (ert-info ("Simple command") @@ -1519,9 +1489,9 @@ erc-tests--check-prompt-input-messages '("Stripping" "Padding")) (ert-deftest erc--check-prompt-input-for-multiline-blanks () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests--set-fake-server-process "sleep" "10") + (erc-tests-common-init-server-proc "sleep" "10") (should-not erc-send-whitespace-lines) (should erc-warn-about-blank-lines) @@ -1600,9 +1570,9 @@ erc--check-prompt-input-for-multiline-blanks/explanations rv )))))) (ert-deftest erc-send-whitespace-lines () - (erc-tests--with-process-input-spy + (erc-tests-common-with-process-input-spy (lambda (next) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (setq-local erc-send-whitespace-lines t) (ert-info ("Multiline hunk with blank line correctly split") @@ -1697,7 +1667,7 @@ erc-process-input-line (erc-default-recipients '("#chan")) calls) (with-temp-buffer - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-init-server-proc "sleep" "1") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) @@ -1755,120 +1725,19 @@ erc-process-input-line (should-not calls)))))) -(defun erc-tests--get-inserted-msg-setup () - (erc-mode) - (erc--initialize-markers (point) nil) - (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi" - :sender "bob" - :command "PRIVMSG" - :command-args (list "#chan" "hi") - :contents "hi")) - (erc--msg-prop-overrides '((erc--ts . 0)))) - (erc-display-message parsed nil (current-buffer) - (erc-format-privmessage "bob" "hi" nil t))) - (goto-char 3) - (should (looking-at " hi"))) - -;; All these bounds-finding functions take an optional POINT argument. -;; So run each case with and without it at each pos in the message. -(defun erc-tests--assert-get-inserted-msg (from to assert-fn) - (dolist (pt-arg '(nil t)) - (dolist (i (number-sequence from to)) - (goto-char i) - (ert-info ((format "At %d (%c) %s param" i (char-after i) - (if pt-arg "with" ""))) - (funcall assert-fn (and pt-arg i)))))) - -(defun erc-tests--assert-get-inserted-msg/basic (test-fn) - (erc-tests--get-inserted-msg-setup) - (goto-char 11) - (should (looking-back " hi")) - (erc-tests--assert-get-inserted-msg 3 11 test-fn)) - -(defun erc-tests--assert-get-inserted-msg/stamp (test-fn) - (require 'erc-stamp) - (defvar erc-insert-timestamp-function) - (defvar erc-timestamp-format) - (defvar erc-timestamp-use-align-to) - (let ((erc-insert-modify-hook erc-insert-modify-hook) - (erc-insert-timestamp-function 'erc-insert-timestamp-right) - (erc-timestamp-use-align-to 0) - (erc-timestamp-format "[00:00]")) - (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook) - (erc-tests--get-inserted-msg-setup)) - (goto-char 19) - (should (looking-back (rx " hi [00:00]"))) - (erc-tests--assert-get-inserted-msg 3 19 test-fn)) - -;; This is a "mixin" and requires a base assertion function to work. -(defun erc-tests--assert-get-inserted-msg-readonly-with (assert-fn test-fn) - (defvar erc-readonly-mode) - (defvar erc-readonly-mode-hook) - (let ((erc-readonly-mode nil) - (erc-readonly-mode-hook nil) - (erc-send-post-hook erc-send-post-hook) - (erc-insert-post-hook erc-insert-post-hook)) - (erc-readonly-mode +1) - (funcall assert-fn test-fn))) - (ert-deftest erc--get-inserted-msg-beg/basic () - (erc-tests--assert-get-inserted-msg/basic - (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) - -(ert-deftest erc--get-inserted-msg-beg/readonly () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/basic - (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) - -(ert-deftest erc--get-inserted-msg-beg/stamp () - (erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) - -(ert-deftest erc--get-inserted-msg-beg/readonly/stamp () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/stamp + (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) (ert-deftest erc--get-inserted-msg-end/basic () - (erc-tests--assert-get-inserted-msg/basic + (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) -(ert-deftest erc--get-inserted-msg-end/readonly () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/basic - (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) - -(ert-deftest erc--get-inserted-msg-end/stamp () - (erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) - -(ert-deftest erc--get-inserted-msg-end/readonly/stamp () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) - (ert-deftest erc--get-inserted-msg-bounds/basic () - (erc-tests--assert-get-inserted-msg/basic + (erc-tests-common-assert-get-inserted-msg/basic (lambda (arg) (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) -(ert-deftest erc--get-inserted-msg-bounds/readonly () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/basic - (lambda (arg) - (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) - -(ert-deftest erc--get-inserted-msg-bounds/stamp () - (erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) - (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) - -(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp () - (erc-tests--assert-get-inserted-msg-readonly-with - #'erc-tests--assert-get-inserted-msg/stamp - (lambda (arg) - (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) - (ert-deftest erc--delete-inserted-message () (erc-mode) (erc--initialize-markers (point) nil) @@ -2631,8 +2500,8 @@ erc--format-speaker-input-message (should (equal (erc--format-speaker-input-message "oh my") expect)))) (ert-deftest erc--route-insertion () - (erc-tests--send-prep) - (erc-tests--set-fake-server-process "sleep" "1") + (erc-tests-common-prep-for-insertion) + (erc-tests-common-init-server-proc "sleep" "1") (setq erc-networks--id (erc-networks--id-create 'foonet)) (let* ((erc-modules) ; for `erc--open-target' @@ -3018,30 +2887,6 @@ erc-server-select (erc-server-connect-function erc-open-network-stream)))))))) -(defun erc-tests--make-server-buf (name) - (with-current-buffer (get-buffer-create name) - (erc-mode) - (setq erc-server-process (start-process "sleep" (current-buffer) - "sleep" "1") - erc-session-server (concat "irc." name ".org") - erc-session-port 6667 - erc-network (intern name)) - (set-process-query-on-exit-flag erc-server-process nil) - (current-buffer))) - -(defun erc-tests--make-client-buf (server name) - (unless (bufferp server) - (setq server (get-buffer server))) - (with-current-buffer (get-buffer-create name) - (erc-mode) - (setq erc--target (erc--target-from-string name)) - (dolist (v '(erc-server-process - erc-session-server - erc-session-port - erc-network)) - (set v (buffer-local-value v server))) - (current-buffer))) - (ert-deftest erc-handle-irc-url () (let* (calls rvbuf @@ -3055,10 +2900,10 @@ erc-handle-irc-url (cl-letf (((symbol-function 'erc-cmd-JOIN) (lambda (&rest r) (push r calls)))) - (with-current-buffer (erc-tests--make-server-buf "foonet") + (with-current-buffer (erc-tests-common-make-server-buf "foonet") (setq rvbuf (current-buffer))) - (erc-tests--make-server-buf "barnet") - (erc-tests--make-server-buf "baznet") + (erc-tests-common-make-server-buf "barnet") + (erc-tests-common-make-server-buf "baznet") (ert-info ("Unknown network") (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc") @@ -3082,7 +2927,8 @@ erc-handle-irc-url (should-not calls)) (ert-info ("Known network, existing chan with key") - (erc-tests--make-client-buf "foonet" "#chan") + (save-excursion + (with-current-buffer "foonet" (erc--open-target "#chan"))) (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc") (should (equal '("#chan" "sec") (pop calls))) (should-not calls)) @@ -3095,7 +2941,7 @@ erc-handle-irc-url (ert-info ("Unknown network, connect, chan") (with-current-buffer "foonet" (should-not (local-variable-p 'erc-after-connect))) - (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu"))) + (setq rvbuf (lambda () (erc-tests-common-make-server-buf "gnu"))) (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc") (should (equal '("irc" :server "irc.gnu.org") (pop calls))) (should-not calls) @@ -3107,10 +2953,7 @@ erc-handle-irc-url (should-not calls)))) (when noninteractive - (kill-buffer "foonet") - (kill-buffer "barnet") - (kill-buffer "baznet") - (kill-buffer "#chan"))) + (erc-tests-common-kill-buffers))) (ert-deftest erc-channel-user () ;; Traditional and alternate constructor swapped for compatibility. @@ -3201,31 +3044,7 @@ erc--normalize-module-symbol (should (eq (erc--normalize-module-symbol 'nickserv) 'services))) (defun erc-tests--assert-printed-in-subprocess (code expected) - (let* ((package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) - ((string-prefix-p "erc-" found))) - (intern found) - 'erc)) - ;; This is for integrations testing with managed configs - ;; ("starter kits") that use a different package manager. - (init (and-let* ((found (getenv "ERC_TESTS_INIT")) - (files (split-string found ","))) - (mapcan (lambda (f) (list "-l" f)) files))) - (prog - `(progn - ,@(and (not init) (featurep 'compat) - `((require 'package) - (let ((package-load-list '((compat t) (,package t)))) - (package-initialize)))) - (require 'erc) - (cl-assert (equal erc-version ,erc-version) t) - ,code)) - (proc (apply #'start-process - (symbol-name (ert-test-name (ert-running-test))) - (current-buffer) - (concat invocation-directory invocation-name) - `("-batch" ,@(or init '("-Q")) - "-eval" ,(format "%S" prog))))) - (set-process-query-on-exit-flag proc t) + (let ((proc (erc-tests-common-create-subprocess code '("-batch") nil))) (while (accept-process-output proc 10)) (goto-char (point-min)) (unless (equal (read (current-buffer)) expected) @@ -3573,38 +3392,11 @@ define-erc-module--local (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) -(defun erc-tests--string-to-propertized-parts (string) - "Return a sequence of `propertize' forms for generating STRING. -Expect maintainers manipulating template catalogs to use this -with `pp-eval-last-sexp' or similar to convert back and forth -between literal strings." - `(concat - ,@(mapcar - (pcase-lambda (`(,beg ,end ,plist)) - ;; At the time of writing, `propertize' produces a string - ;; with the order of the input plist reversed. - `(propertize ,(substring-no-properties string beg end) - ,@(let (out) - (while-let ((plist) - (k (pop plist)) - (v (pop plist))) - (push (if (or (consp v) (symbolp v)) `',v v) out) - (push `',k out)) - out))) - (object-intervals string)))) - -(defun erc-tests-pp-propertized-parts (arg) - "Convert literal string before point into a `propertize'd form. -For simplicity, assume string evaluates to itself." - (interactive "P") - (let ((sexp (erc-tests--string-to-propertized-parts (pp-last-sexp)))) - (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp)))) - -(ert-deftest erc-tests--string-to-propertized-parts () +(ert-deftest erc-tests-common-string-to-propertized-parts () :tags '(:unstable) ; only run this locally (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'")) - (should (equal (erc-tests--string-to-propertized-parts + (should (equal (erc-tests-common-string-to-propertized-parts #("abc" 0 1 (face default foo 1) 1 3 (face (default italic) bar "2"))) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el new file mode 100644 index 00000000000..9d9cc4294bb --- /dev/null +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -0,0 +1,287 @@ +;;; erc-tests-common.el --- Common helpers for ERC tests -*- 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 . + +;;; Commentary: + +;; This file must *not* contain any `ert-deftest' definitions. See +;; top of test/lisp/erc/erc-tests.el for loading example. +;; +;; Environment variables: +;; +;; `ERC_PACKAGE_NAME': Name of the installed ERC package currently +;; running. ERC needs this in order to load the same package in +;; tests that run in a subprocess. Necessary even when the package +;; name is `erc' and not something like `erc-49860'. +;; +;; `ERC_TESTS_INIT': The name of an alternate init file. Mainly for +;; integrations tests involving starter kits. +;; +;; `ERC_TESTS_SNAPSHOT_SAVE': When set, ERC saves the current test's +;; snapshots to disk. +;; + +;;; Code: +(require 'ert-x) +(require 'erc) + +;; Caller should probably shadow `erc-insert-modify-hook' or populate +;; user tables for erc-button. +;; FIXME explain this comment ^ in more detail or delete. +(defun erc-tests-common-prep-for-insertion () + "Initialize current buffer with essentials for message insertion. +Assume caller intends to use `erc-display-message'." + (erc-mode) + (erc--initialize-markers (point) nil) + (should (= (point) erc-input-marker))) + +(defun erc-tests-common-init-server-proc (&rest args) + "Create a process with `start-process' from ARGS. +Assign the result to `erc-server-process' in the current buffer." + (setq erc-server-process + (apply #'start-process (car args) (current-buffer) args)) + (set-process-query-on-exit-flag erc-server-process nil) + erc-server-process) + +;; After dropping support for Emacs 27, callers can use +;; `get-buffer-create' with INHIBIT-BUFFER-HOOKS. +(defun erc-tests-common-kill-buffers (&rest extra-buffers) + "Kill all ERC buffers and possibly EXTRA-BUFFERS." + (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (dolist (buf (erc-buffer-list)) + (kill-buffer buf)) + (named-let doit ((buffers extra-buffers)) + (dolist (buf buffers) + (if (consp buf) (doit buf) (kill-buffer buf)))))) + +(defun erc-tests-common-with-process-input-spy (test-fn) + "Mock `erc-process-input-line' and call TEST-FN. +Shadow `erc--input-review-functions' and `erc-pre-send-functions' +with `erc-add-to-input-ring' removed. Shadow other relevant +variables as nil, and bind `erc-last-input-time' to 0. Also mock +`erc-server-buffer' to return the current buffer. Call TEST-FN +with a utility function that returns the set of arguments most +recently passed to the mocked `erc-process-input-line'. Make +`inhibit-message' non-nil unless running interactively." + (with-current-buffer (get-buffer-create "FakeNet") + (let* ((erc--input-review-functions + (remove 'erc-add-to-input-ring erc--input-review-functions)) + (erc-pre-send-functions + (remove 'erc-add-to-input-ring erc-pre-send-functions)) ; for now + (inhibit-message noninteractive) + (erc-server-current-nick "tester") + (erc-last-input-time 0) + erc-accidental-paste-threshold-seconds + erc-send-modify-hook + ;; + calls) + (cl-letf (((symbol-function 'erc-process-input-line) + (lambda (&rest r) (push r calls))) + ((symbol-function 'erc-server-buffer) + (lambda () (current-buffer)))) + (erc-tests-common-prep-for-insertion) + (funcall test-fn (lambda () (pop calls))))) + (when noninteractive (kill-buffer)))) + +(defun erc-tests-common-make-server-buf (name) + "Return a server buffer named NAME, creating it if necessary. +Use NAME for the network and the session server as well." + (with-current-buffer (get-buffer-create name) + (erc-tests-common-prep-for-insertion) + (erc-tests-common-init-server-proc "sleep" "1") + (setq erc-session-server (concat "irc." name ".org") + erc-server-announced-name (concat "west." name ".org") + erc-session-port 6667 + erc-network (intern name) + erc-networks--id (erc-networks--id-create nil)) + (current-buffer))) + +(defun erc-tests-common-string-to-propertized-parts (string) + "Return a sequence of `propertize' forms for generating STRING. +Expect maintainers manipulating template catalogs to use this +with `pp-eval-last-sexp' or similar to convert back and forth +between literal strings." + `(concat + ,@(mapcar + (pcase-lambda (`(,beg ,end ,plist)) + ;; At the time of writing, `propertize' produces a string + ;; with the order of the input plist reversed. + `(propertize ,(substring-no-properties string beg end) + ,@(let (out) + (while-let ((plist) + (k (pop plist)) + (v (pop plist))) + (push (if (or (consp v) (symbolp v)) `',v v) out) + (push `',k out)) + out))) + (object-intervals string)))) + +(defun erc-tests-common-pp-propertized-parts (arg) + "Convert literal string before point into a `propertize'd form. +For simplicity, assume string evaluates to itself." + (interactive "P") + (let ((sexp (erc-tests-common-string-to-propertized-parts (pp-last-sexp)))) + (if arg (insert (pp-to-string sexp)) (pp-eval-expression sexp)))) + +;; The following utilities are meant to help prepare tests for +;; `erc--get-inserted-msg-bounds' and friends. +(defun erc-tests-common-get-inserted-msg-setup () + (erc-tests-common-prep-for-insertion) + (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi" + :sender "bob" + :command "PRIVMSG" + :command-args (list "#chan" "hi") + :contents "hi")) + (erc--msg-prop-overrides '((erc--ts . 0)))) + (erc-display-message parsed nil (current-buffer) + (erc-format-privmessage "bob" "hi" nil t))) + (goto-char 3) + (should (looking-at " hi"))) + +;; All these bounds-finding functions take an optional POINT argument. +;; So run each case with and without it at each pos in the message. +(defun erc-tests-common-assert-get-inserted-msg (from to assert-fn) + (dolist (pt-arg '(nil t)) + (dolist (i (number-sequence from to)) + (goto-char i) + (ert-info ((format "At %d (%c) %s param" i (char-after i) + (if pt-arg "with" ""))) + (funcall assert-fn (and pt-arg i)))))) + +(defun erc-tests-common-assert-get-inserted-msg/basic (test-fn) + (erc-tests-common-get-inserted-msg-setup) + (goto-char 11) + (should (looking-back " hi")) + (erc-tests-common-assert-get-inserted-msg 3 11 test-fn)) + +;; This is a "mixin" and requires a base assertion function, like +;; `erc-tests-common-assert-get-inserted-msg/basic', to work. +(defun erc-tests-common-assert-get-inserted-msg-readonly-with + (assert-fn test-fn) + (defvar erc-readonly-mode) + (defvar erc-readonly-mode-hook) + (let ((erc-readonly-mode nil) + (erc-readonly-mode-hook nil) + (erc-send-post-hook erc-send-post-hook) + (erc-insert-post-hook erc-insert-post-hook)) + (erc-readonly-mode +1) + (funcall assert-fn test-fn))) + + +;;;; Buffer snapshots + +;; Use this variable to generate new snapshots after carefully +;; reviewing the output of *each* snapshot (not just first and last). +;; Obviously, only run one test at a time. +(defvar erc-tests-common-snapshot-save-p (getenv "ERC_TESTS_SNAPSHOT_SAVE")) + +(defun erc-tests-common-snapshot-compare (name dir trans-fn buf-init-fn) + "Compare `buffer-string' to snapshot NAME.eld in DIR, if present. +When non-nil, run TRANS-FN to fiter the current buffer string, +and expect a similar string in return. Call BUF-INIT-FN, when +non-nil, in the preview buffer after inserting the filtered +string." + (let* ((expect-file (file-name-with-extension (expand-file-name name dir) + "eld")) + (erc--own-property-names + (seq-difference `(font-lock-face ,@erc--own-property-names) + `(field display wrap-prefix line-prefix + erc--msg erc--cmd erc--spkr erc--ts erc--ctcp + erc--ephemeral) + #'eq)) + (print-circle t) + (print-escape-newlines t) + (print-escape-nonascii t) + (got (erc--remove-text-properties + (buffer-substring (point-min) erc-insert-marker))) + (repr (funcall (or trans-fn #'identity) (prin1-to-string got)))) + (with-current-buffer (generate-new-buffer name) + (with-silent-modifications + (insert (setq got (read repr)))) + (when buf-init-fn (funcall buf-init-fn)) + (erc-mode)) + ;; LHS is a string, RHS is a symbol. + (if (string= erc-tests-common-snapshot-save-p + (ert-test-name (ert-running-test))) + (let (inhibit-message) + (with-temp-file expect-file + (insert repr)) + ;; Limit writing snapshots to one test at a time. + (message "erc-tests-common-snapshot-compare: wrote %S" expect-file)) + (if (file-exists-p expect-file) + ;; Ensure string-valued properties, like timestamps, aren't + ;; recursive (signals `max-lisp-eval-depth' exceeded). + (named-let assert-equal + ((latest (read repr)) + (expect (read (with-temp-buffer + (insert-file-contents-literally expect-file) + (buffer-string))))) + (pcase latest + ((or "" 'nil) t) + ((pred stringp) + (should (equal-including-properties latest expect)) + (let ((latest-intervals (object-intervals latest)) + (expect-intervals (object-intervals expect))) + (while-let ((l-iv (pop latest-intervals)) + (x-iv (pop expect-intervals)) + (l-tab (map-into (nth 2 l-iv) 'hash-table)) + (x-tab (map-into (nth 2 x-iv) 'hash-table))) + (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab)) + (assert-equal l-v (gethash l-k x-tab)) + (remhash l-k x-tab)) + (should (zerop (hash-table-count x-tab)))))) + ((pred sequencep) + (assert-equal (seq-first latest) (seq-first expect)) + (assert-equal (seq-rest latest) (seq-rest expect))) + (_ (should (equal latest expect))))) + (message "Snapshot file missing: %S" expect-file))))) + +(defun erc-tests-common-create-subprocess (code switches libs) + "Return subprocess for running CODE in an inferior Emacs. +Include SWITCHES, like \"-batch\", as well as libs, after +interspersing \"-l\" between members." + (let* ((package (if-let ((found (getenv "ERC_PACKAGE_NAME")) + ((string-prefix-p "erc-" found))) + (intern found) + 'erc)) + ;; For integrations testing with managed configs that use a + ;; different package manager. + (init (and-let* ((found (getenv "ERC_TESTS_INIT")) + (files (split-string found ","))) + (mapcan (lambda (f) (list "-l" f)) files))) + (prog + `(progn + ,@(and (not init) (featurep 'compat) + `((require 'package) + (let ((package-load-list '((compat t) (,package t)))) + (package-initialize)))) + (require 'erc) + (cl-assert (equal erc-version ,erc-version) t) + ,code)) + (proc (apply #'start-process + (symbol-name (ert-test-name (ert-running-test))) + (current-buffer) + (concat invocation-directory invocation-name) + `(,@(or init '("-Q")) + ,@switches + ,@(mapcan (lambda (f) (list "-l" f)) libs) + "-eval" ,(format "%S" prog))))) + (set-process-query-on-exit-flag proc t) + proc)) + +(provide 'erc-tests-common) commit c83a2d15097e39d2a46d898f7731ca592c59e5a7 Author: F. Jason Park Date: Sat Dec 23 15:23:44 2023 -0800 Allow selecting graphical ERC tests manually * test/lisp/erc/erc-fill-tests.el (erc-fill-wrap--monospace, erc-fill-wrap--merge, erc-fill-wrap-tests--merge-action, erc-fill-wrap-tests--merge-action/indicator-pre, erc-fill-wrap-tests--merge-action/indicator-post, erc-fill-line-spacing, erc-fill-wrap-visual-keys--body, erc-fill-wrap-visual-keys--prompt, erc-fill--left-hand-stamps): Tag as :erc--graphcial. * test/lisp/erc/erc-scenarios-internal.el (erc-scenarios-internal--run-interactive-all): New test to assist ERC contributors in -jN parallel runs. * test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el (erc-scenarios-scrolltobottom--relaxed): Tag as :erc--graphical. * test/lisp/erc/erc-scenarios-scrolltobottom.el (erc-scenarios-scrolltobottom--normal, erc-scenarios-scrolltobottom--all): Tag as :erc--graphical. * test/lisp/erc/erc-scenarios-status-sidebar.el (erc-scenarios-status-sidebar--nickbar): Tag as :erc--graphical. * test/lisp/erc/erc-tests.el (erc--channel-modes/graphic-p): Tag as :erc--graphical. * test/lisp/erc/resources/base/local-modules/first.eld: Timeouts. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--graphical-p): New variable. (erc-scenarios-common--make-bindings): Don't enable `inhibit-interaction' when interactive. Set `erc-scenarios-common--graphical-p' flag when `:erc--graphical' tag present and running interactively. (erc-scenarios-common-with-cleanup): Account for variable `erc-scenarios-common--graphical-p'. (erc-scenarios-common-scrolltobottom--normal): Turn off `erc-scrolltobottom-mode' when test finishes so as not to pollute when running multiple interactive tests. ; * test/lisp/erc/resources/join/network-id/barnet.eld: Timeouts. diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 8560d421cc2..5e5b1d332ac 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -210,7 +210,8 @@ erc-fill-tests--compare ;; or similar. (ert-deftest erc-fill-wrap--monospace () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) @@ -256,7 +257,8 @@ erc-fill-tests--simulate-refill (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker nil nil)))) (ert-deftest erc-fill-wrap--merge () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) @@ -341,23 +343,27 @@ erc-fill-wrap-tests--merge-action (erc-fill-tests--compare compare-file)))) (ert-deftest erc-fill-wrap--merge-action () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (erc-fill-wrap-tests--merge-action "merge-wrap-01")) (ert-deftest erc-fill-wrap--merge-action/indicator-pre () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (let ((erc-fill-wrap-merge-indicator '(pre ?> shadow))) (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-pre-01"))) ;; One crucial thing this test asserts is that the indicator is ;; omitted when the previous line ends in a stamp. (ert-deftest erc-fill-wrap--merge-action/indicator-post () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (let ((erc-fill-wrap-merge-indicator '(post ?~ shadow))) (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-post-01"))) (ert-deftest erc-fill-line-spacing () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) @@ -371,7 +377,8 @@ erc-fill-line-spacing (erc-fill-tests--compare "spacing-01-mono"))))) (ert-deftest erc-fill-wrap-visual-keys--body () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (erc-fill-tests--wrap-populate (lambda () @@ -413,7 +420,8 @@ erc-fill-wrap-visual-keys--body (should-not (looking-at (rx " "))))))) (ert-deftest erc-fill-wrap-visual-keys--prompt () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (erc-fill-tests--wrap-populate (lambda () @@ -456,7 +464,8 @@ erc-fill-wrap-visual-keys--prompt (execute-kbd-macro "\C-a"))))) (ert-deftest erc-fill--left-hand-stamps () - :tags '(:unstable) + :tags `(:unstable + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) diff --git a/test/lisp/erc/erc-scenarios-internal.el b/test/lisp/erc/erc-scenarios-internal.el index 18eb94e24b0..4ec94cedf0e 100644 --- a/test/lisp/erc/erc-scenarios-internal.el +++ b/test/lisp/erc/erc-scenarios-internal.el @@ -28,4 +28,34 @@ load-path))) (load "erc-d-tests" nil 'silent))) +;; Run all tests tagged `:erc--graphical' in an "interactive" +;; subprocess. Time out after 90 seconds. +(ert-deftest erc-scenarios-internal--run-graphical-all () + :tags '(:expensive-test :unstable) + (unless (and (getenv "ERC_TESTS_GRAPHICAL_ALL") + (not (getenv "ERC_TESTS_GRAPHICAL")) + (not (getenv "CI"))) + (ert-skip "Environmental conditions unmet")) + + (let* ((default-directory (expand-file-name "../" (ert-resource-directory))) + (libs (directory-files default-directory 'full (rx ".el" eot))) + (process-environment (cons "ERC_TESTS_GRAPHICAL=1" + process-environment)) + (program '(progn (ert (quote (tag :erc--graphical))) + (with-current-buffer ert--output-buffer-name + (kill-emacs (ert--stats-failed-unexpected + ert--results-stats))))) + (args `("erc-interactive-all" ,(current-buffer) + ,(concat invocation-directory invocation-name) + "-Q" "-L" "." "-l" "ert" + ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o) + "-eval" ,(format "%S" program))) + (proc (apply #'start-process args))) + (set-process-query-on-exit-flag proc nil) + + (erc-d-t-wait-for 90 "interactive tests to complete" + (not (process-live-p proc))) + + (should (zerop (process-exit-status proc))))) + ;;; erc-scenarios-internal.el ends here diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el index 68ea0b1b070..e99a05526f3 100644 --- a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el +++ b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el @@ -30,7 +30,8 @@ (require 'erc-goodies) (ert-deftest erc-scenarios-scrolltobottom--relaxed () - :tags '(:expensive-test) + :tags `(:expensive-test + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) (when (version< emacs-version "29") (ert-skip "Times out")) (should-not erc-scrolltobottom-all) diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el index 206687ccab5..25b5c09577f 100644 --- a/test/lisp/erc/erc-scenarios-scrolltobottom.el +++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el @@ -30,7 +30,8 @@ ;; now to stay in sync with `erc-scenarios-scrolltobottom--relaxed'. (ert-deftest erc-scenarios-scrolltobottom--normal () - :tags '(:expensive-test) + :tags `(:expensive-test ,@(and (getenv "ERC_TESTS_GRAPHICAL") + '(:erc--graphical))) (when (version< emacs-version "29") (ert-skip "Times out")) (should-not erc-scrolltobottom-all) @@ -45,7 +46,8 @@ erc-scenarios-scrolltobottom--normal (not (erc-scenarios-common--at-win-end-p w)))))))) (ert-deftest erc-scenarios-scrolltobottom--all () - :tags '(:expensive-test) + :tags `(:expensive-test ,@(and (getenv "ERC_TESTS_GRAPHICAL") + '(:erc--graphical))) (when (version< emacs-version "29") (ert-skip "Times out")) (should-not erc-scrolltobottom-all) diff --git a/test/lisp/erc/erc-scenarios-status-sidebar.el b/test/lisp/erc/erc-scenarios-status-sidebar.el index b2b6351e333..d447817e307 100644 --- a/test/lisp/erc/erc-scenarios-status-sidebar.el +++ b/test/lisp/erc/erc-scenarios-status-sidebar.el @@ -99,7 +99,8 @@ erc-nickbar-mode (defvar speedbar-buffer) (ert-deftest erc-scenarios-status-sidebar--nickbar () - :tags '(:unstable :expensive-test) + :tags `(:expensive-test :unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") + '(:erc--graphical))) (when noninteractive (ert-skip "Interactive only")) (erc-scenarios-common-with-cleanup diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 1d2090e1027..ffc96eb4f1d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -886,7 +886,8 @@ erc--channel-modes (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces (ert-deftest erc--channel-modes/graphic-p () - :tags '(:unstable) + :tags `(:unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") + '(:erc--graphical))) (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant")) (erc-tests--set-fake-server-process "sleep" "1") diff --git a/test/lisp/erc/resources/base/local-modules/first.eld b/test/lisp/erc/resources/base/local-modules/first.eld index f9181a80fb7..4e923270e24 100644 --- a/test/lisp/erc/resources/base/local-modules/first.eld +++ b/test/lisp/erc/resources/base/local-modules/first.eld @@ -1,7 +1,7 @@ ;; -*- mode: lisp-data; -*- ((cap 10 "CAP REQ :sasl")) -((nick 1 "NICK tester")) -((user 1 "USER tester 0 * :tester")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester")) ((authenticate 5 "AUTHENTICATE PLAIN") (0.0 ":irc.foonet.org CAP * ACK sasl") @@ -11,7 +11,7 @@ (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester") (0.01 ":irc.foonet.org 903 * :Authentication successful")) -((cap 3.2 "CAP END") +((cap 10 "CAP END") (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0") (0.2 ":irc.foonet.org 003 tester :This server was created Sun, 20 Nov 2022 23:10:36 UTC") diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 311d8a82d72..d842454d085 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -61,6 +61,25 @@ ;; always associated with the fake network FooNet, while nicks Joe and ;; Mike are always on BarNet. (Networks are sometimes downcased.) ;; +;; Environment variables: +;; +;; `ERC_TESTS_GRAPHICAL': Internal variable to unskip those few tests +;; capable of running consecutively while interactive on a graphical +;; display. This triggers both the tests and the suite to commence +;; with teardown activities normally skipped to allow for inspection +;; while interactive. This is also handy when needing to quickly +;; run `ert-results-rerun-test-at-point-debugging-errors' on a +;; failing test because you don't have to go around hunting for and +;; killing associated buffers and processes. +;; +;; `ERC_TESTS_GRAPHICAL_ALL': Currently targets a single "meta" test, +;; `erc-scenarios-internal--run-interactive-all', that runs all +;; tests tagged `:erc--graphical' in an interactive subprocess. +;; +;; `ERC_TESTS_SUBPROCESS': Used internally to detect nested tests. +;; +;; `ERC_D_DEBUG': Tells `erc-d' to emit debugging info to stderr. +;; ;; XXX This file should *not* contain any test cases. ;;; Code: @@ -91,6 +110,7 @@ erc-scenarios-common--resources-dir (defvar erc-scenarios-common-dialog nil) (defvar erc-scenarios-common-extra-teardown nil) +(defvar erc-scenarios-common--graphical-p nil) (defun erc-scenarios-common--add-silence () (advice-add #'erc-login :around #'erc-d-t-silence-around) @@ -110,7 +130,11 @@ erc-scenarios-common--print-trace (eval-and-compile (defun erc-scenarios-common--make-bindings (bindings) - `((erc-d-u-canned-dialog-dir (expand-file-name + `((erc-scenarios-common--graphical-p + (and (or erc-scenarios-common--graphical-p + (memq :erc--graphical (ert-test-tags (ert-running-test)))) + (not (and noninteractive (ert-skip "Interactive only"))))) + (erc-d-u-canned-dialog-dir (expand-file-name (or erc-scenarios-common-dialog (cadr (assq 'erc-scenarios-common-dialog ',bindings))) @@ -119,7 +143,7 @@ erc-scenarios-common--print-trace (quit . ,(erc-quit/part-reason-default)) (erc-version . ,erc-version))) (erc-modules (copy-sequence erc-modules)) - (inhibit-interaction t) + (inhibit-interaction noninteractive) (auth-source-do-cache nil) (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) @@ -139,13 +163,19 @@ erc-scenarios-common-with-cleanup below and can be overridden, except when wanting the \"real\" default value, which must be looked up or captured outside of the calling form. +When running tests tagged as serially runnable while interactive +and the flag `erc-scenarios-common--graphical-p' is non-nil, run +teardown tasks normally inhibited when interactive. That is, +behave almost as if `noninteractive' were also non-nil, and +ensure buffers and other resources are destroyed on completion. + Dialog resource directories are located by expanding the variable `erc-scenarios-common-dialog' or its value in BINDINGS." (declare (indent 1)) (let* ((orig-autojoin-mode (make-symbol "orig-autojoin-mode")) (combined `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode)) - ,@(erc-scenarios-common--make-bindings bindings)))) + ,@(erc-scenarios-common--make-bindings bindings)))) `(erc-d-t-with-cleanup (,@combined) @@ -165,8 +195,9 @@ erc-scenarios-common-with-cleanup (not (eq erc-autojoin-mode ,orig-autojoin-mode))) (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1))) - (when noninteractive - (erc-scenarios-common--print-trace) + (when (or noninteractive erc-scenarios-common--graphical-p) + (when noninteractive + (erc-scenarios-common--print-trace)) (erc-d-t-kill-related-buffers) (delete-other-windows))) @@ -179,7 +210,8 @@ erc-scenarios-common-with-cleanup (erc-d-t-search-for 3 "Starting"))))) (ert-info ("Activate erc-debug-irc-protocol") - (unless (and noninteractive (not erc-debug-irc-protocol)) + (unless (and (or noninteractive erc-scenarios-common--graphical-p) + (not erc-debug-irc-protocol)) (erc-toggle-debug-irc-protocol))) ,@body))) @@ -417,7 +449,9 @@ erc-scenarios-common-scrolltobottom--normal (erc-scenarios-common-say "/msg NickServ help identify") ;; New arriving messages trigger a snap when inserted. (erc-d-t-wait-for 10 (erc-scenarios-common--at-win-end-p)) - (funcall expect 10 "IDENTIFY lets you login"))))) + (funcall expect 10 "IDENTIFY lets you login")) + + (erc-scrolltobottom-mode -1)))) (cl-defun erc-scenarios-common--base-network-id-bouncer ((&key autop foo-id bar-id after diff --git a/test/lisp/erc/resources/join/network-id/barnet.eld b/test/lisp/erc/resources/join/network-id/barnet.eld index e33dd6be29e..ad6a7c820a9 100644 --- a/test/lisp/erc/resources/join/network-id/barnet.eld +++ b/test/lisp/erc/resources/join/network-id/barnet.eld @@ -40,4 +40,4 @@ (0.05 ":mike!~u@6yximxrnkg65a.irc PRIVMSG #chan :joe: And now, dear maid, be you as free to us.") (0.00 ":joe!~u@6yximxrnkg65a.irc PRIVMSG #chan :mike: He hath an uncle here in Messina will be very much glad of it.")) -((linger 3.5 LINGER)) +((linger 30 LINGER)) commit 7576926bea34c45ea9b035b59b8a9d3967311f60 Author: F. Jason Park Date: Sun Dec 24 11:49:26 2023 -0800 Replace erc--get-inserted-msg-bounds with functions * lisp/erc/erc-fill.el (erc-fill--wrap-rejigger-region): Call `erc--get-inserted-msg-end' instead of `erc--get-inserted-msg-bounds' with `end' arg. * lisp/erc/erc-truncate.el (erc-truncate-buffer-to-size): Call `erc--get-inserted-msg-beg' with `point' instead of `erc--get-inserted-msg-bounds' with `beg' arg. * lisp/erc/erc.el (erc--get-inserted-msg-beg-at, erc--get-inserted-msg-end-at): New macros. (erc--get-inserted-msg-beg, erc--get-inserted-msg-end): New functions. (erc--get-inserted-msg-bounds): Convert to function with different signature, and refactor. This was introduced for the yet unreleased 5.6 (Emacs 30) by bug#60936. (erc--get-inserted-msg-prop): Use `erc--get-inserted-msg-beg' instead of `erc--get-inserted-msg-bounds' with `beg' arg. (erc--delete-inserted-message): Update call site of `erc--get-inserted-msg-bounds' to match new signature. (erc-cmd-CLEAR): Use `erc--get-inserted-msg-beg' instead of `erc--get-inserted-msg-bounds' with `beg' arg. * test/lisp/erc/erc-scenarios-match.el (erc-scenarios-match--stamp-right-fools-invisible): Call `erc--get-inserted-msg-end' instead of `erc--get-inserted-msg-bounds'. * test/lisp/erc/erc-tests.el (erc-tests--get-inserted-msg-setup, erc-tests--assert-get-inserted-msg, erc-tests--assert-get-inserted-msg/basic, erc-tests--assert-get-inserted-msg/stamp, erc-tests--assert-get-inserted-msg-readonly-with): New helper functions. (erc--get-inserted-msg-beg/basic, erc--get-inserted-msg-beg/readonly, erc--get-inserted-msg-beg/stamp, erc--get-inserted-msg-beg/readonly/stamp, erc--get-inserted-msg-end/basic, erc--get-inserted-msg-end/stamp, erc--get-inserted-msg-end/readonly, erc--get-inserted-msg-end/readonly/stamp, erc--get-inserted-msg-bounds/readonly, erc--get-inserted-msg-bounds/stamp, erc--get-inserted-msg-bounds/readonly/stamp): New tests. (erc--get-inserted-msg-bounds, erc--get-inserted-msg-bounds/basic): Move `beg' and `end' cases to separate test variants and rename former to latter. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 16ae5bae8d5..03d16c2fcce 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -768,7 +768,7 @@ erc-fill--wrap-rejigger-region ;; Skip to end of message upon encountering accidental gaps ;; introduced by third parties (or bugs). (if-let (((/= ?\n (char-after end))) - (next (erc--get-inserted-msg-bounds 'end beg))) + (next (erc--get-inserted-msg-end beg))) (progn (cl-assert (= ?\n (char-after next))) (when repairp ; eol <= next diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 3350cbd13b7..18c2396d58a 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -102,7 +102,7 @@ erc-truncate-buffer-to-size ;; Truncate at message boundary (formerly line boundary ;; before 5.6). (goto-char end) - (goto-char (or (erc--get-inserted-msg-bounds 'beg) + (goto-char (or (erc--get-inserted-msg-beg end) (pos-bol))) (setq end (point)) ;; try to save the current buffer using diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ab9c769cbbf..02bfda143bc 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3210,34 +3210,45 @@ erc--check-msg-prop (v (gethash prop erc--msg-props))) (if (consp val) (memq v val) (if val (eq v val) v)))) -(defmacro erc--get-inserted-msg-bounds (&optional only point) - "Return the bounds of a message in an ERC buffer. -Return ONLY one side when the first arg is `end' or `beg'. With -POINT, search from POINT instead of `point'." - ;; TODO add edebug spec. - `(let* ((point ,(or point '(point))) - (at-start-p (get-text-property point 'erc--msg))) - (and-let* - (,@(and (member only '(nil beg 'beg)) - '((b (or (and at-start-p point) - (and-let* - ((p (previous-single-property-change point - 'erc--msg))) - (if (= p (1- point)) - (if (get-text-property p 'erc--msg) p (1- p)) - (1- p))))))) - ,@(and (member only '(nil end 'end)) - '((e (1- (next-single-property-change - (if at-start-p (1+ point) point) - 'erc--msg nil erc-insert-marker)))))) - ,(pcase only - ('(quote beg) 'b) - ('(quote end) 'e) - (_ '(cons b e)))))) +(defmacro erc--get-inserted-msg-beg-at (point at-start-p) + (macroexp-let2* nil ((point point) + (at-start-p at-start-p)) + `(or (and ,at-start-p ,point) + (and-let* ((p (previous-single-property-change ,point 'erc--msg))) + (if (and (= p (1- ,point)) (get-text-property p 'erc--msg)) + p + (1- p)))))) + +(defmacro erc--get-inserted-msg-end-at (point at-start-p) + (macroexp-let2 nil point point + `(1- (next-single-property-change (if ,at-start-p (1+ ,point) ,point) + 'erc--msg nil erc-insert-marker)))) + +(defun erc--get-inserted-msg-beg (&optional point) + "Maybe return the start of message in an ERC buffer." + (erc--get-inserted-msg-beg-at (or point (setq point (point))) + (get-text-property point 'erc--msg))) + +(defun erc--get-inserted-msg-end (&optional point) + "Return the end of message in an ERC buffer. +Include any trailing white space before final newline. Expect +POINT to be less than `erc-insert-marker', and don't bother +considering `erc--insert-marker', for now." + (erc--get-inserted-msg-end-at (or point (setq point (point))) + (get-text-property point 'erc--msg))) + +(defun erc--get-inserted-msg-bounds (&optional point) + "Return bounds of message at POINT in an ERC buffer when found. +Search from POINT, when non-nil, instead of `point'. Return nil +if not found." + (let ((at-start-p (get-text-property (or point (setq point (point))) + 'erc--msg))) + (and-let* ((b (erc--get-inserted-msg-beg-at point at-start-p))) + (cons b (erc--get-inserted-msg-end-at point at-start-p))))) (defun erc--get-inserted-msg-prop (prop) "Return the value of text property PROP for some message at point." - (and-let* ((stack-pos (erc--get-inserted-msg-bounds 'beg))) + (and-let* ((stack-pos (erc--get-inserted-msg-beg (point)))) (get-text-property stack-pos prop))) (defmacro erc--with-inserted-msg (&rest body) @@ -3525,7 +3536,7 @@ erc--delete-inserted-message (save-restriction (widen) (unless end - (setq end (erc--get-inserted-msg-bounds nil beg-or-point) + (setq end (erc--get-inserted-msg-bounds beg-or-point) beg (pop end))) (with-silent-modifications (if erc-legacy-invisible-bounds-p @@ -4167,7 +4178,7 @@ erc-cmd-CLEAR (with-silent-modifications (let ((max (if (>= (point) erc-insert-marker) (1- erc-insert-marker) - (or (erc--get-inserted-msg-bounds 'beg) (pos-bol))))) + (or (erc--get-inserted-msg-beg (point)) (pos-bol))))) (run-hook-with-args 'erc--pre-clear-functions max) (delete-region (point-min) max))) t) diff --git a/test/lisp/erc/erc-scenarios-match.el b/test/lisp/erc/erc-scenarios-match.el index 0eed1853879..b18c0a4bd17 100644 --- a/test/lisp/erc/erc-scenarios-match.el +++ b/test/lisp/erc/erc-scenarios-match.el @@ -191,7 +191,7 @@ erc-scenarios-match--stamp-right-fools-invisible (should (= (next-single-property-change msg-end 'invisible) end))))) (lambda () - (let ((end (erc--get-inserted-msg-bounds 'end))) + (let ((end (erc--get-inserted-msg-end (point)))) ;; This message has a time stamp like all the others. (should (eq (field-at-pos (1- end)) 'erc-timestamp)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8a28d351b0f..1d2090e1027 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1754,7 +1754,7 @@ erc-process-input-line (should-not calls)))))) -(ert-deftest erc--get-inserted-msg-bounds () +(defun erc-tests--get-inserted-msg-setup () (erc-mode) (erc--initialize-markers (point) nil) (let ((parsed (make-erc-response :unparsed ":bob PRIVMSG #chan :hi" @@ -1766,42 +1766,107 @@ erc--get-inserted-msg-bounds (erc-display-message parsed nil (current-buffer) (erc-format-privmessage "bob" "hi" nil t))) (goto-char 3) - (should (looking-at " hi")) - (goto-char 11) - (should (looking-back " hi")) - - (ert-info ("Parameter `only' being `beg'") - (dolist (i (number-sequence 3 11)) - (goto-char i) - (ert-info ((format "At %d (%c)" i (char-after i))) - (should (= 3 (erc--get-inserted-msg-bounds 'beg))))) - - (ert-info ("Parameter `point'") - (dolist (i (number-sequence 3 11)) - (ert-info ((format "At %d (%c)" i (char-after i))) - (should (= 3 (erc--get-inserted-msg-bounds 'beg i))))))) + (should (looking-at " hi"))) - (ert-info ("Parameter `only' being `end'") - (dolist (i (number-sequence 3 11)) +;; All these bounds-finding functions take an optional POINT argument. +;; So run each case with and without it at each pos in the message. +(defun erc-tests--assert-get-inserted-msg (from to assert-fn) + (dolist (pt-arg '(nil t)) + (dolist (i (number-sequence from to)) (goto-char i) - (ert-info ((format "At %d (%c)" i (char-after i))) - (should (= 11 (erc--get-inserted-msg-bounds 'end))))) + (ert-info ((format "At %d (%c) %s param" i (char-after i) + (if pt-arg "with" ""))) + (funcall assert-fn (and pt-arg i)))))) - (ert-info ("Parameter `point'") - (dolist (i (number-sequence 3 11)) - (ert-info ((format "At %d (%c)" i (char-after i))) - (should (= 11 (erc--get-inserted-msg-bounds 'end i))))))) - - (ert-info ("Parameter `only' being nil") - (dolist (i (number-sequence 3 11)) - (goto-char i) - (ert-info ((format "At %d (%c)" i (char-after i))) - (should (equal '(3 . 11) (erc--get-inserted-msg-bounds nil))))) +(defun erc-tests--assert-get-inserted-msg/basic (test-fn) + (erc-tests--get-inserted-msg-setup) + (goto-char 11) + (should (looking-back " hi")) + (erc-tests--assert-get-inserted-msg 3 11 test-fn)) - (ert-info ("Parameter `point'") - (dolist (i (number-sequence 3 11)) - (ert-info ((format "At %d (%c)" i (char-after i))) - (should (equal '(3 . 11) (erc--get-inserted-msg-bounds nil i)))))))) +(defun erc-tests--assert-get-inserted-msg/stamp (test-fn) + (require 'erc-stamp) + (defvar erc-insert-timestamp-function) + (defvar erc-timestamp-format) + (defvar erc-timestamp-use-align-to) + (let ((erc-insert-modify-hook erc-insert-modify-hook) + (erc-insert-timestamp-function 'erc-insert-timestamp-right) + (erc-timestamp-use-align-to 0) + (erc-timestamp-format "[00:00]")) + (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook) + (erc-tests--get-inserted-msg-setup)) + (goto-char 19) + (should (looking-back (rx " hi [00:00]"))) + (erc-tests--assert-get-inserted-msg 3 19 test-fn)) + +;; This is a "mixin" and requires a base assertion function to work. +(defun erc-tests--assert-get-inserted-msg-readonly-with (assert-fn test-fn) + (defvar erc-readonly-mode) + (defvar erc-readonly-mode-hook) + (let ((erc-readonly-mode nil) + (erc-readonly-mode-hook nil) + (erc-send-post-hook erc-send-post-hook) + (erc-insert-post-hook erc-insert-post-hook)) + (erc-readonly-mode +1) + (funcall assert-fn test-fn))) + +(ert-deftest erc--get-inserted-msg-beg/basic () + (erc-tests--assert-get-inserted-msg/basic + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-beg/readonly () + (erc-tests--assert-get-inserted-msg-readonly-with + #'erc-tests--assert-get-inserted-msg/basic + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-beg/stamp () + (erc-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-beg/readonly/stamp () + (erc-tests--assert-get-inserted-msg-readonly-with + #'erc-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg)))))) + +(ert-deftest erc--get-inserted-msg-end/basic () + (erc-tests--assert-get-inserted-msg/basic + (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-end/readonly () + (erc-tests--assert-get-inserted-msg-readonly-with + #'erc-tests--assert-get-inserted-msg/basic + (lambda (arg) (should (= 11 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-end/stamp () + (erc-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-end/readonly/stamp () + (erc-tests--assert-get-inserted-msg-readonly-with + #'erc-tests--assert-get-inserted-msg/stamp + (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/basic () + (erc-tests--assert-get-inserted-msg/basic + (lambda (arg) + (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/readonly () + (erc-tests--assert-get-inserted-msg-readonly-with + #'erc-tests--assert-get-inserted-msg/basic + (lambda (arg) + (should (equal '(3 . 11) (erc--get-inserted-msg-bounds arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/stamp () + (erc-tests--assert-get-inserted-msg/stamp + (lambda (arg) + (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) + +(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp () + (erc-tests--assert-get-inserted-msg-readonly-with + #'erc-tests--assert-get-inserted-msg/stamp + (lambda (arg) + (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg)))))) (ert-deftest erc--delete-inserted-message () (erc-mode) commit 65735efdca017f2ec0aa1022b7e82f68fbe0084d Author: F. Jason Park Date: Sat Dec 23 12:46:33 2023 -0800 Improve multi-window erc-keep-place-indicator-mode * lisp/erc/erc-goodies.el (erc-keep-place-indicator-follow): Describe condition causing an indicator update. (erc--keep-place-indicator-on-window-configuration-change, erc--keep-place-indicator-on-window-buffer-change): Rename former to latter, add required WINDOW parameter, and don't move indicator if buffer appears in multiple windows. Also, don't bother checking whether either buffer is a mini because the manual says window change functions don't run for minibuffer replacements. (erc--keep-place-indicator-setup): Hook on `window-buffer-change-functions' instead of `window-configuration-change-hook'. (erc-keep-place-mode, erc-keep-place-disable): Remove member from `window-buffer-change-functions' instead of `window-configuration-change-hook'. (erc-keep-place): Use `visible' FRAME arg of `get-buffer-window'. Don't twiddle `window-prev-buffers' when `erc-keep-place-indicator-mode' is non-nil. This feature was originally introduced by bug#59943. * test/lisp/erc/erc-goodies-tests.el (erc-goodies-tests--assert-kp-indicator-on, erc-goodies-tests--assert-kp-indicator-off): Update hook name. * test/lisp/erc/erc-scenarios-keep-place-indicator.el: New file. * test/lisp/erc/resources/keep-place/follow.eld: New file. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index e10f047b187..9d385b628dc 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -300,7 +300,10 @@ erc-keep-place-indicator-buffer-type (defcustom erc-keep-place-indicator-follow nil "Whether to sync visual kept place to window's top when reading. -For use with `erc-keep-place-indicator-mode'." +For use with `erc-keep-place-indicator-mode'. When enabled, the +indicator updates when the last window displaying the same buffer +switches away, but only if the indicator resides earlier in the +buffer than the window's start." :group 'erc :package-version '(ERC . "5.6") :type 'boolean) @@ -328,17 +331,26 @@ erc-keep-place-indicator-arrow (defvar-local erc--keep-place-indicator-overlay nil "Overlay for `erc-keep-place-indicator-mode'.") -(defun erc--keep-place-indicator-on-window-configuration-change () +(defun erc--keep-place-indicator-on-window-buffer-change (window) "Maybe sync `erc--keep-place-indicator-overlay'. -Specifically, do so unless switching to or from another window in -the active frame." - (when erc-keep-place-indicator-follow - (unless (or (minibuffer-window-active-p (minibuffer-window)) - (eq (window-old-buffer) (current-buffer))) - (when (< (overlay-end erc--keep-place-indicator-overlay) - (window-start) - erc-insert-marker) - (erc-keep-place-move (window-start)))))) +Do so only when switching to a new buffer in the same window if +the replaced buffer is no longer visible in another window and +its `window-start' at the time of switching is strictly greater +than the indicator's position." + (when-let ((erc-keep-place-indicator-follow) + ((eq window (selected-window))) + (old-buffer (window-old-buffer window)) + ((buffer-live-p old-buffer)) + ((not (eq old-buffer (current-buffer)))) + (ov (buffer-local-value 'erc--keep-place-indicator-overlay + old-buffer)) + ((not (get-buffer-window old-buffer 'visible))) + (prev (assq old-buffer (window-prev-buffers window))) + (old-start (nth 1 prev)) + (old-inmkr (buffer-local-value 'erc-insert-marker old-buffer)) + ((< (overlay-end ov) old-start old-inmkr))) + (with-current-buffer old-buffer + (erc-keep-place-move old-start)))) (defun erc--keep-place-indicator-setup () "Initialize buffer for maintaining `erc--keep-place-indicator-overlay'." @@ -347,8 +359,8 @@ erc--keep-place-indicator-setup erc--keep-place-indicator-overlay (make-overlay 0 0)) (add-hook 'erc-keep-place-mode-hook #'erc--keep-place-indicator-on-global-module nil t) - (add-hook 'window-configuration-change-hook - #'erc--keep-place-indicator-on-window-configuration-change nil t) + (add-hook 'window-buffer-change-functions + #'erc--keep-place-indicator-on-window-buffer-change 40 t) (when-let* (((memq erc-keep-place-indicator-style '(t arrow))) (ov-property (if (zerop (fringe-columns 'left)) 'after-string @@ -368,7 +380,11 @@ keep-place-indicator "Buffer-local `keep-place' with fringe arrow and/or highlighted face. Play nice with global module `keep-place' but don't depend on it. Expect that users may want different combinations of `keep-place' -and `keep-place-indicator' in different buffers." +and `keep-place-indicator' in different buffers. Unlike global +`keep-place', when `switch-to-buffer-preserve-window-point' is +enabled, don't forcibly sync point in all windows where buffer +has previously been shown because that defeats the purpose of +having a placeholder." ((cond (erc-keep-place-mode) ((memq 'keep-place erc-modules) (erc-keep-place-mode +1)) @@ -382,8 +398,8 @@ keep-place-indicator (erc-keep-place-indicator-mode -1))) ((when erc--keep-place-indicator-overlay (delete-overlay erc--keep-place-indicator-overlay)) - (remove-hook 'window-configuration-change-hook - #'erc--keep-place-indicator-on-window-configuration-change t) + (remove-hook 'window-buffer-change-functions + #'erc--keep-place-indicator-on-window-buffer-change t) (remove-hook 'erc-keep-place-mode-hook #'erc--keep-place-indicator-on-global-module t) (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) @@ -450,13 +466,13 @@ erc-keep-place (forward-line -1) (when erc-keep-place-indicator-mode (unless (or (minibuffer-window-active-p (selected-window)) - (and (frame-visible-p (selected-frame)) - (get-buffer-window (current-buffer) (selected-frame)))) + (get-buffer-window nil 'visible)) (erc-keep-place-move nil))) ;; if `switch-to-buffer-preserve-window-point' is set, ;; we cannot rely on point being saved, and must commit ;; it to window-prev-buffers. - (when switch-to-buffer-preserve-window-point + (when (and switch-to-buffer-preserve-window-point + (not erc-keep-place-indicator-mode)) (dolist (frame (frame-list)) (walk-window-tree (lambda (window) diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index cdf861e2018..ca02089eb7c 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -247,7 +247,7 @@ erc-controls-highlight--motd (defun erc-goodies-tests--assert-kp-indicator-on () (should erc--keep-place-indicator-overlay) - (should (local-variable-p 'window-configuration-change-hook)) + (should (local-variable-p 'window-buffer-change-functions)) (should window-configuration-change-hook) (should (memq 'erc-keep-place erc-insert-pre-hook)) (should (eq erc-keep-place-mode @@ -255,7 +255,7 @@ erc-goodies-tests--assert-kp-indicator-on (defun erc-goodies-tests--assert-kp-indicator-off () (should-not (local-variable-p 'erc-insert-pre-hook)) - (should-not (local-variable-p 'window-configuration-change-hook)) + (should-not (local-variable-p 'window-buffer-change-functions)) (should-not erc--keep-place-indicator-overlay)) (defun erc-goodies-tests--kp-indicator-populate () diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el new file mode 100644 index 00000000000..7566288066e --- /dev/null +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -0,0 +1,134 @@ +;;; erc-scenarios-keep-place-indicator.el --- erc-keep-place-indicator-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))) + +(require 'erc-goodies) + +;; This test shows that the indicator does not update when at least +;; one window remains. When the last window showing a buffer switches +;; away, the indicator is updated if it's earlier in the buffer. +(ert-deftest erc-scenarios-keep-place-indicator--follow () + :tags `(:expensive-test + ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) + (when (version< emacs-version "29") (ert-skip "Times out")) + ;; XXX verify that this continues to be the case ^. + + (should-not erc-scrolltobottom-all) + (should-not erc-scrolltobottom-mode) + (should-not erc-keep-place-mode) + + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "keep-place") + (dumb-server (erc-d-run "localhost" t 'follow)) + (port (process-contact dumb-server :service)) + (erc-modules `( keep-place-indicator scrolltobottom fill-wrap + ,@erc-modules)) + (erc-keep-place-indicator-follow t) + (erc-scrolltobottom-all t) + (erc-server-flood-penalty 0.1) + (erc-autojoin-channels-alist '((foonet "#chan" "#spam"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester" + :user "tester") + (funcall expect 10 "debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (set-window-buffer nil (current-buffer)) + (delete-other-windows) + (split-window-below) + (funcall expect 10 " tester, welcome!") + (recenter 0) + (other-window 1) + (funcall expect 10 " tester, welcome!") + (recenter 0) + (should (= 2 (length (window-list)))) + + (ert-info ("Last window to switch away has point earlier in buffer") + ;; Lower window, with point later in buffer, switches away first. + (switch-to-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))) ; lower + (other-window 1) + (switch-to-buffer "#spam") ; upper + (erc-scenarios-common-say "one") + (funcall expect 10 "Ay, the heads") + + ;; Overlay has moved to upper window start. + (switch-to-buffer "#chan") + (redisplay) ; force overlay to update + (save-excursion + (goto-char (window-point)) + (should (looking-back (rx " tester, welcome!"))) + (should (= (pos-bol) (window-start))) + (should (= (overlay-start erc--keep-place-indicator-overlay) + (pos-bol)))) + ;; Lower window is still centered at start. + (other-window 1) + (switch-to-buffer "#chan") + (save-excursion + (goto-char (window-point)) + (should (looking-back (rx " tester, welcome!"))) + (should (= (pos-bol) (window-start))))) + + (ert-info ("Last window to switch away has point later in buffer") + ;; Lower window advances. + (funcall expect 10 " alice: Since you can cog") + (recenter 0) + (redisplay) ; force ^ to appear on first line + + (other-window 1) ; upper still at indicator, swtiches first + (switch-to-buffer "#spam") + (other-window 1) + (switch-to-buffer "#spam") ; lower follows, speaks to sync + (erc-scenarios-common-say "two") + (funcall expect 10 " Cause they take") + + ;; Upper switches back first, finds indicator gone. + (other-window 1) + (switch-to-buffer "#chan") + (save-excursion + (goto-char (window-point)) + (should (looking-back (rx " tester, welcome!"))) + (should (= (pos-bol) (window-start))) + (should (> (overlay-start erc--keep-place-indicator-overlay) + (pos-eol)))) + + ;; Lower window follows, window-start preserved. + (other-window 1) + (switch-to-buffer "#chan") + (save-excursion + (goto-char (window-point)) + (should (looking-back (rx "you can cog"))) + (should (= (pos-bol) (window-start))) + (should (= (overlay-start erc--keep-place-indicator-overlay) + (pos-bol)))))) + + (erc-keep-place-mode -1) + (erc-scrolltobottom-mode -1))) + +;;; erc-scenarios-keep-place-indicator.el ends here diff --git a/test/lisp/erc/resources/keep-place/follow.eld b/test/lisp/erc/resources/keep-place/follow.eld new file mode 100644 index 00000000000..e857c17175d --- /dev/null +++ b/test/lisp/erc/resources/keep-place/follow.eld @@ -0,0 +1,73 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Tue, 26 Dec 2023 08:36:35 UTC") + (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 2 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.00 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.03 ":irc.foonet.org 422 tester :MOTD File is missing") + (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i")) + +((join 10 "JOIN #chan") + (0.01 ":irc.foonet.org 221 tester +i") + (0.01 ":tester!~u@p64eqfwvvbxrk.irc JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester") + (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.00 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :tester, welcome!") + (0.01 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :tester, welcome!")) + +((join 10 "JOIN #spam") + (0.00 ":tester!~u@p64eqfwvvbxrk.irc JOIN #spam") + (0.06 ":irc.foonet.org 353 tester = #spam :@fsbot bob alice tester") + (0.01 ":irc.foonet.org 366 tester #spam :End of NAMES list") + (0.03 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #spam :tester, welcome!") + (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #spam :tester, welcome!")) + +((mode 10 "MODE #chan") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.02 ":irc.foonet.org 329 tester #chan 1703579802") + (0.02 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: Madam, my lord is gone, for ever gone.") + (0.10 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :The kinder we, to give them thanks for nothing.")) + +((mode 10 "MODE #spam") + (0.00 ":irc.foonet.org 324 tester #spam +Cnt") + (0.02 ":irc.foonet.org 329 tester #spam 1703579805") + (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :Most manifest, and not denied by himself.") + (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: To bed, to bed: there's knocking at the gate. Come, come, come, come, give me your hand. What's done cannot be undone.") + (0.02 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: And what I spake, I spake it to my face.") + (0.08 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: Since you can cog, I'll play no more with you.") + (0.06 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: The little casket bring me hither.") + (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: Not to-night, good Iago: I have very poor and unhappy brains for drinking: I could well wish courtesy would invent some other custom of entertainment.") + (0.02 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :Yes, faith will I, Fridays and Saturdays and all.")) + +((privmsg 10 "PRIVMSG #spam :one") + (0.03 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: This is the first truth that e'er thine own tongue was guilty of.") + (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: Drown the lamenting fool in sea-salt tears.") + + ;; Insert some lines ^ before rendezvous, so #chan can update scrolltobottom. + (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #spam :Ay, the heads of the maids, or their maidenheads; take it in what sense thou wilt.") + + (0.05 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: And work confusion on his enemies.") + (0.06 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :bob: Truly, she must be given, or the marriage is not lawful.")) + +((privmsg 10 "PRIVMSG #spam :two") + (0.02 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :To be whipped; and yet a better love than my master.") + (0.06 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :And duty in his service perishing.") + + ;; Second check point. + (0.01 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #spam :Cause they take vengeance of such kind of men.") + + (0.03 ":bob!~u@2q6ysndq32az6.irc PRIVMSG #chan :alice: No egma, no riddle, no l'envoy; no salve in the mail, sir. O! sir, plantain, a plain plantain: no l'envoy, no l'envoy: no salve, sir, but a plantain.") + (0.03 ":alice!~u@2q6ysndq32az6.irc PRIVMSG #chan :Signior Iachimo will not from it. Pray, let us follow 'em.")) commit 8f571769e155a214ae2f9f760dd179b687d9982e Author: Stefan Kangas Date: Thu Dec 28 01:20:20 2023 +0100 ; Fix typos diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 5ce72eac77e..9023f1b1ebf 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -267,14 +267,14 @@ jsonrpc-connection-receive conn (setf last-error error) (cond - (;; A remote response whose request has been cancelled + (;; A remote response whose request has been canceled ;; (i.e. timeout or C-g) ;; (and response-p (null cont)) (jsonrpc--event conn 'internal :log-text - (format "Response to request %s which has been cancelled" + (format "Response to request %s which has been canceled" id) :id id) ;; TODO: food for thought: this seems to be also where @@ -823,7 +823,7 @@ jsonrpc--continue (funcall success-fn result))) (t ;; For clarity. This happens if the `jsonrpc-request' was - ;; cancelled + ;; canceled )))) (cl-defun jsonrpc--async-request-1 (connection diff --git a/lisp/recentf.el b/lisp/recentf.el index 7040b432074..869e7a2546a 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -810,7 +810,7 @@ recentf-arrange-rules ("C/C++ files (%d)" ,(rx nonl "." (or "c" "cc" "cpp" "h" "hpp" "cxx" "hxx") eos)) - ("Python files (%d" ,(rx nonl ".py" eos)) + ("Python files (%d)" ,(rx nonl ".py" eos)) ("Java files (%d)" ,(rx nonl ".java" eos)) ) "List of rules used by `recentf-arrange-by-rule' to build sub-menus. diff --git a/lisp/ses.el b/lisp/ses.el index 881fe92a940..02ed2faae3c 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -2763,7 +2763,7 @@ ses-read-default-printer ;; Spreadsheet size adjustments ;;---------------------------------------------------------------------------- (defun ses--blank-line-needs-printing-p () - "Returns `t' when blank new line print-out needs to be initialised + "Returns `t' when blank new line print-out needs to be initialized by calling the printers on it, `nil' otherwise." (let (ret printer commit ea4cbb3aae3c7f72ef04337bc2db7292909ca9a1 Author: Jim Porter Date: Thu Dec 14 11:31:27 2023 -0800 Abbreviate the VC revision in vc-annotate's buffer name * lisp/vc/vc-hooks.el (vc-use-short-revision): New variable. (vc-short-revision): New function. * lisp/vc/vc-annotate.el (vc-annotate-use-short-revision): New option... (vc-annotate): ... use it. * lisp/vc/vc-git.el (vc-git--rev-parse): Consult 'vc-use-short-revision'. * etc/NEWS: Announce this change (bug#67062). diff --git a/etc/NEWS b/etc/NEWS index f82564946b7..c002ec33d45 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -497,6 +497,12 @@ switch is used, commands to see the diff of the old revision ('d'), check out an old file version ('f') or annotate it right away ('a'), also work on revisions which precede renames. +--- +*** 'vc-annotate' now abbreviates the Git revision in the buffer name. +When using the Git backend, 'vc-annotate' will use an abbreviated +revision identifier in its buffer name. To restore the previous +behavior, set 'vc-annotate-use-short-revision' to nil. + *** New option 'vc-git-file-name-changes-switches'. It allows tweaking the thresholds for rename and copy detection. diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index de6c3adbbdb..cfca7cbfac0 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -162,6 +162,11 @@ vc-annotate-menu-elements :type '(repeat number) :group 'vc) +(defcustom vc-annotate-use-short-revision t + "If non-nil, \\[vc-annotate] will use short revisions in its buffer name." + :type 'boolean + :group 'vc) + (defvar-keymap vc-annotate-mode-map :doc "Local keymap used for VC-Annotate mode." "a" #'vc-annotate-revision-previous-to-line @@ -397,7 +402,10 @@ vc-annotate (save-current-buffer (vc-ensure-vc-buffer) (list buffer-file-name - (let ((def (vc-working-revision buffer-file-name))) + (let ((def (funcall (if vc-annotate-use-short-revision + #'vc-short-revision + #'vc-working-revision) + buffer-file-name))) (if (null current-prefix-arg) def (vc-read-revision (format-prompt "Annotate from revision" def) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 24469f04f7c..bd74e2a6a44 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1857,8 +1857,11 @@ vc-git-previous-revision (defun vc-git--rev-parse (rev) (with-temp-buffer (and - (vc-git--out-ok "rev-parse" rev) - (buffer-substring-no-properties (point-min) (+ (point-min) 40))))) + (apply #'vc-git--out-ok "rev-parse" + (append (when vc-use-short-revision '("--short")) + (list rev))) + (goto-char (point-min)) + (buffer-substring-no-properties (point) (pos-eol))))) (defun vc-git-next-revision (file rev) "Git-specific version of `vc-next-revision'." diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 8451128286b..e84cdffe2dd 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -506,6 +506,18 @@ vc-working-revision (vc-call-backend backend 'working-revision file)))))) +(defvar vc-use-short-revision nil + "If non-nil, VC backend functions should return short revisions if possible. +This is set to t when calling `vc-short-revision', which will +then call the \\=`working-revision' backend function.") + +(defun vc-short-revision (file &optional backend) + "Return the repository version for FILE in a shortened form. +If FILE is not registered, this function always returns nil." + (let ((vc-use-short-revision t)) + (vc-call-backend (or backend (vc-backend file)) + 'working-revision file))) + (defun vc-default-registered (backend file) "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." (let ((sym (vc-make-backend-sym backend 'master-templates))) commit 9e0eeb2d49ccd443bb667be9231fe932be67bb10 Author: Eli Zaretskii Date: Wed Dec 27 18:42:41 2023 +0200 ; * doc/misc/eglot.texi (Performance): Fix a typo. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index fbf0b411633..a338677e844 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -1457,7 +1457,7 @@ Performance @cindex performance problems, with Eglot A common and easy-to-fix cause of performance problems in Eglot (especially in older versions) is its events buffer, since it -represent additional work that Eglot must do (@pxref{Eglot Commands, +represents additional work that Eglot must do (@pxref{Eglot Commands, eglot-events-buffer}). If you find Eglot is operating correctly but slowly, try to customize the variable @code{eglot-events-buffer-config} (@pxref{Eglot Variables}) and set commit 4f017f5f0e89e07757dd2d5e0971219420920b79 Author: João Távora Date: Wed Dec 27 09:19:01 2023 -0600 Eglot: experimental support for Eglot-only subprojects * lisp/progmodes/eglot.el (eglot-alternatives) (eglot-server-programs): : Rework docstring. (eglot--guess-contact): Pass project to eglot-server-programs function. (project-root): Define for new experimental Eglot project type. Github-reference: https://github.com/joaotavora/eglot/discussions/1337 diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 1b593439d62..f267d089e3a 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -173,11 +173,12 @@ eglot-alternatives "Compute server-choosing function for `eglot-server-programs'. Each element of ALTERNATIVES is a string PROGRAM or a list of strings (PROGRAM ARGS...) where program names an LSP server -program to start with ARGS. Returns a function of one argument. -When invoked, that function will return a list (ABSPATH ARGS), -where ABSPATH is the absolute path of the PROGRAM that was -chosen (interactively or automatically)." - (lambda (&optional interactive) +program to start with ARGS. Returns a function to be invoked +automatically by Eglot on startup. When invoked, that function +will return a list (ABSPATH ARGS), where ABSPATH is the absolute +path of the PROGRAM that was chosen (interactively or +automatically)." + (lambda (&optional interactive _project) ;; JT@2021-06-13: This function is way more complicated than it ;; could be because it accounts for the fact that ;; `eglot--executable-find' may take much longer to execute on @@ -187,7 +188,10 @@ eglot-alternatives (err (lambda () (error "None of '%s' are valid executables" (mapconcat #'car listified ", "))))) - (cond (interactive + (cond ((and interactive current-prefix-arg) + ;; A C-u always lets user input something manually, + nil) + (interactive (let* ((augmented (mapcar (lambda (a) (let ((found (eglot--executable-find (car a) t))) @@ -352,16 +356,16 @@ eglot-server-programs which you should see for the semantics of the mandatory :PROCESS argument. -* A function of a single argument producing any of the above - values for CONTACT. The argument's value is non-nil if the - connection was requested interactively (e.g. from the `eglot' - command), and nil if it wasn't (e.g. from `eglot-ensure'). If - the call is interactive, the function can ask the user for - hints on finding the required programs, etc. Otherwise, it - should not ask the user for any input, and return nil or signal - an error if it can't produce a valid CONTACT. The helper - function `eglot-alternatives' (which see) can be used to - produce a function that offers more than one server for a given +* A function of two arguments (INTERACTIVE PROJECT) producing any + of the above values for CONTACT. INTERACTIVE will be t if an + interactive `M-x eglot' was used, and nil otherwise (e.g. from + `eglot-ensure'). Interactive calls may ask the user for hints + on finding the required programs, etc. PROJECT is whatever + project Eglot discovered via `project-find-functions' (which + see). The function should return nil or signal an error if it + can't produce a valid CONTACT. The helper function + `eglot-alternatives' (which see) can be used to produce a + function that offers more than one server for a given MAJOR-MODE.") (defface eglot-highlight-symbol-face @@ -1232,7 +1236,8 @@ eglot--guess-contact Return (MANAGED-MODES PROJECT CLASS CONTACT LANG-IDS). If INTERACTIVE is non-nil, maybe prompt user, else error as soon as something can't be guessed." - (let* ((guessed-mode (if buffer-file-name major-mode)) + (let* ((project (eglot--current-project)) + (guessed-mode (if buffer-file-name major-mode)) (guessed-mode-name (and guessed-mode (symbol-name guessed-mode))) (main-mode (cond @@ -1252,7 +1257,9 @@ eglot--guess-contact (language-ids (mapcar #'cdr (car languages-and-contact))) (guess (cdr languages-and-contact)) (guess (if (functionp guess) - (funcall guess interactive) + (pcase (cdr (func-arity guess)) + (1 (funcall guess interactive)) + (_ (funcall guess interactive project))) guess)) (class (or (and (consp guess) (symbolp (car guess)) (prog1 (unless current-prefix-arg (car guess)) @@ -1303,7 +1310,7 @@ eglot--guess-contact (string-to-number (match-string 2 input))) (split-string-and-unquote input)) guess))) - (list managed-modes (eglot--current-project) class contact language-ids))) + (list managed-modes project class contact language-ids))) (defvar eglot-lsp-context nil "Dynamically non-nil when searching for projects in LSP context.") @@ -1319,6 +1326,9 @@ eglot--current-project (or (project-current) `(transient . ,(expand-file-name default-directory))))) +(cl-defmethod project-root ((project (head eglot--project))) + (cadr project)) + ;;;###autoload (defun eglot (managed-major-modes project class contact language-ids &optional _interactive) commit c5a4366b3f3c6ee4178d954e58eb226441d1d2ee Author: João Távora Date: Wed Dec 27 06:05:43 2023 -0600 Eglot: bump to 1.16 * etc/EGLOT-NEWS: Update. * lisp/progmodes/eglot.el (Version): Bump to 1.15 (Package-Requires): Bump jsonrpc depedency to 1.23 diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 2f54dc43cbf..03feaabc9d8 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,15 +20,30 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes in upcoming Eglot -** Diff previews of edits and new variable 'eglot-confirm-server-edits' + +* Changes in Eglot 1.16 (27/12/2023) + +** Code actions can be previewed in diff format The variable 'eglot-confirm-server-edits' replaces the obsolete 'eglot-confirm-server-initiated-edits' and brings about a new -confirmation model, making it possible to have only certain commands -require user confirmation. The type of confirmation has also been -enhanced. In particular it allows a temporary 'diff-mode' buffer to -display the proposed changes, so the user can apply them one by one. -See bug#60338. +confirmation model for code actions, making it possible to have only +certain commands require user confirmation. It allows a temporary +'diff-mode' buffer to display the proposed changes, so the user can +apply them one by one. See bug#60338. + +** Completion sorting has been fixed + +In some situations, Eglot was not respecting the completion sort order +decided by the language server, falling back on the sort order +determined by the 'flex' completion style instead. See github#1306. + +** Improve mouse invocation of code actions + +When invoking code actions by middle clicking with the mouse on +Flymake diagnostics, it was often the case that Eglot didn't request +code actions correctly and thus no actions were offered to the user. +This has been fixed. See github#1295. ** Optimized file-watching capability @@ -37,24 +52,43 @@ watching requests. This change slightly reduces the number of file watcher objects requested from the operating system, which can be a problem, particularly on Mac OS. See github#1228 and github#1226. -** Fixed "onTypeFormatting" feature +** Faster, more accurate, event logging + +The Eglot events buffer takes advantage of new functionality in +Jsonrpc 1.23. By default, Lisp-style printing of JSON-RPC message (a +common cause of performance degradation) is disabled. The full +original JSON message is presented instead. See new variable +'eglot-events-buffer-config', which replaces the obsolete +'eglot-events-buffer-size'. + +** 'textdocument/onTypeFormatting' feature has been fixed For 'newline' commands, Eglot sometimes sent the wrong character code -to the server. Also made this feature less chatty in the mode-line +to the server. Also this feature is now less chatty in the mode-line and messages buffer. -** Fixed completion sorting +** Partial fix C-M-i "middle-of-symbol" completions (github#1339) -In some situations, Eglot was not respecting the completion sort order -decided by the language server, falling back on the sort order -determined by the 'flex' completion style instead. See github#1306. +** Add "Extending Eglot" section to manual -** Improve mouse invocation of code actions +** Fixed Elisp interface 'eglot-lsp-context' (github#1336, github#1337) -When invoking code actions by middle clicking with the mouse on -Flymake diagnostics, it was often the case that Eglot didn't request -code actions correctly and thus no actions were offered to the user. -This has been fixed. github#1295 +** Supports LSP's 'window/showRequest' (bug#62116) + +** The self-upgrade command is now called 'eglot-upgrade-eglot' + +** Newly added directories also watched (github#1228) + +** Send correct ':language-id' for JavaScript server (bug#67150) + +** New servers have been added to 'eglot-server-programs'. + +- nls (bug#63603) +- nixd (bug#64214) +- lexical (bug#65359) +- terraform-ls (bug#65671) +- ruff-lsp (bug#67441) +- uiua (bug#67850) * Changes in Eglot 1.15 (29/4/2023) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index b11fe1a86cc..5ce72eac77e 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -1003,9 +1003,9 @@ jsonrpc--log-event (or method "") (if id (format "[%s]" id) ""))))) (msg - (cond ((eq format 'full) + (cond (nil(eq format 'full) (format "%s%s\n" preamble (or json log-text))) - ((eq format 'short) + (nil(eq format 'short) (format "%s%s\n" preamble (or log-text ""))) (t (format "%s%s" preamble diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 8ff2711ea85..1b593439d62 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2023 Free Software Foundation, Inc. -;; Version: 1.15 +;; Version: 1.16 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.23") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any commit d4485838e14718f0a4a53004c4ab4fc8d049ca18 Author: João Távora Date: Wed Dec 27 07:53:30 2023 -0600 Eglot: fix typo * lisp/progmodes/eglot.el (eglot--guess-contact): Fix typo. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 9b11a22dafb..8ff2711ea85 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1288,7 +1288,8 @@ eglot--guess-contact "\n" base-prompt) (eglot--error (concat "`%s' not found in PATH, but can't form" - " an interactive prompt for to fix %s!") + " an interactive prompt for help you fix" + " this.") program guess)))))) (input (and prompt (read-shell-command prompt full-program-invocation commit d9b5f618baa31e97a5d675c665c9094cf757d184 Author: João Távora Date: Wed Dec 27 06:38:31 2023 -0600 Eglot: introduce eglot-events-buffer-config * doc/misc/eglot.texi (Eglot Variables): Reword. (Performance): Reword. * lisp/progmodes/eglot.el (eglot-events-buffer-size): Obsolete. (eglot-events-buffer-config): New customization variable. (eglot--connect): Use eglot-events-buffer-config. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index c0592a6fe68..fbf0b411633 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -836,13 +836,13 @@ Eglot Variables waiting period. The value of @code{nil} or @code{0} means don't block at all during the waiting period. -@item eglot-events-buffer-size -This determines the size of the Eglot events buffer. @xref{Eglot -Commands, eglot-events-buffer}, for how to display that buffer. If -the value is changed, for it to take effect the connection should be -restarted using @kbd{M-x eglot-reconnect}. +@item eglot-events-buffer-config +This configures the size and format of the Eglot events buffer. +@xref{Eglot Commands, eglot-events-buffer}, for how to access that +buffer. If the value is changed, the connection should be restarted +using @kbd{M-x eglot-reconnect} for the new value to take effect. @c FIXME: Shouldn't the defcustom do this by itself using the :set -@c attribute? +@c attribute? Maybe not because reconnecting is a complex task. @xref{Troubleshooting Eglot}, for when this could be useful. @item eglot-autoshutdown @@ -1455,12 +1455,14 @@ Troubleshooting Eglot @node Performance @section Performance @cindex performance problems, with Eglot -A common and easy-to-fix cause of performance problems is the length -of the Eglot events buffer because it represent additional work that -Eglot must do. After verifying Eglot is operating correctly but -slowly, try to customize the variable @code{eglot-events-buffer-size} -(@pxref{Eglot Variables}) to 0. This will disable any debug logging -and may speed things up. +A common and easy-to-fix cause of performance problems in Eglot +(especially in older versions) is its events buffer, since it +represent additional work that Eglot must do (@pxref{Eglot Commands, +eglot-events-buffer}). If you find Eglot is operating correctly but +slowly, try to customize the variable +@code{eglot-events-buffer-config} (@pxref{Eglot Variables}) and set +its @code{:size} property to 0. This will disable recording any +events and may speed things up. In other situations, the cause of poor performance lies in the language server itself. Servers use aggressive caching and other diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d777e488c43..9b11a22dafb 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -138,6 +138,8 @@ tramp-use-ssh-controlmaster-options 'eglot-managed-mode-hook "1.6") (define-obsolete-variable-alias 'eglot-confirm-server-initiated-edits 'eglot-confirm-server-edits "1.16") +(make-obsolete-variable 'eglot-events-buffer-size + 'eglot-events-buffer-config "1.16") (define-obsolete-function-alias 'eglot--uri-to-path 'eglot-uri-to-path "1.16") (define-obsolete-function-alias 'eglot--path-to-uri 'eglot-path-to-uri "1.16") (define-obsolete-function-alias 'eglot--range-region 'eglot-range-region "1.16") @@ -413,17 +415,29 @@ eglot-send-changes-idle-time "Don't tell server of changes before Emacs's been idle for this many seconds." :type 'number) -(defcustom eglot-events-buffer-size 2000000 - "Control the size of the Eglot events buffer. -If a number, don't let the buffer grow larger than that many -characters. If 0, don't use an event's buffer at all. If nil, -let the buffer grow forever. - -For changes on this variable to take effect on a connection -already started, you need to restart the connection. That can be -done by `eglot-reconnect'." - :type '(choice (const :tag "No limit" nil) - (integer :tag "Number of characters"))) +(defcustom eglot-events-buffer-config + (list :size (or (bound-and-true-p eglot-events-buffer-size) 2000000) + :format 'full) + "Configure the Eglot events buffer. + +Value is a plist accepting the keys `:size', which controls the +size in characters of the buffer (0 disables, nil means +infinite), and `:format', which controls the shape of each log +entry (`full' includes the original JSON, `lisp' uses +pretty-printed Lisp). + +For changes on this variable to take effect, you need to restart +the LSP connection. That can be done by `eglot-reconnect'." + :type '(plist :key-type (symbol :tag "Keyword") + :options (((const :tag "Size" :size) + (choice + (const :tag "No limit" nil) + (integer :tag "Number of characters"))) + ((const :tag "Format" :format) + (choice + (const :tag "Full with original JSON" full) + (const :tag "Shortened" short) + (const :tag "Pretty-printed lisp" lisp)))))) (defcustom eglot-confirm-server-edits '((eglot-rename . nil) (t . maybe-summary)) @@ -1513,7 +1527,7 @@ eglot--connect (apply #'make-instance class :name readable-name - :events-buffer-config `(:size ,eglot-events-buffer-size :format full) + :events-buffer-config eglot-events-buffer-config :notification-dispatcher (funcall spread #'eglot-handle-notification) :request-dispatcher (funcall spread #'eglot-handle-request) :on-shutdown #'eglot--on-shutdown commit 731cfee3b45361158d88bded3c32c9a48ace7bdb Author: João Távora Date: Wed Dec 27 06:10:28 2023 -0600 Jsonrpc: bump to 1.0.23 * lisp/jsonrpc.el (Version): Bump to 1.0.23 diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index a1f8892da64..b11fe1a86cc 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,7 +4,7 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Version: 1.0.22 +;; Version: 1.0.23 ;; Package-Requires: ((emacs "25.2")) ;; This is a GNU ELPA :core package. Avoid functionality that is not