(defconst generate-autoload-section-continuation ";;;;;; "
"String to add on each continuation of the section header form.")
-(defvar autoload-timestamps t
+;; 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,
(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))))
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))))
(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
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
;;;###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)
;; 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)))
(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
(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
;; 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.
nil nil 'emacs-mule-unix)
(if autoload-timestamps
(nth 5 (file-attributes relfile))
- t)))
+ autoload--non-timestamp)))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer))))
(or noninteractive
(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.
(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))
(if (and (or (null existing-buffer)
(not (buffer-modified-p existing-buffer)))
(cond
- ;; last-time is the time-stamp (specifying
- ;; the last time we looked at the file) and
- ;; the file hasn't been changed since.
- ((listp last-time) (= (length last-time) 2)
- (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,
;; file modtime in such a case,
;; if there are multiple input files
;; contributing to the output.
- ((and output-time (eq t last-time))
+ ((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.
+ ((listp last-time)
+ (not (time-less-p last-time file-time)))
;; last-time is an MD5 checksum instead.
((stringp last-time)
(equal last-time
(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.
(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)
;; Remove the obsolete section.
(autoload-remove-section (match-beginning 0))
(setq last-time (nth 4 form))
- (if (equal t last-time)
+ (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))))
;; 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)))
((not (time-less-p (let ((oldtime (nth 4 form)))
- (if (equal t oldtime)
+ (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.
(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.
(autoload-insert-section-header
(current-buffer) nil nil no-autoloads (if autoload-timestamps
no-autoloads-time
- t))
+ 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))))
(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)