mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-09 15:50:40 -08:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into feature/igc

Browse source
This commit is contained in:
Pip Cet 2025-05-01 12:59:07 +00:00
commit fc555a3772
330 changed files with 10080 additions and 5191 deletions
Download patch file Download diff file Expand all files Collapse all files

23
lisp/emacs-lisp/cl-generic.el
View file

@ -644,22 +644,24 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
;; FIXME: Try to avoid re-constructing a new function if the old one
;; is still valid (e.g. still empty method cache)?
(gfun (cl--generic-make-function generic)))
(unless (symbol-function sym)
(defalias sym 'dummy)) ;Record definition into load-history.
(cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format
(cl--generic-name generic)
qualifiers specializers))
current-load-list :test #'equal)
(let ((old-adv-cc (get-advertised-calling-convention
(symbol-function sym)))
;; Prevent `defalias' from recording this as the definition site of
;; the generic function.
current-load-list)
(symbol-function sym))))
(when (listp old-adv-cc)
(set-advertised-calling-convention gfun old-adv-cc nil))
;; But do use `defalias', so that it interacts properly with nadvice,
;; e.g. for tracing/debug-on-entry.
(defalias sym gfun)))))
(set-advertised-calling-convention gfun old-adv-cc nil)))
(if (not (symbol-function sym))
;; If this is the first definition, use it as "the definition site of
;; the generic function" since we don't know if a `cl-defgeneric'
;; will follow or not.
(defalias sym gfun)
;; Prevent `defalias' from recording this as the definition site of
;; the generic function. But do use `defalias', so it interacts
;; properly with nadvice, e.g. for ;; tracing/debug-on-entry.
(let (current-load-list)
(defalias sym gfun))))))
(defvar cl--generic-dispatchers (make-hash-table :test #'equal))
@ -1440,6 +1442,7 @@ Used internally for the (major-mode MODE) context specializers."
(cl-call-next-method)))
(cl--generic-prefill-dispatchers 0 oclosure)
(cl--generic-prefill-dispatchers 0 (eql 'x) oclosure integer)
;;; Support for unloading.

4
lisp/emacs-lisp/cl-print.el
View file

@ -518,7 +518,9 @@ BUTTON can also be a buffer position or nil (to mean point)."
(user-error "No ellipsis to expand here")))
(let* ((end (next-single-property-change (point) 'cl-print-ellipsis))
(begin (previous-single-property-change end 'cl-print-ellipsis))
(value (get-text-property begin 'cl-print-ellipsis)))
(value (get-text-property begin 'cl-print-ellipsis))
;; Ensure clicking the button works even in read only buffers.
(inhibit-read-only t))
;; FIXME: Rather than `t' (i.e. reuse the print-length/level unchanged),
;; I think it would make sense to increase the level by 1 and to
;; double the length at each expansion step.

1
lisp/emacs-lisp/comp-run.el
View file

@ -282,6 +282,7 @@ display a message."
(mapcar #'prin1-to-string expr)))
(_ (progn
(with-temp-file temp-file
(insert ";;; -*- lexical-binding: t -*-\n")
(mapc #'insert expr-strings))
(comp-log "\n")
(mapc #'comp-log expr-strings)))

11
lisp/emacs-lisp/eieio-base.el
View file

@ -207,11 +207,12 @@ All slots are unbound, except those initialized with PARAMS."
nobj))
(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
(if (not (stringp (car args)))
(if (not (and eieio-backward-compatibility args
(let ((x (car args))) (or (stringp x) (null x)))))
(cl-call-next-method)
(funcall (if eieio-backward-compatibility #'ignore #'message)
"Obsolete: name passed without :object-name to %S constructor"
class)
(when (eq eieio-backward-compatibility 'warn)
(message "Obsolete: name passed without :object-name to %S constructor"
class))
(apply #'cl-call-next-method class :object-name args)))
;;; eieio-persistent
@ -345,6 +346,8 @@ objects found there."
(object-of-class-p newobj 'eieio-named)
(not (oref newobj object-name))
name)
(when (eq eieio-backward-compatibility 'warn)
(message "Obsolete name slot initialized for %S" newobj))
(oset newobj object-name name))
newobj))))

45
lisp/emacs-lisp/eieio-core.el
View file

@ -63,12 +63,14 @@ default setting for optimization purposes.")
(defvar eieio-optimize-primary-methods-flag t
"Non-nil means to optimize the method dispatch on primary methods.")
(defvar eieio-backward-compatibility t
(defvar eieio-backward-compatibility 'warn
"If nil, drop support for some behaviors of older versions of EIEIO.
Currently under control of this var:
- Define every class as a var whose value is the class symbol.
- Define <class>-child-p and <class>-list-p predicates.
- Allow object names in constructors.")
- Allow object names in constructors.
When `warn', also emit warnings at run-time when code uses those
deprecated features.")
(define-obsolete-variable-alias 'eieio-unbound 'eieio--unbound "28.1")
(defvar eieio--unbound (make-symbol "eieio--unbound")
@ -208,9 +210,7 @@ It creates an autoload function for CNAME's constructor."
;; turn this into a usable self-pointing symbol
(when eieio-backward-compatibility
(set cname cname)
(make-obsolete-variable cname (format "\
use '%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
(make-obsolete-variable cname (format "use '%s instead" cname) "25.1"))
(when (memq nil parents)
;; If some parents aren't yet fully defined, just ignore them for now.
@ -361,6 +361,8 @@ See `defclass' for more information."
(internal--format-docstring-line
"Test OBJ to see if it a list of objects which are a child of type `%s'."
cname))
(when (eq eieio-backward-compatibility 'warn)
(message "Use of obsolete function %S" csym))
(when (listp obj)
(let ((ans t)) ;; nil is valid
;; Loop over all the elements of the input list, test
@ -740,18 +742,19 @@ Argument FN is the function calling this verifier."
;;; Get/Set slots in an object.
(eval-and-compile
(defun eieio--check-slot-name (exp _obj slot &rest _)
(pcase slot
((and (or `',name (and name (pred keywordp)))
(guard (not (eieio--known-slot-name-p name))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only name))
(_ exp))))
(defun eieio-oref (obj slot)
"Return the value in OBJ at SLOT in the object vector."
(declare (compiler-macro
(lambda (exp)
(ignore obj)
(pcase slot
((and (or `',name (and name (pred keywordp)))
(guard (not (eieio--known-slot-name-p name))))
(macroexp-warn-and-return
(format-message "Unknown slot `%S'" name)
exp nil 'compile-only name))
(_ exp))))
(declare (compiler-macro eieio--check-slot-name)
;; FIXME: Make it a gv-expander such that the hash-table lookup is
;; only performed once when used in `push' and friends?
(gv-setter eieio-oset))
@ -822,6 +825,7 @@ Fills in CLASS's SLOT with its default value."
(defun eieio-oset (obj slot value)
"Do the work for the macro `oset'.
Fills in OBJ's SLOT with VALUE."
(declare (compiler-macro eieio--check-slot-name))
(cl-check-type slot symbol)
(cond
((cl-typep obj '(or eieio-object cl-structure-object))
@ -909,12 +913,15 @@ reverse-lookup that name, and recurse with the associated slot value."
(let* ((fsi (gethash slot (cl--class-index-table class))))
(if (integerp fsi)
fsi
(let ((fn (eieio--initarg-to-attribute class slot)))
(if fn
(when eieio-backward-compatibility
(let ((fn (eieio--initarg-to-attribute class slot)))
(when fn
(when (eq eieio-backward-compatibility 'warn)
(message "Accessing slot `%S' via obsolete initarg name `%S'"
fn slot))
;; Accessing a slot via its :initarg is accepted by EIEIO
;; (but not CLOS) but is a bad idea (for one: it's slower).
(eieio--slot-name-index class fn)
nil)))))
(eieio--slot-name-index class fn)))))))
(defun eieio--class-slot-name-index (class slot)
"In CLASS find the index of the named SLOT.

1
lisp/emacs-lisp/eieio-custom.el
View file

@ -31,6 +31,7 @@
;; `:custom'.
(require 'eieio)
(require 'eieio-base) ;; For `eieio-named's slot.
(require 'widget)
(require 'wid-edit)

52
lisp/emacs-lisp/eieio.el
View file

@ -216,6 +216,9 @@ and reference them using the function `class-option'."
"Retrieve the class slot `%S' from a class `%S'."
sname name)
"\nThis method is obsolete.")
(when (eq eieio-backward-compatibility 'warn)
(message "Use of obsolete method %S on %S"
',acces '(subclass ,name)))
(if (slot-boundp this ',sname)
(eieio-oref-default this ',sname)))
accessors)))
@ -293,18 +296,21 @@ and reference them using the function `class-option'."
(apply #'make-instance ',name slots))))))
(defun eieio--constructor-macro (whole &rest slots)
;; When `eieio-backward-compatibility' is removed, we should
;; remove this compiler-macro, until then, it's best to emit a compile-time
;; warning even if `eieio-backward-compatibility' is nil, I think.
(if (or (null slots) (keywordp (car slots))
;; Detect the second pass!
(eq 'identity (car-safe (car slots))))
whole
(macroexp-warn-and-return
(format "Obsolete name arg %S to constructor %S"
(format "Obsolete name argument %S to constructor %S"
(car slots) (car whole))
;; Keep the name arg, for backward compatibility,
;; but hide it so we don't trigger indefinitely.
`(,(car whole) (identity ,(car slots))
,@(cdr slots))
nil nil (car slots))))
'(obsolete eieio-constructor-name-arg) nil (car slots))))
;;; Get/Set slots in an object.
;;
@ -405,7 +411,7 @@ contents of field NAME is matched against PAT, or they can be of
(cl-defgeneric eieio-object-name-string (obj)
"Return a string which is OBJ's name."
(or (gethash obj eieio--object-names)
(format "%s-%x" (eieio-object-class obj) (sxhash-eq obj))))
(format "%x" (sxhash-eq obj))))
(define-obsolete-function-alias
'object-name-string #'eieio-object-name-string "24.4")
@ -554,6 +560,7 @@ after they are created."
Setting a slot's value makes it bound. Calling `slot-makeunbound' will
make a slot unbound.
OBJECT can be an instance or a class."
(declare (compiler-macro eieio--check-slot-name))
;; Skip typechecking while retrieving this value.
(let ((eieio-skip-typecheck t))
;; Return nil if the magic symbol is in there.
@ -700,6 +707,23 @@ for each slot. For example:
(make-instance \\='foo :slot1 value1 :slotN valueN)")
(put 'make-instance 'compiler-macro
;; When `eieio-backward-compatibility' is removed, we should
;; remove this compiler-macro, until then, it's best to emit a compile-time
;; warning even if `eieio-backward-compatibility' is nil, I think.
(lambda (whole class &rest slots)
(if (or (null slots) (keywordp (car slots))
;; Detect the second pass!
(eq 'identity (car-safe (car slots))))
whole
(macroexp-warn-and-return
(format "Obsolete name arg %S to `make-instance'" (car slots))
;; Keep the name arg, for backward compatibility,
;; but hide it so we don't trigger indefinitely.
`(,(car whole) ,class (identity ,(car slots))
,@(cdr slots))
'(obsolete eieio-constructor-name-arg) nil (car slots)))))
(define-obsolete-function-alias 'constructor #'make-instance "25.1")
(cl-defmethod make-instance
@ -711,12 +735,13 @@ It allocates the vector used to represent an EIEIO object, and then
calls `initialize-instance' on that object."
(let* ((new-object (copy-sequence (eieio--class-default-object-cache
(eieio--class-object class)))))
(if (and slots
(let ((x (car slots)))
(or (stringp x) (null x))))
(funcall (if eieio-backward-compatibility #'ignore #'message)
"Obsolete name %S passed to %S constructor"
(pop slots) class))
(when (and eieio-backward-compatibility slots
(let ((x (car slots)))
(or (stringp x) (null x))))
(let ((name (pop slots)))
(when (eq eieio-backward-compatibility 'warn)
(message "Obsolete name argument %S passed to %S constructor"
name class))))
;; Call the initialize method on the new object with the slots
;; that were passed down to us.
(initialize-instance new-object slots)
@ -820,9 +845,12 @@ first and modify the returned object.")
(cl-defmethod clone ((obj eieio-default-superclass) &rest params)
"Make a copy of OBJ, and then apply PARAMS."
(let ((nobj (copy-sequence obj)))
(if (stringp (car params))
(funcall (if eieio-backward-compatibility #'ignore #'message)
"Obsolete name %S passed to clone" (pop params)))
(when (and eieio-backward-compatibility params
(let ((x (car params)))
(or (stringp x) (null x))))
(let ((name (pop params)))
(when (eq eieio-backward-compatibility 'warn)
(message "Obsolete name argument %S passed to clone" name))))
(if params (shared-initialize nobj params))
nobj))

11
lisp/emacs-lisp/find-func.el
View file

@ -487,11 +487,14 @@ The search is done in the source for library LIBRARY."
;; If the regexp search didn't find the location of
;; the symbol (for example, because it is generated by
;; a macro), try a slightly more expensive search that
;; expands macros until it finds the symbol.
;; expands macros until it finds the symbol. Since
;; macro-expansion involves arbitrary code execution,
;; only attempt it in trusted buffers.
(cons (current-buffer)
(find-function--search-by-expanding-macros
(current-buffer) symbol type
form-matcher-factory))))))))))
(when (trusted-content-p)
(find-function--search-by-expanding-macros
(current-buffer) symbol type
form-matcher-factory)))))))))))
;;;###autoload
(defun find-function-update-type-alist (symbol type variable)

2
lisp/emacs-lisp/macroexp.el
View file

@ -489,7 +489,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
(macroexp--unfold-lambda `(,fn ,eexp . ,eargs)))
(_ `(,fn ,eexp . ,eargs)))))
(`(funcall . ,_) form) ;bug#53227
(`(,func . ,_)
(`(,(and func (pred symbolp)) . ,_)
(let ((handler (function-get func 'compiler-macro)))
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can

23
lisp/emacs-lisp/package-vc.el
View file

@ -219,7 +219,9 @@ asynchronously."
;; FIXME: vc should be extended to allow querying the commit of a
;; directory (as is possible when dealing with git repositories).
;; This should be a fallback option.
(cl-loop with dir = (package-desc-dir pkg-desc)
(cl-loop with dir = (let ((pkg-spec (package-vc--desc->spec pkg-desc)))
(or (plist-get pkg-spec :lisp-dir)
(package-desc-dir pkg-desc)))
for file in (directory-files dir t "\\.el\\'" t)
when (vc-working-revision file) return it
finally return "unknown"))
@ -241,10 +243,10 @@ asynchronously."
(cl-assert (package-vc-p pkg-desc))
(let* ((pkg-spec (package-vc--desc->spec pkg-desc))
(name (symbol-name (package-desc-name pkg-desc)))
(directory (file-name-concat
(directory (expand-file-name
(or (plist-get pkg-spec :lisp-dir) ".")
(or (package-desc-dir pkg-desc)
(expand-file-name name package-user-dir))
(plist-get pkg-spec :lisp-dir)))
(expand-file-name name package-user-dir))))
(file (expand-file-name
(or (plist-get pkg-spec :main-file)
(concat name ".el"))
@ -460,7 +462,7 @@ identify a package as a VC package later on), building
documentation and marking the package as installed."
(let* ((pkg-spec (package-vc--desc->spec pkg-desc))
(lisp-dir (plist-get pkg-spec :lisp-dir))
(lisp-path (file-name-concat pkg-dir lisp-dir))
(lisp-path (expand-file-name (or lisp-dir ".") pkg-dir))
missing)
;; In case the package was installed directly from source, the
@ -508,7 +510,7 @@ documentation and marking the package as installed."
(with-temp-buffer
(insert ";; Autoload indirection for package-vc\n\n")
(prin1 `(load (expand-file-name
,(file-name-concat lisp-dir auto-name)
,(expand-file-name auto-name lisp-dir)
(or (and load-file-name
(file-name-directory load-file-name))
(car load-path))))
@ -924,16 +926,17 @@ for the NAME of the package to set up."
(read-string
(format-prompt "Package name" base)
nil nil base)))))
(unless (vc-responsible-backend dir)
(user-error "Directory %S is not under version control" dir))
(package-vc--archives-initialize)
(let* ((name (or name (file-name-base (directory-file-name dir))))
(pkg-dir (expand-file-name name package-user-dir)))
(pkg-dir (expand-file-name name package-user-dir))
(package-vc-selected-packages
(cons (list name :lisp-dir (expand-file-name dir))
package-vc-selected-packages)))
(when (file-exists-p pkg-dir)
(if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?" name))
(package--delete-directory pkg-dir)
(error "There already exists a checkout for %s" name)))
(make-symbolic-link (expand-file-name dir) pkg-dir)
(make-directory pkg-dir t)
(package-vc--unpack-1
(package-desc-create
:name (intern name)

40
lisp/emacs-lisp/package.el
View file

@ -1007,8 +1007,9 @@ untar into a directory named DIR; otherwise, signal an error."
('dir
(make-directory pkg-dir t)
(let ((file-list
(directory-files
default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
(or (and (derived-mode-p 'dired-mode)
(dired-get-marked-files))
(directory-files-recursively default-directory "" nil))))
(dolist (source-file file-list)
(let ((target-el-file
(expand-file-name (file-name-nondirectory source-file) pkg-dir)))
@ -1252,7 +1253,9 @@ The return result is a `package-desc'."
(with-temp-buffer
(insert-file-contents desc-file)
(package--read-pkg-desc 'dir))
(let ((files (directory-files default-directory t "\\.el\\'" t))
(let ((files (or (and (derived-mode-p 'dired-mode)
(dired-get-marked-files))
(directory-files-recursively default-directory "\\.el\\'")))
info)
(while files
(with-temp-buffer
@ -2374,7 +2377,8 @@ info node `(elisp)Packaging').
Specially, if current buffer is a directory, the -pkg.el
description file is not mandatory, in which case the information
is derived from the main .el file in the directory.
is derived from the main .el file in the directory. Using Dired,
you can restrict what files to install by marking specific files.
Downloads and installs required packages as needed."
(interactive)
@ -4591,6 +4595,19 @@ activations need to be changed, such as when `package-load-list' is modified."
(delete-file (concat package-quickstart-file "c"))
(delete-file package-quickstart-file)))
(defvar package--quickstart-dir nil
"Set by `package-quickstart-file' to the directory containing it.")
(defun package--quickstart-rel (file)
"Return an expr depending on `package--quickstart-dir' which evaluates to FILE.
If FILE is in `package--quickstart-dir', returns an expression that is
relative to that directory, so if that directory is moved we can still
find FILE."
(if (file-in-directory-p file package--quickstart-dir)
`(file-name-concat package--quickstart-dir ,(file-relative-name file package--quickstart-dir))
file))
(defun package-quickstart-refresh ()
"(Re)Generate the `package-quickstart-file'."
(interactive)
@ -4605,7 +4622,8 @@ activations need to be changed, such as when `package-load-list' is modified."
;; aren't truncated.
(print-length nil)
(print-level nil)
(Info-directory-list '("")))
(Info-directory-list '(""))
(package--quickstart-dir nil))
(dolist (elt package-alist)
(condition-case err
(package-activate (car elt))
@ -4617,12 +4635,17 @@ activations need to be changed, such as when `package-load-list' is modified."
(emacs-lisp-mode) ;For `syntax-ppss'.
(insert ";;; Quickstart file to activate all packages at startup -*- lexical-binding:t -*-\n")
(insert ";; ¡¡ This file is autogenerated by `package-quickstart-refresh', DO NOT EDIT !!\n\n")
(setq package--quickstart-dir
(file-name-directory (expand-file-name package-quickstart-file)))
(pp '(setq package--quickstart-dir
(file-name-directory (expand-file-name load-file-name)))
(current-buffer))
(dolist (pkg package--quickstart-pkgs)
(let* ((file
;; Prefer uncompiled files (and don't accept .so files).
(let ((load-suffixes '(".el" ".elc")))
(locate-library (package--autoloads-file-name pkg))))
(pfile (prin1-to-string file)))
(pfile (prin1-to-string (package--quickstart-rel file))))
(insert "(let* ((load-file-name " pfile ")\
\(load-true-file-name load-file-name))\n")
(insert-file-contents file)
@ -4638,12 +4661,13 @@ activations need to be changed, such as when `package-load-list' is modified."
(append ',(mapcar #'package-desc-name package--quickstart-pkgs)
package-activated-list)))
(current-buffer))
(let ((info-dirs (butlast Info-directory-list)))
(let ((info-dirs
(mapcar #'package--quickstart-rel (butlast Info-directory-list))))
(when info-dirs
(pp `(progn (require 'info)
(info-initialize)
(setq Info-directory-list
(append ',info-dirs Info-directory-list)))
(append (list . ,info-dirs) Info-directory-list)))
(current-buffer))))
;; Use `\s' instead of a space character, so this code chunk is not
;; mistaken for an actual file-local section of package.el.

11
lisp/emacs-lisp/warnings.el
View file

@ -176,6 +176,9 @@ also call that function before the next warning.")
"Format for displaying the warning type in the warning message.
The result of formatting the type this way gets included in the
message under the control of the string in `warning-levels'.")
;;;###autoload
(defvar warning-inhibit-types nil
"Like `warning-suppress-log-types', but intended for programs to let-bind.")
(defun warning-numeric-level (level)
"Return a numeric measure of the warning severity level LEVEL."
@ -277,9 +280,10 @@ disable automatic display of the warning or disable the warning
entirely by setting `warning-suppress-types' or
`warning-suppress-log-types' on their behalf."
(if (not (or after-init-time noninteractive (daemonp)))
;; Ensure warnings that happen early in the startup sequence
;; are visible when startup completes (bug#20792).
(delay-warning type message level buffer-name)
(or (warning-suppress-p type warning-inhibit-types)
;; Ensure warnings that happen early in the startup sequence
;; are visible when startup completes (bug#20792).
(delay-warning type message level buffer-name))
(unless level
(setq level :warning))
(unless buffer-name
@ -290,6 +294,7 @@ entirely by setting `warning-suppress-types' or
(setq level new)))
(or (< (warning-numeric-level level)
(warning-numeric-level warning-minimum-log-level))
(warning-suppress-p type warning-inhibit-types)
(warning-suppress-p type warning-suppress-log-types)
(let* ((typename (if (consp type) (car type) type))
(old (get-buffer buffer-name))