summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/advice.el2
-rw-r--r--lisp/emacs-lisp/autoload.el333
-rw-r--r--lisp/emacs-lisp/byte-opt.el5
-rw-r--r--lisp/emacs-lisp/bytecomp.el61
-rw-r--r--lisp/emacs-lisp/check-declare.el142
-rw-r--r--lisp/emacs-lisp/checkdoc.el21
-rw-r--r--lisp/emacs-lisp/cl-generic.el3
-rw-r--r--lisp/emacs-lisp/derived.el15
-rw-r--r--lisp/emacs-lisp/easy-mmode.el7
-rw-r--r--lisp/emacs-lisp/edebug.el7
-rw-r--r--lisp/emacs-lisp/eieio-compat.el2
-rw-r--r--lisp/emacs-lisp/eieio-core.el105
-rw-r--r--lisp/emacs-lisp/eieio-custom.el2
-rw-r--r--lisp/emacs-lisp/eieio-opt.el2
-rw-r--r--lisp/emacs-lisp/eieio.el71
-rw-r--r--lisp/emacs-lisp/eldoc.el5
-rw-r--r--lisp/emacs-lisp/ert-x.el40
-rw-r--r--lisp/emacs-lisp/ert.el31
-rw-r--r--lisp/emacs-lisp/find-func.el71
-rw-r--r--lisp/emacs-lisp/let-alist.el9
-rw-r--r--lisp/emacs-lisp/lisp-mode.el18
-rw-r--r--lisp/emacs-lisp/package.el6
-rw-r--r--lisp/emacs-lisp/seq.el24
-rw-r--r--lisp/emacs-lisp/syntax.el6
-rw-r--r--lisp/emacs-lisp/timer-list.el112
25 files changed, 740 insertions, 360 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index ea01253d1ea..c0da59c81cb 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1832,7 +1832,7 @@ Redefining advices affect the construction of an advised definition."
;; @@ Interactive input functions:
;; ===============================
-(declare-function 'function-called-at-point "help")
+(declare-function function-called-at-point "help")
(defun ad-read-advised-function (&optional prompt predicate default)
"Read name of advised function with completion from the minibuffer.
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index eb6b746bd80..80f5c28f3ec 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -87,6 +87,29 @@ that text will be copied verbatim to `generated-autoload-file'.")
(defconst generate-autoload-section-continuation ";;;;;; "
"String to add on each continuation of the section header form.")
+;; In some ways it would be nicer to use a value that is recognizably
+;; not a time-value, eg t, but that can cause issues if an older Emacs
+;; that does not expect non-time-values loads the file.
+(defconst autoload--non-timestamp '(0 0 0 0)
+ "Value to insert when `autoload-timestamps' is nil.")
+
+(defvar autoload-timestamps nil ; experimental, see bug#22213
+ "Non-nil means insert a timestamp for each input file into the output.
+We use these in incremental updates of the output file to decide
+if we need to rescan an input file. If you set this to nil,
+then we use the timestamp of the output file instead. As a result:
+ - for fixed inputs, the output will be the same every time
+ - incremental updates of the output file might not be correct if:
+ i) the timestamp of the output file cannot be trusted (at least
+ relative to that of the input files)
+ ii) any of the input files can be modified during the time it takes
+ to create the output
+ iii) only a subset of the input files are scanned
+ These issues are unlikely to happen in practice, and would arguably
+ represent bugs in the build system. Item iii) will happen if you
+ use a command like `update-file-autoloads', though, since it only
+ checks a single input file.")
+
(defvar autoload-modified-buffers) ;Dynamically scoped var.
(defun make-autoload (form file &optional expansion)
@@ -160,10 +183,12 @@ expression, in which case we want to handle forms differently."
(args (pcase car
((or `defun `defmacro
`defun* `defmacro* `cl-defun `cl-defmacro
- `define-overloadable-function) (nth 2 form))
+ `define-overloadable-function)
+ (nth 2 form))
(`define-skeleton '(&optional str arg))
((or `define-generic-mode `define-derived-mode
- `define-compilation-mode) nil)
+ `define-compilation-mode)
+ nil)
(_ t)))
(body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
(doc (if (stringp (car body)) (pop body))))
@@ -179,7 +204,8 @@ expression, in which case we want to handle forms differently."
define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode
- define-minor-mode)) t)
+ define-minor-mode))
+ t)
(eq (car-safe (car body)) 'interactive))
,(if macrop ''macro nil))))
@@ -234,9 +260,22 @@ If a buffer is visiting the desired autoload file, return it."
(enable-local-eval nil))
;; We used to use `raw-text' to read this file, but this causes
;; problems when the file contains non-ASCII characters.
- (let ((delay-mode-hooks t))
- (find-file-noselect
- (autoload-ensure-default-file (autoload-generated-file))))))
+ (let* ((delay-mode-hooks t)
+ (file (autoload-generated-file))
+ (file-missing (not (file-exists-p file))))
+ (when file-missing
+ (autoload-ensure-default-file file))
+ (with-current-buffer
+ (find-file-noselect
+ (autoload-ensure-file-writeable
+ file))
+ ;; block backups when the file has just been created, since
+ ;; the backups will just be the auto-generated headers.
+ ;; bug#23203
+ (when file-missing
+ (setq buffer-backed-up t)
+ (save-buffer))
+ (current-buffer)))))
(defun autoload-generated-file ()
(expand-file-name generated-autoload-file
@@ -277,7 +316,7 @@ The variable `autoload-print-form-outbuf' specifies the buffer to
put the output in."
(cond
;; If the form is a sequence, recurse.
- ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
+ ((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
;; Symbols at the toplevel are meaningless.
((symbolp form) nil)
(t
@@ -357,25 +396,36 @@ not be relied upon."
;;;###autoload
(put 'autoload-ensure-writable 'risky-local-variable t)
+(defun autoload-ensure-file-writeable (file)
+ ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
+ ;; which was designed to handle CVSREAD=1 and equivalent.
+ (and autoload-ensure-writable
+ (let ((modes (file-modes file)))
+ (if (zerop (logand modes #o0200))
+ ;; Ignore any errors here, and let subsequent attempts
+ ;; to write the file raise any real error.
+ (ignore-errors (set-file-modes file (logior modes #o0200))))))
+ file)
+
(defun autoload-ensure-default-file (file)
"Make sure that the autoload file FILE exists, creating it if needed.
If the file already exists and `autoload-ensure-writable' is non-nil,
make it writable."
- (if (file-exists-p file)
- ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
- ;; which was designed to handle CVSREAD=1 and equivalent.
- (and autoload-ensure-writable
- (let ((modes (file-modes file)))
- (if (zerop (logand modes #o0200))
- ;; Ignore any errors here, and let subsequent attempts
- ;; to write the file raise any real error.
- (ignore-errors (set-file-modes file (logior modes #o0200))))))
- (write-region (autoload-rubric file) nil file))
- file)
+ (write-region (autoload-rubric file) nil file))
(defun autoload-insert-section-header (outbuf autoloads load-name file time)
"Insert the section-header line,
which lists the file name and which functions are in it, etc."
+ ;; (cl-assert ;Make sure we don't insert it in the middle of another section.
+ ;; (save-excursion
+ ;; (or (not (re-search-backward
+ ;; (concat "\\("
+ ;; (regexp-quote generate-autoload-section-header)
+ ;; "\\)\\|\\("
+ ;; (regexp-quote generate-autoload-section-trailer)
+ ;; "\\)")
+ ;; nil t))
+ ;; (match-end 2))))
(insert generate-autoload-section-header)
(prin1 `(autoloads ,autoloads ,load-name ,file ,time)
outbuf)
@@ -434,7 +484,7 @@ which lists the file name and which functions are in it, etc."
;; without checking its content. This makes it generate wrong load
;; names for cases like lisp/term which is not added to load-path.
(setq dir (expand-file-name (pop names) dir)))
- (t (setq name (mapconcat 'identity names "/")))))
+ (t (setq name (mapconcat #'identity names "/")))))
(if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
(substring name 0 (match-beginning 0))
name)))
@@ -450,8 +500,93 @@ Return non-nil in the case where no autoloads were added at point."
(let ((generated-autoload-file buffer-file-name))
(autoload-generate-file-autoloads file (current-buffer))))
-(defvar print-readably)
-
+(defun autoload--split-prefixes-1 (strs)
+ (let ((prefixes ()))
+ (dolist (str strs)
+ (string-match "\\`[^-:/_]*[-:/_]*" str)
+ (let* ((prefix (match-string 0 str))
+ (tail (substring str (match-end 0)))
+ (cell (assoc prefix prefixes)))
+ (cond
+ ((null cell) (push (list prefix tail) prefixes))
+ ((equal (cadr cell) tail) nil)
+ (t (setcdr cell (cons tail (cdr cell)))))))
+ prefixes))
+
+(defun autoload--split-prefixes (prefixes)
+ (apply #'nconc
+ (mapcar (lambda (cell)
+ (let ((prefix (car cell)))
+ (mapcar (lambda (cell)
+ (cons (concat prefix (car cell)) (cdr cell)))
+ (autoload--split-prefixes-1 (cdr cell)))))
+ prefixes)))
+
+(defvar autoload-compute-prefixes t
+ "If non-nil, autoload will add code to register the prefixes used in a file.
+Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
+variables or functions that use \"foo-\" as prefix, that will not be registered.
+But all other prefixes will be included.")
+
+(defconst autoload-defs-autoload-max-size 5
+ "Target length of the list of definition prefixes per file.
+If set too small, the prefixes will be too generic (i.e. they'll use little
+memory, we'll end up looking in too many files when we need a particular
+prefix), and if set too large, they will be too specific (i.e. they will
+cost more memory use).")
+
+(defvar autoload-popular-prefixes nil)
+
+(defun autoload--make-defs-autoload (defs file)
+ ;; Remove the defs that obey the rule that file foo.el (or
+ ;; foo-mode.el) uses "foo-" as prefix.
+ ;; FIXME: help--symbol-completion-table still doesn't know how to use
+ ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix.
+ ;;(let ((prefix
+ ;; (concat (substring file 0 (string-match "-mode\\'" file)) "-")))
+ ;; (dolist (def (prog1 defs (setq defs nil)))
+ ;; (unless (string-prefix-p prefix def)
+ ;; (push def defs))))
+
+ ;; Then compute a small set of prefixes that cover all the
+ ;; remaining definitions.
+ (let ((prefixes (autoload--split-prefixes-1 defs))
+ (again t))
+ ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes))
+ (while again
+ (setq again nil)
+ (let ((newprefixes
+ (sort
+ (mapcar (lambda (cell)
+ (cons cell
+ (autoload--split-prefixes-1 (cdr cell))))
+ prefixes)
+ (lambda (x y) (< (length (cdr x)) (length (cdr y)))))))
+ (setq prefixes nil)
+ (while newprefixes
+ (let ((x (pop newprefixes)))
+ (if (or (equal '("") (cdar x))
+ (and (cddr x)
+ (not (member (caar x)
+ autoload-popular-prefixes))
+ (> (+ (length prefixes) (length newprefixes)
+ (length (cdr x)))
+ autoload-defs-autoload-max-size)))
+ ;; Nothing to split or would split too deep.
+ (push (car x) prefixes)
+ ;; (message "Expand %S to %S" (caar x) (cdr x))
+ (setq again t)
+ (setq prefixes
+ (nconc (mapcar (lambda (cell)
+ (cons (concat (caar x)
+ (car cell))
+ (cdr cell)))
+ (cdr x))
+ prefixes)))))))
+ ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
+ (when prefixes
+ `(if (fboundp 'register-definition-prefixes)
+ (register-definition-prefixes ,file ',(mapcar #'car prefixes))))))
(defun autoload--setup-output (otherbuf outbuf absfile load-name)
(let ((outbuf
@@ -529,11 +664,11 @@ FILE's modification time."
(let (load-name
(print-length nil)
(print-level nil)
- (print-readably t) ; This does something in Lucid Emacs.
(float-output-format nil)
(visited (get-file-buffer file))
(otherbuf nil)
(absfile (expand-file-name file))
+ (defs '())
;; nil until we found a cookie.
output-start)
(when
@@ -592,13 +727,73 @@ FILE's modification time."
;; Don't read the comment.
(forward-line 1))
(t
+ ;; Avoid (defvar <foo>) by requiring a trailing space.
+ ;; Also, ignore this prefix business
+ ;; for ;;;###tramp-autoload and friends.
+ (when (and (equal generate-autoload-cookie ";;;###autoload")
+ (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
+ (not (member
+ (match-string 1)
+ '("define-obsolete-function-alias"
+ "define-obsolete-variable-alias"
+ "define-category" "define-key"
+ "defgroup" "defface" "defadvice"
+ ;; Hmm... this is getting ugly:
+ "define-widget"
+ "defun-rcirc-command"))))
+ (push (match-string 2) defs))
(forward-sexp 1)
(forward-line 1))))))
+ (when (and autoload-compute-prefixes defs)
+ ;; This output needs to always go in the main loaddefs.el,
+ ;; regardless of generated-autoload-file.
+ ;; FIXME: the files that don't have autoload cookies but
+ ;; do have definitions end up listed twice in loaddefs.el:
+ ;; once for their register-definition-prefixes and once in
+ ;; the list of "files without any autoloads".
+ (let ((form (autoload--make-defs-autoload defs load-name)))
+ (cond
+ ((null form)) ;All defs obey the default rule, yay!
+ ((not otherbuf)
+ (unless output-start
+ (setq output-start (autoload--setup-output
+ nil outbuf absfile load-name)))
+ (let ((autoload-print-form-outbuf
+ (marker-buffer output-start)))
+ (autoload-print-form form)))
+ (t
+ (let* ((other-output-start
+ ;; To force the output to go to the main loaddefs.el
+ ;; rather than to generated-autoload-file,
+ ;; there are two cases: if outbuf is non-nil,
+ ;; then passing otherbuf=nil is enough, but if
+ ;; outbuf is nil, that won't cut it, so we
+ ;; locally bind generated-autoload-file.
+ (let ((generated-autoload-file
+ (default-value 'generated-autoload-file)))
+ (autoload--setup-output nil outbuf absfile load-name)))
+ (autoload-print-form-outbuf
+ (marker-buffer other-output-start)))
+ (autoload-print-form form)
+ (with-current-buffer (marker-buffer other-output-start)
+ (save-excursion
+ ;; Insert the section-header line which lists
+ ;; the file name and which functions are in it, etc.
+ (goto-char other-output-start)
+ (let ((relfile (file-relative-name absfile)))
+ (autoload-insert-section-header
+ (marker-buffer other-output-start)
+ "actual autoloads are elsewhere" load-name relfile
+ (nth 5 (file-attributes absfile)))
+ (insert ";;; Generated autoloads from " relfile "\n")))
+ (insert generate-autoload-section-trailer)))))))
+
(when output-start
(let ((secondary-autoloads-file-buf
(if otherbuf (current-buffer))))
(with-current-buffer (marker-buffer output-start)
+ (cl-assert (> (point) output-start))
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
@@ -624,7 +819,9 @@ FILE's modification time."
;; We'd really want to just use
;; `emacs-internal' instead.
nil nil 'emacs-mule-unix)
- (nth 5 (file-attributes relfile))))
+ (if autoload-timestamps
+ (nth 5 (file-attributes relfile))
+ autoload--non-timestamp)))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer))))
(or noninteractive
@@ -655,6 +852,8 @@ FILE's modification time."
(let ((version-control 'never))
(save-buffer)))))
+;; FIXME This command should be deprecated.
+;; See http://debbugs.gnu.org/22213#41
;;;###autoload
(defun update-file-autoloads (file &optional save-after outfile)
"Update the autoloads for FILE.
@@ -672,6 +871,9 @@ Return FILE if there was no autoload cookie in it, else nil."
(read-file-name "Write autoload definitions to file: ")))
(let* ((generated-autoload-file (or outfile generated-autoload-file))
(autoload-modified-buffers nil)
+ ;; We need this only if the output file handles more than one input.
+ ;; See http://debbugs.gnu.org/22213#38 and subsequent.
+ (autoload-timestamps t)
(no-autoloads (autoload-generate-file-autoloads file)))
(if autoload-modified-buffers
(if save-after (autoload-save-buffers))
@@ -689,6 +891,9 @@ removes any prior now out-of-date autoload entries."
(catch 'up-to-date
(let* ((buf (current-buffer))
(existing-buffer (if buffer-file-name buf))
+ (output-file (autoload-generated-file))
+ (output-time (if (file-exists-p output-file)
+ (nth 5 (file-attributes output-file))))
(found nil))
(with-current-buffer (autoload-find-generated-file)
;; This is to make generated-autoload-file have Unix EOLs, so
@@ -713,16 +918,28 @@ removes any prior now out-of-date autoload entries."
(file-time (nth 5 (file-attributes file))))
(if (and (or (null existing-buffer)
(not (buffer-modified-p existing-buffer)))
- (or
+ (cond
+ ;; FIXME? Arguably we should throw a
+ ;; user error, or some kind of warning,
+ ;; if we were called from update-file-autoloads,
+ ;; which can update only a single input file.
+ ;; It's not appropriate to use the output
+ ;; file modtime in such a case,
+ ;; if there are multiple input files
+ ;; contributing to the output.
+ ((and output-time
+ (member last-time
+ (list t autoload--non-timestamp)))
+ (not (time-less-p output-time file-time)))
;; last-time is the time-stamp (specifying
;; the last time we looked at the file) and
;; the file hasn't been changed since.
- (and (listp last-time)
- (not (time-less-p last-time file-time)))
+ ((listp last-time)
+ (not (time-less-p last-time file-time)))
;; last-time is an MD5 checksum instead.
- (and (stringp last-time)
- (equal last-time
- (md5 buf nil nil 'emacs-mule)))))
+ ((stringp last-time)
+ (equal last-time
+ (md5 buf nil nil 'emacs-mule)))))
(throw 'up-to-date nil)
(autoload-remove-section begin)
(setq found t))))
@@ -768,12 +985,13 @@ write its autoloads into the specified file instead."
(dolist (suf (get-load-suffixes))
(unless (string-match "\\.elc" suf) (push suf tmp)))
(concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
- (files (apply 'nconc
+ (files (apply #'nconc
(mapcar (lambda (dir)
(directory-files (expand-file-name dir)
t files-re))
dirs)))
- (done ())
+ (done ()) ;Files processed; to remove duplicates.
+ (changed nil) ;Non-nil if some change occured.
(last-time)
;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings.
@@ -782,13 +1000,16 @@ write its autoloads into the specified file instead."
(generated-autoload-file
(if (called-interactively-p 'interactive)
(read-file-name "Write autoload definitions to file: ")
- generated-autoload-file)))
+ generated-autoload-file))
+ (output-time
+ (if (file-exists-p generated-autoload-file)
+ (nth 5 (file-attributes generated-autoload-file)))))
(with-current-buffer (autoload-find-generated-file)
(save-excursion
;; Canonicalize file names and remove the autoload file itself.
(setq files (delete (file-relative-name buffer-file-name)
- (mapcar 'file-relative-name files)))
+ (mapcar #'file-relative-name files)))
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
@@ -800,14 +1021,15 @@ write its autoloads into the specified file instead."
;; Remove the obsolete section.
(autoload-remove-section (match-beginning 0))
(setq last-time (nth 4 form))
- (when (listp last-time)
- (dolist (file file)
- (let ((file-time (nth 5 (file-attributes file))))
- (when (and file-time
- (not (time-less-p last-time file-time)))
- ;; file unchanged
- (push file no-autoloads)
- (setq files (delete file files)))))))
+ (if (member last-time (list t autoload--non-timestamp))
+ (setq last-time output-time))
+ (dolist (file file)
+ (let ((file-time (nth 5 (file-attributes file))))
+ (when (and file-time
+ (not (time-less-p last-time file-time)))
+ ;; file unchanged
+ (push file no-autoloads)
+ (setq files (delete file files))))))
((not (stringp file)))
((or (not (file-exists-p file))
;; Remove duplicates as well, just in case.
@@ -815,13 +1037,19 @@ write its autoloads into the specified file instead."
;; If the file is actually excluded.
(member (expand-file-name file) autoload-excludes))
;; Remove the obsolete section.
+ (setq changed t)
(autoload-remove-section (match-beginning 0)))
- ((and (listp (nth 4 form))
- (not (time-less-p (nth 4 form)
- (nth 5 (file-attributes file)))))
+ ((not (time-less-p (let ((oldtime (nth 4 form)))
+ (if (member oldtime
+ (list
+ t autoload--non-timestamp))
+ output-time
+ oldtime))
+ (nth 5 (file-attributes file))))
;; File hasn't changed.
nil)
(t
+ (setq changed t)
(autoload-remove-section (match-beginning 0))
(if (autoload-generate-file-autoloads
;; Passing `current-buffer' makes it insert at point.
@@ -841,7 +1069,8 @@ write its autoloads into the specified file instead."
(autoload-generate-file-autoloads file nil buffer-file-name))
(push file no-autoloads)
(if (time-less-p no-autoloads-time file-time)
- (setq no-autoloads-time file-time)))))
+ (setq no-autoloads-time file-time)))
+ (t (setq changed t))))
(when no-autoloads
;; Sort them for better readability.
@@ -850,11 +1079,17 @@ write its autoloads into the specified file instead."
(goto-char (point-max))
(search-backward "\f" nil t)
(autoload-insert-section-header
- (current-buffer) nil nil no-autoloads no-autoloads-time)
+ (current-buffer) nil nil no-autoloads (if autoload-timestamps
+ no-autoloads-time
+ autoload--non-timestamp))
(insert generate-autoload-section-trailer)))
- (let ((version-control 'never))
- (save-buffer))
+ ;; Don't modify the file if its content has not been changed, so `make'
+ ;; dependencies don't trigger unnecessarily.
+ (when changed
+ (let ((version-control 'never))
+ (save-buffer)))
+
;; In case autoload entries were added to other files because of
;; file-local autoload-generated-file settings.
(autoload-save-buffers))))
@@ -886,7 +1121,7 @@ should be non-nil)."
(push (expand-file-name file) autoload-excludes)))))))
(let ((args command-line-args-left))
(setq command-line-args-left nil)
- (apply 'update-directory-autoloads args)))
+ (apply #'update-directory-autoloads args)))
(provide 'autoload)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index b3bf4a58849..dbaf2bc6f6a 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1209,8 +1209,9 @@
radians-to-degrees rassq rassoc read-from-string regexp-quote
region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp string-to-char
- string-to-int string-to-number substring sxhash symbol-function
- symbol-name symbol-plist symbol-value string-make-unibyte
+ string-to-int string-to-number substring
+ sxhash sxhash-equal sxhash-eq sxhash-eql
+ symbol-function symbol-name symbol-plist symbol-value string-make-unibyte
string-make-multibyte string-as-multibyte string-as-unibyte
string-to-multibyte
tan truncate
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 1526e2fdeb9..aa13210b633 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1360,31 +1360,33 @@ extra args."
(dolist (elt '(format message error))
(put elt 'byte-compile-format-like t))
-;; Warn if a custom definition fails to specify :group.
+;; Warn if a custom definition fails to specify :group, or :type.
(defun byte-compile-nogroup-warn (form)
- (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
- byte-compile-current-group)
- ;; The group will be provided implicitly.
- nil
- (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
- (name (cadr form)))
- (or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
- '((custom-declare-group . defgroup)
- (custom-declare-face . defface)
- (custom-declare-variable . defcustom))))
- (cadr name)))
- ;; Update the current group, if needed.
- (if (and byte-compile-current-file ;Only when compiling a whole file.
- (eq (car form) 'custom-declare-group)
- (eq (car-safe name) 'quote))
- (setq byte-compile-current-group (cadr name))))))
+ (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
+ (name (cadr form)))
+ (when (eq (car-safe name) 'quote)
+ (or (not (eq (car form) 'custom-declare-variable))
+ (plist-get keyword-args :type)
+ (byte-compile-warn
+ "defcustom for `%s' fails to specify type" (cadr name)))
+ (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
+ byte-compile-current-group)
+ ;; The group will be provided implicitly.
+ nil
+ (or (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
+ '((custom-declare-group . defgroup)
+ (custom-declare-face . defface)
+ (custom-declare-variable . defcustom))))
+ (cadr name)))
+ ;; Update the current group, if needed.
+ (if (and byte-compile-current-file ;Only when compiling a whole file.
+ (eq (car form) 'custom-declare-group))
+ (setq byte-compile-current-group (cadr name)))))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
@@ -2956,23 +2958,24 @@ for symbols generated by the byte compiler itself."
(list body))))
;; Special macro-expander used during byte-compilation.
-(defun byte-compile-macroexpand-declare-function (fn file &rest args)
- (let ((gotargs (and (consp args) (listp (car args))))
+(defun byte-compile-macroexpand-declare-function (fn file &optional arglist
+ fileonly)
+ (let ((gotargs (listp arglist))
(unresolved (assq fn byte-compile-unresolved-functions)))
(when unresolved ; function was called before declaration
(if (and gotargs (byte-compile-warning-enabled-p 'callargs))
- (byte-compile-arglist-warn fn (car args) nil)
+ (byte-compile-arglist-warn fn arglist nil)
(setq byte-compile-unresolved-functions
(delq unresolved byte-compile-unresolved-functions))))
(push (cons fn (if gotargs
- (list 'declared (car args))
+ (list 'declared arglist)
t)) ; Arglist not specified.
byte-compile-function-environment))
;; We are stating that it _will_ be defined at runtime.
(setq byte-compile-noruntime-functions
(delq fn byte-compile-noruntime-functions))
;; Delegate the rest to the normal macro definition.
- (macroexpand `(declare-function ,fn ,file ,@args)))
+ (macroexpand `(declare-function ,fn ,file ,arglist ,fileonly)))
;; This is the recursive entry point for compiling each subform of an
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index b6fa0546088..e1e756be077 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -43,7 +43,7 @@
"Name of buffer used to display any `check-declare' warnings.")
(defun check-declare-locate (file basefile)
- "Return the full path of FILE.
+ "Return the relative name of FILE.
Expands files with a \".c\" or \".m\" extension relative to the Emacs
\"src/\" directory. Otherwise, `locate-library' searches for FILE.
If that fails, expands FILE relative to BASEFILE's directory part.
@@ -70,6 +70,7 @@ the result."
(string-match "\\.el\\'" tfile))
tfile
(concat tfile ".el")))))
+ (setq file (file-relative-name file))
(if ext (concat "ext:" file)
file)))
@@ -80,49 +81,40 @@ where only the first two elements need be present. This claims that FNFILE
defines FN, with ARGLIST. FILEONLY non-nil means only check that FNFILE
exists, not that it defines FN. This is for function definitions that we
don't know how to recognize (e.g. some macros)."
- (let ((m (format "Scanning %s..." file))
- alist form len fn fnfile arglist fileonly)
- (message "%s" m)
+ (let (alist)
(with-temp-buffer
(insert-file-contents file)
;; FIXME we could theoretically be inside a string.
(while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t)
- (goto-char (match-beginning 1))
- (if (and (setq form (ignore-errors (read (current-buffer))))
+ (let ((pos (match-beginning 1)))
+ (goto-char pos)
+ (let ((form (ignore-errors (read (current-buffer))))
+ len fn formfile fnfile arglist fileonly)
+ (if (and
;; Exclude element of byte-compile-initial-macro-environment.
(or (listp (cdr form)) (setq form nil))
(> (setq len (length form)) 2)
(< len 6)
+ (setq formfile (nth 2 form))
(symbolp (setq fn (cadr form)))
(setq fn (symbol-name fn)) ; later we use as a search string
- (stringp (setq fnfile (nth 2 form)))
- (setq fnfile (check-declare-locate fnfile
- (expand-file-name file)))
+ (stringp formfile)
+ (setq fnfile (check-declare-locate formfile file))
;; Use t to distinguish unspecified arglist from empty one.
(or (eq t (setq arglist (if (> len 3)
(nth 3 form)
t)))
(listp arglist))
(symbolp (setq fileonly (nth 4 form))))
- (setq alist (cons (list fnfile fn arglist fileonly) alist))
- ;; FIXME make this more noticeable.
- (if form (message "Malformed declaration for `%s'" (cadr form))))))
- (message "%sdone" m)
+ (setq alist (cons (list fnfile fn arglist fileonly) alist))
+ (when form
+ (check-declare-warn file (or fn "unknown function")
+ (if (stringp formfile) formfile
+ "unknown file")
+ "Malformed declaration"
+ (line-number-at-pos pos))))))))
alist))
-(defun check-declare-errmsg (errlist &optional full)
- "Return a string with the number of errors in ERRLIST, if any.
-Normally just counts the number of elements in ERRLIST.
-With optional argument FULL, sums the number of elements in each element."
- (if errlist
- (let ((l (length errlist)))
- (when full
- (setq l 0)
- (dolist (e errlist)
- (setq l (+ l (1- (length e))))))
- (format "%d problem%s found" l (if (= l 1) "" "s")))
- "OK"))
-
(autoload 'byte-compile-arglist-signature "bytecomp")
(defgroup check-declare nil
@@ -144,11 +136,9 @@ to only check that FNFILE exists, not that it actually defines FN.
Returns nil if all claims are found to be true, otherwise a list
of errors with elements of the form \(FILE FN TYPE), where TYPE
is a string giving details of the error."
- (let ((m (format "Checking %s..." fnfile))
- (cflag (member (file-name-extension fnfile) '("c" "m")))
+ (let ((cflag (member (file-name-extension fnfile) '("c" "m")))
(ext (string-match "^ext:" fnfile))
re fn sig siglist arglist type errlist minargs maxargs)
- (message "%s" m)
(if ext
(setq fnfile (substring fnfile 4)))
(if (file-regular-p fnfile)
@@ -216,7 +206,8 @@ fset\\|\\(?:cl-\\)?defmethod\\)\\>" type)
(setq arglist (nth 2 e)
type
(if (not re)
- "file not found"
+ (when (or check-declare-ext-errors (not ext))
+ "file not found")
(if (not (setq sig (assoc (cadr e) siglist)))
(unless (nth 3 e) ; fileonly
"function not found")
@@ -235,13 +226,6 @@ fset\\|\\(?:cl-\\)?defmethod\\)\\>" type)
"arglist mismatch")))))
(when type
(setq errlist (cons (list (car e) (cadr e) type) errlist))))
- (message "%s%s" m
- (if (or re (or check-declare-ext-errors
- (not ext)))
- (check-declare-errmsg errlist)
- (progn
- (setq errlist nil)
- "skipping external file")))
errlist))
(defun check-declare-sort (alist)
@@ -258,30 +242,27 @@ Returned list has elements FNFILE (FILE ...)."
(setq sort (cons (list fnfile (cons file rest)) sort)))))
sort))
-(defun check-declare-warn (file fn fnfile type)
+(defun check-declare-warn (file fn fnfile type &optional line)
"Warn that FILE made a false claim about FN in FNFILE.
-TYPE is a string giving the nature of the error. Warning is displayed in
-`check-declare-warning-buffer'."
+TYPE is a string giving the nature of the error.
+Optional LINE is the claim's line number; otherwise, search for the claim.
+Display warning in `check-declare-warning-buffer'."
(let ((warning-prefix-function
(lambda (level entry)
- (let ((line 0)
- (col 0))
- (insert
- (with-current-buffer (find-file-noselect file)
- (goto-char (point-min))
- (when (re-search-forward
- (format "(declare-function[ \t\n]+%s" fn) nil t)
- (goto-char (match-beginning 0))
- (setq line (line-number-at-pos))
- (setq col (1+ (current-column))))
- (format "%s:%d:%d:"
- (file-name-nondirectory file)
- line col))))
+ (insert (format "%s:%d:" (file-relative-name file) (or line 0)))
entry))
(warning-fill-prefix " "))
+ (unless line
+ (with-current-buffer (find-file-noselect file)
+ (goto-char (point-min))
+ (when (and (not line)
+ (re-search-forward
+ (format "(declare-function[ \t\n]+%s" fn) nil t))
+ (goto-char (match-beginning 0))
+ (setq line (line-number-at-pos)))))
(display-warning 'check-declare
(format-message "said `%s' was defined in %s: %s"
- fn (file-name-nondirectory fnfile) type)
+ fn (file-relative-name fnfile) type)
nil check-declare-warning-buffer)))
(declare-function compilation-forget-errors "compile" ())
@@ -289,7 +270,18 @@ TYPE is a string giving the nature of the error. Warning is displayed in
(defun check-declare-files (&rest files)
"Check veracity of all `declare-function' statements in FILES.
Return a list of any errors found."
- (let (alist err errlist)
+ (if (get-buffer check-declare-warning-buffer)
+ (kill-buffer check-declare-warning-buffer))
+ (let ((buf (get-buffer-create check-declare-warning-buffer))
+ alist err errlist)
+ (with-current-buffer buf
+ (unless (derived-mode-p 'compilation-mode)
+ (compilation-mode))
+ (setq mode-line-process
+ '(:propertize ":run" face compilation-mode-line-run))
+ (let ((inhibit-read-only t))
+ (insert "\f\n"))
+ (compilation-forget-errors))
(dolist (file files)
(setq alist (cons (cons file (check-declare-scan file)) alist)))
;; Sort so that things are ordered by the files supposed to
@@ -298,19 +290,15 @@ Return a list of any errors found."
(if (setq err (check-declare-verify (car e) (cdr e)))
(setq errlist (cons (cons (car e) err) errlist))))
(setq errlist (nreverse errlist))
- (if (get-buffer check-declare-warning-buffer)
- (kill-buffer check-declare-warning-buffer))
- (with-current-buffer (get-buffer-create check-declare-warning-buffer)
- (unless (derived-mode-p 'compilation-mode)
- (compilation-mode))
- (let ((inhibit-read-only t))
- (insert "\f\n"))
- (compilation-forget-errors))
;; Sort back again so that errors are ordered by the files
;; containing the declare-function statements.
(dolist (e (check-declare-sort errlist))
(dolist (f (cdr e))
(check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
+ (with-current-buffer buf
+ (setq mode-line-process
+ '(:propertize ":exit" face compilation-mode-line-run))
+ (force-mode-line-update))
errlist))
;;;###autoload
@@ -320,34 +308,22 @@ See `check-declare-directory' for more information."
(interactive "fFile to check: ")
(or (file-exists-p file)
(error "File `%s' not found" file))
- (let ((m (format "Checking %s..." file))
- errlist)
- (message "%s" m)
- (setq errlist (check-declare-files file))
- (message "%s%s" m (check-declare-errmsg errlist))
- errlist))
+ (check-declare-files file))
;;;###autoload
(defun check-declare-directory (root)
"Check veracity of all `declare-function' statements under directory ROOT.
Returns non-nil if any false statements are found."
(interactive "DDirectory to check: ")
- (or (file-directory-p (setq root (expand-file-name root)))
+ (setq root (directory-file-name (file-relative-name root)))
+ (or (file-directory-p root)
(error "Directory `%s' not found" root))
- (let ((m "Checking `declare-function' statements...")
- (m2 "Finding files with declarations...")
- errlist files)
- (message "%s" m)
- (message "%s" m2)
- (setq files (process-lines find-program root
- "-name" "*.el"
- "-exec" grep-program
- "-l" "^[ \t]*(declare-function" "{}" ";"))
- (message "%s%d found" m2 (length files))
+ (let ((files (process-lines find-program root
+ "-name" "*.el"
+ "-exec" grep-program
+ "-l" "^[ \t]*(declare-function" "{}" "+")))
(when files
- (setq errlist (apply 'check-declare-files files))
- (message "%s%s" m (check-declare-errmsg errlist t))
- errlist)))
+ (apply #'check-declare-files files))))
(provide 'check-declare)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index fd8f108a54e..3a81adeb6a6 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1638,6 +1638,17 @@ function,command,variable,option or symbol." ms1))))))
;; * If a user option variable records a true-or-false
;; condition, give it a name that ends in `-flag'.
+ ;; "True ..." should be "Non-nil ..."
+ (when (looking-at "\"\\*?\\(True\\)\\b")
+ (if (checkdoc-autofix-ask-replace
+ (match-beginning 1) (match-end 1)
+ "Say \"Non-nil\" instead of \"True\"? "
+ "Non-nil")
+ nil
+ (checkdoc-create-error
+ "\"True\" should usually be \"Non-nil\""
+ (match-beginning 1) (match-end 1))))
+
;; If the variable has -flag in the name, make sure
(if (and (string-match "-flag$" (car fp))
(not (looking-at "\"\\*?Non-nil\\s-+means\\s-+")))
@@ -1798,6 +1809,16 @@ Replace with \"%s\"? " original replace)
"Probably \"%s\" should be imperative \"%s\""
original replace)
(match-beginning 1) (match-end 1))))))
+ ;; "Return true ..." should be "Return non-nil ..."
+ (when (looking-at "\"Return \\(true\\)\\b")
+ (if (checkdoc-autofix-ask-replace
+ (match-beginning 1) (match-end 1)
+ "Say \"non-nil\" instead of \"true\"? "
+ "non-nil")
+ nil
+ (checkdoc-create-error
+ "\"true\" should usually be \"non-nil\""
+ (match-beginning 1) (match-end 1))))
;; Done with functions
)))
;;* When a documentation string refers to a Lisp symbol, write it as
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 37edf45df38..0144daf3793 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -410,7 +410,8 @@ to be a cons with VAL as its head.
;; function, so warnings like "not known to be defined" are fair game.
;; But in practice, it's common to use `cl-defmethod'
;; without a previous `cl-defgeneric'.
- (declare-function ,name "")
+ ;; The ",'" is a no-op that pacifies check-declare.
+ (,'declare-function ,name "")
(cl-generic-define-method ',name ',(nreverse qualifiers) ',args
,uses-cnm ,fun)))))
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index a615f9a5854..0f7691af0f4 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -137,6 +137,9 @@ BODY can start with a bunch of keyword arguments. The following keyword
:abbrev-table TABLE
Use TABLE instead of the default (CHILD-abbrev-table).
A nil value means to simply use the same abbrev-table as the parent.
+:after-hook FORM
+ A single lisp form which is evaluated after the mode hooks have been
+ run. It should not be quoted.
Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
@@ -184,7 +187,8 @@ See Info node `(elisp)Derived Modes' for more details."
(declare-abbrev t)
(declare-syntax t)
(hook (derived-mode-hook-name child))
- (group nil))
+ (group nil)
+ (after-hook nil))
;; Process the keyword args.
(while (keywordp (car body))
@@ -192,6 +196,7 @@ See Info node `(elisp)Derived Modes' for more details."
(`:group (setq group (pop body)))
(`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
(`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
+ (`:after-hook (setq after-hook (pop body)))
(_ (pop body))))
(setq docstring (derived-mode-make-docstring
@@ -272,7 +277,11 @@ No problems result if this variable is not bound.
,@body
)
;; Run the hooks, if any.
- (run-mode-hooks ',hook)))))
+ (run-mode-hooks ',hook)
+ ,@(when after-hook
+ `((if delay-mode-hooks
+ (push ',after-hook delayed-after-hook-forms)
+ ,after-hook)))))))
;; PUBLIC: find the ultimate class of a derived mode.
@@ -344,7 +353,7 @@ which more-or-less shadow%s %s's corresponding table%s."
(format "`%s' " parent))
"might have run,\nthis mode "))
(format "runs the hook `%s'" hook)
- ", as the final step\nduring initialization.")))
+ ", as the final or penultimate step\nduring initialization.")))
(unless (string-match "\\\\[{[]" docstring)
;; And don't forget to put the mode's keymap.
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 05229d2df04..38295c302ea 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -108,9 +108,10 @@ Optional LIGHTER is displayed in the mode line when the mode is on.
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
or an expression that returns either a keymap or a list of
- arguments for `easy-mmode-define-keymap'. If you supply a KEYMAP
- argument that is not a symbol, this macro defines the variable
- MODE-map and gives it the value that KEYMAP specifies.
+ (KEY . BINDING) pairs where KEY and BINDING are suitable for
+ `define-key'. If you supply a KEYMAP argument that is not a
+ symbol, this macro defines the variable MODE-map and gives it
+ the value that KEYMAP specifies.
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index e8484fa1f94..c283c168b5e 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -233,6 +233,12 @@ If the result is non-nil, then break. Errors are ignored."
:type 'number
:group 'edebug)
+(defcustom edebug-sit-on-break t
+ "Whether or not to pause for `edebug-sit-for-seconds' on reaching a break."
+ :type 'boolean
+ :group 'edebug
+ :version "25.2")
+
;;; Form spec utilities.
(defun get-edebug-spec (symbol)
@@ -2489,6 +2495,7 @@ MSG is printed after `::::} '."
(progn
;; Display result of previous evaluation.
(if (and edebug-break
+ edebug-sit-on-break
(not (eq edebug-execution-mode 'Continue-fast)))
(sit-for edebug-sit-for-seconds)) ; Show message.
(edebug-previous-result)))
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index 6d4798b92f9..7ee897093b2 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -265,7 +265,7 @@ Summary:
;; Local Variables:
-;; generated-autoload-file: "eieio-core.el"
+;; generated-autoload-file: "eieio-loaddefs.el"
;; End:
(provide 'eieio-compat)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 631e4a437f2..fd8ae2abecb 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -33,6 +33,7 @@
(require 'cl-lib)
(require 'pcase)
+(require 'eieio-loaddefs)
;;;
;; A few functions that are better in the official EIEIO src, but
@@ -756,9 +757,7 @@ Argument FN is the function calling this verifier."
;; The slot-missing method is a cool way of allowing an object author
;; to intercept missing slot definitions. Since it is also the LAST
;; thing called in this fn, its return value would be retrieved.
- (slot-missing obj slot 'oref)
- ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
- )
+ (slot-missing obj slot 'oref))
(cl-check-type obj eieio-object)
(eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
@@ -780,9 +779,7 @@ Fills in OBJ's SLOT with its default value."
;; Oref that slot.
(aref (eieio--class-class-allocation-values cl)
c)
- (slot-missing obj slot 'oref-default)
- ;;(signal 'invalid-slot-name (list (class-name cl) slot))
- )
+ (slot-missing obj slot 'oref-default))
(eieio-barf-if-slot-unbound
(let ((val (cl--slot-descriptor-initform
(aref (eieio--class-slots cl)
@@ -822,9 +819,7 @@ Fills in OBJ's SLOT with VALUE."
(aset (eieio--class-class-allocation-values class)
c value))
;; See oref for comment on `slot-missing'
- (slot-missing obj slot 'oset value)
- ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
- )
+ (slot-missing obj slot 'oset value))
(eieio--validate-slot-value class c value slot)
(aset obj c value))))
@@ -1100,98 +1095,6 @@ method invocation orders of the involved classes."
(cl-defmethod cl-generic-generalizers ((_specializer (head subclass)))
(list eieio--generic-subclass-generalizer))
-
-;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "6aca3c1b5f751a01331761da45fc4f5c")
-;;; Generated autoloads from eieio-compat.el
-
-(autoload 'eieio--defalias "eieio-compat" "\
-Like `defalias', but with less side-effects.
-More specifically, it has no side-effects at all when the new function
-definition is the same (`eq') as the old one.
-
-\(fn NAME BODY)" nil nil)
-
-(autoload 'defgeneric "eieio-compat" "\
-Create a generic function METHOD.
-DOC-STRING is the base documentation for this class. A generic
-function has no body, as its purpose is to decide which method body
-is appropriate to use. Uses `defmethod' to create methods, and calls
-`defgeneric' for you. With this implementation the ARGS are
-currently ignored. You can use `defgeneric' to apply specialized
-top level documentation to a method.
-
-\(fn METHOD ARGS &optional DOC-STRING)" nil t)
-
-(function-put 'defgeneric 'doc-string-elt '3)
-
-(make-obsolete 'defgeneric 'cl-defgeneric '"25.1")
-
-(autoload 'defmethod "eieio-compat" "\
-Create a new METHOD through `defgeneric' with ARGS.
-
-The optional second argument KEY is a specifier that
-modifies how the method is called, including:
- :before - Method will be called before the :primary
- :primary - The default if not specified
- :after - Method will be called after the :primary
- :static - First arg could be an object or class
-The next argument is the ARGLIST. The ARGLIST specifies the arguments
-to the method as with `defun'. The first argument can have a type
-specifier, such as:
- ((VARNAME CLASS) ARG2 ...)
-where VARNAME is the name of the local variable for the method being
-created. The CLASS is a class symbol for a class made with `defclass'.
-A DOCSTRING comes after the ARGLIST, and is optional.
-All the rest of the args are the BODY of the method. A method will
-return the value of the last form in the BODY.
-
-Summary:
-
- (defmethod mymethod [:before | :primary | :after | :static]
- ((typearg class-name) arg2 &optional opt &rest rest)
- \"doc-string\"
- body)
-
-\(fn METHOD &rest ARGS)" nil t)
-
-(function-put 'defmethod 'doc-string-elt '3)
-
-(make-obsolete 'defmethod 'cl-defmethod '"25.1")
-
-(autoload 'eieio--defgeneric-init-form "eieio-compat" "\
-
-
-\(fn METHOD DOC-STRING)" nil nil)
-
-(autoload 'eieio--defmethod "eieio-compat" "\
-
-
-\(fn METHOD KIND ARGCLASS CODE)" nil nil)
-
-(autoload 'eieio-defmethod "eieio-compat" "\
-Obsolete work part of an old version of the `defmethod' macro.
-
-\(fn METHOD ARGS)" nil nil)
-
-(make-obsolete 'eieio-defmethod 'cl-defmethod '"24.1")
-
-(autoload 'eieio-defgeneric "eieio-compat" "\
-Obsolete work part of an old version of the `defgeneric' macro.
-
-\(fn METHOD DOC-STRING)" nil nil)
-
-(make-obsolete 'eieio-defgeneric 'cl-defgeneric '"24.1")
-
-(autoload 'eieio-defclass "eieio-compat" "\
-
-
-\(fn CNAME SUPERCLASSES SLOTS OPTIONS)" nil nil)
-
-(make-obsolete 'eieio-defclass 'eieio-defclass-internal '"25.1")
-
-;;;***
-
-
(provide 'eieio-core)
;;; eieio-core.el ends here
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 0ba1eba4f48..d2d87ea1537 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -473,7 +473,7 @@ Return the symbol for the group, or nil"
(provide 'eieio-custom)
;; Local variables:
-;; generated-autoload-file: "eieio.el"
+;; generated-autoload-file: "eieio-loaddefs.el"
;; End:
;;; eieio-custom.el ends here
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index c1f8297b4a5..2f1d69f78f8 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -349,7 +349,7 @@ INDENT is the current indentation level."
(provide 'eieio-opt)
;; Local variables:
-;; generated-autoload-file: "eieio.el"
+;; generated-autoload-file: "eieio-loaddefs.el"
;; End:
;;; eieio-opt.el ends here
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index f045e267ff4..80ac8eff322 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -678,7 +678,8 @@ This class is not stored in the `parent' slot of a class vector."
(setq eieio-default-superclass (cl--find-class 'eieio-default-superclass))
-(defalias 'standard-class 'eieio-default-superclass)
+(define-obsolete-function-alias 'standard-class
+ 'eieio-default-superclass "25.2")
(cl-defgeneric make-instance (class &rest initargs)
"Make a new instance of CLASS based on INITARGS.
@@ -765,11 +766,7 @@ dynamically set from SLOTS."
;; Shared initialize will parse our slots for us.
(shared-initialize this slots))
-(cl-defgeneric slot-missing (object slot-name operation &optional new-value)
- "Method invoked when an attempt to access a slot in OBJECT fails.")
-
-(cl-defmethod slot-missing ((object eieio-default-superclass) slot-name
- _operation &optional _new-value)
+(cl-defgeneric slot-missing (object slot-name _operation &optional _new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.
SLOT-NAME is the name of the failed slot, OPERATION is the type of access
that was requested, and optional NEW-VALUE is the value that was desired
@@ -777,8 +774,9 @@ to be set.
This method is called from `oref', `oset', and other functions which
directly reference slots in EIEIO objects."
- (signal 'invalid-slot-name (list (eieio-object-name object)
- slot-name)))
+ (signal 'invalid-slot-name
+ (list (if (eieio-object-p object) (eieio-object-name object) object)
+ slot-name)))
(cl-defgeneric slot-unbound (object class slot-name fn)
"Slot unbound is invoked during an attempt to reference an unbound slot.")
@@ -815,22 +813,19 @@ first and modify the returned object.")
(if params (shared-initialize nobj params))
nobj))
-(cl-defgeneric destructor (this &rest params)
- "Destructor for cleaning up any dynamic links to our object.")
-
-(cl-defmethod destructor ((_this eieio-default-superclass) &rest _params)
- "Destructor for cleaning up any dynamic links to our object.
-Argument THIS is the object being destroyed. PARAMS are additional
-ignored parameters."
+(cl-defgeneric destructor (_this &rest _params)
+ "Destructor for cleaning up any dynamic links to our object."
+ (declare (obsolete nil "25.2"))
;; No cleanup... yet.
- )
+ nil)
-(cl-defgeneric object-print (this &rest strings)
- "Pretty printer for object THIS. Call function `object-name' with STRINGS.
+(cl-defgeneric object-print (this &rest _strings)
+ "Pretty printer for object THIS.
It is sometimes useful to put a summary of the object into the
default #<notation> string when using EIEIO browsing tools.
-Implement this method to customize the summary.")
+Implement this method to customize the summary."
+ (format "%S" this))
(cl-defmethod object-print ((this eieio-default-superclass) &rest strings)
"Pretty printer for object THIS. Call function `object-name' with STRINGS.
@@ -938,11 +933,12 @@ this object."
;;; Unimplemented functions from CLOS
;;
-(defun change-class (_obj _class)
+(defun eieio-change-class (_obj _class)
"Change the class of OBJ to type CLASS.
This may create or delete slots, but does not affect the return value
of `eq'."
(error "EIEIO: `change-class' is unimplemented"))
+(define-obsolete-function-alias 'change-class 'eieio-change-class "25.2")
;; Hook ourselves into help system for describing classes and methods.
;; FIXME: This is not actually needed any more since we can click on the
@@ -970,41 +966,6 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
(advice-add 'edebug-prin1-to-string
:around #'eieio-edebug-prin1-to-string)
-
-;;; Start of automatically extracted autoloads.
-
-;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "e8d466f8eee341f3da967c2931b28043")
-;;; Generated autoloads from eieio-custom.el
-
-(autoload 'customize-object "eieio-custom" "\
-Customize OBJ in a custom buffer.
-Optional argument GROUP is the sub-group of slots to display.
-
-\(fn OBJ &optional GROUP)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "0b9c6be48520da2085812f6e7fed9792")
-;;; Generated autoloads from eieio-opt.el
-
-(autoload 'eieio-browse "eieio-opt" "\
-Create an object browser window to show all objects.
-If optional ROOT-CLASS, then start with that, otherwise start with
-variable `eieio-default-superclass'.
-
-\(fn &optional ROOT-CLASS)" t nil)
-
-(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1")
-
-(autoload 'eieio-help-constructor "eieio-opt" "\
-Describe CTR if it is a class constructor.
-
-\(fn CTR)" nil nil)
-
-;;;***
-
-;;; End of automatically extracted autoloads.
-
(provide 'eieio)
;;; eieio ends here
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 096102ae7e1..6c2f869f260 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -197,7 +197,10 @@ expression point is on."
(t
(kill-local-variable 'eldoc-message-commands)
(remove-hook 'post-command-hook 'eldoc-schedule-timer t)
- (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))))
+ (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)
+ (when eldoc-timer
+ (cancel-timer eldoc-timer)
+ (setq eldoc-timer nil)))))
;;;###autoload
(define-minor-mode global-eldoc-mode
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 2a2418fa7d2..67cb102a67c 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -285,6 +285,46 @@ BUFFER defaults to current buffer. Does not modify BUFFER."
(kill-buffer clone)))))))
+(defmacro ert-with-function-mocked (name mock &rest body)
+ "Mocks function NAME with MOCK and run BODY.
+
+Once BODY finishes (be it normally by returning a value or
+abnormally by throwing or signaling), the old definition of
+function NAME is restored.
+
+BODY may further change the mock with `fset'.
+
+If MOCK is nil, the function NAME is mocked with a function
+`ert-fail'ing when called.
+
+For example:
+
+ ;; Regular use, function is mocked inside the BODY:
+ (should (eq 2 (+ 1 1)))
+ (ert-with-function-mocked ((+ (lambda (a b) (- a b))))
+ (should (eq 0 (+ 1 1))))
+ (should (eq 2 (+ 1 1)))
+
+ ;; Macro correctly recovers from a throw or signal:
+ (should
+ (catch 'done
+ (ert-with-function-mocked ((+ (lambda (a b) (- a b))))
+ (should (eq 0 (+ 1 1))))
+ (throw 'done t)))
+ (should (eq 2 (+ 1 1)))
+"
+ (declare (indent 2))
+ (let ((old-var (make-symbol "old-var"))
+ (mock-var (make-symbol "mock-var")))
+ `(let ((,old-var (symbol-function (quote ,name))) (,mock-var ,mock))
+ (fset (quote ,name)
+ (or ,mock-var (lambda (&rest _)
+ (ert-fail (concat "`" ,(symbol-name name)
+ "' unexpectedly called.")))))
+ (unwind-protect
+ (progn ,@body)
+ (fset (quote ,name) ,old-var)))))
+
(provide 'ert-x)
;;; ert-x.el ends here
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 7a914da3977..0308c9cd37c 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1470,7 +1470,7 @@ this exits Emacs, with status as per `ert-run-tests-batch-and-exit'."
(user-error "This function is only for use in batch mode"))
(let ((nlogs (length command-line-args-left))
(ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0)
- nnotrun logfile notests badtests unexpected)
+ nnotrun logfile notests badtests unexpected skipped)
(with-temp-buffer
(while (setq logfile (pop command-line-args-left))
(erase-buffer)
@@ -1490,9 +1490,10 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
(push logfile unexpected)
(setq nunexpected (+ nunexpected
(string-to-number (match-string 4)))))
- (if (match-string 5)
- (setq nskipped (+ nskipped
- (string-to-number (match-string 5)))))))))
+ (when (match-string 5)
+ (push logfile skipped)
+ (setq nskipped (+ nskipped
+ (string-to-number (match-string 5)))))))))
(setq nnotrun (- ntests nrun))
(message "\nSUMMARY OF TEST RESULTS")
(message "-----------------------")
@@ -1516,6 +1517,26 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
(when unexpected
(message "%d files contained unexpected results:" (length unexpected))
(mapc (lambda (l) (message " %s" l)) unexpected))
+ ;; More details on hydra, where the logs are harder to get to.
+ (when (and (getenv "NIX_STORE")
+ (not (zerop (+ nunexpected nskipped))))
+ (message "\nDETAILS")
+ (message "-------")
+ (with-temp-buffer
+ (dolist (x (list (list skipped "skipped" "SKIPPED")
+ (list unexpected "unexpected" "FAILED")))
+ (mapc (lambda (l)
+ (erase-buffer)
+ (insert-file-contents l)
+ (message "%s:" l)
+ (when (re-search-forward (format "^[ \t]*[0-9]+ %s results:"
+ (nth 1 x))
+ nil t)
+ (while (and (zerop (forward-line 1))
+ (looking-at (format "^[ \t]*%s" (nth 2 x))))
+ (message "%s" (buffer-substring (line-beginning-position)
+ (line-end-position))))))
+ (car x)))))
(kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2)
(unexpected 1)
(t 0)))))
@@ -2460,7 +2481,7 @@ To be used in the ERT results buffer."
stats)
for end-time across (ert--stats-test-end-times stats)
collect (list test
- (float-time (subtract-time
+ (float-time (time-subtract
end-time start-time))))))
(setq data (sort data (lambda (a b)
(> (cl-second a) (cl-second b)))))
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index f174a64fcba..71437ce89bd 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -43,6 +43,8 @@
;;; Code:
+(require 'seq)
+
;;; User variables:
(defgroup find-function nil
@@ -182,15 +184,15 @@ See the functions `find-function' and `find-variable'."
LIBRARY should be a string (the name of the library)."
;; If the library is byte-compiled, try to find a source library by
;; the same name.
- (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
- (setq library (replace-match "" t t library)))
+ (when (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
+ (setq library (replace-match "" t t library)))
(or
(locate-file library
- (or find-function-source-path load-path)
- (find-library-suffixes))
+ (or find-function-source-path load-path)
+ (find-library-suffixes))
(locate-file library
- (or find-function-source-path load-path)
- load-file-rep-suffixes)
+ (or find-function-source-path load-path)
+ load-file-rep-suffixes)
(when (file-name-absolute-p library)
(let ((rel (find-library--load-name library)))
(when rel
@@ -201,8 +203,44 @@ LIBRARY should be a string (the name of the library)."
(locate-file rel
(or find-function-source-path load-path)
load-file-rep-suffixes)))))
+ (find-library--from-load-path library)
(error "Can't find library %s" library)))
+(defun find-library--from-load-path (library)
+ ;; In `load-history', the file may be ".elc", ".el", ".el.gz", and
+ ;; LIBRARY may be "foo.el" or "foo", so make sure that we get all
+ ;; potential matches, and then see whether any of them lead us to an
+ ;; ".el" or an ".el.gz" file.
+ (let* ((elc-regexp "\\.el\\(c\\(\\..*\\)?\\)\\'")
+ (suffix-regexp
+ (concat "\\("
+ (mapconcat 'regexp-quote (find-library-suffixes) "\\'\\|")
+ "\\|" elc-regexp "\\)\\'"))
+ (potentials
+ (mapcar
+ (lambda (entry)
+ (if (string-match suffix-regexp (car entry))
+ (replace-match "" t t (car entry))
+ (car entry)))
+ (seq-filter
+ (lambda (entry)
+ (string-match
+ (concat "\\`"
+ (regexp-quote
+ (replace-regexp-in-string suffix-regexp "" library))
+ suffix-regexp)
+ (file-name-nondirectory (car entry))))
+ load-history)))
+ result)
+ (dolist (file potentials)
+ (dolist (suffix (find-library-suffixes))
+ (when (not result)
+ (cond ((file-exists-p file)
+ (setq result file))
+ ((file-exists-p (concat file suffix))
+ (setq result (concat file suffix)))))))
+ result))
+
(defvar find-function-C-source-directory
(let ((dir (expand-file-name "src" source-directory)))
(if (file-accessible-directory-p dir) dir))
@@ -255,9 +293,12 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
(cons (current-buffer) (match-beginning 0))))
;;;###autoload
-(defun find-library (library)
+(defun find-library (library &optional other-window)
"Find the Emacs Lisp source of LIBRARY.
-LIBRARY should be a string (the name of the library)."
+LIBRARY should be a string (the name of the library). If the
+optional OTHER-WINDOW argument (i.e., the command argument) is
+specified, pop to a different window before displaying the
+buffer."
(interactive
(let* ((dirs (or find-function-source-path load-path))
(suffixes (find-library-suffixes))
@@ -279,11 +320,17 @@ LIBRARY should be a string (the name of the library)."
(when (and def (not (test-completion def table)))
(setq def nil))
(list
- (completing-read (if def (format "Library name (default %s): " def)
+ (completing-read (if def
+ (format "Library name (default %s): " def)
"Library name: ")
- table nil nil nil nil def))))
- (let ((buf (find-file-noselect (find-library-name library))))
- (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
+ table nil nil nil nil def)
+ current-prefix-arg)))
+ (prog1
+ (funcall (if other-window
+ 'pop-to-buffer
+ 'pop-to-buffer-same-window)
+ (find-file-noselect (find-library-name library)))
+ (run-hooks 'find-function-after-hook)))
;;;###autoload
(defun find-function-search-for-symbol (symbol type library)
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index e400b499036..3507a395436 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -2,13 +2,16 @@
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
-;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
-;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
+;; Author: Artur Malabarba <emacs@endlessparentheses.com>
+;; Package-Requires: ((emacs "24.1"))
;; Version: 1.0.4
;; Keywords: extensions lisp
;; Prefix: let-alist
;; Separator: -
+;; This is an Elpa :core package. Don't use functionality that is not
+;; compatible with Emacs 24.1.
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -134,7 +137,7 @@ displayed in the example above."
(let ((var (make-symbol "alist")))
`(let ((,var ,alist))
(let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
- (delete-dups (let-alist--deep-dot-search body)))
+ (delete-dups (let-alist--deep-dot-search body)))
,@body))))
(provide 'let-alist)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 315b3d56343..4f3af2a7d7f 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -168,6 +168,8 @@
(defvar lisp-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
+(defconst lisp-prettify-symbols-alist '(("lambda" . ?λ))
+ "Alist of symbol/\"pretty\" characters to be displayed.")
;;;; Font-lock support.
@@ -594,7 +596,7 @@ font-lock keywords will not be case sensitive."
(font-lock-extra-managed-props help-echo)
(font-lock-syntactic-face-function
. lisp-font-lock-syntactic-face-function)))
- (setq-local prettify-symbols-alist lisp--prettify-symbols-alist)
+ (setq-local prettify-symbols-alist lisp-prettify-symbols-alist)
(setq-local electric-pair-skip-whitespace 'chomp)
(setq-local electric-pair-open-newline-between-pairs nil))
@@ -655,9 +657,6 @@ font-lock keywords will not be case sensitive."
:type 'hook
:group 'lisp)
-(defconst lisp--prettify-symbols-alist
- '(("lambda" . ?λ)))
-
;;; Generic Lisp mode.
(defvar lisp-mode-map
@@ -1217,8 +1216,15 @@ and initial semicolons."
;;
;; The `fill-column' is temporarily bound to
;; `emacs-lisp-docstring-fill-column' if that value is an integer.
- (let ((paragraph-start (concat paragraph-start
- "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))
+ (let ((paragraph-start
+ (concat paragraph-start
+ (format "\\|\\s-*\\([(;%s\"]\\|`(\\|#'(\\)"
+ ;; If we're inside a string (like the doc
+ ;; string), don't consider a colon to be
+ ;; a paragraph-start character.
+ (if (nth 3 (syntax-ppss))
+ ""
+ ":"))))
(paragraph-separate
(concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
(fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 58973dfa920..8afe18f8d94 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -150,6 +150,7 @@
(require 'tabulated-list)
(require 'macroexp)
+(require 'url-handlers)
(defgroup package nil
"Manager for Emacs Lisp packages."
@@ -905,12 +906,15 @@ untar into a directory named DIR; otherwise, signal an error."
file)
(defvar generated-autoload-file)
+(defvar autoload-timestamps)
(defvar version-control)
(defun package-generate-autoloads (name pkg-dir)
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
+ ;; We don't need 'em, and this makes the output reproducible.
+ (autoload-timestamps nil)
;; Silence `autoload-generate-file-autoloads'.
(noninteractive inhibit-message)
(backup-inhibited t)
@@ -2297,7 +2301,7 @@ Otherwise no newline is inserted."
(insert "\n")
(unless (and pkg-dir (not archive)) ; Installed pkgs don't have archive.
(package--print-help-section "Archive"
- (or archive "n/a") "\n"))
+ (or archive "n/a")))
(and version
(package--print-help-section "Version"
(package-version-join version)))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 8362ddafd3f..92f0ad78566 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
-;; Version: 2.3
+;; Version: 2.14
;; Package: seq
;; Maintainer: emacs-devel@gnu.org
@@ -144,6 +144,18 @@ if positive or too small if negative)."
sequence)
(nreverse result)))
+(defun seq-map-indexed (function sequence)
+ "Return the result of applying FUNCTION to each element of SEQUENCE.
+Unlike `seq-map', FUNCTION takes two arguments: the element of
+the sequence, and its index within the sequence."
+ (let ((index 0))
+ (seq-map (lambda (elt)
+ (prog1
+ (funcall function elt index)
+ (setq index (1+ index))))
+ sequence)))
+
+
;; faster implementation for sequences (sequencep)
(cl-defmethod seq-map (function (sequence sequence))
(mapcar function sequence))
@@ -206,6 +218,16 @@ The result is a sequence of the same type as SEQUENCE."
(cl-defmethod seq-sort (pred (list list))
(sort (seq-copy list) pred))
+(defun seq-sort-by (function pred sequence)
+ "Sort SEQUENCE using PRED as a comparison function.
+Elements of SEQUENCE are transformed by FUNCTION before being
+sorted. FUNCTION must be a function of one argument."
+ (seq-sort (lambda (a b)
+ (funcall pred
+ (funcall function a)
+ (funcall function b)))
+ sequence))
+
(cl-defgeneric seq-reverse (sequence)
"Return a sequence with elements of SEQUENCE in reverse order."
(let ((result '()))
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 654f234fa62..31fc67ec815 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -417,6 +417,9 @@ point (where the PPSS is equivalent to nil).")
(error nil)))
syntax-ppss-stats))
+(defvar-local syntax-ppss-table nil
+ "Syntax-table to use during `syntax-ppss', if any.")
+
(defun syntax-ppss (&optional pos)
"Parse-Partial-Sexp State at POS, defaulting to point.
The returned value is the same as that of `parse-partial-sexp'
@@ -432,6 +435,7 @@ running the hook."
(unless pos (setq pos (point)))
(syntax-propertize pos)
;;
+ (with-syntax-table (or syntax-ppss-table (syntax-table))
(let ((old-ppss (cdr syntax-ppss-last))
(old-pos (car syntax-ppss-last))
(ppss nil)
@@ -568,7 +572,7 @@ running the hook."
;; we may end up calling parse-partial-sexp with a position before
;; point-min. In that case, just parse from point-min assuming
;; a nil state.
- (parse-partial-sexp (point-min) pos)))))
+ (parse-partial-sexp (point-min) pos))))))
;; Debugging functions
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
new file mode 100644
index 00000000000..9b13e52dd7c
--- /dev/null
+++ b/lisp/emacs-lisp/timer-list.el
@@ -0,0 +1,112 @@
+;;; timer-list.el --- list active timers in a buffer
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Package: emacs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+;;;###autoload
+(defun timer-list (&optional _ignore-auto _nonconfirm)
+ "List all timers in a buffer."
+ (interactive)
+ (pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (timer-list-mode)
+ (dolist (timer (append timer-list timer-idle-list))
+ (insert (format "%4s %10s %8s %s"
+ ;; Idle.
+ (if (aref timer 7)
+ "*"
+ " ")
+ ;; Next time.
+ (let ((time (float-time (list (aref timer 1)
+ (aref timer 2)
+ (aref timer 3)))))
+ (format "%.2f"
+ (if (aref timer 7)
+ time
+ (- (float-time (list (aref timer 1)
+ (aref timer 2)
+ (aref timer 3)))
+ (float-time)))))
+ ;; Repeat.
+ (let ((repeat (aref timer 4)))
+ (cond
+ ((numberp repeat)
+ (format "%.2f" (/ repeat 60)))
+ ((null repeat)
+ "-")
+ (t
+ (format "%s" repeat))))
+ ;; Function.
+ (let ((function (aref timer 5)))
+ (replace-regexp-in-string
+ "\n" " "
+ (cond
+ ((byte-code-function-p function)
+ (replace-regexp-in-string
+ "[^-A-Za-z0-9 ]" ""
+ (format "%s" function)))
+ (t
+ (format "%s" function)))))))
+ (put-text-property (line-beginning-position)
+ (1+ (line-beginning-position))
+ 'timer timer)
+ (insert "\n")))
+ (goto-char (point-min)))
+;; This command can be destructive if they don't know what they are
+;; doing. Kids, don't try this at home!
+;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
+
+(defvar timer-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "c" 'timer-list-cancel)
+ (easy-menu-define nil map ""
+ '("Timers"
+ ["Cancel" timer-list-cancel t]))
+ map))
+
+(define-derived-mode timer-list-mode special-mode "timer-list"
+ "Mode for listing and controlling timers."
+ (setq truncate-lines t)
+ (buffer-disable-undo)
+ (setq-local revert-buffer-function 'timer-list)
+ (setq buffer-read-only t)
+ (setq header-line-format
+ (format "%4s %10s %8s %s"
+ "Idle" "Next" "Repeat" "Function")))
+
+(defun timer-list-cancel ()
+ "Cancel the timer on the line under point."
+ (interactive)
+ (let ((timer (get-text-property (line-beginning-position) 'timer))
+ (inhibit-read-only t))
+ (unless timer
+ (error "No timer on the current line"))
+ (cancel-timer timer)
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2))))
+
+(provide 'timer-list)
+
+;;; timer-list.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 10:50:53 +0000