summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/autoload.el67
-rw-r--r--lisp/emacs-lisp/bytecomp.el50
-rw-r--r--lisp/emacs-lisp/checkdoc.el25
-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/ert-x.el40
-rw-r--r--lisp/emacs-lisp/let-alist.el9
-rw-r--r--lisp/emacs-lisp/lisp-mode.el7
-rw-r--r--lisp/emacs-lisp/package.el6
-rw-r--r--lisp/emacs-lisp/seq.el12
-rw-r--r--lisp/emacs-lisp/syntax.el6
-rw-r--r--lisp/emacs-lisp/timer-list.el112
15 files changed, 312 insertions, 204 deletions
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index e688d6be725..1b06fb6a51d 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -87,6 +87,23 @@ 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.")
+(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)
@@ -624,7 +641,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))
+ t)))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer))))
(or noninteractive
@@ -655,6 +674,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 +693,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 +713,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 +740,26 @@ 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
;; 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)))
+ ;; 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 (eq t last-time))
+ (not (time-less-p output-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))))
@@ -782,7 +819,10 @@ 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
@@ -800,6 +840,8 @@ write its autoloads into the specified file instead."
;; Remove the obsolete section.
(autoload-remove-section (match-beginning 0))
(setq last-time (nth 4 form))
+ (if (equal t last-time)
+ (setq last-time output-time))
(dolist (file file)
(let ((file-time (nth 5 (file-attributes file))))
(when (and file-time
@@ -815,7 +857,10 @@ write its autoloads into the specified file instead."
(member (expand-file-name file) autoload-excludes))
;; Remove the obsolete section.
(autoload-remove-section (match-beginning 0)))
- ((not (time-less-p (nth 4 form)
+ ((not (time-less-p (let ((oldtime (nth 4 form)))
+ (if (equal t oldtime)
+ output-time
+ oldtime))
(nth 5 (file-attributes file))))
;; File hasn't changed.
nil)
@@ -848,7 +893,9 @@ 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
+ t))
(insert generate-autoload-section-trailer)))
(let ((version-control 'never))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 1526e2fdeb9..11eb44cea31 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.
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index fd8f108a54e..e93294d6cc2 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1580,7 +1580,7 @@ mouse-[0-3]\\)\\)\\>"))
(if (and sym (boundp sym) (fboundp sym)
(save-excursion
(goto-char mb)
- (forward-word-strictly -1)
+ (forward-word -1)
(not (looking-at
"variable\\|option\\|function\\|command\\|symbol"))))
(if (checkdoc-autofix-ask-replace
@@ -1596,7 +1596,7 @@ mouse-[0-3]\\)\\)\\>"))
nil t nil nil "variable")))
(goto-char (1- mb))
(insert disambiguate " ")
- (forward-word-strictly 1))
+ (forward-word 1))
(setq ret
(format "Disambiguate %s by preceding w/ \
function,command,variable,option or symbol." ms1))))))
@@ -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/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 8a4df0635c4..9e5f524a945 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 772ebd900de..47aff333d44 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" "5bd32f1033d0e2eee7c32c0ad28330fc")
-;;; 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/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 2a2418fa7d2..eb10c845d3f 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 signalling), 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/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 cb8abde52ed..8d57c193f4e 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
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index b65e45b1bf6..869c1549658 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -149,6 +149,7 @@
(require 'tabulated-list)
(require 'macroexp)
+(require 'url-handlers)
(defgroup package nil
"Manager for Emacs Lisp packages."
@@ -904,12 +905,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)
@@ -2288,7 +2292,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 300fe5cd1fd..8b7b594f5e1 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -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))
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index e20a210de71..c221a017f51 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -416,6 +416,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'
@@ -431,6 +434,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)
@@ -567,7 +571,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-21 10:18:35 +0000