From 36941e9e6a58c4e7f233be411c46806c79f6de2d Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 26 Nov 2023 15:49:59 -0600 Subject: [PATCH] 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) -- 2.39.2