>From 08b84a699644ccbc08e1c3e630090297f259269a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 5 Dec 2024 20:23:23 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.7] Use speaker-end marker in ERC insertion hooks [5.7] Introduce lower level erc-match API [5.7] Use erc-match-type API for erc-desktop-notifications doc/misc/erc.texi | 490 ++++++++++++++++-- etc/ERC-NEWS | 22 + lisp/erc/erc-desktop-notifications.el | 69 ++- lisp/erc/erc-fill.el | 20 +- lisp/erc/erc-match.el | 428 ++++++++++++++- lisp/erc/erc.el | 48 +- .../erc/erc-desktop-notifications-tests.el | 115 ++++ test/lisp/erc/erc-match-tests.el | 214 +++++++- 8 files changed, 1296 insertions(+), 110 deletions(-) create mode 100644 test/lisp/erc/erc-desktop-notifications-tests.el Interdiff: diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 49dbfe3623a..995254d544e 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -2150,12 +2150,26 @@ Match API Here, the user could just as well shove the incrementer into the @samp{predicate} body, since @samp{handler} is set to @code{ignore} by default (however, some frown at the notion of a predicate exhibiting -side effects). Likewise, the user could also choose to concentrate only -on chat content by filtering out non-@samp{PRIVMSG} messages via the -slot @samp{command}. +side effects). The user could also choose to concentrate only on chat +content by filtering out non-@samp{PRIVMSG} messages via the slot +@samp{command}. -For a detailed example of matching without highlighting, see the -@samp{jabbycat} demo module, available on ERC's dev-oriented package +In cases where you need a handler to only run when some other match type +appearing earlier in @code{erc-match-functions} has _not_ yielded a +match, use: + +@defun erc-match-get-match constructor + +When called from a @samp{handler} or a @samp{predicate} body, this +utility returns instances of prior @code{erc-match-functions} that have +already successfully matched the current message. Use this for +deduplication and to share data between match instances. + +@end defun + +@noindent +For a detailed example of matching for non-highlighting purposes, see +the @samp{jabbycat} demo module, available on ERC's dev-oriented package archive: @uref{https://emacs-erc.gitlab.io/bugs/archive/jabbycat.html}. If you're in a hurry, check out @file{erc-desktop-notifications.el}, which ships with ERC, but please ignore the parts that involve adapting @@ -2169,10 +2183,12 @@ Match API @subsection Highlighting @cindex highlighting -Third-party modules likely want to manage and apply faces themselves. -However, in a pinch you can just piggyback atop the highlighting -functionality already provided by @samp{match} to support its many -high-level options. +End users and third-party modules likely want to manage and apply faces +themselves. If that's you, feel free to skip to the more extensive +examples further below. However, for the sake of completeness, it's +worth mentioning that in a pinch, you can likely piggyback atop the +highlighting functionality already provided by @samp{match} to support +its many high-level options. @lisp (require 'erc-match) @@ -2235,58 +2251,189 @@ Match API @end deftp @noindent -You likely won't be needing these, but for the sake of completeness, -other options-based types similar to @code{erc-match-opt-keyword} -include @code{erc-match-opt-current-nick}, @code{erc-match-opt-fool}, +You likely won't be needing these, but just for the record, other +options-based types similar to @code{erc-match-opt-keyword} include +@code{erc-match-opt-current-nick}, @code{erc-match-opt-fool}, @code{erc-match-opt-pal}, and @code{erc-match-opt-dangerous-host}. (If you're familiar with this module's user options, you'll notice some parallels here.) -And, finally, here's a more elaborate, module-like example demoing -highlighting based on the @code{erc-match-traditional} type: +@anchor{highlighting examples} +@subsubsection Complete Highlighting Examples +@cindex highlighting examples + +As mentioned, most users needn't bother with the piggybacking approach +detailed above, which can oftentimes be more complicated than starting +afresh. Here's a more elaborate, module-like example demoing some +highlighting with a bespoke @code{erc-match}-derived type: @lisp -;; -*- lexical-binding: t; -*- +;;; erc-org-markup.el --- Org Markup for ERC -*- lexical-binding: t; -*- (require 'erc-match) -(require 'erc-button) - -(defvar my-keywords - `((foonet ("#chan" ,(rx bow (or "foo" "bar" "baz") eow))))) - -(defface my-keyword '((t (:underline (:color "tomato" :style wave)))) - "My face.") - -(defun my-get-keyword () - (and-let* ((chans (alist-get (erc-network) my-keywords)) - ((cdr (assoc (erc-target) chans)))))) +(require 'org) + +(defgroup erc-org-markup nil + "Highlight messages written in Org markup." + :group 'erc) + +(defcustom erc-org-markup-targets '("#org") + "List of buffers in which to highlight messages." + :type '(repeat string)) + +(define-erc-module org-markup nil + "Local module that treats messages as having Org markup." + ((erc-org-markup-ensure-buffer) + (if (member (erc-target) erc-org-markup-targets) + (progn + (add-hook 'erc-match-functions #'erc-org-markup 0 t) + (add-to-invisibility-spec '(org-link))) + (erc-org-markup-mode -1))) + ((remove-hook 'erc-match-functions #'erc-org-markup t) + (remove-from-invisibility-spec '(org-link))) + 'local) + +(cl-defstruct (erc-org-markup + (:include erc-match + (predicate #'erc-org-markup--should-p) + (handler #'erc-org-markup--fontify)) + (:constructor erc-org-markup)) + "Match type to highlight messages written in Org markup.") + +(defun erc-org-markup--should-p (match) + "Return non-nil if MATCH describes an Org-markup worthy message." + (and erc-org-markup-mode (erc-match-nick match))) + +(defun erc-org-markup-ensure-buffer () + "Return existing global work buffer or create it anew." + (or (get-buffer "*erc-org-markup*") + (with-current-buffer (get-buffer-create "*erc-org-markup*") + (org-mode) + (make-local-variable 'org-link-parameters) + (setf (plist-get (cdr (assoc "https" org-link-parameters)) + :activate-func) + #'erc-org-markup-activate-link) + (setq-local org-hide-emphasis-markers t) + (current-buffer)))) + +(defun erc-org-markup--fontify (match) + "Overwrite text properties in MATCH'd message with Org's." + (save-restriction + (narrow-to-region (erc-match-body-beg match) (1- (point-max))) + (let ((buffer (current-buffer))) + (with-current-buffer (erc-org-markup-ensure-buffer) + (save-window-excursion + (buffer-swap-text buffer) + (font-lock-ensure) + (buffer-swap-text buffer)))))) + +(defun erc-org-markup-activate-link (beg end path _) + "Ensure Org https link between BEG and END has `erc-button' props." + (erc-button-add-button beg end #'browse-url-button-open-url nil + (list (concat "https:" path)) "")) + +(provide 'erc-org-markup) + +;;; erc-org-markup.el ends here +@end lisp -(cl-defstruct (my-match (:include erc-match-opt-keyword - (data (my-get-keyword)) - (face 'my-keyword)) - (:constructor my-match))) +@noindent +Finally, here's a slightly more complete demo module: a superficial +rewrite of @file{erc-colorize.el} by Sylvain Rousseau +@uref{https://github.com/thisirs/erc-colorize.git}. -(add-hook 'erc-match-functions #'my-match) +@lisp +;;; erc-colorize.el --- Per-user message faces -*- lexical-binding: t; -*- -(cl-defmethod erc-match-highlight-by-part ((instance my-match) - (_ (eql keyword))) - "Highlight keywords by merging instead of clobbering." - (dolist (pat (my-match-data instance)) - (goto-char (my-match-body-beg instance)) - (while (re-search-forward pat nil t) - (erc-button-add-face (match-beginning 0) (match-end 0) - (my-match-face instance))))) +(require 'ring) +(require 'erc-match) +(require 'erc-button) ; for `erc-button-add-face' + +(defgroup erc-colorize nil + "Highlight messages with per-user faces from a limited pool." + :group 'erc) + +(defface erc-colorize-1 '((t :inherit font-lock-keyword-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-2 '((t :inherit font-lock-type-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-3 '((t :inherit font-lock-string-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-4 '((t :inherit font-lock-constant-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-5 '((t :inherit font-lock-preprocessor-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-6 '((t :inherit font-lock-variable-name-face)) + "Auto-assigned face for distinguishing between messages.") + +(defface erc-colorize-7 '((t :inherit font-lock-warning-face)) + "Auto-assigned face for distinguishing between messages.") + +(defvar erc-colorize-faces '(erc-colorize-1 + erc-colorize-2 + erc-colorize-3 + erc-colorize-4 + erc-colorize-5 + erc-colorize-6 + erc-colorize-7) + "List of faces to apply to chat messages.") + +(defvar-local erc-colorize-ring nil + "Ring of cons cells of the form (NICK . FACE).") + +(define-erc-module colorize nil + "Highlight messages from a speaker with the same face in target buffers." + ((when (erc-target) + (add-hook 'erc-match-functions 'erc-colorize 0 t) + (setq erc-colorize-ring (make-ring (length erc-colorize-faces))))) + ((remove-hook 'erc-match-functions 'erc-colorize t)) + 'local) + +(defun erc-colorize-color (ring nick) + "Return a face to use for string NICK. +Prefer an existing entry in RING. If there isn't one, pick the first +unused face in `erc-colorize-faces'. Otherwise, pick the least used +face." + (cond + ((and-let* ((i (catch 'found + (dotimes (i (ring-length ring)) + (when (equal (car (ring-ref ring i)) nick) + (throw 'found i)))))) + (ring-insert ring (ring-remove ring i)) + (cdr (ring-ref ring 0)))) + ((let ((used (mapcar #'cdr (ring-elements ring)))) + (and-let* ((face (catch 'found + (dolist (face erc-colorize-faces) + (unless (member face used) + (throw 'found face)))))) + (prog1 face + (ring-insert ring (cons nick face)))))) + ((let ((older (ring-remove ring))) + (ring-insert ring (cons nick (cdr older))) + (cdr older))))) + +(cl-defstruct (erc-colorize ( :include erc-match + (predicate #'erc-colorize-nick) + (handler #'erc-colorize-message)) + (:constructor erc-colorize)) + "An `erc-match' type for the `erc-colorize' module.") + +(defun erc-colorize-message (match) + "Highlight MATCH's full message with a face from `erc-colorize-faces'." + (erc-button-add-face (point-min) (1- (point-max)) + (erc-colorize-color erc-colorize-ring + (erc-colorize-nick match)))) + +(provide 'erc-colorize) + +;;; erc-colorize.el ends here @end lisp -@noindent -Note that in the method body, you @emph{could} technically skip to the -beginning of the last match for the first go around because the match -data from the @samp{predicate} is still fresh. Also, while the method -could simply call @code{my-get-keyword} directly instead of accessing -the @samp{data} slot and also reference the @code{my-keyword} face -instead of using the @samp{face} slot, other methods may need to share -@samp{data} or alter @samp{face}. - @node Options @section Options diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index dba7a708567..8fcb83bb471 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -751,6 +751,9 @@ erc-match-highlight-by-part (defvar erc-match-highlight-matched nil "Matched `erc-match' instance in `erc-text-matched-hook'.") +(defvar erc-match--instances nil + "Alist mapping constructors to successful `erc-match' instances.") + (defun erc-match-highlight (instance) "Dispatch `erc-match-highlight-by-part' on INSTANCE's `:part' slot. Run `erc-text-matched-hook' when INSTANCE's `category' slot is non-nil." @@ -775,6 +778,12 @@ erc-match-get-message-body "Return the message body in the narrowed buffer for match INSTANCE." (buffer-substring (erc-match-body-beg instance) (1- (point-max)))) +(defun erc-match-get-match (constructor) + "Return successful `erc-match' instance for CONSTRUCTOR, if any. +Expect to be called only from `erc-match' :predicate and :handler +functions as well as `erc-text-matched-hook' members." + (alist-get constructor erc-match--instances)) + (defun erc-match--run-match (constructor spkr-beg spkr-end body-beg nick sender command) "Run :handler for for `erc-match' instance if :predicate returns non-nil. @@ -791,6 +800,7 @@ erc-match--run-match ((goto-char (point-min))) ((funcall (erc-match-predicate instance) instance))) (funcall (erc-match-handler instance) instance) + (push (cons constructor instance) erc-match--instances) nil)) (defun erc-match--message () @@ -812,7 +822,8 @@ erc-match--message (skip-syntax-forward "-") (point))) ((point-min))))) - (command (erc--check-msg-prop 'erc--cmd))) + (command (erc--check-msg-prop 'erc--cmd)) + (erc-match--instances ())) (with-syntax-table erc-match-syntax-table (run-hook-wrapped 'erc-match-functions #'erc-match--run-match spkr-beg spkr-end body-beg nick -- 2.47.0