From 35f6fc539ba753b1742cbe8580c15cc9ade62541 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 7 Feb 2023 06:58:15 -0800 Subject: [PATCH 0/6] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (6): [5.6] Copy over upstream Compat macros to erc-compat [5.6] Leverage loaddefs for migrating ERC modules [5.6] Don't require erc-goodies in erc.el [5.6] Modify erc-mode-map in module definitions [5.6] Add missing colors to erc-irccontrols-mode [5.6] Convert ERC's Imenu integration into proper module lisp/erc/erc-backend.el | 2 +- lisp/erc/erc-button.el | 6 +- lisp/erc/erc-common.el | 39 +---- lisp/erc/erc-compat.el | 52 ++++-- lisp/erc/erc-goodies.el | 97 ++++++----- lisp/erc/erc-ibuffer.el | 1 + lisp/erc/erc-imenu.el | 20 +++ lisp/erc/erc-log.el | 8 +- lisp/erc/erc-match.el | 8 +- lisp/erc/erc-page.el | 4 + lisp/erc/erc-pcomplete.el | 2 + lisp/erc/erc-services.el | 1 + lisp/erc/erc-sound.el | 1 + lisp/erc/erc-speedbar.el | 1 + lisp/erc/erc-stamp.el | 4 + lisp/erc/erc.el | 60 ++++--- test/lisp/erc/erc-goodies-tests.el | 251 +++++++++++++++++++++++++++++ test/lisp/erc/erc-tests.el | 155 ++++++++++++++++-- 18 files changed, 587 insertions(+), 125 deletions(-) create mode 100644 test/lisp/erc/erc-goodies-tests.el Interdiff: diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 1be47c3e665..a5fa50d01df 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -55,11 +55,11 @@ button ((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-mode-hook #'erc-button-setup)) + (erc--modify-local-map t "" #'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-mode-hook #'erc-button-setup))) + (erc--modify-local-map nil "" #'erc-button-previous))) ;;; Variables @@ -233,6 +233,8 @@ erc-button-keys-added "Internal variable used to keep track of whether we've added the global-level ERC button keys yet.") +;; Maybe deprecate this function and `erc-button-keys-added' if they +;; continue to go unused for a another version (currently 5.6). (defun erc-button-setup () "Add ERC mode-level button movement keys. This is only done once." ;; Add keys. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e567a108191..3332d240f6e 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -88,48 +88,13 @@ erc--target (contents "" :type string) (tags '() :type list)) -;; TODO move goodies modules here after 29 is released. -(defconst erc--features-to-modules - '((erc-pcomplete completion pcomplete) - (erc-capab capab-identify) - (erc-join autojoin) - (erc-page page ctcp-page) - (erc-sound sound ctcp-sound) - (erc-stamp stamp timestamp) - (erc-services services nickserv) - (erc-goodies scrolltobottom) - (erc-goodies readonly) - (erc-goodies move-to-prompt) - (erc-goodies keep-place) - (erc-goodies noncommands) - (erc-goodies irccontrols) - (erc-goodies smiley) - (erc-goodies unmorse)) - "Migration alist mapping a library feature to module names. -Keys need not be unique: a library may define more than one -module. Sometimes a module's downcased alias will be its -canonical name.") - -(defconst erc--modules-to-features - (let (pairs) - (pcase-dolist (`(,feature . ,names) erc--features-to-modules) - (dolist (name names) - (push (cons name feature) pairs))) - (nreverse pairs)) - "Migration alist mapping a module's name to its home library feature.") - -(defconst erc--module-name-migrations - (let (pairs) - (pcase-dolist (`(,_ ,canonical . ,rest) erc--features-to-modules) - (dolist (obsolete rest) - (push (cons obsolete canonical) pairs))) - pairs) - "Association list of obsolete module names to canonical names.") - +;; After deprecating 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) - "Return preferred SYMBOL for `erc-modules'." - (setq symbol (intern (downcase (symbol-name symbol)))) - (or (cdr (assq symbol erc--module-name-migrations)) symbol)) + "Return preferred SYMBOL for `erc--modules'." + (while-let ((canonical (get symbol 'erc--module)) + ((not (eq canonical symbol)))) + (setq symbol canonical)) + symbol) (defun erc--assemble-toggle (localp name ablsym mode val body) (let ((arg (make-symbol "arg"))) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 01e51df0481..3d018bb11e0 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -30,21 +30,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(require 'erc-common) - -(defvar erc-controls-highlight-regexp) -(defvar erc-controls-remove-regexp) -(defvar erc-input-marker) -(defvar erc-insert-marker) -(defvar erc-log-p) -(defvar erc-mode-map) -(defvar erc-modules) -(defvar erc-server-process) - -(declare-function erc-buffer-list "erc" (&optional predicate proc)) -(declare-function erc-error "erc" (&rest args)) -(declare-function erc-extract-command-from-line "erc" (line)) -(declare-function erc-beg-of-input-line "erc" nil) +(require 'erc) ;;; Automatically scroll to bottom @@ -58,6 +44,7 @@ erc-input-line-position :group 'erc-display :type '(choice integer (const nil))) +;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) (define-erc-module scrolltobottom nil "This mode causes the prompt to stay at the end of the window." ((add-hook 'erc-mode-hook #'erc-add-scroll-to-bottom) @@ -109,6 +96,7 @@ erc-scroll-to-bottom (recenter (or erc-input-line-position -1))))))) ;;; Make read only +;;;###autoload(autoload 'erc-readonly-mode "erc-goodies" nil t) (define-erc-module readonly nil "This mode causes all inserted text to be read-only." ((add-hook 'erc-insert-post-hook #'erc-make-read-only) @@ -124,6 +112,7 @@ erc-make-read-only (put-text-property (point-min) (point-max) 'rear-nonsticky t)) ;;; Move to prompt when typing text +;;;###autoload(autoload 'erc-move-to-prompt-mode "erc-goodies" nil t) (define-erc-module move-to-prompt nil "This mode causes the point to be moved to the prompt when typing text." ((add-hook 'erc-mode-hook #'erc-move-to-prompt-setup) @@ -148,6 +137,7 @@ erc-move-to-prompt-setup (add-hook 'pre-command-hook #'erc-move-to-prompt nil t)) ;;; Keep place in unvisited channels +;;;###autoload(autoload 'erc-keep-place-mode "erc-goodies" nil t) (define-erc-module keep-place nil "Leave point above un-viewed text in other channels." ((add-hook 'erc-insert-pre-hook #'erc-keep-place)) @@ -186,6 +176,7 @@ erc-noncommands-list If a command's function symbol is in this list, the typed command does not appear in the ERC buffer after the user presses ENTER.") +;;;###autoload(autoload 'erc-noncommands-mode "erc-goodies" nil t) (define-erc-module noncommands nil "This mode distinguishes non-commands. Commands listed in `erc-insert-this' know how to display @@ -346,19 +337,38 @@ bg:erc-color-face15 "ERC face." :group 'erc-faces) +;; https://lists.gnu.org/archive/html/emacs-erc/2021-07/msg00005.html +(defvar erc--controls-additional-colors + ["#470000" "#472100" "#474700" "#324700" "#004700" "#00472c" + "#004747" "#002747" "#000047" "#2e0047" "#470047" "#47002a" + "#740000" "#743a00" "#747400" "#517400" "#007400" "#007449" + "#007474" "#004074" "#000074" "#4b0074" "#740074" "#740045" + "#b50000" "#b56300" "#b5b500" "#7db500" "#00b500" "#00b571" + "#00b5b5" "#0063b5" "#0000b5" "#7500b5" "#b500b5" "#b5006b" + "#ff0000" "#ff8c00" "#ffff00" "#b2ff00" "#00ff00" "#00ffa0" + "#00ffff" "#008cff" "#0000ff" "#a500ff" "#ff00ff" "#ff0098" + "#ff5959" "#ffb459" "#ffff71" "#cfff60" "#6fff6f" "#65ffc9" + "#6dffff" "#59b4ff" "#5959ff" "#c459ff" "#ff66ff" "#ff59bc" + "#ff9c9c" "#ffd39c" "#ffff9c" "#e2ff9c" "#9cff9c" "#9cffdb" + "#9cffff" "#9cd3ff" "#9c9cff" "#dc9cff" "#ff9cff" "#ff94d3" + "#000000" "#131313" "#282828" "#363636" "#4d4d4d" "#656565" + "#818181" "#9f9f9f" "#bcbcbc" "#e2e2e2" "#ffffff"]) + (defun erc-get-bg-color-face (n) "Fetches the right face for background color N (0-15)." (if (stringp n) (setq n (string-to-number n))) (if (not (numberp n)) (prog1 'default (erc-error "erc-get-bg-color-face: n is NaN: %S" n)) - (when (> n 16) + (when (> n 99) (erc-log (format " Wrong color: %s" n)) (setq n (mod n 16))) (cond ((and (>= n 0) (< n 16)) (intern (concat "bg:erc-color-face" (number-to-string n)))) - (t (erc-log (format " Wrong color: %s" n)) 'default)))) + ((< 15 n 99) + (list :background (aref erc--controls-additional-colors (- n 16)))) + (t (erc-log (format " Wrong color: %s" n)) '(default))))) (defun erc-get-fg-color-face (n) "Fetches the right face for foreground color N (0-15)." @@ -366,34 +376,44 @@ erc-get-fg-color-face (if (not (numberp n)) (prog1 'default (erc-error "erc-get-fg-color-face: n is NaN: %S" n)) - (when (> n 16) + (when (> n 99) (erc-log (format " Wrong color: %s" n)) (setq n (mod n 16))) (cond ((and (>= n 0) (< n 16)) (intern (concat "fg:erc-color-face" (number-to-string n)))) - (t (erc-log (format " Wrong color: %s" n)) 'default)))) + ((< 15 n 99) + (list :foreground (aref erc--controls-additional-colors (- n 16)))) + (t (erc-log (format " Wrong color: %s" n)) '(default))))) +;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t) (define-erc-module irccontrols nil "This mode enables the interpretation of IRC control chars." ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight) (add-hook 'erc-send-modify-hook #'erc-controls-highlight) - (add-hook 'erc-mode-hook #'erc--irccontrols-on-major-mode)) + (erc--modify-local-map t "C-c C-c" #'erc-toggle-interpret-controls)) ((remove-hook 'erc-insert-modify-hook #'erc-controls-highlight) (remove-hook 'erc-send-modify-hook #'erc-controls-highlight) - (remove-hook 'erc-mode-hook #'erc--irccontrols-on-major-mode) - (erc-with-all-buffers-of-server nil nil - (erc--irccontrols-on-major-mode)))) - -(defun erc--irccontrols-on-major-mode () - ;; FIXME all these keymap-* functions require Compat 29 - (if erc-irccontrols-mode - ;; Interrogate composed view of local map and `erc-mode-map' - (unless (keymap-lookup (current-local-map) "C-c C-c") - (keymap-local-set "C-c C-c" #'erc-toggle-interpret-controls)) - (when (eq (keymap-local-lookup "C-c C-c") - #'erc-toggle-interpret-controls) - (keymap-local-unset "C-c C-c" t)))) + (erc--modify-local-map nil "C-c C-c" #'erc-toggle-interpret-controls))) + +;; These patterns were moved here to circumvent compiler warnings but +;; otherwise translated verbatim from their original string-literal +;; definitions (minus a small bug fix to satisfy newly added tests). +(defvar erc-controls-remove-regexp + (rx (or ?\C-b ?\C-\] ?\C-_ ?\C-v ?\C-g ?\C-o + (: ?\C-c (? (any "0-9")) (? (any "0-9")) + (? (group ?, (any "0-9") (? (any "0-9"))))))) + "Regular expression matching control characters to remove.") + +;; Before the change to `rx', group 3 used to be a sibling of group 2. +;; This was assumed to be a bug. A few minor simplifications were +;; also performed. If incorrect, please admonish. +(defvar erc-controls-highlight-regexp + (rx (group (or ?\C-b ?\C-\] ?\C-v ?\C-_ ?\C-g ?\C-o + (: ?\C-c (? (group (** 1 2 (any "0-9"))) + (? (group ?, (group (** 1 2 (any "0-9"))))))))) + (group (* (not (any ?\C-b ?\C-c ?\C-g ?\n ?\C-o ?\C-v ?\C-\] ?\C-_))))) + "Regular expression matching control chars to highlight.") (defun erc-controls-interpret (str) "Return a copy of STR after dealing with IRC control characters. @@ -455,16 +475,6 @@ erc-controls-strip (setq s (replace-match "" nil nil s))) s))) -(defvar erc-controls-remove-regexp - "\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?" - "Regular expression which matches control characters to remove.") - -(defvar erc-controls-highlight-regexp - (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|" - "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)" - "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)") - "Regular expression which matches control chars and the text to highlight.") - (defun erc-controls-highlight () "Highlight IRC control chars in the buffer. This is useful for `erc-insert-modify-hook' and `erc-send-modify-hook'. @@ -544,6 +554,8 @@ erc-controls-propertize (list (erc-get-bg-color-face bg)) nil)) str) + (when (and fg bg (equal fg bg)) + (put-text-property from to 'mouse-face 'erc-inverse-face str)) str) (defun erc-toggle-interpret-controls (&optional arg) @@ -560,6 +572,7 @@ erc-toggle-interpret-controls (if erc-interpret-controls-p "ON" "OFF"))) ;; Smiley +;;;###autoload(autoload 'erc-smiley-mode "erc-goodies" nil t) (define-erc-module smiley nil "This mode translates text-smileys such as :-) into pictures. This requires the function `smiley-region', which is defined in @@ -576,6 +589,7 @@ erc-smiley (smiley-region (point-min) (point-max)))) ;; Unmorse +;;;###autoload(autoload 'erc-unmorse-mode "erc-goodies" nil t) (define-erc-module unmorse nil "This mode causes morse code in the current channel to be unmorsed." ((add-hook 'erc-insert-modify-hook #'erc-unmorse)) diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 2514ffcc4d3..3b5dd988c18 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -134,6 +134,7 @@ erc-imenu-setup (setq erc-imenu--create-index-function imenu-create-index-function)) (setq-local imenu-create-index-function #'erc-create-imenu-index)) +;;;###autoload(autoload 'erc-imenu-mode "erc-imenu" nil t) (define-erc-module imenu nil "Simple Imenu integration for ERC." ((add-hook 'erc-mode-hook #'erc-imenu-setup)) diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 2cb9031640d..a44437ddcf7 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -230,7 +230,8 @@ log ;; append, so that 'erc-initialize-log-marker runs first (add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append) (dolist (buffer (erc-buffer-list)) - (erc-log-setup-logging buffer))) + (erc-log-setup-logging buffer)) + (erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs)) ;; disable ((remove-hook 'erc-insert-post-hook #'erc-save-buffer-in-logs) (remove-hook 'erc-send-post-hook #'erc-save-buffer-in-logs) @@ -241,9 +242,8 @@ log (remove-hook 'erc-part-hook #'erc-conditional-save-buffer) (remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging) (dolist (buffer (erc-buffer-list)) - (erc-log-disable-logging buffer)))) - -(define-key erc-mode-map "\C-c\C-l" #'erc-save-buffer-in-logs) + (erc-log-disable-logging buffer)) + (erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs))) ;;; functionality referenced from erc.el (defun erc-log-setup-logging (buffer) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 499bcaf5724..661471ea35c 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -52,8 +52,10 @@ 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) + (erc--modify-local-map t "C-c C-k" #'erc-go-to-log-matches-buffer)) + ((remove-hook 'erc-insert-modify-hook #'erc-match-message) + (erc--modify-local-map nil "C-c C-k" #'erc-go-to-log-matches-buffer))) ;; Remaining customizations @@ -647,8 +649,6 @@ erc-go-to-log-matches-buffer (get-buffer (car buffer-cons)))))) (switch-to-buffer buffer-name))) -(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer) - (defun erc-hide-fools (match-type _nickuserhost _message) "Hide foolish comments. This function should be called from `erc-text-matched-hook'." diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el index 8eb558ecda7..a94678e5132 100644 --- a/lisp/erc/erc-page.el +++ b/lisp/erc/erc-page.el @@ -36,6 +36,7 @@ erc-page "React to CTCP PAGE messages." :group 'erc) +;;;###autoload(put 'ctcp-page 'erc--module 'page) ;;;###autoload(autoload 'erc-page-mode "erc-page") (define-erc-module page ctcp-page "Process CTCP PAGE requests from IRC." diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 0bce856018c..7eb7431fb91 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -56,6 +56,8 @@ erc-pcomplete-order-nickname-completions "If t, order nickname completions with the most recent speakers first." :type 'boolean) +;;;###autoload(put 'Completion 'erc--module 'completion) +;;;###autoload(put 'pcomplete 'erc--module 'completion) ;;;###autoload(autoload 'erc-completion-mode "erc-pcomplete" nil t) (define-erc-module pcomplete Completion "In ERC Completion mode, the TAB key does completion whenever possible." diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 1c2fc2fcdc8..87cb77ad774 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -102,6 +102,7 @@ erc-nickserv-identify-mode (when (featurep 'erc-services) (erc-nickserv-identify-mode val)))) +;;;###autoload(put 'nickserv 'erc--module 'services) ;;;###autoload(autoload 'erc-services-mode "erc-services" nil t) (define-erc-module services nickserv "This mode automates communication with services." diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el index 0abdbfd959c..9da9202f0cf 100644 --- a/lisp/erc/erc-sound.el +++ b/lisp/erc/erc-sound.el @@ -47,6 +47,7 @@ (require 'erc) +;;;###autoload(put 'ctcp-sound 'erc--module 'sound) ;;;###autoload(autoload 'erc-sound-mode "erc-sound") (define-erc-module sound ctcp-sound "In ERC sound mode, the client will respond to CTCP SOUND requests diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 0aa1590f801..d1a1507f700 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -147,6 +147,10 @@ erc-timestamp-face "ERC timestamp face." :group 'erc-faces) +;; New libraries should only autoload the minor mode for a module's +;; preferred name (rather than its alias). + +;;;###autoload(put 'timestamp 'erc--module 'stamp) ;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 61adfe2e2ec..ec1ea29a6af 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1214,6 +1214,19 @@ erc-mode-map map) "ERC keymap.") +(defun erc--modify-local-map (mode &rest bindings) + "Modify `erc-mode-map' on behalf of a global module. +Add or remove `key-valid-p' BINDINGS when toggling MODE." + (declare (indent 1)) + (while (pcase-let* ((`(,key ,def . ,rest) bindings) + (existing (keymap-lookup erc-mode-map key))) + (if mode + (when (or (not existing) (eq existing #'undefined)) + (keymap-set erc-mode-map key def)) + (when (eq existing def) + (keymap-unset erc-mode-map key t))) + (setq bindings rest)))) + ;; Faces ; Honestly, I have a horrible sense of color and the "defaults" below @@ -1858,13 +1871,12 @@ erc-modules capab-identify) (const :tag "completion: Complete nicknames and commands (programmable)" completion) - (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete) (const :tag "dcc: Provide Direct Client-to-Client support" dcc) (const :tag "fill: Wrap long lines" fill) (const :tag "identd: Launch an identd server on port 8113" identd) + (const :tag "imenu: A simple Imenu integration" imenu) (const :tag "irccontrols: Highlight or remove IRC control characters" irccontrols) - (const :tag "imenu: A simple Imenu integration" imenu) (const :tag "keep-place: Leave point above un-viewed text" keep-place) (const :tag "list: List channels in a separate buffer" list) (const :tag "log: Save buffers in logs" log) @@ -1876,11 +1888,11 @@ erc-modules (const :tag "networks: Provide data about IRC networks" networks) (const :tag "noncommands: Don't display non-IRC commands after evaluation" noncommands) + (const :tag "notifications: Desktop alerts on PRIVMSG or mentions" + notifications) (const :tag "notify: Notify when the online status of certain users changes" notify) - (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions" - notifications) (const :tag "page: Process CTCP PAGE requests from IRC" page) (const :tag "readonly: Make displayed lines read-only" readonly) (const :tag "replace: Replace text in messages" replace) @@ -1893,8 +1905,8 @@ erc-modules (const :tag "smiley: Convert smileys to pretty icons" smiley) (const :tag "sound: Play sounds when you receive CTCP SOUND requests" sound) - (const :tag "stamp: Add timestamps to messages" stamp) (const :tag "spelling: Check spelling" spelling) + (const :tag "stamp: Add timestamps to messages" stamp) (const :tag "track: Track channel activity in the mode-line" track) (const :tag "truncate: Truncate buffers to a certain size" truncate) (const :tag "unmorse: Translate morse code in messages" unmorse) @@ -1909,18 +1921,26 @@ erc-update-modules (erc--update-modules) nil) +(defun erc--find-mode (sym) + (setq sym (erc--normalize-module-symbol sym)) + (let ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))) + (or mode + (and (require (or (get sym 'erc--feature) + (intern (concat "erc-" (symbol-name sym)))) + nil 'noerror) + (setq mode (intern-soft (concat "erc-" (symbol-name sym) + "-mode"))) + (fboundp mode) + mode)))) + (defun erc--update-modules () (let (local-modes) (dolist (module erc-modules local-modes) - (require (or (alist-get module erc--modules-to-features) - (intern (concat "erc-" (symbol-name module)))) - nil 'noerror) ; some modules don't have a corresponding feature - (let ((mode (intern-soft (concat "erc-" (symbol-name module) "-mode")))) - (unless (and mode (fboundp mode)) - (error "`%s' is not a known ERC module" module)) - (if (custom-variable-p mode) - (funcall mode 1) - (push mode local-modes)))))) + (if-let ((mode (erc--find-mode module))) + (if (custom-variable-p mode) + (funcall mode 1) + (push mode local-modes)) + (error "`%s' is not a known ERC module" module))))) (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el new file mode 100644 index 00000000000..8cab1dd0857 --- /dev/null +++ b/test/lisp/erc/erc-goodies-tests.el @@ -0,0 +1,251 @@ +;;; erc-goodies-tests.el --- Tests for erc-goodies -*- 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: +;;; Code: +(require 'ert-x) +(require 'erc-goodies) +(declare-function erc--initialize-markers "erc" (old-point continued) t) + +(defun erc-goodies-tests--assert-face (beg end-str present &optional absent) + (setq beg (+ beg (point-min))) + (let ((end (+ beg (1- (length end-str))))) + (while (and beg (< beg end)) + (let* ((val (get-text-property beg 'font-lock-face)) + (ft (flatten-tree (ensure-list val)))) + (dolist (p (ensure-list present)) + (if (consp p) + (should (member p val)) + (should (memq p ft)))) + (dolist (a (ensure-list absent)) + (if (consp a) + (should-not (member a val)) + (should-not (memq a ft)))) + (setq beg (text-property-not-all beg (point-max) + 'font-lock-face val)))))) + +;; These are from the "Examples" section of +;; https://modern.ircdocs.horse/formatting.html + +(ert-deftest erc-controls-highlight--examples () + ;; FIXME remove after adding + (unless (fboundp 'erc--initialize-markers) + (ert-skip "Missing required function")) + (should (eq t erc-interpret-controls-p)) + (let ((erc-insert-modify-hook '(erc-controls-highlight)) + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (with-current-buffer (get-buffer-create "#chan") + (erc-mode) + (setq-local erc-interpret-mirc-color t) + (erc--initialize-markers (point) nil) + + (let* ((m "I love \C-c3IRC!\C-c It is the \C-c7best protocol ever!") + (msg (erc-format-privmessage "bob" m nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + (narrow-to-region (point) (pos-eol)) + (erc-goodies-tests--assert-face + 0 "I love" 'erc-default-face 'fg:erc-color-face3) + (erc-goodies-tests--assert-face + 7 " IRC!" 'fg:erc-color-face3) + (erc-goodies-tests--assert-face + 11 " It is the " 'erc-default-face 'fg:erc-color-face7) + (erc-goodies-tests--assert-face + 22 "best protocol ever!" 'fg:erc-color-face7)) + + (let* ((m "This is a \C-]\C-c13,9cool \C-cmessage") + (msg (erc-format-privmessage "alice" m nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (should (search-forward " " nil t)) + (save-restriction + (narrow-to-region (point) (pos-eol)) + (erc-goodies-tests--assert-face + 0 "this is a " 'erc-default-face 'erc-italic-face) + (erc-goodies-tests--assert-face + 10 "cool " '(erc-italic-face fg:erc-color-face13 bg:erc-color-face9)) + (erc-goodies-tests--assert-face + 15 "message" 'erc-italic-face + '(fg:erc-color-face13 bg:erc-color-face9))) + + (let* ((m "IRC \C-bis \C-c4,12so \C-cgreat\C-o!") + (msg (erc-format-privmessage "bob" m nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (should (search-forward " " nil t)) + (save-restriction + (narrow-to-region (point) (pos-eol)) + (erc-goodies-tests--assert-face + 0 "IRC " 'erc-default-face 'erc-bold-face) + (erc-goodies-tests--assert-face + 4 "is " 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12)) + (erc-goodies-tests--assert-face + 7 "so " '(erc-bold-face fg:erc-color-face4 bg:erc-color-face12)) + (erc-goodies-tests--assert-face + 10 "great" 'erc-bold-face '(fg:erc-color-face4 bg:erc-color-face12)) + (erc-goodies-tests--assert-face + 15 "!" 'erc-default-face 'erc-bold-face)) + + (let* ((m (concat "Rules: Don't spam 5\C-c13,8,6\C-c,7,8, " + "and especially not \C-b9\C-b\C-]!")) + (msg (erc-format-privmessage "alice" m nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (should (search-forward " " nil t)) + (save-restriction + (narrow-to-region (point) (pos-eol)) + (erc-goodies-tests--assert-face + 0 "Rules: Don't spam 5" 'erc-default-face + '(fg:erc-color-face13 bg:erc-color-face8)) + (erc-goodies-tests--assert-face + 19 ",6" '(fg:erc-color-face13 bg:erc-color-face8)) + (erc-goodies-tests--assert-face + 21 ",7,8, and especially not " 'erc-default-face + '(fg:erc-color-face13 bg:erc-color-face8 erc-bold-face)) + (erc-goodies-tests--assert-face + 44 "9" 'erc-bold-face 'erc-italic-face) + (erc-goodies-tests--assert-face + 45 "!" 'erc-italic-face 'erc-bold-face)) + + (when noninteractive + (kill-buffer))))) + +;; Like the test above, this is most intuitive when run interactively. +;; Hovering over the redacted area should reveal its underlying text +;; in a high-contrast face. + +(ert-deftest erc-controls-highlight--inverse () + ;; FIXME remove after adding + (unless (fboundp 'erc--initialize-markers) + (ert-skip "Missing required function")) + (should (eq t erc-interpret-controls-p)) + (let ((erc-insert-modify-hook '(erc-controls-highlight)) + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (with-current-buffer (get-buffer-create "#chan") + (erc-mode) + (setq-local erc-interpret-mirc-color t) + (erc--initialize-markers (point) nil) + + (let* ((m "Spoiler: \C-c0,0Hello\C-c1,1World!") + (msg (erc-format-privmessage "bob" m nil t))) + (erc-display-message nil nil (current-buffer) msg)) + (forward-line -1) + (should (search-forward " " nil t)) + (save-restriction + (narrow-to-region (point) (pos-eol)) + (should (eq (get-text-property (+ 9 (point)) 'mouse-face) + 'erc-inverse-face)) + (should (eq (get-text-property (1- (pos-eol)) 'mouse-face) + 'erc-inverse-face)) + (erc-goodies-tests--assert-face + 0 "Spoiler: " 'erc-default-face + '(fg:erc-color-face0 bg:erc-color-face0)) + (erc-goodies-tests--assert-face + 9 "Hello" '(fg:erc-color-face0 bg:erc-color-face0) + '(fg:erc-color-face1 bg:erc-color-face1)) + (erc-goodies-tests--assert-face + 18 " World" '(fg:erc-color-face1 bg:erc-color-face1) + '(fg:erc-color-face0 bg:erc-color-face0))) + (when noninteractive + (kill-buffer))))) + +(defvar erc-goodies-tests--motd + ;; This is from ergo's MOTD + '((":- - this is \2bold text\17.") + (":- - this is \35italics text\17.") + (":- - this is \0034red\3 and \0032blue\3 text.") + (":- - this is \0034,12red text with a light blue background\3.") + (":- - this is a normal escaped dollarsign: $") + (":- ") + (":- " + "\0031,0 00 \0030,1 01 \0030,2 02 \0030,3 03 " + "\0031,4 04 \0030,5 05 \0030,6 06 \0031,7 07 ") + (":- " + "\0031,8 08 \0031,9 09 \0030,10 10 \0031,11 11 " + "\0030,12 12 \0031,13 13 \0031,14 14 \0031,15 15 ") + (":- ") + (":- " + "\0030,16 16 \0030,17 17 \0030,18 18 \0030,19 19 " + "\0030,20 20 \0030,21 21 \0030,22 22 \0030,23 23 " + "\0030,24 24 \0030,25 25 \0030,26 26 \0030,27 27 ") + (":- " + "\0030,28 28 \0030,29 29 \0030,30 30 \0030,31 31 " + "\0030,32 32 \0030,33 33 \0030,34 34 \0030,35 35 " + "\0030,36 36 \0030,37 37 \0030,38 38 \0030,39 39 ") + (":- " + "\0030,40 40 \0030,41 41 \0030,42 42 \0030,43 43 " + "\0030,44 44 \0030,45 45 \0030,46 46 \0030,47 47 " + "\0030,48 48 \0030,49 49 \0030,50 50 \0030,51 51 ") + (":- " + "\0030,52 52 \0030,53 53 \0031,54 54 \0031,55 55 " + "\0031,56 56 \0031,57 57 \0031,58 58 \0030,59 59 " + "\0030,60 60 \0030,61 61 \0030,62 62 \0030,63 63 ") + (":- " + "\0030,64 64 \0031,65 65 \0031,66 66 \0031,67 67 " + "\0031,68 68 \0031,69 69 \0031,70 70 \0031,71 71 " + "\0030,72 72 \0030,73 73 \0030,74 74 \0030,75 75 ") + (":- " + "\0031,76 76 \0031,77 77 \0031,78 78 \0031,79 79 " + "\0031,80 80 \0031,81 81 \0031,82 82 \0031,83 83 " + "\0031,84 84 \0031,85 85 \0031,86 86 \0031,87 87 ") + (":- " + "\0030,88 88 \0030,89 89 \0030,90 90 \0030,91 91 " + "\0030,92 92 \0030,93 93 \0030,94 94 \0030,95 95 " + "\0031,96 96 \0031,97 97 \0031,98 98 \399,99 99 ") + (":- "))) + +(ert-deftest erc-controls-highlight--motd () + ;; FIXME remove after adding + (unless (fboundp 'erc--initialize-markers) + (ert-skip "Missing required function")) + (should (eq t erc-interpret-controls-p)) + (let ((erc-insert-modify-hook '(erc-controls-highlight)) + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (with-current-buffer (get-buffer-create "#chan") + (erc-mode) + (setq-local erc-interpret-mirc-color t) + (erc--initialize-markers (point) nil) + + (dolist (parts erc-goodies-tests--motd) + (erc-display-message nil 'notice (current-buffer) (string-join parts))) + + ;; Spot check + (goto-char (point-min)) + (should (search-forward " 16 " nil t)) + (save-restriction + (narrow-to-region (point) (pos-eol)) + (erc-goodies-tests--assert-face + 0 " 17 " '(fg:erc-color-face0 (:background "#472100"))) + (erc-goodies-tests--assert-face + 4 " 18 " '(fg:erc-color-face0 (:background "#474700")) + '((:background "#472100")))) + + (should (search-forward " 71 " nil t)) + (save-restriction + (narrow-to-region (point) (pos-eol)) + (erc-goodies-tests--assert-face + 0 " 72 " '(fg:erc-color-face0 (:background "#5959ff"))) + (erc-goodies-tests--assert-face + 4 " 73 " '(fg:erc-color-face0 (:background "#c459ff")) + '((:background "#5959ff")))) + + (goto-char (point-min)) + (when noninteractive + (kill-buffer))))) + +;;; erc-goodies-tests.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 40a2d2de657..816469d9894 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -471,6 +471,50 @@ erc--target-from-string (should (equal (erc--target-from-string "&Bitlbee") #s(erc--target-channel-local "&Bitlbee" &bitlbee))))) +(ert-deftest erc--modify-local-map () + (when (and (bound-and-true-p erc-irccontrols-mode) + (fboundp 'erc-irccontrols-mode)) + (erc-irccontrols-mode -1)) + (when (and (bound-and-true-p erc-match-mode) + (fboundp 'erc-match-mode)) + (erc-match-mode -1)) + (let* (calls + (inhibit-message noninteractive) + (cmd-foo (lambda () (interactive) (push 'foo calls))) + (cmd-bar (lambda () (interactive) (push 'bar calls)))) + + (ert-info ("Add non-existing") + (erc--modify-local-map t "C-c C-c" cmd-foo "C-c C-k" cmd-bar) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k")) + (should (equal calls '(bar foo)))) + (setq calls nil) + + (ert-info ("Add existing") ; Attempt to swap definitions fails + (erc--modify-local-map t "C-c C-c" cmd-bar "C-c C-k" cmd-foo) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k")) + (should (equal calls '(bar foo)))) + (setq calls nil) + + (ert-info ("Remove existing") + (ert-with-message-capture messages + (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k")) + (should (string-search "C-c C-c is undefined" messages)) + (should (string-search "C-c C-k is undefined" messages)) + (should-not calls))))) + (ert-deftest erc-ring-previous-command-base-case () (ert-info ("Create ring when nonexistent and do nothing") (let (erc-input-ring @@ -1203,6 +1247,66 @@ erc-handle-irc-url (kill-buffer "baznet") (kill-buffer "#chan"))) +(defconst erc-tests--modules + '( autoaway autojoin button capab-identify completion dcc fill identd + imenu irccontrols keep-place list log match menu move-to-prompt netsplit + networks noncommands notifications notify page readonly + replace ring sasl scrolltobottom services smiley sound + spelling stamp track truncate unmorse xdcc)) + +(ert-deftest erc--normalize-module-symbol () + (dolist (mod erc-tests--modules) + (should (eq (erc--normalize-module-symbol mod) mod))) + (should (eq (erc--normalize-module-symbol 'pcomplete) 'completion)) + (should (eq (erc--normalize-module-symbol 'Completion) 'completion)) + (should (eq (erc--normalize-module-symbol 'ctcp-page) 'page)) + (should (eq (erc--normalize-module-symbol 'ctcp-sound) 'sound)) + (should (eq (erc--normalize-module-symbol 'timestamp) 'stamp)) + (should (eq (erc--normalize-module-symbol 'nickserv) 'services))) + +;; Worrying about which library a module comes from is mostly not +;; worth the hassle so long as ERC can find its minor mode. However, +;; bugs involving multiple modules living in the same library may slip +;; by because a module's loading problems may remain hidden on account +;; of its place in the default ordering. + +(ert-deftest erc--find-mode () + (let* ((package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) + ((string-prefix-p "erc-" found))) + (intern found) + 'erc)) + (prog + `(,@(and (featurep 'compat) + `((progn + (require 'package) + (let ((package-load-list '((compat t) (,package t)))) + (package-initialize))))) + (require 'erc) + (let ((mods (mapcar #'cadddr + (cdddr (get 'erc-modules 'custom-type)))) + moded) + (setq mods + (sort mods (lambda (a b) (if (zerop (random 2)) a b)))) + (dolist (mod mods) + (unless (keywordp mod) + (push (if-let ((mode (erc--find-mode mod))) + mod + (list :missing mod)) + moded))) + (message "%S" + (sort moded + (lambda (a b) + (string< (symbol-name a) (symbol-name b)))))))) + (proc (start-process "erc--module-mode-autoloads" + (current-buffer) + (concat invocation-directory invocation-name) + "-batch" "-Q" + "-eval" (format "%S" (cons 'progn prog))))) + (set-process-query-on-exit-flag proc t) + (while (accept-process-output proc 10)) + (goto-char (point-min)) + (should (equal (read (current-buffer)) erc-tests--modules)))) + (ert-deftest erc-migrate-modules () (should (equal (erc-migrate-modules '(autojoin timestamp button)) '(autojoin stamp button))) @@ -1213,17 +1317,28 @@ erc--update-modules (let (calls erc-modules erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + + ;; This `lbaz' module is unknown, so ERC looks for it via the + ;; symbol proerty `erc--feature' and, failing that, by + ;; `require'ing its "erc-" prefixed symbol. + (should-not (intern-soft "erc-lbaz-mode")) + (cl-letf (((symbol-function 'require) - (lambda (s &rest _) (push s calls))) + (lambda (s &rest _) + (when (eq s 'erc--lbaz-feature) + (fset (intern "erc-lbaz-mode") ; local module + (lambda (n) (push (cons 'lbaz n) calls)))) + (push s calls))) ;; Local modules - ((symbol-function 'erc-fake-bar-mode) - (lambda (n) (push (cons 'fake-bar n) calls))) + ((symbol-function 'erc-lbar-mode) + (lambda (n) (push (cons 'lbar n) calls))) + ((get 'lbaz 'erc--feature) 'erc--lbaz-feature) ;; Global modules - ((symbol-function 'erc-fake-foo-mode) - (lambda (n) (push (cons 'fake-foo n) calls))) - ((get 'erc-fake-foo-mode 'standard-value) 'ignore) + ((symbol-function 'erc-gfoo-mode) + (lambda (n) (push (cons 'gfoo n) calls))) + ((get 'erc-gfoo-mode 'standard-value) 'ignore) ((symbol-function 'erc-autojoin-mode) (lambda (n) (push (cons 'autojoin n) calls))) ((get 'erc-autojoin-mode 'standard-value) 'ignore) @@ -1234,20 +1349,28 @@ erc--update-modules (lambda (n) (push (cons 'completion n) calls))) ((get 'erc-completion-mode 'standard-value) 'ignore)) + (ert-info ("Unknown module") + (setq erc-modules '(lfoo)) + (should-error (erc--update-modules)) + (should (equal (pop calls) 'erc-lfoo)) + (should-not calls)) + (ert-info ("Local modules") - (setq erc-modules '(fake-foo fake-bar)) - (should (equal (erc--update-modules) '(erc-fake-bar-mode))) - ;; Bar the feature is still required but the mode is not activated - (should (equal (nreverse calls) - '(erc-fake-foo (fake-foo . 1) erc-fake-bar))) + (setq erc-modules '(gfoo lbar lbaz)) + ;; Don't expose the mode here + (should (equal (mapcar #'symbol-name (erc--update-modules)) + '("erc-lbaz-mode" "erc-lbar-mode"))) + ;; Lbaz required because unknown. + (should (equal (nreverse calls) '((gfoo . 1) erc--lbaz-feature))) + (fmakunbound (intern "erc-lbaz-mode")) + (unintern (intern "erc-lbaz-mode") obarray) (setq calls nil)) - (ert-info ("Module name overrides") - (setq erc-modules '(completion autojoin networks)) + (ert-info ("Global modules") ; `pcomplete' resolved to `completion' + (setq erc-modules '(pcomplete autojoin networks)) (should-not (erc--update-modules)) ; no locals - (should (equal (nreverse calls) '( erc-pcomplete (completion . 1) - erc-join (autojoin . 1) - erc-networks (networks . 1)))) + (should (equal (nreverse calls) + '((completion . 1) (autojoin . 1) (networks . 1)))) (setq calls nil))))) (ert-deftest erc--merge-local-modes () -- 2.39.1