master 36941e9e6a5: Font-lock shorthands with arbitrary punctuation (bug#67390)

[João Távora]

branch: master
commit 36941e9e6a58c4e7f233be411c46806c79f6de2d
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Font-lock shorthands with arbitrary punctuation (bug#67390)
    
    * lisp/emacs-lisp/shorthands.el
    (shorthands--mismatch-from-end): Rework and document.  Works like
    CL's mismatch now.
    (shorthands-font-lock-shorthands): Allow arbitrary punctuation
    as separator for font-locking logic.
---
 lisp/emacs-lisp/shorthands.el | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el
index 82200ab88e9..b0665a55695 100644
--- a/lisp/emacs-lisp/shorthands.el
+++ b/lisp/emacs-lisp/shorthands.el
@@ -53,11 +53,16 @@
   :group 'font-lock-faces)
 
 (defun shorthands--mismatch-from-end (str1 str2)
+  "Tell index of first mismatch in STR1 and STR2, from end.
+The index is a valid 0-based index on STR1.  Returns nil if STR1
+equals STR2.  Return 0 if STR1 is a suffix of 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))))
+           while (eq (aref str1 i1) (aref str2 i2))
+           if (zerop i2) return (if (zerop i1) nil i1)
+           if (zerop i1) return 0
+           finally (return i1)))
 
 (defun shorthands-font-lock-shorthands (limit)
   (when read-symbol-shorthands
@@ -69,10 +74,16 @@
                                                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))
+             (mismatch (and sname (shorthands--mismatch-from-end
+                                   (match-string 1) sname)))
+             (guess (and mismatch (1+ mismatch))))
+        (when guess
+          (when (and (< guess (1- (length (match-string 1))))
+                     ;; In bug#67390 we allow other separators
+                     (eq (char-syntax (aref (match-string 1) guess)) ?_))
+            (setq guess (1+ guess)))
+          (add-face-text-property (match-beginning 1)
+                                  (+ (match-beginning 1) guess)
                                   'elisp-shorthand-font-lock-face))))))
 
 (font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) 
t)