emacs-28 e6fbc45 1/2: Font-lock shorthands in elisp-mode for quick visual recognition (bug#50959)

[João Távora]

branch: emacs-28
commit e6fbc45b7b49a27ab4db348385762bafc330bcf3
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Font-lock shorthands in elisp-mode for quick visual recognition (bug#50959)
    
    Only the shorthanded prefix is font-locked.  This allows the remainder
    of the font-lock logic to subsist (e.g. for macro-defining symbols).
    
    * lisp/shorthands.el (cl-lib): Require it when compiling.
    (elisp-shorthand-font-lock-face): New face.
    (shorthands--mismatch-from-end): New helper.
    (shorthands-font-lock-shorthands): New helper.
    
    * test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el:
    Add some dummy test code.
---
 lisp/shorthands.el                                 | 39 ++++++++++++++++++++++
 .../elisp-mode-resources/simple-shorthand-test.el  |  8 +++++
 2 files changed, 47 insertions(+)

diff --git a/lisp/shorthands.el b/lisp/shorthands.el
index 6162efd..f657047 100644
--- a/lisp/shorthands.el
+++ b/lisp/shorthands.el
@@ -26,6 +26,7 @@
 
 ;;; Code:
 (require 'files)
+(eval-when-compile (require 'cl-lib))
 
 (defun hack-elisp-shorthands (fullname)
   "Return value of `elisp-shorthands' file-local variable in FULLNAME.
@@ -57,4 +58,42 @@ value of `elisp-shorthands', when it processes that file's 
Elisp code."
   (let ((elisp-shorthands (hack-elisp-shorthands fullname)))
     (load-with-code-conversion fullname file noerror nomessage)))
 
+
+;; FIXME: move this all to progmodes/elisp-mode.el?  OTOH it'd make
+;; more sense there, OTOH all the elisp font-lock stuff is actually in
+;; lisp/emacs-lisp/lisp-mode.el, which isn't right either.  So
+;; shorthand font-locking logic is probably better here for now.
+
+(defface elisp-shorthand-font-lock-face
+  '((t :inherit font-lock-keyword-face :foreground "cyan"))
+  "Face for highlighting shorthands in Emacs Lisp."
+  :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-font-lock-shorthands (limit)
+  (when elisp-shorthands
+    (while (re-search-forward
+            (eval-when-compile
+              (concat "\\_<\\(" lisp-mode-symbol-regexp "\\)\\_>"))
+            limit t)
+      (let* ((existing (get-text-property (match-beginning 1) 'face))
+             (probe (and (not (memq existing '(font-lock-comment-face
+                                               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))
+                                  'elisp-shorthand-font-lock-face))))))
+
+(font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands)) 
t)
+
 ;;; shorthands.el ends here
diff --git a/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el 
b/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el
index ec56809..29ee36a 100644
--- a/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el
+++ b/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el
@@ -16,8 +16,16 @@
 
 (defvar f-test-complete-me 42)
 
+(elisp--foo-test3)
+
 (defun #_f-test4--- () 84)
 
+(defmacro f-define-test-5 ())
+
+;; should be font locked with both shorthand
+;; highlighting _and_ macro highlighting.
+(f-define-test-5)
+
 (when nil
   (f-test3)
   (f-test2)