procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Font-lock shorthands with arbitrary punctuation (bug#67390)

Browse source 
* 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.
This commit is contained in:
João Távora 2023-11-26 15:49:59 -06:00
parent f4bdc9b092
commit 36941e9e6a
1 changed files with 17 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

23
lisp/emacs-lisp/shorthands.el
View file

@ -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)