Package: emacs;
Reported by: Jonas Bernoulli <jonas <at> bernoul.li>
Date: Wed, 22 Nov 2023 22:19:01 UTC
Severity: normal
View this message in rfc822 format
From: João Távora <joaotavora <at> gmail.com> To: Jonas Bernoulli <jonas <at> bernoul.li>, Eli Zaretskii <eliz <at> gnu.org> Cc: Joseph Turner <joseph <at> ushin.org>, 67390 <at> debbugs.gnu.org, Adam Porter <adam <at> alphapapa.net> Subject: bug#67390: 28; shorthands-font-lock-shorthands assumes shorthand uses same separator Date: Thu, 30 Nov 2023 14:16:51 +0000
Hi all,
I've been working on all these shorthand-related issues over the last
two days and I have reasonably short fixes for all of them.
For this particular issue (bug#67309), I've opted to
use Joseph's patch with very slight adjustments, as it's the
only one that guarantees correct behaviour and doesn't seem
to impact performance.
The other issues are:
bug#63480 (loaddefs-gen.el doesn't know about shorthands)
bug#67325 (prefix discovery i.e. register-definition-prefixes)
bug#67523 (check-declare.el doesn't know about shorthands)
I have all this in 6 commits in the bugfix/shorthand-fixes branch.
Here's the full patch minus whitespace changes. If there are
no comments I'll push in a few days' time.
João
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index 1f3b677d7fb..18e80311177 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -761,6 +761,23 @@ Shorthands
;; End:
@end example
+Note that if you have two shorthands in the same file where one is the
+prefix of the other, the longer shorthand will be attempted first.
+This happens regardless of the order you specify shorthands in the
+local variables section of your file.
+
+@example
+'(
+ t//foo ; reads to 'my-tricks--foo', not 'my-tricks-/foo'
+ t/foo ; reads to 'my-tricks-foo'
+ )
+
+;; Local Variables:
+;; read-symbol-shorthands: (("t/" . "my-tricks-")
+;; ("t//" . "my-tricks--")
+;; End:
+@end example
+
@subsection Exceptions
There are two exceptions to rules governing Shorthand transformations:
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index c887d95210c..b19aedf314d 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -145,21 +145,26 @@ check-declare-verify
(if (file-regular-p fnfile)
(with-temp-buffer
(insert-file-contents fnfile)
+ (unless cflag
+ ;; If in Elisp, ensure syntax and shorthands available
+ (set-syntax-table emacs-lisp-mode-syntax-table)
+ (let (enable-local-variables) (hack-local-variables)))
;; defsubst's don't _have_ to be known at compile time.
- (setq re (format (if cflag
- "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
+ (setq re (if cflag
+ (format "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
+ (regexp-opt (mapcar 'cadr fnlist) t))
"^[ \t]*(\\(fset[ \t]+'\\|\
cl-def\\(?:generic\\|method\\|un\\)\\|\
def\\(?:un\\|subst\\|foo\\|method\\|class\\|\
ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\
\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\
ine-overloadable-function\\)\\)\
-[ \t]*%s\\([ \t;]+\\|$\\)")
- (regexp-opt (mapcar 'cadr fnlist) t)))
+[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\([ \t;]+\\|$\\)"))
(while (re-search-forward re nil t)
(skip-chars-forward " \t\n")
- (setq fn (match-string 2)
- type (match-string 1)
+ (setq fn (symbol-name (car (read-from-string (match-string 2)))))
+ (when (member fn (mapcar 'cadr fnlist))
+ (setq type (match-string 1)
;; (min . max) for a fixed number of arguments, or
;; arglists with optional elements.
;; (min) for arglists with &rest.
@@ -202,7 +207,7 @@ check-declare-verify
(t
'err))
;; alist of functions and arglist signatures.
- siglist (cons (cons fn sig) siglist)))))
+ siglist (cons (cons fn sig) siglist))))))
(dolist (e fnlist)
(setq arglist (nth 2 e)
type
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 04bea4723a2..e8093200bec 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -378,6 +378,7 @@ loaddefs-generate--parse-file
(let ((defs nil)
(load-name (loaddefs-generate--file-load-name file main-outfile))
(compute-prefixes t)
+ read-symbol-shorthands
local-outfile inhibit-autoloads)
(with-temp-buffer
(insert-file-contents file)
@@ -399,7 +400,19 @@ loaddefs-generate--parse-file
(setq inhibit-autoloads (read (current-buffer)))))
(save-excursion
(when (re-search-forward "autoload-compute-prefixes: *" nil t)
- (setq compute-prefixes (read (current-buffer))))))
+ (setq compute-prefixes (read (current-buffer)))))
+ (save-excursion
+ ;; since we're "open-coding" we have to repeat more
+ ;; complicated logic in `hack-local-variables'.
+ (when (re-search-forward "read-symbol-shorthands: *" nil t)
+ (let* ((commentless (replace-regexp-in-string
+ "\n\\s-*;+" ""
+ (buffer-substring (point) (point-max))))
+ (unsorted-shorthands (car (read-from-string commentless))))
+ (setq read-symbol-shorthands
+ (sort unsorted-shorthands
+ (lambda (sh1 sh2)
+ (> (length (car sh1)) (length (car sh2))))))))))
;; We always return the package version (even for pre-dumped
;; files).
@@ -486,7 +499,11 @@ loaddefs-generate--compute-prefixes
(while (re-search-forward
"^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
(unless (member (match-string 1) autoload-ignored-definitions)
- (let ((name (match-string-no-properties 2)))
+ (let* ((name (match-string-no-properties 2))
+ ;; Consider `read-symbol-shorthands'.
+ (probe (let ((obarray (obarray-make)))
+ (car (read-from-string name)))))
+ (setq name (symbol-name probe))
(when (save-excursion
(goto-char (match-beginning 0))
(or (bobp)
diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el
index b0665a55695..69b562e3c7e 100644
--- a/lisp/emacs-lisp/shorthands.el
+++ b/lisp/emacs-lisp/shorthands.el
@@ -52,38 +52,26 @@ elisp-shorthand-font-lock-face
:version "28.1"
: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 (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)
+ "Font lock until LIMIT considering `read-symbol-shorthands'."
(when read-symbol-shorthands
(while (re-search-forward
(concat "\\_<\\(" (rx lisp-mode-symbol) "\\)\\_>")
limit t)
(let* ((existing (get-text-property (match-beginning 1) 'face))
+ (print-name (match-string 1))
(probe (and (not (memq existing '(font-lock-comment-face
font-lock-string-face)))
- (intern-soft (match-string 1))))
- (sname (and probe (symbol-name probe)))
- (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)))
+ (intern-soft print-name)))
+ (symbol-name (and probe (symbol-name probe)))
+ (prefix (and symbol-name
+ (not (string-equal print-name symbol-name))
+ (car (assoc print-name
+ read-symbol-shorthands
+ #'string-prefix-p)))))
+ (when prefix
(add-face-text-property (match-beginning 1)
- (+ (match-beginning 1) guess)
+ (+ (match-beginning 1) (length prefix))
'elisp-shorthand-font-lock-face))))))
(font-lock-add-keywords 'emacs-lisp-mode
'((shorthands-font-lock-shorthands)) t)
diff --git a/lisp/files.el b/lisp/files.el
index 1cdcec23b11..b266d0727ec 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3735,7 +3735,8 @@ before-hack-local-variables-hook
This hook is called only if there is at least one file-local
variable to set.")
-(defvar permanently-enabled-local-variables '(lexical-binding)
+(defvar permanently-enabled-local-variables
+ '(lexical-binding read-symbol-shorthands)
"A list of file-local variables that are always enabled.
This overrides any `enable-local-variables' setting.")
@@ -4171,6 +4172,13 @@ hack-local-variables--find-variables
;; to use 'thisbuf's name in the
;; warning message.
(or (buffer-file-name thisbuf) ""))))))
+ ((eq var 'read-symbol-shorthands)
+ ;; Sort automatically by shorthand length
+ ;; descending
+ (setq val (sort val
+ (lambda (sh1 sh2) (>
(length (car sh1))
+
(length (car sh2))))))
+ (push (cons 'read-symbol-shorthands val) result))
((and (eq var 'mode) handle-mode))
(t
(ignore-errors
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.