summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/backtrace.el2
-rw-r--r--lisp/emacs-lisp/bindat.el6
-rw-r--r--lisp/emacs-lisp/byte-opt.el2
-rw-r--r--lisp/emacs-lisp/bytecomp.el11
-rw-r--r--lisp/emacs-lisp/cconv.el150
-rw-r--r--lisp/emacs-lisp/cl-extra.el4
-rw-r--r--lisp/emacs-lisp/comp-cstr.el2
-rw-r--r--lisp/emacs-lisp/comp.el21
-rw-r--r--lisp/emacs-lisp/crm.el2
-rw-r--r--lisp/emacs-lisp/eldoc.el127
-rw-r--r--lisp/emacs-lisp/gv.el7
-rw-r--r--lisp/emacs-lisp/hierarchy.el85
-rw-r--r--lisp/emacs-lisp/icons.el25
-rw-r--r--lisp/emacs-lisp/map.el164
-rw-r--r--lisp/emacs-lisp/package.el3
-rw-r--r--lisp/emacs-lisp/re-builder.el31
-rw-r--r--lisp/emacs-lisp/tabulated-list.el2
17 files changed, 401 insertions, 243 deletions
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 4ffe6f573c6..d461698c88e 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -753,7 +753,7 @@ property for use by navigation."
(defun backtrace--line-length-or-nil ()
"Return `backtrace-line-length' if valid, nil else."
- ;; mirror the logic in `cl-print-to-string-with-limits'
+ ;; mirror the logic in `cl-print-to-string-with-limit'
(and (natnump backtrace-line-length)
(not (zerop backtrace-line-length))
backtrace-line-length))
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 0ecac3d52aa..82d3c5309f8 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -163,7 +163,9 @@
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
(setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
- (apply #'unibyte-string s))))
+ ;; FIXME: There should be a more efficient way to do this.
+ ;; Should `apply' accept vectors in addition to lists?
+ (apply #'unibyte-string (append s nil)))))
(defun bindat--unpack-strz (&optional len)
(let ((i 0) s)
@@ -172,7 +174,7 @@
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
(setq bindat-idx (+ bindat-idx (or len (1+ i))))
(if (stringp s) s
- (apply #'unibyte-string s))))
+ (apply #'unibyte-string (append s nil)))))
(defun bindat--unpack-bits (len)
(let ((bits nil) (bnum (1- (* 8 len))) j m)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 5ef2d7fe827..a7e1df3622d 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -178,7 +178,7 @@ Earlier variables shadow later ones with the same name.")
;; be displayed when the function's source file will be
;; compiled anyway, but more importantly we would otherwise
;; emit spurious warnings here because we don't have the full
- ;; context, such as `declare-functions' placed earlier in the
+ ;; context, such as `declare-function's placed earlier in the
;; source file's code or `with-suppressed-warnings' that
;; surrounded the `defsubst'.
(byte-compile-warnings nil))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 45ff1f4a8ec..4d258dab96e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2577,7 +2577,7 @@ list that represents a doc string reference.
;; macroexpand-all.
;; (if (memq byte-optimize '(t source))
;; (setq form (byte-optimize-form form for-effect)))
- (cconv-closure-convert form))
+ (cconv-closure-convert form byte-compile-bound-variables))
;; byte-hunk-handlers cannot call this!
(defun byte-compile-toplevel-file-form (top-level-form)
@@ -4675,13 +4675,6 @@ Return the offset in the form (VAR . OFFSET)."
(byte-compile-form (cadr clause))
(byte-compile-push-constant nil)))))
-(defun byte-compile-not-lexical-var-p (var)
- (or (not (symbolp var))
- (special-variable-p var)
- (memq var byte-compile-bound-variables)
- (memq var '(nil t))
- (keywordp var)))
-
(defun byte-compile-bind (var init-lexenv)
"Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'.
INIT-LEXENV should be a lexical-environment alist describing the
@@ -4690,7 +4683,7 @@ Return non-nil if the TOS value was popped."
;; The mix of lexical and dynamic bindings mean that we may have to
;; juggle things on the stack, to move them to TOS for
;; dynamic binding.
- (if (and lexical-binding (not (byte-compile-not-lexical-var-p var)))
+ (if (not (cconv--not-lexical-var-p var byte-compile-bound-variables))
;; VAR is a simple stack-allocated lexical variable.
(progn (push (assq var init-lexenv)
byte-compile--lexical-environment)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 23d0f121948..f3431db4156 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -64,20 +64,12 @@
;;
;;; Code:
-;; PROBLEM cases found during conversion to lexical binding.
-;; We should try and detect and warn about those cases, even
-;; for lexical-binding==nil to help prepare the migration.
-;; - Uses of run-hooks, and friends.
-;; - Cases where we want to apply the same code to different vars depending on
-;; some test. These sometimes use a (let ((foo (if bar 'a 'b)))
-;; ... (symbol-value foo) ... (set foo ...)).
-
;; TODO: (not just for cconv but also for the lexbind changes in general)
;; - let (e)debug find the value of lexical variables from the stack.
;; - make eval-region do the eval-sexp-add-defvars dance.
;; - byte-optimize-form should be applied before cconv.
;; OTOH, the warnings emitted by cconv-analyze need to come before optimize
-;; since afterwards they can because obnoxious (warnings about an "unused
+;; since afterwards they can become obnoxious (warnings about an "unused
;; variable" should not be emitted when the variable use has simply been
;; optimized away).
;; - let macros specify that some let-bindings come from the same source,
@@ -87,33 +79,9 @@
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities.
;; - new byte codes for unwind-protect so that closures aren't needed at all.
-;; - a reference to a var that is known statically to always hold a constant
-;; should be turned into a byte-constant rather than a byte-stack-ref.
-;; Hmm... right, that's called constant propagation and could be done here,
-;; but when that constant is a function, we have to be careful to make sure
-;; the bytecomp only compiles it once.
;; - Since we know here when a variable is not mutated, we could pass that
;; info to the byte-compiler, e.g. by using a new `immutable-let'.
;; - call known non-escaping functions with `goto' rather than `call'.
-;; - optimize mapc to a dolist loop.
-
-;; (defmacro dlet (binders &rest body)
-;; ;; Works in both lexical and non-lexical mode.
-;; (declare (indent 1) (debug let))
-;; `(progn
-;; ,@(mapcar (lambda (binder)
-;; `(defvar ,(if (consp binder) (car binder) binder)))
-;; binders)
-;; (let ,binders ,@body)))
-
-;; (defmacro llet (binders &rest body)
-;; ;; Only works in lexical-binding mode.
-;; `(funcall
-;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
-;; binders)
-;; ,@body)
-;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
-;; binders)))
(eval-when-compile (require 'cl-lib))
@@ -142,13 +110,19 @@ is less than this number.")
;; interactive forms.
(make-hash-table :test #'eq :weakness 'key))
+(defvar cconv--dynbound-variables nil
+ "List of variables known to be dynamically bound.")
+
;;;###autoload
-(defun cconv-closure-convert (form)
+(defun cconv-closure-convert (form &optional dynbound-vars)
"Main entry point for closure conversion.
FORM is a piece of Elisp code after macroexpansion.
+DYNBOUND-VARS is a list of symbols that should be considered as
+using dynamic scoping.
Returns a form where all lambdas don't have any free variables."
- (let ((cconv-freevars-alist '())
+ (let ((cconv--dynbound-variables dynbound-vars)
+ (cconv-freevars-alist '())
(cconv-var-classification '()))
;; Analyze form - fill these variables with new information.
(cconv-analyze-form form '())
@@ -156,8 +130,6 @@ Returns a form where all lambdas don't have any free variables."
(prog1 (cconv-convert form nil nil) ; Env initially empty.
(cl-assert (null cconv-freevars-alist)))))
-(defconst cconv--dummy-var (make-symbol "ignored"))
-
(defun cconv--set-diff (s1 s2)
"Return elements of set S1 that are not in set S2."
(let ((res '()))
@@ -262,9 +234,7 @@ Returns a form where all lambdas don't have any free variables."
;; it is often non-trivial for the programmer to avoid such
;; unused vars.
(not (intern-soft var))
- (eq ?_ (aref (symbol-name var) 0))
- ;; As a special exception, ignore "ignored".
- (eq var 'ignored))
+ (eq ?_ (aref (symbol-name var) 0)))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
varkind (bare-symbol var)
@@ -342,7 +312,7 @@ EXTEND is a list of variables which might need to be accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear."
(cl-assert (not (delq nil (mapcar (lambda (mapping)
- (if (eq (cadr mapping) 'apply-partially)
+ (if (eq (cadr mapping) #'apply-partially)
(cconv--set-diff (cdr (cddr mapping))
extend)))
env))))
@@ -634,6 +604,12 @@ places where they originally did not directly appear."
(defvar byte-compile-lexical-variables)
+(defun cconv--not-lexical-var-p (var dynbounds)
+ (or (not lexical-binding)
+ (not (symbolp var))
+ (special-variable-p var)
+ (memq var dynbounds)))
+
(defun cconv--analyze-use (vardata form varkind)
"Analyze the use of a variable.
VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
@@ -677,7 +653,7 @@ FORM is the parent form that binds this var."
;; outside of it.
(envcopy
(mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
- (byte-compile-bound-variables byte-compile-bound-variables)
+ (cconv--dynbound-variables cconv--dynbound-variables)
(newenv envcopy))
;; Push it before recursing, so cconv-freevars-alist contains entries in
;; the order they'll be used by closure-convert-rec.
@@ -685,7 +661,7 @@ FORM is the parent form that binds this var."
(when lexical-binding
(dolist (arg args)
(cond
- ((byte-compile-not-lexical-var-p arg)
+ ((cconv--not-lexical-var-p arg cconv--dynbound-variables)
(byte-compile-warn-x
arg
"Lexical argument shadows the dynamic variable %S"
@@ -715,6 +691,8 @@ FORM is the parent form that binds this var."
(setf (nth 3 (car env)) t))
(setq env (cdr env) envcopy (cdr envcopy))))))
+(defvar cconv--dynbindings)
+
(defun cconv-analyze-form (form env)
"Find mutated variables and variables captured by closure.
Analyze lambdas if they are suitable for lambda lifting.
@@ -730,7 +708,7 @@ This function does not return anything but instead fills the
(let ((orig-env env)
(newvars nil)
(var nil)
- (byte-compile-bound-variables byte-compile-bound-variables)
+ (cconv--dynbound-variables cconv--dynbound-variables)
(value nil))
(dolist (binder binders)
(if (not (consp binder))
@@ -743,7 +721,9 @@ This function does not return anything but instead fills the
(cconv-analyze-form value (if (eq letsym 'let*) env orig-env)))
- (unless (or (byte-compile-not-lexical-var-p var) (not lexical-binding))
+ (if (cconv--not-lexical-var-p var cconv--dynbound-variables)
+ (when (boundp 'cconv--dynbindings)
+ (push var cconv--dynbindings))
(cl-pushnew var byte-compile-lexical-variables)
(let ((varstruct (list var nil nil nil nil)))
(push (cons binder (cdr varstruct)) newvars)
@@ -797,7 +777,8 @@ This function does not return anything but instead fills the
(cconv-analyze-form protected-form env)
(unless lexical-binding
(setq var nil))
- (when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
+ (when (and var (symbolp var)
+ (cconv--not-lexical-var-p var cconv--dynbound-variables))
(byte-compile-warn-x
var "Lexical variable shadows the dynamic variable %S" var))
(let* ((varstruct (list var nil nil nil nil)))
@@ -813,9 +794,9 @@ This function does not return anything but instead fills the
(cconv-analyze-form form env)
(cconv--analyze-function () body env form))
- (`(defvar ,var) (push var byte-compile-bound-variables))
+ (`(defvar ,var) (push var cconv--dynbound-variables))
(`(,(or 'defconst 'defvar) ,var ,value . ,_)
- (push var byte-compile-bound-variables)
+ (push var cconv--dynbound-variables)
(cconv-analyze-form value env))
(`(,(or 'funcall 'apply) ,fun . ,args)
@@ -847,5 +828,78 @@ This function does not return anything but instead fills the
(setf (nth 1 dv) t))))))
(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1")
+(defun cconv-fv (form lexvars dynvars)
+ "Return the list of free variables in FORM.
+LEXVARS is the list of statically scoped vars in the context
+and DYNVARS is the list of dynamically scoped vars in the context.
+Returns a pair (LEXV . DYNV) of those vars actually used by FORM."
+ (let* ((fun
+ ;; Wrap FORM into a function because the analysis code we
+ ;; have only computes freevars for functions.
+ ;; In practice FORM is always already of the form
+ ;; #'(lambda ...), so optimize for this case.
+ (if (and (eq 'function (car-safe form))
+ (eq 'lambda (car-safe (cadr form)))
+ ;; To get correct results, FUN needs to be a "simple lambda"
+ ;; without nested forms that aren't part of the body. :-(
+ (not (assq 'interactive (cadr form)))
+ (not (assq ':documentation (cadr form))))
+ form
+ `#'(lambda () ,form)))
+ (analysis-env (mapcar (lambda (v) (list v nil nil nil nil)) lexvars))
+ (cconv--dynbound-variables dynvars)
+ (byte-compile-lexical-variables nil)
+ (cconv--dynbindings nil)
+ (cconv-freevars-alist '())
+ (cconv-var-classification '()))
+ (let* ((body (cddr (cadr fun))))
+ ;; Analyze form - fill these variables with new information.
+ (cconv-analyze-form fun analysis-env)
+ (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
+ (unless (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist))
+ (message "BOOH!\n%S\n%S"
+ body (caar cconv-freevars-alist)))
+ (cl-assert (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist)))
+ (let ((fvs (nreverse (cdar cconv-freevars-alist)))
+ (dyns (delq nil (mapcar (lambda (var) (car (memq var dynvars)))
+ (delete-dups cconv--dynbindings)))))
+ (cons fvs dyns)))))
+
+(defun cconv-make-interpreted-closure (fun env)
+ (cl-assert (eq (car-safe fun) 'lambda))
+ (let ((lexvars (delq nil (mapcar #'car-safe env))))
+ (if (null lexvars)
+ ;; The lexical environment is empty, so there's no need to
+ ;; look for free variables.
+ `(closure ,env . ,(cdr fun))
+ ;; We could try and cache the result of the macroexpansion and
+ ;; `cconv-fv' analysis. Not sure it's worth the trouble.
+ (let* ((form `#',fun)
+ (expanded-form
+ (let ((lexical-binding t) ;; Tell macros which dialect is in use.
+ ;; Make the macro aware of any defvar declarations in scope.
+ (macroexp--dynvars
+ (if macroexp--dynvars
+ (append env macroexp--dynvars) env)))
+ (macroexpand-all form macroexpand-all-environment)))
+ ;; Since we macroexpanded the body, we may as well use that.
+ (expanded-fun-cdr
+ (pcase expanded-form
+ (`#'(lambda . ,cdr) cdr)
+ (_ (cdr fun))))
+
+ (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
+ (fvs (cconv-fv expanded-form lexvars dynvars))
+ (newenv (nconc (mapcar (lambda (fv) (assq fv env)) (car fvs))
+ (cdr fvs))))
+ ;; Never return a nil env, since nil means to use the dynbind
+ ;; dialect of ELisp.
+ `(closure ,(or newenv '(t)) . ,expanded-fun-cdr)))))
+
+
(provide 'cconv)
;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 7c7f027d777..66b214554ee 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -615,12 +615,12 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
,(funcall setter
`(cl--set-getf ,getter ,k ,val))
,val)))))))))
- (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (let ((val-tail (cdr (plist-member plist tag))))
(if val-tail (car val-tail) def)))
;;;###autoload
(defun cl--set-getf (plist tag val)
- (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (let ((val-tail (cdr (plist-member plist tag))))
(if val-tail (progn (setcar val-tail val) plist)
(cl-list* tag val plist))))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 8cff06a383a..1338ae6e139 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -96,7 +96,7 @@ Integer values are handled in the `range' slot.")
`comp-common-supertype'.")
(subtype-p-mem (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
-`comp-subtype-p-mem'.")
+`comp-cstr-ctxt-subtype-p-mem'.")
(union-1-mem-no-range (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
`comp-cstr-union-1'.")
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 5a05fe4854b..863e895efdb 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -57,7 +57,7 @@
:safe #'integerp
:version "28.1")
-(defcustom native-comp-debug (if (eq 'windows-nt system-type) 1 0)
+(defcustom native-comp-debug 0
"Debug level for native compilation, a number between 0 and 3.
This is intended for debugging the compiler itself.
0 no debug output.
@@ -67,7 +67,7 @@ This is intended for debugging the compiler itself.
passes and libgccjit log file."
:type 'natnum
:safe #'natnump
- :version "28.1")
+ :version "29.1")
(defcustom native-comp-verbose 0
"Compiler verbosity for native compilation, a number between 0 and 3.
@@ -2057,9 +2057,10 @@ and the annotation emission."
"Lexically-scoped FUNCTION."
(let ((args (comp-func-l-args function)))
(cons (make-comp-mvar :constant (comp-args-base-min args))
- (make-comp-mvar :constant (if (comp-args-p args)
- (comp-args-max args)
- 'many)))))
+ (make-comp-mvar :constant (cond
+ ((comp-args-p args) (comp-args-max args))
+ ((comp-nargs-rest args) 'many)
+ (t (comp-nargs-nonrest args)))))))
(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d))
"Dynamically scoped FUNCTION."
@@ -3689,8 +3690,7 @@ Prepare every function for final compilation and drive the C back-end."
(print-circle t)
(print-escape-multibyte t)
(expr `((require 'comp)
- (setf comp-no-spawn t
- native-comp-verbose ,native-comp-verbose
+ (setf native-comp-verbose ,native-comp-verbose
comp-libgccjit-reproducer ,comp-libgccjit-reproducer
comp-ctxt ,comp-ctxt
native-comp-eln-load-path ',native-comp-eln-load-path
@@ -3716,7 +3716,8 @@ Prepare every function for final compilation and drive the C back-end."
(if (zerop
(call-process (expand-file-name invocation-name
invocation-directory)
- nil t t "--batch" "-l" temp-file))
+ nil t t "-no-comp-spawn" "--batch" "-l"
+ temp-file))
(progn
(delete-file temp-file)
output)
@@ -3948,7 +3949,6 @@ display a message."
source-file (comp-el-to-eln-filename source-file))))
do (let* ((expr `((require 'comp)
(setq comp-async-compilation t
- comp-no-spawn t
warning-fill-column most-positive-fixnum)
,(let ((set (list 'setq)))
(dolist (var '(comp-file-preloaded-p
@@ -4005,7 +4005,8 @@ display a message."
:command (list
(expand-file-name invocation-name
invocation-directory)
- "--batch" "-l" temp-file)
+ "-no-comp-spawn" "--batch" "-l"
+ temp-file)
:sentinel
(lambda (process _event)
(run-hook-with-args
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 6d4b29b552c..8e61797315f 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -201,7 +201,7 @@ This function is modeled after `minibuffer-complete-and-exit'."
(if doexit (exit-minibuffer))))
(defun crm--choose-completion-string (choice buffer base-position
- &rest ignored)
+ &rest _ignored)
"Completion string chooser for `completing-read-multiple'.
This is called from `choose-completion-string-functions'.
It replaces the string that is currently being completed, without
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 6fd89a690dc..e1801c45b75 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -55,21 +55,24 @@
:group 'extensions)
(defcustom eldoc-idle-delay 0.50
- "Number of seconds of idle time to wait before printing.
+ "Number of seconds of idle time to wait before displaying documentation.
If user input arrives before this interval of time has elapsed after the
-last input, no documentation will be printed.
+last input event, no documentation will be displayed.
-If this variable is set to 0, no idle time is required."
+If this variable is set to 0, display the documentation without any delay."
:type 'number)
(defcustom eldoc-print-after-edit nil
- "If non-nil, eldoc info is only shown when editing.
+ "If non-nil, eldoc info is only shown after editing commands.
Changing the value requires toggling `eldoc-mode'."
:type 'boolean)
(defcustom eldoc-echo-area-display-truncation-message t
"If non-nil, provide verbose help when a message has been truncated.
-If nil, truncated messages will just have \"...\" appended."
+When this is non-nil, and the documentation string was truncated to
+fit in the echo-area, the documentation will be followed by an
+explanation of how to display the full documentation text.
+If nil, truncated messages will just have \"...\" to indicate truncation."
:type 'boolean
:version "28.1")
@@ -93,22 +96,24 @@ Note that this variable has no effect, unless
(defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
"Allow long ElDoc doc strings to resize echo area display.
-If value is t, never attempt to truncate messages, even if the
-echo area must be resized to fit.
+If the value is t, never attempt to truncate messages, even if the
+echo area must be resized to fit. In that case, Emacs will resize
+the mini-window up to the limit set by `max-mini-window-height'.
If the value is a positive number, it is used to calculate a
-number of logical lines of documentation that ElDoc is allowed to
-put in the echo area. If a positive integer, the number is used
-directly, while a float specifies the number of lines as a
-proportion of the echo area frame's height.
+number of screen lines of documentation that ElDoc is allowed to
+put in the echo area. A positive integer specifies the maximum
+number of lines directly, while a floating-point number specifies
+the number of screen lines as a fraction of the echo area frame's
+height.
-If value is the symbol `truncate-sym-name-if-fit', the part of
+If the value is the symbol `truncate-sym-name-if-fit', the part of
the doc string that represents a symbol's name may be truncated
if it will enable the rest of the doc string to fit on a single
line, without resizing the echo area.
-If value is nil, a doc string is always truncated to fit in a
-single line of display in the echo area.
+If the value is nil, a doc string is always truncated to fit in a
+single screen line of echo-area display.
Any resizing of the echo area additionally respects
`max-mini-window-height'."
@@ -121,12 +126,12 @@ Any resizing of the echo area additionally respects
line" truncate-sym-name-if-fit)))
(defcustom eldoc-echo-area-prefer-doc-buffer nil
- "Prefer ElDoc's documentation buffer if it is showing in some frame.
+ "Prefer ElDoc's documentation buffer if it is displayed in some window.
If this variable's value is t, ElDoc will skip showing
documentation in the echo area if the dedicated documentation
-buffer (given by `eldoc-doc-buffer') is being displayed in some
-window. If the value is the symbol `maybe', then the echo area
-is only skipped if the documentation doesn't fit there."
+buffer (displayed by `eldoc-doc-buffer') is already displayed in
+some window. If the value is the symbol `maybe', then the echo area
+is only skipped if the documentation needs to be truncated there."
:type 'boolean)
(defface eldoc-highlight-function-argument
@@ -287,8 +292,10 @@ reflect the change."
(put 'eldoc-mode-line-string 'risky-local-variable t)
(defun eldoc-minibuffer-message (format-string &rest args)
- "Display messages in the mode-line when in the minibuffer.
-Otherwise work like `message'."
+ "Display message specified by FORMAT-STRING and ARGS on the mode-line as needed.
+This function displays the message produced by formatting ARGS
+with FORMAT-STRING on the mode line when the current buffer is a minibuffer.
+Otherwise, it displays the message like `message' would."
(if (minibufferp)
(progn
(add-hook 'minibuffer-exit-hook
@@ -632,8 +639,8 @@ If INTERACTIVE is t, also display the buffer."
(when interactive (eldoc-doc-buffer t)))
(defun eldoc-documentation-default ()
- "Show first doc string for item at point.
-Default value for `eldoc-documentation-strategy'."
+ "Show the first non-nil documentation string for item at point.
+This is the default value for `eldoc-documentation-strategy'."
(run-hook-with-args-until-success 'eldoc-documentation-functions
(eldoc--make-callback :patient)))
@@ -651,18 +658,18 @@ else wait for all doc strings."
t)
(defun eldoc-documentation-compose ()
- "Show multiple doc strings at once after waiting for all.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show multiple documentation strings together after waiting for all of them.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-compose-1 nil))
(defun eldoc-documentation-compose-eagerly ()
- "Show multiple doc strings at once as soon as possible.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show multiple documentation strings one by one as soon as possible.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-compose-1 t))
(defun eldoc-documentation-enthusiast ()
- "Show most important doc string produced so far.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show most important documentation string produced so far.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(run-hook-wrapped 'eldoc-documentation-functions
(lambda (f)
(let* ((callback (eldoc--make-callback :enthusiast))
@@ -692,40 +699,42 @@ Meant as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-strategy-defcustom eldoc-documentation-strategy
eldoc-documentation-function
#'eldoc-documentation-default
- "How to collect and organize results of `eldoc-documentation-functions'.
-
-This variable controls how `eldoc-documentation-functions', which
-specifies the sources of documentation, is queried and how its
-results are organized before being displayed to the user. The
-following values are allowed:
-
-- `eldoc-documentation-default': calls functions in the special
- hook in order until one is found that produces a doc string
- value. Display only that value;
-
-- `eldoc-documentation-compose': calls all functions in the
- special hook and displays all of the resulting doc strings
- together. Wait for all strings to be ready, and preserve their
- relative order as specified by the order of functions in the hook;
-
-- `eldoc-documentation-compose-eagerly': calls all functions in
- the special hook and displays as many of the resulting doc
- strings as possible, as soon as possible. Preserves the
- relative order of doc strings;
-
-- `eldoc-documentation-enthusiast': calls all functions in the
- special hook and displays only the most important resulting
- docstring one at any given time. A function appearing first in
- the special hook is considered more important.
-
-This variable can also be set to a function of no args that
-returns something other than a string or nil and allows for some
+ "How to collect and display results of `eldoc-documentation-functions'.
+
+This variable controls how to call the functions in the special hook
+`eldoc-documentation-functions', and how to organize their results
+for display to the user. The functions in `eldoc-documentation-functions'
+are the source of documentation, and act as back-end for ElDoc.
+
+The following values are supported:
+
+- `eldoc-documentation-default': Call functions in the special
+ hook in order, until one of them returns a non-nil string
+ value. Display only that string.
+
+- `eldoc-documentation-compose': Call all the functions in the
+ special hook and display all of the resulting strings together,
+ after all of the functions were called, and in the order of the
+ functions in the hook.
+
+- `eldoc-documentation-compose-eagerly': Call all the functions in
+ the special hook, and display each non-nil string as soon as it
+ is returned by a function, before calling the next function.
+
+- `eldoc-documentation-enthusiast': Call all the functions in the
+ special hook, and display only the most important resulting
+ string at any given time. A function appearing first in
+ the special hook is considered more important than those which
+ appear after it.
+
+This variable can also be set to a function of no arguments that
+returns something other than a string or nil, and allows for some
or all of the special hook `eldoc-documentation-functions' to be
run. In that case, the strategy function should follow that
-other variable's protocol closely and endeavor to display the
-resulting doc strings itself.
+other variable's protocol closely and display the resulting doc
+strings itself.
-For backward compatibility to the \"old\" protocol, this variable
+For backward compatibility with the \"old\" protocol, this variable
can also be set to a function that returns nil or a doc string,
depending whether or not there is documentation to display at
all."
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index a96fa19a3ff..11251d7a963 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -445,16 +445,17 @@ The return value is the last VAL in the list.
,v))))))))))
(gv-define-expander plist-get
- (lambda (do plist prop)
+ (lambda (do plist prop &optional predicate)
(macroexp-let2 macroexp-copyable-p key prop
(gv-letplace (getter setter) plist
- (macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
+ (macroexp-let2 nil p `(cdr (plist-member ,getter ,key ,predicate))
(funcall do
`(car ,p)
(lambda (val)
`(if ,p
(setcar ,p ,val)
- ,(funcall setter `(cons ,key (cons ,val ,getter)))))))))))
+ ,(funcall setter
+ `(cons ,key (cons ,val ,getter)))))))))))
;;; Some occasionally handy extensions.
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index 6c95d86b47e..fb5d518b22d 100644
--- a/lisp/emacs-lisp/hierarchy.el
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -71,7 +71,8 @@
(:conc-name hierarchy--))
(roots (list)) ; list of the hierarchy roots (no parent)
(parents (make-hash-table :test 'equal)) ; map an item to its parent
- (children (make-hash-table :test 'equal)) ; map an item to its childre
+ (children (make-hash-table :test 'equal)) ; map an item to its children
+ (delaying-parents (make-hash-table :test 'equal)) ; map an item to its childrenfn
;; cache containing the set of all items in the hierarchy
(seen-items (make-hash-table :test 'equal))) ; map an item to t
@@ -133,7 +134,8 @@ keys are :key and :test."
"Create a hierarchy and return it."
(hierarchy--make))
-(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn)
+(defun hierarchy-add-tree (hierarchy item parentfn
+ &optional childrenfn acceptfn delay-children-p)
"In HIERARCHY, add ITEM.
PARENTFN is either nil or a function defining the child-to-parent
@@ -151,27 +153,39 @@ CHILDRENFN are expected to be coherent with each other.
ACCEPTFN is a function returning non-nil if its parameter (any object)
should be an item of the hierarchy. By default, ACCEPTFN returns non-nil
-if its parameter is non-nil."
+if its parameter is non-nil.
+
+DELAY-CHILDREN-P is a predicate determining whether the children that would
+normally be processed by CHILDRENFN should, instead, have their processing be
+delayed and stored to be processed by CHILDRENFN when the child is selected
+during use of the hierarchy."
(unless (hierarchy-has-item hierarchy item)
(let ((acceptfn (or acceptfn #'identity)))
(hierarchy--seen-items-add hierarchy item)
(let ((parent (and parentfn (funcall parentfn item))))
(when (funcall acceptfn parent)
(hierarchy--add-relation hierarchy item parent acceptfn)
- (hierarchy-add-tree hierarchy parent parentfn childrenfn)))
- (let ((children (and childrenfn (funcall childrenfn item))))
- (mapc (lambda (child)
- (when (funcall acceptfn child)
- (hierarchy--add-relation hierarchy child item acceptfn)
- (hierarchy-add-tree hierarchy child parentfn childrenfn)))
- children)))))
-
-(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn)
+ (hierarchy-add-tree hierarchy parent
+ parentfn (if delay-children-p nil childrenfn))))
+ (if (and childrenfn delay-children-p)
+ (map-put! (hierarchy--delaying-parents hierarchy) item childrenfn)
+ (let ((children (and childrenfn (funcall childrenfn item))))
+ (map-put! (hierarchy--delaying-parents hierarchy) item nil)
+ (mapc (lambda (child)
+ (when (funcall acceptfn child)
+ (hierarchy--add-relation hierarchy child item acceptfn)
+ (hierarchy-add-tree hierarchy child parentfn childrenfn)))
+ children))))))
+
+(defun hierarchy-add-trees (hierarchy items parentfn
+ &optional childrenfn acceptfn delay-children-p)
"Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS.
-PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'."
+PARENTFN, CHILDRENFN, ACCEPTFN, and DELAY-CHILDREN-P have the same meaning as in
+`hierarchy-add'."
(seq-map (lambda (item)
- (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn))
+ (hierarchy-add-tree hierarchy item parentfn
+ childrenfn acceptfn delay-children-p))
items))
(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
@@ -541,6 +555,30 @@ nil. The buffer is returned."
buffer))
(declare-function widget-convert "wid-edit")
+(defun hierarchy--create-delayed-tree-widget (elem labelfn indent childrenfn)
+ "Return a list of tree-widgets for the children generated.
+
+ELEM is the element of the hierarchy passed from
+`hierarchy-convert-to-tree-widget'; it and the CHILDRENFN are used to generate
+the children of the element dynamically.
+
+LABELFN is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+INDENT is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+CHILDRENFN is the function used to discover the children of ELEM."
+ (lambda (_widget)
+ (mapcar
+ (lambda (item)
+ (widget-convert
+ 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn item indent)
+ :expander (hierarchy--create-delayed-tree-widget
+ item
+ labelfn
+ (1+ indent)
+ childrenfn)))
+ (funcall childrenfn elem))))
(defun hierarchy-convert-to-tree-widget (hierarchy labelfn)
"Return a tree-widget for HIERARCHY.
@@ -550,10 +588,21 @@ node label."
(require 'wid-edit)
(require 'tree-widget)
(hierarchy-map-tree (lambda (item indent children)
- (widget-convert
- 'tree-widget
- :tag (hierarchy-labelfn-to-string labelfn item indent)
- :args children))
+ (let ((childrenfn (map-elt
+ (hierarchy--delaying-parents hierarchy)
+ item)))
+ (apply
+ #'widget-convert
+ (list 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn item indent)
+ (if childrenfn :expander :args)
+ (if childrenfn
+ (hierarchy--create-delayed-tree-widget
+ item
+ labelfn
+ (1+ indent)
+ childrenfn)
+ children)))))
hierarchy))
(defun hierarchy-tree-display (hierarchy labelfn &optional buffer)
diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el
index a08ac7463ce..86c44830308 100644
--- a/lisp/emacs-lisp/icons.el
+++ b/lisp/emacs-lisp/icons.el
@@ -196,18 +196,21 @@ present if the icon is represented by an image."
(image-supported-file-p file)
(propertize
" " 'display
- (if-let ((height (plist-get keywords :height)))
- (create-image file
- nil nil
- :height (if (eq height 'line)
+ (let ((props
+ (append
+ (if-let ((height (plist-get keywords :height)))
+ (list :height (if (eq height 'line)
(window-default-line-height)
- height)
- :scale 1
- :rotation (or (plist-get keywords :rotation) 0)
- :ascent (if (plist-member keywords :ascent)
- (plist-get keywords :ascent)
- 'center))
- (create-image file))))))
+ height)))
+ '(:scale 1)
+ (if-let ((rotation (plist-get keywords :rotation)))
+ (list :rotation rotation))
+ (if-let ((margin (plist-get keywords :margin)))
+ (list :margin margin))
+ (list :ascent (if (plist-member keywords :ascent)
+ (plist-get keywords :ascent)
+ 'center)))))
+ (apply 'create-image file nil nil props))))))
(cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords)
(when-let ((font (and (display-multi-font-p)
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 8c67d7c7a25..8e3b698d372 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -5,7 +5,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, lisp
-;; Version: 3.2.1
+;; Version: 3.3.1
;; Package-Requires: ((emacs "26"))
;; This file is part of GNU Emacs.
@@ -80,48 +80,82 @@ MAP can be an alist, plist, hash-table, or array."
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
,@body))
-(eval-when-compile
- (defmacro map--dispatch (map-var &rest args)
- "Evaluate one of the forms specified by ARGS based on the type of MAP-VAR.
-
-The following keyword types are meaningful: `:list',
-`:hash-table' and `:array'.
-
-An error is thrown if MAP-VAR is neither a list, hash-table nor array.
-
-Returns the result of evaluating the form associated with MAP-VAR's type."
- (declare (debug t) (indent 1))
- `(cond ((listp ,map-var) ,(plist-get args :list))
- ((hash-table-p ,map-var) ,(plist-get args :hash-table))
- ((arrayp ,map-var) ,(plist-get args :array))
- (t (error "Unsupported map type `%S': %S"
- (type-of ,map-var) ,map-var)))))
-
(define-error 'map-not-inplace "Cannot modify map in-place")
(defsubst map--plist-p (list)
+ "Return non-nil if LIST is the start of a nonempty plist map."
(and (consp list) (atom (car list))))
+(defconst map--plist-has-predicate
+ (condition-case nil
+ (with-no-warnings (plist-get () nil #'eq) t)
+ (wrong-number-of-arguments))
+ "Non-nil means `plist-get' & co. accept a predicate in Emacs 29+.
+Note that support for this predicate in map.el is patchy and
+deprecated.")
+
+(defun map--plist-member-1 (plist prop &optional predicate)
+ "Compatibility shim for the PREDICATE argument of `plist-member'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+ (if (or (memq predicate '(nil eq)) (null plist))
+ (plist-member plist prop)
+ (let ((tail plist) found)
+ (while (and (not (setq found (funcall predicate (car tail) prop)))
+ (consp (setq tail (cdr tail)))
+ (consp (setq tail (cdr tail)))))
+ (and tail (not found)
+ (signal 'wrong-type-argument `(plistp ,plist)))
+ tail)))
+
+(defalias 'map--plist-member
+ (if map--plist-has-predicate #'plist-member #'map--plist-member-1)
+ "Compatibility shim for `plist-member' in Emacs 29+.
+\n(fn PLIST PROP &optional PREDICATE)")
+
+(defun map--plist-put-1 (plist prop val &optional predicate)
+ "Compatibility shim for the PREDICATE argument of `plist-put'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+ (if (or (memq predicate '(nil eq)) (null plist))
+ (plist-put plist prop val)
+ (let ((tail plist) prev found)
+ (while (and (consp (cdr tail))
+ (not (setq found (funcall predicate (car tail) prop)))
+ (consp (setq prev tail tail (cddr tail)))))
+ (cond (found (setcar (cdr tail) val))
+ (tail (signal 'wrong-type-argument `(plistp ,plist)))
+ (prev (setcdr (cdr prev) (cons prop (cons val (cddr prev)))))
+ ((setq plist (cons prop (cons val plist)))))
+ plist)))
+
+(defalias 'map--plist-put
+ (if map--plist-has-predicate #'plist-put #'map--plist-put-1)
+ "Compatibility shim for `plist-put' in Emacs 29+.
+\n(fn PLIST PROP VAL &optional PREDICATE)")
+
(cl-defgeneric map-elt (map key &optional default testfn)
"Look up KEY in MAP and return its associated value.
If KEY is not found, return DEFAULT which defaults to nil.
TESTFN is the function to use for comparing keys. It is
deprecated because its default and valid values depend on the MAP
-argument. Generally, alist keys are compared with `equal', plist
-keys with `eq', and hash-table keys with the hash-table's test
+argument, and it was never consistently supported by the map.el
+API. Generally, alist keys are compared with `equal', plist keys
+with `eq', and hash-table keys with the hash-table's test
function.
In the base definition, MAP can be an alist, plist, hash-table,
or array."
(declare
+ ;; `testfn' is deprecated.
+ (advertised-calling-convention (map key &optional default) "27.1")
(gv-expander
(lambda (do)
(gv-letplace (mgetter msetter) `(gv-delay-error ,map)
(macroexp-let2* nil
;; Eval them once and for all in the right order.
((key key) (default default) (testfn testfn))
- (funcall do `(map-elt ,mgetter ,key ,default)
+ (funcall do
+ `(map-elt ,mgetter ,key ,default ,@(and testfn `(,testfn)))
(lambda (v)
(macroexp-let2 nil v v
`(condition-case nil
@@ -132,19 +166,21 @@ or array."
,(funcall msetter
`(map-insert ,mgetter ,key ,v))
;; Always return the value.
- ,v)))))))))
- ;; `testfn' is deprecated.
- (advertised-calling-convention (map key &optional default) "27.1"))
- ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
- (map--dispatch map
- :list (if (map--plist-p map)
- (let ((res (plist-member map key)))
- (if res (cadr res) default))
- (alist-get key map default nil (or testfn #'equal)))
- :hash-table (gethash key map default)
- :array (if (map-contains-key map key)
- (aref map key)
- default)))
+ ,v)))))))))))
+
+(cl-defmethod map-elt ((map list) key &optional default testfn)
+ (if (map--plist-p map)
+ (let ((res (map--plist-member map key testfn)))
+ (if res (cadr res) default))
+ (alist-get key map default nil (or testfn #'equal))))
+
+(cl-defmethod map-elt ((map hash-table) key &optional default _testfn)
+ (gethash key map default))
+
+(cl-defmethod map-elt ((map array) key &optional default _testfn)
+ (if (map-contains-key map key)
+ (aref map key)
+ default))
(defmacro map-put (map key value &optional testfn)
"Associate KEY with VALUE in MAP and return VALUE.
@@ -154,8 +190,12 @@ When MAP is an alist, test equality with TESTFN if non-nil,
otherwise use `equal'.
MAP can be an alist, plist, hash-table, or array."
- (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
- `(setf (map-elt ,map ,key nil ,testfn) ,value))
+ (declare
+ (obsolete "use `map-put!' or `(setf (map-elt ...) ...)' instead." "27.1"))
+ (if testfn
+ `(with-no-warnings
+ (setf (map-elt ,map ,key nil ,testfn) ,value))
+ `(setf (map-elt ,map ,key) ,value)))
(defun map--plist-delete (map key)
(let ((tail map) last)
@@ -338,15 +378,16 @@ The default implementation delegates to `map-length'."
"Return non-nil if and only if MAP contains KEY.
TESTFN is deprecated. Its default depends on MAP.
The default implementation delegates to `map-some'."
+ (declare (advertised-calling-convention (map key) "27.1"))
(unless testfn (setq testfn #'equal))
(map-some (lambda (k _v) (funcall testfn key k)) map))
(cl-defmethod map-contains-key ((map list) key &optional testfn)
"Return non-nil if MAP contains KEY.
If MAP is an alist, TESTFN defaults to `equal'.
-If MAP is a plist, `plist-member' is used instead."
+If MAP is a plist, TESTFN defaults to `eq'."
(if (map--plist-p map)
- (plist-member map key)
+ (map--plist-member map key testfn)
(let ((v '(nil)))
(not (eq v (alist-get key map v nil (or testfn #'equal)))))))
@@ -459,24 +500,30 @@ This operates by modifying MAP in place.
If it cannot do that, it signals a `map-not-inplace' error.
To insert an element without modifying MAP, use `map-insert'."
;; `testfn' only exists for backward compatibility with `map-put'!
- (declare (advertised-calling-convention (map key value) "27.1"))
- ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
- (map--dispatch
- map
- :list
- (progn
- (if (map--plist-p map)
- (plist-put map key value)
- (let ((oldmap map))
- (setf (alist-get key map key nil (or testfn #'equal)) value)
- (unless (eq oldmap map)
- (signal 'map-not-inplace (list oldmap)))))
- ;; Always return the value.
- value)
- :hash-table (puthash key value map)
- ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
- ;; and let `map-insert' grow the array?
- :array (aset map key value)))
+ (declare (advertised-calling-convention (map key value) "27.1")))
+
+(cl-defmethod map-put! ((map list) key value &optional testfn)
+ (if (map--plist-p map)
+ (map--plist-put map key value testfn)
+ (let ((oldmap map))
+ (setf (alist-get key map key nil (or testfn #'equal)) value)
+ (unless (eq oldmap map)
+ (signal 'map-not-inplace (list oldmap)))))
+ ;; Always return the value.
+ value)
+
+(cl-defmethod map-put! ((map hash-table) key value &optional _testfn)
+ (puthash key value map))
+
+(cl-defmethod map-put! ((map array) key value &optional _testfn)
+ ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
+ ;; and let `map-insert' grow the array?
+ (aset map key value))
+
+;; There shouldn't be old source code referring to `map--put', yet we do
+;; need to keep it for backward compatibility with .elc files where the
+;; expansion of `setf' may call this function.
+(define-obsolete-function-alias 'map--put #'map-put! "27.1")
(cl-defgeneric map-insert (map key value)
"Return a new map like MAP except that it associates KEY with VALUE.
@@ -493,11 +540,6 @@ The default implementation defaults to `map-copy' and `map-put!'."
(cons key (cons value map))
(cons (cons key value) map)))
-;; There shouldn't be old source code referring to `map--put', yet we do
-;; need to keep it for backward compatibility with .elc files where the
-;; expansion of `setf' may call this function.
-(define-obsolete-function-alias 'map--put #'map-put! "27.1")
-
(cl-defmethod map-apply (function (map list))
(if (map--plist-p map)
(cl-call-next-method)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 425abfeea5c..977a16a7e19 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -872,8 +872,7 @@ byte-compilation of the new package to fail."
If DEPS is non-nil, also activate its dependencies (unless they
are already activated).
If RELOAD is non-nil, also `load' any files inside the package which
-correspond to previously loaded files (those returned by
-`package--list-loaded-files')."
+correspond to previously loaded files."
(let* ((name (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc)))
(unless pkg-dir
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 897c35b5b19..0f9b60730f3 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -211,6 +211,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(defvar reb-valid-string ""
"String in mode line showing validity of RE.")
+(put 'reb-valid-string 'risky-local-variable t)
(defconst reb-buffer "*RE-Builder*"
"Buffer to use for the RE Builder.")
@@ -308,13 +309,13 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
"Return t if display is capable of displaying colors."
(eq 'color (frame-parameter nil 'display-type)))
-(defsubst reb-lisp-syntax-p ()
+(defun reb-lisp-syntax-p ()
"Return non-nil if RE Builder uses `rx' syntax."
(eq reb-re-syntax 'rx))
-(defmacro reb-target-binding (symbol)
+(defun reb-target-value (symbol)
"Return binding for SYMBOL in the RE Builder target buffer."
- `(with-current-buffer reb-target-buffer ,symbol))
+ (buffer-local-value symbol reb-target-buffer))
(defun reb-initialize-buffer ()
"Initialize the current buffer as a RE Builder buffer."
@@ -440,7 +441,7 @@ provided in the Commentary section of this library."
(interactive)
(reb-update-regexp)
(let ((re (with-output-to-string
- (print (reb-target-binding reb-regexp)))))
+ (print (reb-target-value 'reb-regexp)))))
(setq re (substring re 1 (1- (length re))))
(setq re (string-replace "\n" "\\n" re))
(kill-new re)
@@ -518,12 +519,17 @@ An actual update is only done if the regexp has changed or if the
optional fourth argument FORCE is non-nil."
(let ((prev-valid reb-valid-string)
(new-valid
- (condition-case nil
+ (condition-case err
(progn
(when (or (reb-update-regexp) force)
(reb-do-update))
"")
- (error " *invalid*"))))
+ (error (propertize
+ (format " %s"
+ (if (and (consp (cdr err)) (stringp (cadr err)))
+ (format "%s: %s" (car err) (cadr err))
+ (car err)))
+ 'face 'font-lock-warning-face)))))
(setq reb-valid-string new-valid)
(force-mode-line-update)
@@ -554,7 +560,7 @@ optional fourth argument FORCE is non-nil."
(if reb-subexp-mode
(format " (subexp %s)" (or reb-subexp-displayed "-"))
"")
- (if (not (reb-target-binding case-fold-search))
+ (if (not (reb-target-value 'case-fold-search))
" Case"
"")))
(force-mode-line-update))
@@ -600,7 +606,7 @@ optional fourth argument FORCE is non-nil."
(defun reb-insert-regexp ()
"Insert current RE."
- (let ((re (or (reb-target-binding reb-regexp)
+ (let ((re (or (reb-target-value 'reb-regexp)
(reb-empty-regexp))))
(cond ((eq reb-re-syntax 'read)
(print re (current-buffer)))
@@ -608,7 +614,7 @@ optional fourth argument FORCE is non-nil."
(insert "\n\"" re "\""))
;; For the Lisp syntax we need the "source" of the regexp
((reb-lisp-syntax-p)
- (insert (or (reb-target-binding reb-regexp-src)
+ (insert (or (reb-target-value 'reb-regexp-src)
(reb-empty-regexp)))))))
(defun reb-cook-regexp (re)
@@ -627,9 +633,8 @@ Return t if the (cooked) expression changed."
(prog1
(not (string= oldre re))
(setq reb-regexp re)
- ;; Only update the source re for the lisp formats
- (when (reb-lisp-syntax-p)
- (setq reb-regexp-src re-src)))))))
+ ;; Update the source re for the Lisp formats.
+ (setq reb-regexp-src re-src))))))
;; And now the real core of the whole thing
@@ -644,7 +649,7 @@ Return t if the (cooked) expression changed."
(defun reb-update-overlays (&optional subexp)
"Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
- (let* ((re (reb-target-binding reb-regexp))
+ (let* ((re (reb-target-value 'reb-regexp))
(subexps (reb-count-subexps re))
(matches 0)
(submatches 0)
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index c01f3fd4fec..206c10a7734 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -374,7 +374,7 @@ Optional arg POS is a buffer position where to look for a fake header;
defaults to `point-min'."
(overlays-at (or pos (point-min))))
-(defun tabulated-list-revert (&rest ignored)
+(defun tabulated-list-revert (&rest _ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
(interactive)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 01:24:43 +0000