(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))))
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
(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)
-
+(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-def-prefixes-max-entries 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).")
+
+(defconst autoload-def-prefixes-max-length 12
+ "Target size of definition prefixes.
+Don't try to split prefixes that are already longer than that.")
+
+(require 'radix-tree)
+
+(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* ((tree (let ((tree radix-tree-empty))
+ (dolist (def defs)
+ (setq tree (radix-tree-insert tree def t)))
+ tree))
+ (prefixes nil))
+ ;; Get the root prefixes, that we should include in any case.
+ (radix-tree-iter-subtrees
+ tree (lambda (prefix subtree)
+ (push (cons prefix subtree) prefixes)))
+ ;; In some cases, the root prefixes are too short, e.g. if you define
+ ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
+ (dolist (pair (prog1 prefixes (setq prefixes nil)))
+ (let ((s (car pair)))
+ (if (or (> (length s) 2) ;Long enough!
+ (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
+ (radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
+ (push pair prefixes) ;Keep it as is.
+ (radix-tree-iter-subtrees
+ (cdr pair) (lambda (prefix subtree)
+ (push (cons (concat s prefix) subtree) prefixes))))))
+ ;; FIXME: The expansions done below are mostly pointless, such as
+ ;; for `yenc', where we replace "yenc-" with an exhaustive list (5
+ ;; elements).
+ ;; (while
+ ;; (let ((newprefixes nil)
+ ;; (changes nil))
+ ;; (dolist (pair prefixes)
+ ;; (let ((prefix (car pair)))
+ ;; (if (or (> (length prefix) autoload-def-prefixes-max-length)
+ ;; (radix-tree-lookup (cdr pair) ""))
+ ;; ;; No point splitting it any further.
+ ;; (push pair newprefixes)
+ ;; (setq changes t)
+ ;; (radix-tree-iter-subtrees
+ ;; (cdr pair) (lambda (sprefix subtree)
+ ;; (push (cons (concat prefix sprefix) subtree)
+ ;; newprefixes))))))
+ ;; (and changes
+ ;; (<= (length newprefixes)
+ ;; autoload-def-prefixes-max-entries)
+ ;; (let ((new nil)
+ ;; (old nil))
+ ;; (dolist (pair prefixes)
+ ;; (unless (memq pair newprefixes) ;Not old
+ ;; (push pair old)))
+ ;; (dolist (pair newprefixes)
+ ;; (unless (memq pair prefixes) ;Not new
+ ;; (push pair new)))
+ ;; (cl-assert new)
+ ;; (message "Expanding %S to %S"
+ ;; (mapcar #'car old) (mapcar #'car new))
+ ;; t)
+ ;; (setq prefixes newprefixes)
+ ;; (< (length prefixes) autoload-def-prefixes-max-entries))))
+
+ ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
+ (when prefixes
+ (let ((strings
+ (mapcar
+ (lambda (x)
+ (let ((prefix (car x)))
+ (if (or (> (length prefix) 2) ;Long enough!
+ (string-match ".[[:punct:]]\\'" prefix))
+ prefix
+ ;; Some packages really don't follow the rules.
+ ;; Drop the most egregious cases such as the
+ ;; one-letter prefixes.
+ (let ((dropped ()))
+ (radix-tree-iter-mappings
+ (cdr x) (lambda (s _)
+ (push (concat prefix s) dropped)))
+ (message "Not registering prefix \"%s\" from %s. Affects: %S"
+ prefix file dropped)
+ nil))))
+ prefixes)))
+ `(if (fboundp 'register-definition-prefixes)
+ (register-definition-prefixes ,file ',(delq nil strings)))))))
(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"
+ "def-edebug-spec"
+ ;; Hmm... this is getting ugly:
+ "define-widget"
+ "define-erc-response-handler"
+ "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.
(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 occurred.
(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)
;; 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 (member oldtime
;; 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--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)