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.

diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el
index 82200ab88e9b2623fab296632720078fa42e593b..b0665a556954177f8c6de7a826fe404117415ba0 100644 (file)
--- 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)