diff options
Diffstat (limited to 'lisp/emacs-lisp/autoload.el')
| -rw-r--r-- | lisp/emacs-lisp/autoload.el | 333 |
1 files changed, 284 insertions, 49 deletions
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) |