Subject: bug#67390: 28; shorthands-font-lock-shorthands assumes shorthand uses same separator

From: Joseph Turner <[email-masked]>
Date: Fri, 24 Nov 2023 19:26:54 -0800

João Távora <[email-masked]> writes:

> On Fri, Nov 24, 2023 at 9:51 PM Jonas Bernoulli <[email-masked]> wrote:
>
>> Also, have you considered throwing in a
>>   (not (string-equal (match-string 1) sname))
>>
>> to avoid having to call `shorthands--mismatch-from-end' at all?
>
> Where and how this be thrown in?  How would you know what to highlight
> in the shorthand printed form?  There can be many shorthand prefixes
> in a given file.  But do show some code.

Please see the attached patch, inspired by Jonas's comment.

>> Maybe you have, but concluded it is cheaper to do a bit too much work
>> for non-shorthands, than to effectively repeat some work for shorthands.
>
> Maybe.  Not sure this is more work (string-equal must still compare
> every character right?), but, in summary, I'm not married to this
> implementation.  I somewhat appreciate that I could still read it
> after not having looked  at it for a couple years, but feel free to
> change it.

I haven't done any benchmarking - I'm curious to learn how to benchmark
font lock though!

Thanks!!

Joseph

>From e469c9d621116857bd1d84720eb2eb43d4560074 Mon Sep 17 00:00:00 2001
From: Joseph Turner <[email-masked]>
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