From 8ff3d6905355e41bd91fd8e24577b68e762cfb0a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 27 Jan 2023 06:28:37 -0800 Subject: [PATCH 0/8] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (8): [5.6] Refactor marker initialization in erc-open [5.6] Adjust some old text properties in ERC buffers [5.6] Expose insertion time as text prop in erc-stamp [5.6] Make some erc-stamp functions more limber [5.6] Put display properties to better use in erc-stamp [5.6] Convert erc-fill minor mode into a proper module [5.6] Add variant for erc-match invisibility spec [5.6] Add erc-fill style based on visual-line-mode lisp/erc/erc-common.el | 1 + lisp/erc/erc-fill.el | 307 ++++++++++++++++-- lisp/erc/erc-match.el | 31 +- lisp/erc/erc-stamp.el | 166 ++++++++-- lisp/erc/erc.el | 136 +++++--- test/lisp/erc/erc-fill-tests.el | 172 ++++++++++ .../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++ .../erc/erc-scenarios-base-local-modules.el | 99 ------ test/lisp/erc/erc-stamp-tests.el | 261 +++++++++++++++ test/lisp/erc/erc-tests.el | 79 ++++- 10 files changed, 1248 insertions(+), 215 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el create mode 100644 test/lisp/erc/erc-stamp-tests.el Interdiff: diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a05f2a558f8..ecd721f2f03 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -85,8 +85,8 @@ erc-fill-function function is called. A third style resembles static filling but \"wraps\" instead of -fills, courtesy of `visual-line-mode' mode, which ERC -automatically enables when this option is `erc-fill-wrap' or +fills, thanks to `visual-line-mode' mode, which ERC automatically +enables when this option is `erc-fill-wrap' or when `erc-fill-wrap-mode' is active. Set `erc-fill-static-center' to your preferred initial \"prefix\" width. For adjusting the width during a session, see the command `erc-fill-wrap-nudge'." @@ -96,13 +96,15 @@ erc-fill-function function)) (defcustom erc-fill-static-center 27 - "Column around which all statically filled messages will be centered. -This column denotes the point where the ` ' character between - and the entered text will be put, thus aligning nick -names right and text left. - -Also used by the `erc-fill-function' variant `erc-fill-wrap' for -its initial leading \"prefix\" width." + "Number of columns to \"outdent\" the first line of a message. +During early message handing, ERC prepends a span of +non-whitespace characters to every message, such as a bracketed +\"\" or an `erc-notice-prefix'. The +`erc-fill-function' variants `erc-fill-static' and +`erc-fill-wrap' look to this option to determine the amount of +padding to apply to that portion until the filled (or wrapped) +message content aligns with the indicated column. See also +https://en.wikipedia.org/wiki/Hanging_indent." :type 'integer) (defcustom erc-fill-variable-maximum-indentation 17 @@ -171,65 +173,71 @@ erc-fill-variable (defvar-local erc-fill--wrap-prefix nil) (defvar-local erc-fill--wrap-value nil) -(defvar-local erc-fill--wrap-movement nil) +(defvar-local erc-fill--wrap-visual-keys nil) -(defcustom erc-fill-wrap-movement t - "Whether to override keys defined by `visual-line-mode'. -A value of `display' means to favor default `erc-mode' keys when -point is in the input area." +(defcustom erc-fill-wrap-use-pixels t + "Whether to calculate padding in pixels when possible. +A value of nil means ERC should use columns, which may happen +regardless, depending on the Emacs version. This option only +matters when `erc-fill-wrap-mode' is enabled." + :package-version '(ERC . "5.5") ; FIXME sync on release + :type 'boolean) + +(defcustom erc-fill-wrap-visual-keys 'non-input + "Whether to retain keys defined by `visual-line-mode'. +A value of t tells ERC to use movement commands defined by +`visual-line-mode' everywhere in an ERC buffer along with visual +editing commands in the input area. A value of nil means to +never do so. A value of `non-input' tells ERC to act like the +value is nil in the input area and t elsewhere. This option only +plays a role when `erc-fill-wrap-mode' is enabled." :package-version '(ERC . "5.5") ; FIXME sync on release - :type '(choice boolean (const display :tag "Display area" - :doc "Use `erc-mode' keys in input area"))) + :type '(choice (const nil) (const t) (const non-input))) + +(defun erc-fill--wrap-move (normal-cmd visual-cmd arg) + (funcall + (pcase erc-fill--wrap-visual-keys + ('non-input (if (>= (point) erc-input-marker) normal-cmd visual-cmd)) + ('t visual-cmd) + (_ normal-cmd)) + arg)) (defun erc-fill--wrap-kill-line (arg) "Defer to `kill-line' or `kill-visual-line'." (interactive "P") - ;; ERC buffers are read-only outside of the input area, but users - ;; still need to see the message. - (pcase erc-fill--wrap-movement - ('display (if (>= (point) erc-input-marker) - (kill-line arg) - (kill-visual-line arg))) - ('t (kill-visual-line arg)) - (_ (kill-line arg)))) + ;; ERC buffers are read-only outside of the input area, but we run + ;; `kill-line' anyway so that users can see the error. + (erc-fill--wrap-move #'kill-line #'kill-visual-line arg)) (defun erc-fill--wrap-beginning-of-line (arg) "Defer to `move-beginning-of-line' or `beginning-of-visual-line'." (interactive "^p") - (pcase erc-fill--wrap-movement - ('display (if (>= (point) erc-input-marker) - (move-beginning-of-line arg) - (beginning-of-visual-line arg))) - ('t (beginning-of-visual-line arg)) - (_ (move-beginning-of-line arg))) + (let ((inhibit-field-text-motion t)) + (erc-fill--wrap-move #'move-beginning-of-line + #'beginning-of-visual-line arg)) (when (get-text-property (point) 'erc-prompt) (goto-char erc-input-marker))) (defun erc-fill--wrap-end-of-line (arg) - "defer to `move-end-of-line' or `end-of-visual-line'." + "Defer to `move-end-of-line' or `end-of-visual-line'." (interactive "^p") - (pcase erc-fill--wrap-movement - ('display (if (>= (point) erc-input-marker) - (move-end-of-line arg) - (end-of-visual-line arg))) - ('t (end-of-visual-line arg)) - (_ (move-end-of-line arg)))) + (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg)) (defun erc-fill-wrap-cycle-visual-movement (arg) - "Cycle through `erc-fill-wrap-movement' styles ARG times. -Go from nil to t to `display' and back around, but set internal -state instead of mutating `erc-fill-wrap-movement'. When ARG is -0, reset to value of `erc-fill-wrap-movement'." + "Cycle through `erc-fill-wrap-visual-keys' styles ARG times. +Go from nil to t to `non-input' and back around, but set internal +state instead of mutating `erc-fill-wrap-visual-keys'. When ARG +is 0, reset to value of `erc-fill-wrap-visual-keys'." (interactive "^p") (when (zerop arg) - (setq erc-fill--wrap-movement erc-fill-wrap-movement)) + (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys)) (while (not (zerop arg)) (cl-incf arg (- (abs arg))) - (setq erc-fill--wrap-movement (pcase erc-fill--wrap-movement - ('nil t) - ('t 'display) - ('display nil)))) - (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement)) + (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys + ('nil t) + ('t 'non-input) + ('non-input nil)))) + (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys)) (defvar-keymap erc-fill-wrap-mode-map ; Compat 29 :doc "Keymap for ERC's `fill-wrap' module." @@ -237,16 +245,22 @@ erc-fill-wrap-mode-map " " #'erc-fill--wrap-kill-line " " #'erc-fill--wrap-end-of-line " " #'erc-fill--wrap-beginning-of-line - "C-c c" #'erc-fill-wrap-cycle-visual-movement + "C-c a" #'erc-fill-wrap-cycle-visual-movement ;; Not sure if this is problematic because `erc-bol' takes no args. " " #'erc-fill--wrap-beginning-of-line) +(defvar erc-match-mode) +(defvar erc-match--hide-fools-offset-bounds) + (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. This local module depends on the global `fill' module. To use it, either include `fill-wrap' in `erc-modules' or set `erc-fill-function' to `erc-fill-wrap'. You can also manually -invoke one of the minor-mode toggles." +invoke one of the minor-mode toggles. When the option +`erc-insert-timestamp-function' is `erc-insert-timestamp-right' +or `erc-insert-timestamp-left-and-right', it shows timestamps in +the right margin." ((let (msg) (unless erc-fill-mode (unless (memq 'fill erc-modules) @@ -261,11 +275,15 @@ fill-wrap (setq-local erc-fill-function #'erc-fill-wrap)) (when-let* ((vars (or erc--server-reconnecting erc--target-priors)) ((alist-get 'erc-fill-wrap-mode vars))) - (setq erc-fill--wrap-movement (alist-get 'erc-fill--wrap-movement vars) + (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys + vars) erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars) erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars))) - (when (eq erc-timestamp-use-align-to 'margin) - (erc-timestamp--display-margin-mode +1)) + (when (or erc-stamp-mode (memq 'stamp erc-modules)) + (erc-stamp--display-margin-mode +1)) + (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) + (require 'erc-match) + (setq erc-match--hide-fools-offset-bounds t)) (setq erc-fill--wrap-value (or erc-fill--wrap-value erc-fill-static-center) ;; @@ -273,29 +291,30 @@ fill-wrap (or erc-fill--wrap-prefix (list 'space :width erc-fill--wrap-value))) (visual-line-mode +1) - (unless (local-variable-p 'erc-fill--wrap-movement) - (setq erc-fill--wrap-movement erc-fill-wrap-movement)) + (unless (local-variable-p 'erc-fill--wrap-visual-keys) + (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys)) (when msg (erc-display-error-notice nil msg)))) - ((when erc-timestamp--display-margin-mode - (erc-timestamp--display-margin-mode -1)) + ((when erc-stamp--display-margin-mode + (erc-stamp--display-margin-mode -1)) (kill-local-variable 'erc-button--add-nickname-face-function) (kill-local-variable 'erc-fill--wrap-prefix) (kill-local-variable 'erc-fill--wrap-value) (kill-local-variable 'erc-fill-function) - (kill-local-variable 'erc-fill--wrap-movement) + (kill-local-variable 'erc-fill--wrap-visual-keys) (visual-line-mode -1)) 'local) (defvar-local erc-fill--wrap-length-function nil - "Function to determine length of perceived nickname. -It should return an integer representing the length of the -nickname, including any enclosing brackets, or nil, to fall back -to the default behavior of taking the length from the first word.") - -(defvar erc-fill--wrap-use-pixels t) -(declare-function buffer-text-pixel-size "xdisp" - (&optional buffer-or-name window x-limit y-limit)) + "Function to determine length of overhanging characters. +It should return an EXPR as defined by the info node `(elisp) +Pixel Specification'. This value should represent the width of +the overhang with all faces applied, including any enclosing +brackets (which are not normally fontified) and a trailing space. +It can also return nil to tell ERC to fall back to the default +behavior of taking the length from the first \"word\". This +variable can be converted to a public one if needed by third +parties.") (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. @@ -309,12 +328,13 @@ erc-fill-wrap (progn (skip-syntax-forward "^-") (forward-char) - (if (and erc-fill--wrap-use-pixels + (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size)) (save-restriction (narrow-to-region (point-min) (point)) (list (car (buffer-text-pixel-size)))) (- (point) (point-min))))))) + ;; Leaving out the final newline doesn't seem to affect anything. (erc-put-text-properties (point-min) (point-max) '(line-prefix wrap-prefix) nil `((space :width (- ,erc-fill--wrap-value ,len)) @@ -337,7 +357,7 @@ erc-fill--wrap-fix (while (and (zerop (forward-line)) (< (point) (min (point-max) erc-insert-marker))) (save-restriction - (narrow-to-region (pos-bol) (pos-eol)) + (narrow-to-region (line-beginning-position) (line-end-position)) (erc-fill-wrap)))))) (defun erc-fill--wrap-nudge (arg) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 499bcaf5724..87272f0b647 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -52,8 +52,11 @@ match `erc-current-nick-highlight-type'. For all these highlighting types, you can decide whether the entire message or only the sending nick is highlighted." - ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)) - ((remove-hook 'erc-insert-modify-hook #'erc-match-message))) + ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append) + (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)) + ((remove-hook 'erc-insert-modify-hook #'erc-match-message) + (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec) + (erc-match--modify-invisibility-spec))) ;; Remaining customizations @@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer (define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer) +(defvar-local erc-match--hide-fools-offset-bounds nil) + (defun erc-hide-fools (match-type _nickuserhost _message) "Hide foolish comments. This function should be called from `erc-text-matched-hook'." - (when (eq match-type 'fool) - (erc-put-text-properties (point-min) (point-max) - '(invisible intangible) - (current-buffer)))) + (when (eq match-type 'fool) + (if erc-match--hide-fools-offset-bounds + (let ((beg (point-min)) + (end (point-max))) + (save-restriction + (widen) + (put-text-property (1- beg) (1- end) 'invisible 'erc-match))) + ;; The docs say `intangible' is deprecated, but this has been + ;; like this for ages. Should verify unneeded and remove if so. + (erc-put-text-properties (point-min) (point-max) + '(invisible intangible))))) (defun erc-beep-on-match (match-type _nickuserhost _message) "Beep when text matches. @@ -663,6 +675,13 @@ erc-beep-on-match (when (member match-type erc-beep-match-types) (beep))) +(defun erc-match--modify-invisibility-spec () + "Add an ellipsis property to the local spec." + (if erc-match-mode + (add-to-invisibility-spec 'erc-match) + (erc-with-all-buffers-of-server nil nil + (remove-from-invisibility-spec 'erc-match)))) + (provide 'erc-match) ;;; erc-match.el ends here diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index e9592448a33..21885f3a36f 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -55,6 +55,9 @@ erc-timestamp-format :type '(choice (const nil) (string))) +;; FIXME remove surrounding whitespace from default value and have +;; `erc-insert-timestamp-left-and-right' add it before insertion. + (defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" "If set to a string, messages will be timestamped. This string is processed using `format-time-string'. @@ -68,7 +71,7 @@ erc-timestamp-format-left :type '(choice (const nil) (string))) -(defcustom erc-timestamp-format-right " [%H:%M]" +(defcustom erc-timestamp-format-right nil "If set to a string, messages will be timestamped. This string is processed using `format-time-string'. Good examples are \"%T\" and \"%H:%M\". @@ -77,9 +80,14 @@ erc-timestamp-format-right screen when `erc-insert-timestamp-function' is set to `erc-insert-timestamp-left-and-right'. -If nil, timestamping is turned off." +Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if +the value of this option is nil, it falls back to using the value +of `erc-timestamp-format'." + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) (string))) +(make-obsolete-variable 'erc-timestamp-format-right + 'erc-timestamp-format "30.1") (defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right "Function to use to insert timestamps. @@ -157,29 +165,43 @@ stamp (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp))) +(defvar erc-stamp--current-time nil + "The current time when calling `erc-insert-timestamp-function'. +Specifically, this is the same lisp time object used to create +the stamp passed to `erc-insert-timestamp-function'.") + +(cl-defgeneric erc-stamp--current-time () + "Return a lisp time object to associate with an IRC message. +This becomes the message's `erc-timestamp' text property, which +may not be unique." + (current-time)) + +(cl-defmethod erc-stamp--current-time :around () + (or erc-stamp--current-time (cl-call-next-method))) + (defun erc-add-timestamp () "Add timestamp and text-properties to message. This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (get-text-property (point) 'invisible) - (let ((ct (current-time))) - (if (fboundp erc-insert-timestamp-function) - (funcall erc-insert-timestamp-function - (erc-format-timestamp ct erc-timestamp-format)) - (error "Timestamp function unbound")) + (unless (get-text-property (point-min) 'invisible) + (let* ((ct (erc-stamp--current-time)) + (erc-stamp--current-time ct)) + (funcall erc-insert-timestamp-function + (erc-format-timestamp ct erc-timestamp-format)) + ;; FIXME this will error when advice has been applied. (when (and (fboundp erc-insert-away-timestamp-function) erc-away-timestamp-format (erc-away-time) (not erc-timestamp-format)) (funcall erc-insert-away-timestamp-function (erc-format-timestamp ct erc-away-timestamp-format))) - (add-text-properties (point-min) (point-max) + (add-text-properties (point-min) (1- (point-max)) ;; It's important for the function to ;; be different on different entries (bug#22700). (list 'cursor-sensor-functions - (list (lambda (_window _before dir) - (erc-echo-timestamp dir ct)))))))) + ;; Regions are no longer contiguous ^ + '(erc--echo-ts-csf) 'erc-timestamp ct))))) (defvar-local erc-timestamp-last-window-width nil "The width of the last window that showed the current buffer. @@ -232,29 +254,53 @@ erc-timestamp-use-align-to A side effect of enabling this is that there will only be one space before a right timestamp in any saved logs." :type '(choice boolean integer (const margin)) - :package-version '(ERC . "5.4.1")) ; FIXME update when merging - -;; If people want to use this directly, we can offer an option to set -;; the margin's width. -(define-minor-mode erc-timestamp--display-margin-mode - "Internal minor mode for built-in modules integrating with `stamp'." + :package-version '(ERC . "5.5")) ; FIXME sync on release + +(defcustom erc-stamp-right-margin-width nil + "Width in columns of the right margin. +When this option is nil, pretend its value is one column greater +than the `string-width' of the formatted `erc-timestamp-format'. +This option only matters when `erc-timestamp-use-align-to' is set +to `margin'." + :package-version '(ERC . "5.5") ; FIXME sync on release + :type '(choice (const nil) integer)) + +(defun erc-stamp--display-margin-force (orig &rest r) + (let ((erc-timestamp-use-align-to 'margin)) + (apply orig r))) + +;; If people want to use this directly, we can convert it into +;; a local module. +(define-minor-mode erc-stamp--display-margin-mode + "Internal minor mode for built-in modules integrating with `stamp'. +It binds `erc-timestamp-use-align-to' to `margin' around calls to +`erc-insert-timestamp-function' in the current buffer, and sets +the right window margin to `erc-stamp-right-margin-width'. It +also arranges to remove most text properties when a user kills +message text so that stamps will be visible when yanked." :interactive nil - (if-let ((erc-timestamp--display-margin-mode) - (width (if erc-timestamp-last-inserted-right - (length erc-timestamp-last-inserted-right) - (1+ (length (erc-format-timestamp - (current-time) - erc-timestamp-format-right)))))) - (progn + (if erc-stamp--display-margin-mode + (let ((width (or erc-stamp-right-margin-width + (1+ (string-width (or erc-timestamp-last-inserted + (erc-format-timestamp + (current-time) + erc-timestamp-format))))))) (setq right-margin-width width right-fringe-width 0) - (unless noninteractive - (set-window-margins nil left-margin-width width) - (set-window-fringes nil left-fringe-width 0))) + (set-window-margins nil left-margin-width width) + (set-window-fringes nil left-fringe-width 0) + (add-function :filter-return (local 'filter-buffer-substring-function) + #'erc--remove-text-properties) + (add-function :around (local 'erc-insert-timestamp-function) + #'erc-stamp--display-margin-force)) + (remove-function (local 'filter-buffer-substring-function) + #'erc--remove-text-properties) + (remove-function (local 'erc-insert-timestamp-function) + #'erc-stamp--display-margin-force) (kill-local-variable 'right-margin-width) - (unless noninteractive - (set-window-margins nil nil) - (set-window-fringes nil nil)))) + (kill-local-variable 'right-fringe-width) + (set-window-margins left-margin-width nil) + (set-window-fringes left-fringe-width nil))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." @@ -365,14 +411,19 @@ erc-insert-timestamp-right (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) -(defun erc-insert-timestamp-left-and-right (_string) - "This is another function that can be used with `erc-insert-timestamp-function'. -If the date is changed, it will print a blank line, the date, and -another blank line. If the time is changed, it will then print -it off to the right." - (let* ((ct (current-time)) - (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) - (ts-right (erc-format-timestamp ct erc-timestamp-format-right))) +(defun erc-insert-timestamp-left-and-right (string) + "Insert a stamp on either side when it changes. +When the deprecated option `erc-timestamp-format-right' is nil, +use STRING, which originates from `erc-timestamp-format', for the +right-hand stamp. Use `erc-timestamp-format-left' for the +left-hand stamp and expect it to change less frequently." + (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + (ts-right (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (if erc-timestamp-format-right + (erc-format-timestamp ct erc-timestamp-format-right) + string)))) ;; insert left timestamp (unless (string-equal ts-left erc-timestamp-last-inserted-left) (goto-char (point-min)) @@ -400,8 +451,9 @@ erc-format-timestamp ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible - (not erc-hide-timestamps) ; bug#11706 - (erc-put-text-property 0 (length ts) 'cursor-intangible t ts)) + ;; (not erc-hide-timestamps) ; bug#11706 + (erc-put-text-property 0 (1- (length ts)) + 'cursor-intangible t ts)) ts) "")) @@ -450,11 +502,15 @@ erc-toggle-timestamps (defun erc-echo-timestamp (dir stamp) "Print timestamp text-property of an IRC message." - (when (and erc-echo-timestamps (eq 'entered dir)) + (interactive (list 'entered (get-text-property (point) 'erc-timestamp))) + (when (eq 'entered dir) (when stamp (message "%s" (format-time-string erc-echo-timestamp-format stamp))))) +(defun erc--echo-ts-csf (_window _before dir) + (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp))) + (provide 'erc-stamp) ;;; erc-stamp.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4bc9fc20f8a..6b3d0b4af2f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1966,6 +1966,45 @@ erc--merge-local-modes (cons (nreverse (car out)) (nreverse (cdr out)))) (list new-modes))) +;; This function doubles as a convenient helper for use in unit tests. +;; Prior to 5.6, its contents lived in `erc-open'. + +(defun erc--initialize-markers (old-point continued-session) + "Ensure prompt and its bounding markers have been initialized." + ;; FIXME erase assertions after code review and additional testing. + (setq erc-insert-marker (make-marker) + erc-input-marker (make-marker)) + (if continued-session + (progn + ;; Respect existing multiline input after prompt. Expect any + ;; text preceding it on the same line, including whitespace, + ;; to be part of the prompt itself. + (goto-char (point-max)) + (forward-line 0) + (while (and (not (get-text-property (point) 'erc-prompt)) + (zerop (forward-line -1)))) + (cl-assert (not (= (point) (point-min)))) + (set-marker erc-insert-marker (point)) + ;; If the input area is clean, this search should fail and + ;; return point max. Otherwise, it should return the position + ;; after the last char with the `erc-prompt' property, as per + ;; the doc string for `next-single-property-change'. + (set-marker erc-input-marker + (next-single-property-change (point) 'erc-prompt nil + (point-max))) + (cl-assert (= (field-end) erc-input-marker)) + (goto-char old-point) + (erc--unhide-prompt)) + (cl-assert (not (get-text-property (point) 'erc-prompt))) + ;; In the original version from `erc-open', the snippet that + ;; handled these newline insertions appeared twice close in + ;; proximity, which was probably unintended. Nevertheless, we + ;; preserve the double newlines here for historical reasons. + (insert "\n\n") + (set-marker erc-insert-marker (point)) + (erc-display-prompt) + (cl-assert (= (point) (point-max))))) + (defun erc-open (&optional server port nick full-name connect passwd tgt-list channel process client-certificate user id) @@ -1999,10 +2038,12 @@ erc-open (old-recon-count erc-server-reconnect-count) (old-point nil) (delayed-modules nil) - (continued-session (and erc--server-reconnecting - (with-suppressed-warnings - ((obsolete erc-reuse-buffers)) - erc-reuse-buffers)))) + (continued-session (or erc--server-reconnecting + erc--target-priors + (and-let* (((not target)) + (m (buffer-local-value + 'erc-input-marker buffer)) + ((marker-position m))))))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) @@ -2020,21 +2061,6 @@ erc-open (buffer-local-value 'erc-server-announced-name old-buffer))) ;; connection parameters (setq erc-server-process process) - (setq erc-insert-marker (make-marker)) - (setq erc-input-marker (make-marker)) - ;; go to the end of the buffer and open a new line - ;; (the buffer may have existed) - (goto-char (point-max)) - (forward-line 0) - (when (or continued-session (get-text-property (point) 'erc-prompt)) - (setq continued-session t) - (set-marker erc-input-marker - (or (next-single-property-change (point) 'erc-prompt) - (point-max)))) - (unless continued-session - (goto-char (point-max)) - (insert "\n")) - (set-marker erc-insert-marker (point)) ;; stack of default recipients (setq erc-default-recipients tgt-list) (when target @@ -2081,20 +2107,7 @@ erc-open (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) (erc-determine-parameters server port nick full-name user passwd) - - ;; FIXME consolidate this prompt-setup logic with the pass above. - - ;; set up prompt - (unless continued-session - (goto-char (point-max)) - (insert "\n")) - (if continued-session - (progn (goto-char old-point) - (erc--unhide-prompt)) - (set-marker erc-insert-marker (point)) - (erc-display-prompt) - (goto-char (point-max))) - + (erc--initialize-markers old-point continued-session) (save-excursion (run-mode-hooks) (dolist (mod (car delayed-modules)) (funcall mod +1)) (dolist (var (cdr delayed-modules)) (set var nil))) @@ -2867,6 +2880,9 @@ erc-display-message (erc-display-line string buffer) (unless (erc-hide-current-message-p parsed) (erc-put-text-property 0 (length string) 'erc-parsed parsed string) + (put-text-property + 0 (length string) 'erc-message + (erc--get-eq-comparable-cmd (erc-response.command parsed)) string) (when (erc-response.tags parsed) (erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed) string)) @@ -4244,6 +4260,30 @@ erc-ensure-channel-name channel (concat "#" channel))) +(defvar erc--own-property-names + '( tags erc-parsed display ; core + ;; `erc-display-prompt' + rear-nonsticky erc-prompt field front-sticky read-only + ;; stamp + cursor-intangible cursor-sensor-functions isearch-open-invisible + ;; match + invisible intangible + ;; button + erc-callback erc-data mouse-face keymap + ;; fill-wrap + line-prefix wrap-prefix) + "Props added by ERC that should not survive killing. +Among those left behind by default are `font-lock-face' and +`erc-secret'.") + +(defun erc--remove-text-properties (string) + "Remove text properties in STRING added by ERC. +Specifically, remove any that aren't members of +`erc--own-property-names'." + (remove-list-of-text-properties 0 (length string) + erc--own-property-names string) + string) + (defun erc-grab-region (start end) "Copy the region between START and END in a recreatable format. @@ -5667,7 +5707,7 @@ erc-highlight-error (erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s) s) -(defun erc-put-text-property (start end property value &optional object) +(defalias 'erc-put-text-property 'put-text-property "Set text-property for an object (usually a string). START and END define the characters covered. PROPERTY is the text-property set, usually the symbol `face'. @@ -5677,14 +5717,9 @@ erc-put-text-property OBJECT is modified without being copied first. You can redefine or `defadvice' this function in order to add -EmacsSpeak support." - (put-text-property start end property value object)) +EmacsSpeak support.") -(defun erc-list (thing) - "Return THING if THING is a list, or a list with THING as its element." - (if (listp thing) - thing - (list thing))) +(defalias 'erc-list 'ensure-list) (defun erc-parse-user (string) "Parse STRING as a user specification (nick!login@host). @@ -7278,10 +7313,11 @@ erc-find-parsed-property (defun erc-restore-text-properties () "Restore the property `erc-parsed' for the region." - (let ((parsed-posn (erc-find-parsed-property))) - (put-text-property - (point-min) (point-max) - 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn))))) + (when-let* ((parsed-posn (erc-find-parsed-property)) + (found (erc-get-parsed-vector parsed-posn))) + (put-text-property (point-min) (point-max) 'erc-parsed found) + (when-let ((tags (get-text-property parsed-posn 'tags))) + (put-text-property (point-min) (point-max) 'tags tags)))) (defun erc-get-parsed-vector (point) "Return the whole parsed vector on POINT." @@ -7301,6 +7337,13 @@ erc-get-parsed-vector-type (and vect (erc-response.command vect))) +(defun erc--get-eq-comparable-cmd (command) + "Return a symbol or a fixnum representing a message's COMMAND. +See also `erc-message-type'." + ;; IRC numerics are three-digit numbers, possibly with leading 0s. + ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o)) + (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n)) + ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index cf243ef43c7..77d553bc3a2 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -36,6 +36,7 @@ erc-fill-tests--wrap-populate (push 'erc-button-add-buttons erc-insert-modify-hook)) (erc-mode) (setq erc-server-process proc erc-networks--id id) + (set-process-query-on-exit-flag erc-server-process nil) (with-current-buffer (get-buffer-create "#chan") (erc-mode) @@ -63,13 +64,13 @@ erc-fill-tests--wrap-populate (erc-display-message nil nil (current-buffer) - (erc--format-privmsg "alice" msg nil t nil)) + (erc-format-privmessage "alice" msg nil t)) (setq msg "alice: Either your unparagoned mistress is dead,\ or she's outprized by a trifle.") (erc-display-message nil nil (current-buffer) - (erc--format-privmsg "bob" msg nil t nil)) + (erc-format-privmessage "bob" msg nil t)) (funcall test) (when noninteractive @@ -92,9 +93,15 @@ erc-fill-wrap--monospace '(space :width 27))) (should (equal (get-text-property (pos-eol) 'wrap-prefix) '(space :width 27))) + ;; The last elt in the `:width' value is a singleton (NUM) when + ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the + ;; prod rules table under (info "(elisp) Pixel Specification"). (should (pcase (get-text-property (point) 'line-prefix) - (`(space :width (- 27 (,w))) - (should (= w (string-pixel-width " ")))))) + ((and (guard (fboundp 'string-pixel-width)) + `(space :width (- 27 (,w)))) + (= w (string-pixel-width " "))) + (`(space :width (- 27 ,w)) + (= w (length " "))))) (erc-fill--wrap-nudge 2) @@ -106,12 +113,17 @@ erc-fill-wrap--monospace (should (equal (get-text-property (pos-eol) 'wrap-prefix) '(space :width 29))) (should (pcase (get-text-property (point) 'line-prefix) - (`(space :width (- 29 (,w))) - (should (= w (string-pixel-width " "))))))))) + ((and (guard (fboundp 'string-pixel-width)) + `(space :width (- 29 (,w)))) + (= w (string-pixel-width " "))) + (`(space :width (- 29 ,w)) + (= w (length " ")))))))) (ert-deftest erc-fill-wrap--variable-pitch () :tags '(:unstable) - (unless (and (not noninteractive) (display-graphic-p)) + (unless (and (fboundp 'string-pixel-width) + (not noninteractive) + (display-graphic-p)) (ert-skip "Test needs interactive graphical Emacs")) (with-selected-frame (make-frame '((name . "other"))) @@ -124,8 +136,6 @@ erc-fill-wrap--variable-pitch (lambda () - ;; Prefix props are applied properly and faces are accounted - ;; for when determining widths. (goto-char (point-min)) (should (search-forward " w (string-pixel-width " ")))))) + (> w (string-pixel-width " "))))) (erc-fill--wrap-nudge 2) @@ -149,7 +159,7 @@ erc-fill-wrap--variable-pitch '(space :width 29))) (should (pcase (get-text-property (point) 'line-prefix) (`(space :width (- 29 (,w))) - (should (> w (string-pixel-width " ")))))) + (> w (string-pixel-width " "))))) ;; FIXME figure out how to get rid of this "void variable ;; `erc--results-ewoc'" error, which seems related to operating diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el new file mode 100644 index 00000000000..7b91e28dc83 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el @@ -0,0 +1,211 @@ +;;; erc-scenarios-base-local-module-modes.el --- More local-mod 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: + +;; A local module doubles as a minor mode whose mode variable and +;; associated local data can withstand service disruptions. +;; Unfortunately, the current implementation is too unwieldy to be +;; made public because it doesn't perform any of the boiler plate +;; needed to save and restore buffer-local and "network-local" copies +;; of user options. Ultimately, a user-friendly framework must fill +;; this void if third-party local modules are ever to become +;; practical. +;; +;; The following tests all use `sasl' because, as of ERC 5.5, it's the +;; only local module. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-sasl) + +;; After quitting a session for which `sasl' is enabled, you +;; disconnect and toggle `erc-sasl-mode' off. You then reconnect +;; using an alternate nickname. You again disconnect and reconnect, +;; this time immediately, and the mode stays disabled. Finally, you +;; once again disconnect, toggle the mode back on, and reconnect. You +;; are authenticated successfully, just like in the initial session. +;; +;; This is meant to show that a user's local mode settings persist +;; between sessions. It also happens to show (in round four, below) +;; that a server renicking a user on 001 after a 903 is handled just +;; like a user-initiated renick, although this is not the main thrust. + +(ert-deftest erc-scenarios-base-local-module-modes--reconnect () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/local-modules") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (expect (erc-d-t-make-expecter)) + (server-buffer-name (format "127.0.0.1:%d" port))) + + (ert-info ("Round one, initial authentication succeeds as expected") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "This server is in debug mode") + (erc-cmd-JOIN "#chan") + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round two, nick rejected, alternate granted") + (with-current-buffer "foonet" + + (ert-info ("Toggle mode off, reconnect") + (erc-sasl-mode -1) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester`") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Some enigma, some riddle")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round three, send alternate nick initially") + (with-current-buffer "foonet" + + (ert-info ("Keep mode off, reconnect") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester`") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Let our reciprocal vows be remembered.")) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + + (ert-info ("Round four, authenticated successfully again") + (with-current-buffer "foonet" + + (ert-info ("Toggle mode on, reconnect") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-sasl-mode +1) + (erc-cmd-RECONNECT)) + + (funcall expect 10 "User modes for tester") + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + (should (equal (buffer-name) "foonet")) + (should-not (cdr (erc-scenarios-common-buflist "#chan"))) + + (with-current-buffer "#chan" + (funcall expect 10 "Well met; good morrow, Titus and Hortensius.")) + + (erc-cmd-QUIT ""))))) + +;; In contrast to the mode-persistence test above, this one +;; demonstrates that a user reinvoking an entry point declares their +;; intention to reset local-module state for the server buffer. +;; Whether a local-module's state variable is also reset in target +;; buffers up to the module. That is, by default, they're left alone. + +(ert-deftest erc-scenarios-base-local-module-modes--entrypoint () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/local-modules") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'first 'first)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (expect (erc-d-t-make-expecter)) + (server-buffer-name (format "127.0.0.1:%d" port))) + + (ert-info ("Round one, initial authentication succeeds as expected") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "This server is in debug mode") + (erc-cmd-JOIN "#chan") + + (ert-info ("Toggle local-module off in target buffer") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must") + (erc-sasl-mode -1))) + + (erc-cmd-QUIT "") + (funcall expect 10 "finished") + + (ert-info ("Toggle mode off") + (erc-sasl-mode -1) + (should (local-variable-p 'erc-sasl-mode))))) + + (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.") + ;; If you were to /RECONNECT here, no PASS changeme would be + ;; sent instead of CAP SASL, resulting in a failure. + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name)) + (funcall expect 10 "You are now logged in as tester") + + (erc-d-t-wait-for 10 (equal (buffer-name) "foonet")) + (funcall expect 10 "User modes for tester") + (should erc-sasl-mode)) ; obviously + + ;; No other foonet buffer exists, e.g., foonet<2> + (should-not (cdr (erc-scenarios-common-buflist "foonet"))) + + (ert-info ("Target buffer retains local-module state") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "She is Lavinia, therefore must") + (should-not erc-sasl-mode) + (should (local-variable-p 'erc-sasl-mode)) + (erc-cmd-QUIT "")))))) + +;;; erc-scenarios-base-local-module-modes.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el index 916d105779a..990c971b4cd 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -81,105 +81,6 @@ erc-scenarios-base-local-modules--reconnect-let (erc-cmd-QUIT "") (funcall expect 10 "finished"))))) -;; After quitting a session for which `sasl' is enabled, you -;; disconnect and toggle `erc-sasl-mode' off. You then reconnect -;; using an alternate nickname. You again disconnect and reconnect, -;; this time immediately, and the mode stays disabled. Finally, you -;; once again disconnect, toggle the mode back on, and reconnect. You -;; are authenticated successfully, just like in the initial session. -;; -;; This is meant to show that a user's local mode settings persist -;; between sessions. It also happens to show (in round four, below) -;; that a server renicking a user on 001 after a 903 is handled just -;; like a user-initiated renick, although this is not the main thrust. - -(ert-deftest erc-scenarios-base-local-modules--mode-persistence () - :tags '(:expensive-test) - (erc-scenarios-common-with-cleanup - ((erc-scenarios-common-dialog "base/local-modules") - (erc-server-flood-penalty 0.1) - (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth)) - (port (process-contact dumb-server :service)) - (erc-modules (cons 'sasl erc-modules)) - (expect (erc-d-t-make-expecter)) - (server-buffer-name (format "127.0.0.1:%d" port))) - - (ert-info ("Round one, initial authentication succeeds as expected") - (with-current-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :user "tester" - :password "changeme" - :full-name "tester") - (should (string= (buffer-name) server-buffer-name)) - (funcall expect 10 "You are now logged in as tester")) - - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) - (funcall expect 10 "This server is in debug mode") - (erc-cmd-JOIN "#chan") - - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) - (funcall expect 20 "She is Lavinia, therefore must")) - - (erc-cmd-QUIT "") - (funcall expect 10 "finished"))) - - (ert-info ("Round two, nick rejected, alternate granted") - (with-current-buffer "foonet" - - (ert-info ("Toggle mode off, reconnect") - (erc-sasl-mode -1) - (erc-cmd-RECONNECT)) - - (funcall expect 10 "User modes for tester`") - (should-not (cdr (erc-scenarios-common-buflist "foonet"))) - (should (equal (buffer-name) "foonet")) - (should-not (cdr (erc-scenarios-common-buflist "#chan"))) - - (with-current-buffer "#chan" - (funcall expect 10 "Some enigma, some riddle")) - - (erc-cmd-QUIT "") - (funcall expect 10 "finished"))) - - (ert-info ("Round three, send alternate nick initially") - (with-current-buffer "foonet" - - (ert-info ("Keep mode off, reconnect") - (should-not erc-sasl-mode) - (should (local-variable-p 'erc-sasl-mode)) - (erc-cmd-RECONNECT)) - - (funcall expect 10 "User modes for tester`") - (should-not (cdr (erc-scenarios-common-buflist "foonet"))) - (should (equal (buffer-name) "foonet")) - (should-not (cdr (erc-scenarios-common-buflist "#chan"))) - - (with-current-buffer "#chan" - (funcall expect 10 "Let our reciprocal vows be remembered.")) - - (erc-cmd-QUIT "") - (funcall expect 10 "finished"))) - - (ert-info ("Round four, authenticated successfully again") - (with-current-buffer "foonet" - - (ert-info ("Toggle mode on, reconnect") - (should-not erc-sasl-mode) - (should (local-variable-p 'erc-sasl-mode)) - (erc-sasl-mode +1) - (erc-cmd-RECONNECT)) - - (funcall expect 10 "User modes for tester") - (should-not (cdr (erc-scenarios-common-buflist "foonet"))) - (should (equal (buffer-name) "foonet")) - (should-not (cdr (erc-scenarios-common-buflist "#chan"))) - - (with-current-buffer "#chan" - (funcall expect 10 "Well met; good morrow, Titus and Hortensius.")) - - (erc-cmd-QUIT ""))))) - ;; For local modules, the twin toggle commands `erc-FOO-enable' and ;; `erc-FOO-disable' affect all buffers of a connection, whereas ;; `erc-FOO-mode' continues to operate only on the current buffer. diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 4994feefd4e..69523274812 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -20,7 +20,7 @@ ;;; Commentary: ;;; Code: -(require 'ert) +(require 'ert-x) (require 'erc-stamp) (require 'erc-goodies) ; for `erc-make-read-only' @@ -68,7 +68,7 @@ erc-timestamp-use-align-to--nil (erc-display-message nil 'notice (current-buffer) "begin")) (goto-char (point-min)) (should (search-forward-regexp - (rx "begin" (+ "\t") (* " ") " [") nil t)) + (rx "begin" (+ "\t") (* " ") "[") nil t)) ;; Field includes intervening spaces (should (eql ?n (char-before (field-beginning (point))))) ;; Timestamp extends to the end of the line @@ -85,9 +85,9 @@ erc-timestamp-use-align-to--nil (erc-timestamp-right-column 20)) (erc-display-message nil 'notice (current-buffer) "twenty characters")) - (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) ;; Field excludes leading whitespace (arguably undesirable). - (should (eql ?\[ (char-after (1+ (field-beginning (point)))))) + (should (eql ?\[ (char-after (field-beginning (point))))) ;; Timestamp extends to the end of the line. (should (eql ?\n (char-after (field-end (point))))))))) @@ -101,7 +101,7 @@ erc-timestamp-use-align-to--t (erc-display-message nil nil (current-buffer) msg))) (goto-char (point-min)) ;; Exactly two spaces, one from format, one added by erc-stamp. - (should (search-forward "msg one [" nil t)) + (should (search-forward "msg one [" nil t)) ;; Field covers space between. (should (eql ?e (char-before (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point)))))) @@ -112,9 +112,9 @@ erc-timestamp-use-align-to--t (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) (erc-display-message nil nil (current-buffer) msg))) ;; Indented to pos (this is arguably a bug). - (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) ;; Field starts *after* leading space (arguably bad). - (should (eql ?\[ (char-after (1+ (field-beginning (point)))))) + (should (eql ?\[ (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) (ert-deftest erc-timestamp-use-align-to--integer () @@ -146,7 +146,7 @@ erc-timestamp-use-align-to--integer (ert-deftest erc-timestamp-use-align-to--margin () (erc-stamp-tests--insert-right (lambda () - (erc-timestamp--display-margin-mode +1) + (erc-stamp--display-margin-mode +1) (ert-info ("margin, normal") (let ((erc-timestamp-use-align-to 'margin)) @@ -155,7 +155,7 @@ erc-timestamp-use-align-to--margin (erc-display-message nil nil (current-buffer) msg))) (goto-char (point-min)) ;; Space not added (treated as opaque string). - (should (search-forward "msg one [" nil t)) + (should (search-forward "msg one[" nil t)) ;; Field covers stamp alone (should (eql ?e (char-before (field-beginning (point))))) ;; Vanity props extended @@ -170,9 +170,92 @@ erc-timestamp-use-align-to--margin (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) (erc-display-message nil nil (current-buffer) msg))) ;; No hard wrap - (should (search-forward "oooo [" nil t)) + (should (search-forward "oooo[" nil t)) ;; Field starts at leading space. - (should (eql ?\s (char-after (field-beginning (point))))) + (should (eql ?\[ (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) +;; This concerns the partial reversal of changes resulting from: +;; +;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706) +;; +;; Perhaps core behavior has changed since this bug was reported, but +;; C-e stopping one char short of EOL no longer seems a problem. +;; However, invoking C-n (`next-line') exhibits a similar effect. +;; When point is in a stamp or near the beginning of a line, issuing a +;; C-n puts point one past the start of the message (i.e., two chars +;; beyond the timestamp's closing "]". Dropping the invisible +;; property when timestamps are hidden does indeed prevent this, but +;; it's also irreversible, which at least one user has complained +;; about. Turning off `cursor-intangible-mode' does do the trick, but +;; a better solution seems to be decrementing the end of the +;; `cursor-intangible' interval so that, in addition to C-n working, a +;; C-f from before the timestamp doesn't overshoot. This works +;; whether `erc-hide-timestamps' is enabled or not. +;; +;; Note some striking omissions here: +;; +;; 1. a lack of `fill' module integration (we simulate it by +;; making lines short enough to not wrap) +;; 2. functions like `line-move' behave differently when +;; `noninteractive' +;; 3. no actual test assertions involving `cursor-sensor' movement +;; even though that's a huge ingredient + +(ert-deftest erc-timestamp-intangible--left () + (let ((erc-timestamp-only-if-changed-flag nil) + (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) + (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") + (erc-mode) + (erc--initialize-markers (point) nil) + (erc-munge-invisibility-spec) + (erc-display-message nil 'notice (current-buffer) "Welcome") + ;; + ;; Pretend `fill' is active and that these lines are + ;; folded. Otherwise, there's an annoying issue on wrapped lines + ;; (when visual-line-mode is off and stamps are visible) where + ;; C-e sends you to the end of the previous line. + (setq msg "Lorem ipsum dolor sit amet") + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage "alyssa" msg nil t)) + (erc-display-message nil 'notice (current-buffer) "Home") + (goto-char (point-min)) + + ;; EOL is actually EOL (Bug#11706) + + (ert-info ("Notice before stamp, C-e") ; first line/stamp + (should (search-forward "Welcome" nil t)) + (ert-simulate-command '(erc-bol)) + (should (looking-at (rx "["))) + (let ((end (pos-eol))) ; `line-end-position' fails because fields + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (ert-info ("Privmsg before stamp, C-e") + (should (search-forward "Lorem" nil t)) + (goto-char (pos-bol)) + (should (looking-at (rx "["))) + (let ((end (pos-eol))) + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (ert-info ("Privmsg first line, C-e") + (goto-char (pos-bol)) + (should (search-forward "ipsum" nil t)) + (let ((end (pos-eol))) + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (when noninteractive + (kill-buffer))))) + ;;; erc-stamp-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 40a2d2de657..c5a40d9bc72 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -117,11 +117,7 @@ erc-tests--send-prep ;; Caller should probably shadow `erc-insert-modify-hook' or ;; populate user tables for erc-button. (erc-mode) - (insert "\n\n") - (setq erc-input-marker (make-marker) - erc-insert-marker (make-marker)) - (set-marker erc-insert-marker (point-max)) - (erc-display-prompt) + (erc--initialize-markers (point) nil) (should (= (point) erc-input-marker))) (defun erc-tests--set-fake-server-process (&rest args) @@ -257,6 +253,79 @@ erc-hide-prompt (kill-buffer "bob") (kill-buffer "ServNet")))) +(ert-deftest erc--initialize-markers () + (let ((proc (start-process "true" (current-buffer) "true")) + erc-modules + erc-connect-pre-hook + erc-insert-modify-hook + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (set-process-query-on-exit-flag proc nil) + (erc-mode) + (setq erc-server-process proc + erc-networks--id (erc-networks--id-create 'foonet)) + (erc-open "localhost" 6667 "tester" "Tester" nil + "fake" nil "#chan" proc nil "user" nil) + (with-current-buffer (should (get-buffer "#chan")) + (should (= ?\n (char-after 1))) + (should (= ?E (char-after erc-insert-marker))) + (should (= 3 (marker-position erc-insert-marker))) + (should (= 8 (marker-position erc-input-marker))) + (should (= 8 (point-max))) + (should (= 8 (point))) + ;; These prompt properties are a continual source of confusion. + ;; Including the literal defaults here can hopefully serve as a + ;; quick reference for anyone operating in that area. + (should (equal (buffer-string) + #("\n\nERC> " + 2 6 ( font-lock-face erc-prompt-face + rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t) + 6 7 ( rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t)))) + + ;; Simulate some activity by inserting some text before and + ;; after the prompt (multiline). + (erc-display-error-notice nil "Welcome") + (goto-char (point-max)) + (insert "Hello\nWorld") + (goto-char 3) + (should (looking-at-p (regexp-quote "*** Welcome")))) + + (ert-info ("Reconnect") + (erc-open "localhost" 6667 "tester" "Tester" nil + "fake" nil "#chan" proc nil "user" nil) + (should-not (get-buffer "#chan<2>"))) + + (ert-info ("Existing prompt respected") + (with-current-buffer (should (get-buffer "#chan")) + (should (= ?\n (char-after 1))) + (should (= ?E (char-after erc-insert-marker))) + (should (= 15 (marker-position erc-insert-marker))) + (should (= 20 (marker-position erc-input-marker))) + (should (= 3 (point))) ; point restored + (should (equal (buffer-string) + #("\n\n*** Welcome\nERC> Hello\nWorld" + 2 13 (font-lock-face erc-error-face) + 14 18 ( font-lock-face erc-prompt-face + rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t) + 18 19 ( rear-nonsticky t + erc-prompt t + field erc-prompt + front-sticky t + read-only t)))) + (when noninteractive + (kill-buffer)))))) + (ert-deftest erc--switch-to-buffer () (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el -- 2.39.1