Some minor quality-of-life niceties have finally made their way to
ERC. For example, the function 'erc-echo-timestamp' is now
interactive and can be invoked on any message to view its timestamp in
-the echo area. Also, the 'irccontrols' module now supports additional
-colors and special handling for "spoilers" (hidden text). And issuing
-an "/MOTD" now dispatches a purpose-built command handler.
+the echo area. The command 'erc-button-previous' now moves to the
+beginning instead of the end of buttons. And the 'irccontrols' module
+now supports additional colors and special handling for "spoilers"
+(hidden text).
** Changes in the library API.
changes are encouraged to voice their concerns on the bug list.
*** Miscellaneous changes
-For autoloading purposes, 'Info-goto-node' has been supplanted by
-plain old 'info' in 'erc-button-alist', and two helper macros from GNU
-ELPA's Compat library are now available to third-party modules as
-'erc-compat-call' and 'erc-compat-function'.
+Two helper macros from GNU ELPA's Compat library are now available to
+third-party modules as 'erc-compat-call' and 'erc-compat-function'.
+In the area of buttons, 'Info-goto-node' has been supplanted by plain
+old 'info' in 'erc-button-alist', primarily for autoloading purposes.
+And the "TAB" key is now bound to a new command, 'erc-tab', that only
+calls 'completion-at-point' when point is in the input area and
+module-specific commands, like 'erc-button-next', otherwise.
\f
* Changes in ERC 5.5
((erc-button--check-nicknames-entry)
(add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
- (add-hook 'erc-complete-functions #'erc-button-next-function)
+ (add-hook 'erc--tab-functions #'erc-button-next)
(erc--modify-local-map t "<backtab>" #'erc-button-previous))
((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons)
(remove-hook 'erc-send-modify-hook #'erc-button-add-buttons)
- (remove-hook 'erc-complete-functions #'erc-button-next-function)
+ (remove-hook 'erc--tab-functions #'erc-button-next)
(erc--modify-local-map nil "<backtab>" #'erc-button-previous)))
;;; Variables
(defun erc-button-next-function ()
"Pseudo completion function that actually jumps to the next button.
For use on `completion-at-point-functions'."
+ (declare (obsolete erc-nickserv-identify "30.1"))
;; FIXME: This is an abuse of completion-at-point-functions.
(when (< (point) (erc-beg-of-input-line))
(let ((start (point)))
(error "No next button"))
t)))))
-(defun erc-button-next ()
- "Go to the next button in this buffer."
- (interactive)
- (let ((f (erc-button-next-function)))
- (if f (funcall f))))
-
-(defun erc-button-previous ()
- "Go to the previous button in this buffer."
- (interactive)
- (let ((here (point)))
- (when (< here (erc-beg-of-input-line))
- (while (and (get-text-property here 'erc-callback)
- (not (= here (point-min))))
- (setq here (1- here)))
- (while (and (not (get-text-property here 'erc-callback))
- (not (= here (point-min))))
- (setq here (1- here)))
- (if (> here (point-min))
- (goto-char here)
- (error "No previous button"))
- t)))
+(defvar erc-button--prev-next-predicate-functions
+ '(erc-button--end-of-button-p)
+ "Abnormal hook whose members can return non-nil to continue searching.
+Otherwise, if all members return nil, point will stay at the
+current button. Called with a single arg, a buffer position
+greater than `point-min' with a text property of `erc-callback'.")
+
+(defun erc-button--end-of-button-p (point)
+ (get-text-property (1- point) 'erc-callback))
+
+(defun erc--button-next (arg)
+ (let* ((nextp (prog1 (>= arg 1) (setq arg (max 1 (abs arg)))))
+ (search-fn (if nextp
+ #'next-single-char-property-change
+ #'previous-single-char-property-change))
+ (start (point))
+ (p start))
+ (while (progn
+ ;; Break out of current search context.
+ (when-let ((low (max (point-min) (1- (pos-bol))))
+ (high (min (point-max) (1+ (pos-eol))))
+ (prop (get-text-property p 'erc-callback))
+ (q (if nextp
+ (text-property-not-all p high
+ 'erc-callback prop)
+ (funcall search-fn p 'erc-callback nil low)))
+ ((< low q high)))
+ (setq p q))
+ ;; Assume that buttons occur frequently enough that
+ ;; omitting LIMIT is acceptable.
+ (while
+ (and (setq p (funcall search-fn p 'erc-callback))
+ (if nextp (< p erc-insert-marker) (/= p (point-min)))
+ (run-hook-with-args-until-success
+ 'erc-button--prev-next-predicate-functions p)))
+ (and arg
+ (< (point-min) p erc-insert-marker)
+ (goto-char p)
+ (not (zerop (cl-decf arg))))))
+ (when (= (point) start)
+ (user-error (if nextp "No next button" "No previous button")))
+ t))
+
+(defun erc-button-next (&optional arg)
+ "Go to the ARGth next button."
+ (declare (advertised-calling-convention (arg) "30.1"))
+ (interactive "p")
+ (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg)))
+ (erc--button-next arg))
+
+(defun erc-button-previous (&optional arg)
+ "Go to ARGth previous button."
+ (declare (advertised-calling-convention (arg) "30.1"))
+ (interactive "p")
+ (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg)))
+ (erc--button-next (- arg)))
+
+(defun erc-button-previous-of-nick (arg)
+ "Go to ARGth previous button for nick at point."
+ (interactive "p")
+ (if-let* ((prop (get-text-property (point) 'erc-data))
+ (erc-button--prev-next-predicate-functions
+ (cons (lambda (p)
+ (not (equal (get-text-property p 'erc-data) prop)))
+ erc-button--prev-next-predicate-functions)))
+ (erc--button-next (- arg))
+ (user-error "No nick at point")))
(defun erc-browse-emacswiki (thing)
"Browse to THING in the emacs-wiki."
(setq msg (concat msg (and msg " ")
(erc-fill--make-module-dependency-msg "button"))))
(erc-with-server-buffer
- (erc-button-mode +1))))
+ (erc-button-mode +1)))
+ (add-hook 'erc-button--prev-next-predicate-functions
+ #'erc-fill--wrap-merged-button-p nil t))
;; Set local value of user option (can we avoid this somehow?)
(unless (eq erc-fill-function #'erc-fill-wrap)
(setq-local erc-fill-function #'erc-fill-wrap))
(kill-local-variable 'erc-fill--wrap-value)
(kill-local-variable 'erc-fill-function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
+ (remove-hook 'erc-button--prev-next-predicate-functions
+ #'erc-fill--wrap-merged-button-p t)
(remove-function (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(visual-line-mode -1))
`((space :width (- erc-fill--wrap-value ,len))
(space :width erc-fill--wrap-value))))))
+;; FIXME use own text property to avoid false positives.
+(defun erc-fill--wrap-merged-button-p (point)
+ (equal "" (get-text-property point 'display)))
+
;; This is an experimental helper for third-party modules. You could,
;; for example, use this to automatically resize the prefix to a
;; fraction of the window's width on some event change. Another use
:type 'hook)
(defcustom erc-complete-functions nil
- "These functions get called when the user hits TAB in ERC.
+ "These functions get called when the user hits \\`TAB' in ERC.
Each function in turn is called until one returns non-nil to
indicate it has handled the input."
:group 'erc-hooks
(define-key map "\C-c\C-u" #'erc-kill-input)
(define-key map "\C-c\C-x" #'erc-quit-server)
(define-key map "\M-\t" #'ispell-complete-word)
- (define-key map "\t" #'completion-at-point)
+ (define-key map "\t" #'erc-tab)
;; Suppress `font-lock-fontify-block' key binding since it
;; destroys face properties.
(setq erc-input-ring-index nil))
(kill-line)))
+(defvar erc--tab-functions nil
+ "Functions to try when user hits \\`TAB' outside of input area.
+Called with a numeric prefix arg.")
+
+(defun erc-tab (&optional arg)
+ "Call `completion-at-point' when typing in the input area.
+Otherwise call members of `erc--tab-functions' with raw prefix
+ARG until one of them returns non-nil."
+ (interactive "P")
+ (if (>= (point) erc-input-marker)
+ (completion-at-point)
+ (run-hook-with-args-until-success 'erc--tab-functions arg)))
+
(defun erc-complete-word-at-point ()
(run-hook-with-args-until-success 'erc-complete-functions))
--- /dev/null
+;;; erc-button-tests.el --- Tests for erc-button -*- 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'erc-button)
+
+(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
+ (declare (indent 1))
+ (let ((msg (erc-format-privmessage speaker
+ (apply #'concat msg-parts) nil t)))
+ (erc-display-message nil nil (current-buffer) msg)))
+
+(defun erc-button-tests--populate (test)
+ (let ((inhibit-message noninteractive)
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+ (with-current-buffer
+ (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-open "localhost" 6667 "tester" "Tester" 'connect
+ nil nil nil nil nil "tester" 'foonet))
+
+ (with-current-buffer (erc--open-target "#chan")
+ (erc-update-channel-member
+ "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-update-channel-member
+ "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+ (erc-display-message
+ nil 'notice (current-buffer)
+ (concat "This server is in debug mode and is logging all user I/O. "
+ "Blah alice (1) bob (2) blah."))
+
+ (funcall test))
+
+ (when noninteractive
+ (kill-buffer "#chan")
+ (kill-buffer)))))
+
+(ert-deftest erc-button-next ()
+ (erc-button-tests--populate
+ (lambda ()
+ (erc-button-tests--insert-privmsg "alice"
+ "(3) bob (4) come, you are a tedious fool: to the purpose.")
+
+ (erc-button-tests--insert-privmsg "bob"
+ "(5) alice (6) Come me to what was done to her.")
+
+ (should (= erc-input-marker (point)))
+
+ ;; Break out of input area
+ (erc-button-previous 1)
+ (should (looking-at (rx "alice (6)")))
+
+ ;; No next button
+ (should-error (erc-button-next 1) :type 'user-error)
+ (should (looking-at (rx "alice (6)")))
+
+ ;; Next with negative arg is equivalent to previous
+ (erc-button-next -1)
+ (should (looking-at (rx "bob> (5)")))
+
+ ;; One past end of button
+ (forward-char 3)
+ (should (looking-at (rx "> (5)")))
+ (should-not (get-text-property (point) 'erc-callback))
+ (erc-button-previous 1)
+ (should (looking-at (rx "bob> (5)")))
+
+ ;; At end of button
+ (forward-char 2)
+ (should (looking-at (rx "b> (5)")))
+ (erc-button-previous 1)
+ (should (looking-at (rx "bob (4)")))
+
+ ;; Skip multiple buttons back
+ (erc-button-previous 2)
+ (should (looking-at (rx "bob (2)")))
+
+ ;; Skip multiple buttons forward
+ (erc-button-next 2)
+ (should (looking-at (rx "bob (4)")))
+
+ ;; No error as long as some progress made
+ (erc-button-previous 100)
+ (should (looking-at (rx "alice (1)")))
+
+ ;; Error when no progress made
+ (should-error (erc-button-previous 1) :type 'user-error)
+ (should (looking-at (rx "alice (1)"))))))
+
+;; See also `erc-scenarios-networks-announced-missing' in
+;; erc-scenarios-misc.el for a more realistic example.
+(ert-deftest erc-button--display-error-notice-with-keys ()
+ (with-current-buffer (get-buffer-create "*fake*")
+ (let ((mode erc-button-mode)
+ (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-button-mode +1)
+ (should (equal (erc-button--display-error-notice-with-keys
+ "If \\[erc-bol] fails, "
+ "see \\[erc-bug] or `erc-mode-map'.")
+ "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
+ (goto-char (point-min))
+
+ (ert-info ("Keymap substitution succeeds")
+ (erc-button-next 1)
+ (should (looking-at "C-a"))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (erc-button-press-button)
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bol" nil t)))
+ (erc-button-next 1)
+ ;; End of interval correct
+ (erc-button-previous 1)
+ (should (looking-at "C-a fails")))
+
+ (ert-info ("Extended command mapping succeeds")
+ (erc-button-next 1)
+ (should (looking-at "M-x erc-bug"))
+ (erc-button-press-button)
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (with-current-buffer "*Help*"
+ (goto-char (point-min))
+ (should (search-forward "erc-bug" nil t))))
+
+ (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
+ (erc-button-next 1)
+ (should (equal (get-text-property (point) 'font-lock-face)
+ '(erc-button erc-error-face)))
+ (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+ (should (eq erc-button-face 'erc-button))) ; extent evaporates
+
+ (ert-info ("Format when trailing args include non-strings")
+ (should (equal (erc-button--display-error-notice-with-keys
+ "abc" " %d def" " 45%s" 123 '\6)
+ "*** abc 123 def 456")))
+
+ (when noninteractive
+ (unless mode
+ (erc-button-mode -1))
+ (kill-buffer "*Help*")
+ (kill-buffer)))))
+
+;;; erc-button-tests.el ends here
;; Defend against non-local exits from `ert-skip'
(unwind-protect
(funcall test)
+ (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)))
(put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname))))))
-
-;; XXX move erc-button tests to new file if more added.
-(require 'erc-button)
-
-;; See also `erc-scenarios-networks-announced-missing' in
-;; erc-scenarios-misc.el for a more realistic example.
-(ert-deftest erc-button--display-error-notice-with-keys ()
- (with-current-buffer (get-buffer-create "*fake*")
- (let ((mode erc-button-mode)
- (inhibit-message noninteractive)
- erc-modules
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
- (erc-mode)
- (erc-tests--set-fake-server-process "sleep" "1")
- (erc--initialize-markers (point) nil)
- (erc-button-mode +1)
- (should (equal (erc-button--display-error-notice-with-keys
- "If \\[erc-bol] fails, "
- "see \\[erc-bug] or `erc-mode-map'.")
- "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
- (goto-char (point-min))
-
- (ert-info ("Keymap substitution succeeds")
- (erc-button-next)
- (should (looking-at "C-a"))
- (should (eq (get-text-property (point) 'mouse-face) 'highlight))
- (erc-button-press-button)
- (with-current-buffer "*Help*"
- (goto-char (point-min))
- (should (search-forward "erc-bol" nil t)))
- (erc-button-next)
- (erc-button-previous) ; end of interval correct
- (should (looking-at "a fails")))
-
- (ert-info ("Extended command mapping succeeds")
- (erc-button-next)
- (should (looking-at "M-x erc-bug"))
- (erc-button-press-button)
- (should (eq (get-text-property (point) 'mouse-face) 'highlight))
- (with-current-buffer "*Help*"
- (goto-char (point-min))
- (should (search-forward "erc-bug" nil t))))
-
- (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
- (erc-button-next)
- (should (equal (get-text-property (point) 'font-lock-face)
- '(erc-button erc-error-face)))
- (should (eq (get-text-property (point) 'mouse-face) 'highlight))
- (should (eq erc-button-face 'erc-button))) ; extent evaporates
-
- (ert-info ("Format when trailing args include non-strings")
- (should (equal (erc-button--display-error-notice-with-keys
- "abc" " %d def" " 45%s" 123 '\6)
- "*** abc 123 def 456")))
-
- (when noninteractive
- (unless mode
- (erc-button-mode -1))
- (kill-buffer "*Help*")
- (kill-buffer)))))
-
;;; erc-tests.el ends here
projects / emacs.git / commitdiff