From e469c9d621116857bd1d84720eb2eb43d4560074 Mon Sep 17 00:00:00 2001 From: Joseph Turner Date: Fri, 24 Nov 2023 19:17:13 -0800 Subject: [PATCH] Support shorthand prefixes besides "-" Previously, shorthands-font-lock-shorthands added font locking to the shorthand prefix by checking for a mismatch between the shorthand and longhand symbols. This broke font-locking when the shorthand prefix separator was not "-" (bug#67390). Now, shorthands-font-lock-shorthands adds font locking to the shorthand prefix by checking if any of the shorthand prefixes in read-symbol-shorthands are a prefix for the current symbol name. Thanks to Jonas Bernoulli for the idea to use (not (string-equal (match-string 1) sname)) --- lisp/emacs-lisp/shorthands.el | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index 82200ab88e9..141b6115a3d 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el @@ -52,12 +52,14 @@ :version "28.1" :group 'font-lock-faces) -(defun shorthands--mismatch-from-end (str1 str2) - (cl-loop with l1 = (length str1) with l2 = (length str2) - for i from 1 - for i1 = (- l1 i) for i2 = (- l2 i) - while (and (>= i1 0) (>= i2 0) (eq (aref str1 i1) (aref str2 i2))) - finally (return (1- i)))) +(defun shorthands--find-if (predicate seq &optional key) + "Find the first item satisfying PREDICATE in SEQ. +Return the matching item, or nil if not found. Optional argument +KEY is used to filter SEQ, as in `cl-find-if'." + (catch 'found + (dolist (el seq) + (when (funcall predicate (funcall (or key #'identity) el)) + (throw 'found el))))) (defun shorthands-font-lock-shorthands (limit) (when read-symbol-shorthands @@ -69,10 +71,15 @@ font-lock-string-face))) (intern-soft (match-string 1)))) (sname (and probe (symbol-name probe))) - (mm (and sname (shorthands--mismatch-from-end - (match-string 1) sname)))) - (unless (or (null mm) (= mm (length sname))) - (add-face-text-property (match-beginning 1) (1+ (- (match-end 1) mm)) + (prefix (and sname + (not (string-equal (match-string 1) sname)) + (car (shorthands--find-if + (lambda (short) + (string-prefix-p short (match-string 1))) + read-symbol-shorthands #'car))))) + (when prefix + (add-face-text-property (match-beginning 1) + (+ (match-beginning 1) (length prefix)) 'elisp-shorthand-font-lock-face)))))) (font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) t) -- 2.41.0