diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 98a1b11e08..36c7966919 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -33,6 +33,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) (require 'help-mode) (require 'radix-tree) (eval-when-compile (require 'subr-x)) ;For when-let. @@ -678,19 +679,9 @@ help-fns--globalized-minor-mode (terpri))) ;; We could use `symbol-file' but this is a wee bit more efficient. -(defun help-fns--autoloaded-p (function file) - "Return non-nil if FUNCTION has previously been autoloaded. -FILE is the file where FUNCTION was probably defined." - (let* ((file (file-name-sans-extension (file-truename file))) - (load-hist load-history) - (target (cons t function)) - found) - (while (and load-hist (not found)) - (and (stringp (caar load-hist)) - (equal (file-name-sans-extension (caar load-hist)) file) - (setq found (member target (cdar load-hist)))) - (setq load-hist (cdr load-hist))) - found)) +(defun help-fns--autoloaded-p (function) + "Return non-nil if FUNCTION has previously been autoloaded." + (seq-some #'autoloadp (get function 'function-history))) (defun help-fns--interactive-only (function) "Insert some help blurb if FUNCTION should only be used interactively." @@ -873,13 +864,13 @@ help-fns-function-description-header "Print a line describing FUNCTION to `standard-output'." (pcase-let* ((`(,_real-function ,def ,aliased ,real-def) (help-fns--analyze-function function)) - (file-name (find-lisp-object-file-name function (if aliased 'defun - def))) + (file-name (find-lisp-object-file-name + function (if aliased 'defun def))) (beg (if (and (or (byte-code-function-p def) (keymapp def) (memq (car-safe def) '(macro lambda closure))) (stringp file-name) - (help-fns--autoloaded-p function file-name)) + (help-fns--autoloaded-p function)) (concat "an autoloaded " (if (commandp def) "interactive ")) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 48058f4053..8f634afaca 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -157,38 +157,30 @@ unload--set-major-mode ;; mode, or proposed is not nil and not major-mode, and so we use it. (funcall (or proposed 'fundamental-mode))))))) +(defvar loadhist-unload-filename nil) + (cl-defgeneric loadhist-unload-element (x) - "Unload an element from the `load-history'." + "Unload an element from the `load-history'. +The variable `loadhist-unload-filename' holds the name of the file we're +unloading." (message "Unexpected element %S in load-history" x)) -;; In `load-history', the definition of a previously autoloaded -;; function is represented by 2 entries: (t . SYMBOL) comes before -;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when -;; we undefine it. -;; So we use this auxiliary variable to keep track of the last (t . SYMBOL) -;; that occurred. -(defvar loadhist--restore-autoload nil - "If non-nil, is a symbol for which to try to restore a previous autoload.") - -(cl-defmethod loadhist-unload-element ((x (head t))) - (setq loadhist--restore-autoload (cdr x))) - -(defun loadhist--unload-function (x) - (let ((fun (cdr x))) - (when (fboundp fun) - (when (fboundp 'ad-unadvise) - (ad-unadvise fun)) - (let ((aload (get fun 'autoload))) - (defalias fun - (if (and aload (eq fun loadhist--restore-autoload)) - (cons 'autoload aload) - nil))))) - (setq loadhist--restore-autoload nil)) - (cl-defmethod loadhist-unload-element ((x (head defun))) - (loadhist--unload-function x)) -(cl-defmethod loadhist-unload-element ((x (head autoload))) - (loadhist--unload-function x)) + (let ((fun (cdr x)) + (hist (get fun 'function-history))) + (cond + ((null hist) (defalias fun nil)) + ((equal (car hist) loadhist-unload-filename) + (put fun 'function-history (cddr hist)) + (defalias fun (cadr hist))) + (t + ;; Unloading a file whose definition is "inactive" (i.e. has been + ;; overridden by another file): just remove it from the history, + ;; so future unloading of that other file has a chance to DTRT. + (let* ((tmp (plist-member hist loadhist-unload-filename)) + (pos (- (length hist) (length tmp)))) + (cl-assert (> pos 1)) + (setcdr (nthcdr (1- pos) hist) (cdr tmp))))))) (cl-defmethod loadhist-unload-element ((_ (head require))) nil) (cl-defmethod loadhist-unload-element ((_ (head defface))) nil) @@ -257,6 +249,7 @@ unload-feature (prin1-to-string dependents) file)))) (let* ((unload-function-defs-list (feature-symbols feature)) (file (pop unload-function-defs-list)) + (loadhist-unload-filename file) (name (symbol-name feature)) (unload-hook (intern-soft (concat name "-unload-hook"))) (unload-func (intern-soft (concat name "-unload-function")))) diff --git a/src/data.c b/src/data.c index a5a76a2755..8cd13f3a77 100644 --- a/src/data.c +++ b/src/data.c @@ -859,6 +859,43 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, return definition; } +static void +add_to_function_history (Lisp_Object symbol, Lisp_Object olddef) +{ + eassert (!NILP (olddef)); + + Lisp_Object past = Fget (symbol, Qfunction_history); + Lisp_Object file = Qnil; + /* FIXME: Sadly, `Vload_file_name` gives less precise information + (it's sometimes non-nil when it shoujld be nil). */ + Lisp_Object tail = Vcurrent_load_list; + FOR_EACH_TAIL_SAFE (tail) + if (NILP (XCDR (tail)) && STRINGP (XCAR (tail))) + file = XCAR (tail); + + Lisp_Object tem = Fplist_member (past, file); + if (!NILP (tem)) + { /* New def from a file used before. + Overwrite the previous record associated with this file. */ + if (EQ (tem, past)) + /* The new def is from the same file as the last change, so + there's nothing to do: unloading the file should revert to + the status before the last change rather than before this load. */ + return; + Lisp_Object pastlen = Flength (past); + Lisp_Object temlen = Flength (tem); + EMACS_INT tempos = XFIXNUM (pastlen) - XFIXNUM (temlen); + eassert (tempos > 1); + Lisp_Object prev = Fnthcdr (make_fixnum (tempos - 2), past); + /* Remove the previous info for this file. + E.g. change `hist` from (... OTHERFILE DEF3 THISFILE DEF2 ...) + to (... OTHERFILE DEF2). */ + XSETCDR (prev, XCDR (tem)); + } + /* Push new def from new file. */ + Fput (symbol, Qfunction_history, Fcons (file, Fcons (olddef, past))); +} + void defalias (Lisp_Object symbol, Lisp_Object definition) { @@ -867,28 +904,24 @@ defalias (Lisp_Object symbol, Lisp_Object definition) if (!will_dump_p () || !autoload) { /* Only add autoload entries after dumping, because the ones before are not useful and else we get loads of them from the loaddefs.el. */ - Lisp_Object function = XSYMBOL (symbol)->u.s.function; - - if (AUTOLOADP (function)) - /* Remember that the function was already an autoload. */ - LOADHIST_ATTACH (Fcons (Qt, symbol)); - LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); - - if (!NILP (Vautoload_queue) && !NILP (function)) - Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); - - if (AUTOLOADP (function)) - Fput (symbol, Qautoload, XCDR (function)); + LOADHIST_ATTACH (Fcons (Qdefun, symbol)); } } - { /* Handle automatic advice activation. */ - Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); - if (!NILP (hook)) - call2 (hook, symbol, definition); - else - Ffset (symbol, definition); - } + Lisp_Object olddef = XSYMBOL (symbol)->u.s.function; + if (!NILP (olddef)) + { + if (!NILP (Vautoload_queue)) + Vautoload_queue = Fcons (symbol, Vautoload_queue); + add_to_function_history (symbol, olddef); + } + + /* Handle automatic advice activation. */ + Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); + if (!NILP (hook)) + call2 (hook, symbol, definition); + else + Ffset (symbol, definition); } DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, @@ -4171,6 +4204,7 @@ #define PUT_ERROR(sym, tail, msg) \ DEFSYM (Qinteractive_form, "interactive-form"); DEFSYM (Qdefalias_fset_function, "defalias-fset-function"); + DEFSYM (Qfunction_history, "function-history"); DEFSYM (Qbyte_code_function_p, "byte-code-function-p"); diff --git a/src/eval.c b/src/eval.c index b083a00a79..cf38e76718 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2236,35 +2236,40 @@ DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0, && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; + ptrdiff_t count = SPECPDL_INDEX (); + if (will_dump_p) + /* Only add autoload entries after dumping, because the ones before are + not useful and else we get loads of them from the loaddefs.el. */ + specbind (Qcurrent_load_list, Qnil); + if (!NILP (Vpurify_flag) && EQ (docstring, make_fixnum (0))) /* `read1' in lread.c has found the docstring starting with "\ and assumed the docstring will be provided by Snarf-documentation, so it passed us 0 instead. But that leads to accidental sharing in purecopy's hash-consing, so we use a (hopefully) unique integer instead. */ docstring = make_ufixnum (XHASH (function)); - return Fdefalias (function, - list5 (Qautoload, file, docstring, interactive, type), - Qnil); + Lisp_Object tem + = Fdefalias (function, + list5 (Qautoload, file, docstring, interactive, type), + Qnil); + unbind_to (count, Qnil); + return tem; } static void un_autoload (Lisp_Object oldqueue) { - Lisp_Object queue, first, second; - /* Queue to unwind is current value of Vautoload_queue. oldqueue is the shadowed value to leave in Vautoload_queue. */ - queue = Vautoload_queue; + Lisp_Object queue = Vautoload_queue; Vautoload_queue = oldqueue; while (CONSP (queue)) { - first = XCAR (queue); - second = Fcdr (first); - first = Fcar (first); - if (EQ (first, make_fixnum (0))) - Vfeatures = second; + Lisp_Object first = XCAR (queue); + if (CONSP (first) && EQ (XCAR (first), make_fixnum (0))) + Vfeatures = XCDR (first); else - Ffset (first, second); + Ffset (first, Fcar (Fcdr (Fget (first, Qfunction_history)))); queue = XCDR (queue); } } diff --git a/src/lread.c b/src/lread.c index 9910db27de..ada137ff19 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5240,12 +5248,9 @@ syms_of_lread (void) The remaining ENTRIES in the alist element describe the functions and variables defined in that file, the features provided, and the features required. Each entry has the form `(provide . FEATURE)', -`(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)', -`(defface . SYMBOL)', `(define-type . SYMBOL)', -`(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'. -Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry, -and mean that SYMBOL was an autoload before this file redefined it -as a function. In addition, entries may also be single symbols, +`(require . FEATURE)', `(defun . FUNCTION)', `(defface . SYMBOL)', + `(define-type . SYMBOL)', or `(cl-defmethod METHOD SPECIALIZERS)'. +In addition, entries may also be single symbols, which means that symbol was defined by `defvar' or `defconst'. During preloading, the file name recorded is relative to the main Lisp