]> code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/autoload.el
Add new function dom-remove-node
[gnu-emacs] / lisp / emacs-lisp / autoload.el
1 ;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 1991-1997, 2001-2016 Free Software Foundation, Inc.
4
5 ;; Author: Roland McGrath <roland@gnu.org>
6 ;; Keywords: maint
7 ;; Package: emacs
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
27 ;; date. It interprets magic cookies of the form ";;;###autoload" in
28 ;; lisp source files in various useful ways. To learn more, read the
29 ;; source; if you're going to use this, you'd better be able to.
30
31 ;;; Code:
32
33 (require 'lisp-mode) ;for `doc-string-elt' properties.
34 (require 'lisp-mnt)
35 (eval-when-compile (require 'cl-lib))
36
37 (defvar generated-autoload-file nil
38 "File into which to write autoload definitions.
39 A Lisp file can set this in its local variables section to make
40 its autoloads go somewhere else.
41
42 If this is a relative file name, the directory is determined as
43 follows:
44 - If a Lisp file defined `generated-autoload-file' as a
45 file-local variable, use its containing directory.
46 - Otherwise use the \"lisp\" subdirectory of `source-directory'.
47
48 The autoload file is assumed to contain a trailer starting with a
49 FormFeed character.")
50 ;;;###autoload
51 (put 'generated-autoload-file 'safe-local-variable 'stringp)
52
53 (defvar generated-autoload-load-name nil
54 "Load name for `autoload' statements generated from autoload cookies.
55 If nil, this defaults to the file name, sans extension.
56 Typically, you need to set this when the directory containing the file
57 is not in `load-path'.
58 This also affects the generated cus-load.el file.")
59 ;;;###autoload
60 (put 'generated-autoload-load-name 'safe-local-variable 'stringp)
61
62 ;; This feels like it should be a defconst, but MH-E sets it to
63 ;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
64 (defvar generate-autoload-cookie ";;;###autoload"
65 "Magic comment indicating the following form should be autoloaded.
66 Used by \\[update-file-autoloads]. This string should be
67 meaningless to Lisp (e.g., a comment).
68
69 This string is used:
70
71 \;;;###autoload
72 \(defun function-to-be-autoloaded () ...)
73
74 If this string appears alone on a line, the following form will be
75 read and an autoload made for it. If there is further text on the line,
76 that text will be copied verbatim to `generated-autoload-file'.")
77
78 (defvar autoload-excludes nil
79 "If non-nil, list of absolute file names not to scan for autoloads.")
80
81 (defconst generate-autoload-section-header "\f\n;;;### "
82 "String that marks the form at the start of a new file's autoload section.")
83
84 (defconst generate-autoload-section-trailer "\n;;;***\n"
85 "String which indicates the end of the section of autoloads for a file.")
86
87 (defconst generate-autoload-section-continuation ";;;;;; "
88 "String to add on each continuation of the section header form.")
89
90 ;; In some ways it would be nicer to use a value that is recognizably
91 ;; not a time-value, eg t, but that can cause issues if an older Emacs
92 ;; that does not expect non-time-values loads the file.
93 (defconst autoload--non-timestamp '(0 0 0 0)
94 "Value to insert when `autoload-timestamps' is nil.")
95
96 (defvar autoload-timestamps nil ; experimental, see bug#22213
97 "Non-nil means insert a timestamp for each input file into the output.
98 We use these in incremental updates of the output file to decide
99 if we need to rescan an input file. If you set this to nil,
100 then we use the timestamp of the output file instead. As a result:
101 - for fixed inputs, the output will be the same every time
102 - incremental updates of the output file might not be correct if:
103 i) the timestamp of the output file cannot be trusted (at least
104 relative to that of the input files)
105 ii) any of the input files can be modified during the time it takes
106 to create the output
107 iii) only a subset of the input files are scanned
108 These issues are unlikely to happen in practice, and would arguably
109 represent bugs in the build system. Item iii) will happen if you
110 use a command like `update-file-autoloads', though, since it only
111 checks a single input file.")
112
113 (defvar autoload-modified-buffers) ;Dynamically scoped var.
114
115 (defun make-autoload (form file &optional expansion)
116 "Turn FORM into an autoload or defvar for source file FILE.
117 Returns nil if FORM is not a special autoload form (i.e. a function definition
118 or macro definition or a defcustom).
119 If EXPANSION is non-nil, we're processing the macro expansion of an
120 expression, in which case we want to handle forms differently."
121 (let ((car (car-safe form)) expand)
122 (cond
123 ((and expansion (eq car 'defalias))
124 (pcase-let*
125 ((`(,_ ,_ ,arg . ,rest) form)
126 ;; `type' is non-nil if it defines a macro.
127 ;; `fun' is the function part of `arg' (defaults to `arg').
128 ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
129 (and (let fun arg) (let type nil)))
130 arg)
131 ;; `lam' is the lambda expression in `fun' (or nil if not
132 ;; recognized).
133 (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
134 ;; `args' is the list of arguments (or t if not recognized).
135 ;; `body' is the body of `lam' (or t if not recognized).
136 ((or `(lambda ,args . ,body)
137 (and (let args t) (let body t)))
138 lam)
139 ;; Get the `doc' from `body' or `rest'.
140 (doc (cond ((stringp (car-safe body)) (car body))
141 ((stringp (car-safe rest)) (car rest))))
142 ;; Look for an interactive spec.
143 (interactive (pcase body
144 ((or `((interactive . ,_) . ,_)
145 `(,_ (interactive . ,_) . ,_))
146 t))))
147 ;; Add the usage form at the end where describe-function-1
148 ;; can recover it.
149 (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
150 ;; (message "autoload of %S" (nth 1 form))
151 `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
152
153 ((and expansion (memq car '(progn prog1)))
154 (let ((end (memq :autoload-end form)))
155 (when end ;Cut-off anything after the :autoload-end marker.
156 (setq form (copy-sequence form))
157 (setcdr (memq :autoload-end form) nil))
158 (let ((exps (delq nil (mapcar (lambda (form)
159 (make-autoload form file expansion))
160 (cdr form)))))
161 (when exps (cons 'progn exps)))))
162
163 ;; For complex cases, try again on the macro-expansion.
164 ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
165 define-globalized-minor-mode defun defmacro
166 easy-mmode-define-minor-mode define-minor-mode
167 define-inline cl-defun cl-defmacro))
168 (macrop car)
169 (setq expand (let ((load-file-name file)) (macroexpand form)))
170 (memq (car expand) '(progn prog1 defalias)))
171 (make-autoload expand file 'expansion)) ;Recurse on the expansion.
172
173 ;; For special function-like operators, use the `autoload' function.
174 ((memq car '(define-skeleton define-derived-mode
175 define-compilation-mode define-generic-mode
176 easy-mmode-define-global-mode define-global-minor-mode
177 define-globalized-minor-mode
178 easy-mmode-define-minor-mode define-minor-mode
179 cl-defun defun* cl-defmacro defmacro*
180 define-overloadable-function))
181 (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
182 (name (nth 1 form))
183 (args (pcase car
184 ((or `defun `defmacro
185 `defun* `defmacro* `cl-defun `cl-defmacro
186 `define-overloadable-function)
187 (nth 2 form))
188 (`define-skeleton '(&optional str arg))
189 ((or `define-generic-mode `define-derived-mode
190 `define-compilation-mode)
191 nil)
192 (_ t)))
193 (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
194 (doc (if (stringp (car body)) (pop body))))
195 ;; Add the usage form at the end where describe-function-1
196 ;; can recover it.
197 (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
198 ;; `define-generic-mode' quotes the name, so take care of that
199 `(autoload ,(if (listp name) name (list 'quote name))
200 ,file ,doc
201 ,(or (and (memq car '(define-skeleton define-derived-mode
202 define-generic-mode
203 easy-mmode-define-global-mode
204 define-global-minor-mode
205 define-globalized-minor-mode
206 easy-mmode-define-minor-mode
207 define-minor-mode))
208 t)
209 (eq (car-safe (car body)) 'interactive))
210 ,(if macrop ''macro nil))))
211
212 ;; For defclass forms, use `eieio-defclass-autoload'.
213 ((eq car 'defclass)
214 (let ((name (nth 1 form))
215 (superclasses (nth 2 form))
216 (doc (nth 4 form)))
217 (list 'eieio-defclass-autoload (list 'quote name)
218 (list 'quote superclasses) file doc)))
219
220 ;; Convert defcustom to less space-consuming data.
221 ((eq car 'defcustom)
222 (let ((varname (car-safe (cdr-safe form)))
223 (init (car-safe (cdr-safe (cdr-safe form))))
224 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
225 ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
226 )
227 `(progn
228 (defvar ,varname ,init ,doc)
229 (custom-autoload ',varname ,file
230 ,(condition-case nil
231 (null (cadr (memq :set form)))
232 (error nil))))))
233
234 ((eq car 'defgroup)
235 ;; In Emacs this is normally handled separately by cus-dep.el, but for
236 ;; third party packages, it can be convenient to explicitly autoload
237 ;; a group.
238 (let ((groupname (nth 1 form)))
239 `(let ((loads (get ',groupname 'custom-loads)))
240 (if (member ',file loads) nil
241 (put ',groupname 'custom-loads (cons ',file loads))))))
242
243 ;; When processing a macro expansion, any expression
244 ;; before a :autoload-end should be included. These are typically (put
245 ;; 'fun 'prop val) and things like that.
246 ((and expansion (consp form)) form)
247
248 ;; nil here indicates that this is not a special autoload form.
249 (t nil))))
250
251 ;; Forms which have doc-strings which should be printed specially.
252 ;; A doc-string-elt property of ELT says that (nth ELT FORM) is
253 ;; the doc-string in FORM.
254 ;; Those properties are now set in lisp-mode.el.
255
256 (defun autoload-find-generated-file ()
257 "Visit the autoload file for the current buffer, and return its buffer.
258 If a buffer is visiting the desired autoload file, return it."
259 (let ((enable-local-variables :safe)
260 (enable-local-eval nil))
261 ;; We used to use `raw-text' to read this file, but this causes
262 ;; problems when the file contains non-ASCII characters.
263 (let* ((delay-mode-hooks t)
264 (file (autoload-generated-file))
265 (file-missing (not (file-exists-p file))))
266 (when file-missing
267 (autoload-ensure-default-file file))
268 (with-current-buffer
269 (find-file-noselect
270 (autoload-ensure-file-writeable
271 file))
272 ;; block backups when the file has just been created, since
273 ;; the backups will just be the auto-generated headers.
274 ;; bug#23203
275 (when file-missing
276 (setq buffer-backed-up t)
277 (save-buffer))
278 (current-buffer)))))
279
280 (defun autoload-generated-file ()
281 (expand-file-name generated-autoload-file
282 ;; File-local settings of generated-autoload-file should
283 ;; be interpreted relative to the file's location,
284 ;; of course.
285 (if (not (local-variable-p 'generated-autoload-file))
286 (expand-file-name "lisp" source-directory))))
287
288
289 (defun autoload-read-section-header ()
290 "Read a section header form.
291 Since continuation lines have been marked as comments,
292 we must copy the text of the form and remove those comment
293 markers before we call `read'."
294 (save-match-data
295 (let ((beginning (point))
296 string)
297 (forward-line 1)
298 (while (looking-at generate-autoload-section-continuation)
299 (forward-line 1))
300 (setq string (buffer-substring beginning (point)))
301 (with-current-buffer (get-buffer-create " *autoload*")
302 (erase-buffer)
303 (insert string)
304 (goto-char (point-min))
305 (while (search-forward generate-autoload-section-continuation nil t)
306 (replace-match " "))
307 (goto-char (point-min))
308 (read (current-buffer))))))
309
310 (defvar autoload-print-form-outbuf nil
311 "Buffer which gets the output of `autoload-print-form'.")
312
313 (defun autoload-print-form (form)
314 "Print FORM such that `make-docfile' will find the docstrings.
315 The variable `autoload-print-form-outbuf' specifies the buffer to
316 put the output in."
317 (cond
318 ;; If the form is a sequence, recurse.
319 ((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
320 ;; Symbols at the toplevel are meaningless.
321 ((symbolp form) nil)
322 (t
323 (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
324 (outbuf autoload-print-form-outbuf))
325 (if (and doc-string-elt (stringp (nth doc-string-elt form)))
326 ;; We need to hack the printing because the
327 ;; doc-string must be printed specially for
328 ;; make-docfile (sigh).
329 (let* ((p (nthcdr (1- doc-string-elt) form))
330 (elt (cdr p)))
331 (setcdr p nil)
332 (princ "\n(" outbuf)
333 (let ((print-escape-newlines t)
334 (print-quoted t)
335 (print-escape-nonascii t))
336 (dolist (elt form)
337 (prin1 elt outbuf)
338 (princ " " outbuf)))
339 (princ "\"\\\n" outbuf)
340 (let ((begin (with-current-buffer outbuf (point))))
341 (princ (substring (prin1-to-string (car elt)) 1)
342 outbuf)
343 ;; Insert a backslash before each ( that
344 ;; appears at the beginning of a line in
345 ;; the doc string.
346 (with-current-buffer outbuf
347 (save-excursion
348 (while (re-search-backward "\n[[(]" begin t)
349 (forward-char 1)
350 (insert "\\"))))
351 (if (null (cdr elt))
352 (princ ")" outbuf)
353 (princ " " outbuf)
354 (princ (substring (prin1-to-string (cdr elt)) 1)
355 outbuf))
356 (terpri outbuf)))
357 (let ((print-escape-newlines t)
358 (print-quoted t)
359 (print-escape-nonascii t))
360 (print form outbuf)))))))
361
362 (defun autoload-rubric (file &optional type feature)
363 "Return a string giving the appropriate autoload rubric for FILE.
364 TYPE (default \"autoloads\") is a string stating the type of
365 information contained in FILE. If FEATURE is non-nil, FILE
366 will provide a feature. FEATURE may be a string naming the
367 feature, otherwise it will be based on FILE's name.
368
369 At present, a feature is in fact always provided, but this should
370 not be relied upon."
371 (let ((basename (file-name-nondirectory file)))
372 (concat ";;; " basename
373 " --- automatically extracted " (or type "autoloads") "\n"
374 ";;\n"
375 ";;; Code:\n\n"
376 "\f\n"
377 ;; This is used outside of autoload.el, eg cus-dep, finder.
378 "(provide '"
379 (if (stringp feature)
380 feature
381 (file-name-sans-extension basename))
382 ")\n"
383 ";; Local Variables:\n"
384 ";; version-control: never\n"
385 ";; no-byte-compile: t\n"
386 ";; no-update-autoloads: t\n"
387 ";; coding: utf-8\n"
388 ";; End:\n"
389 ";;; " basename
390 " ends here\n")))
391
392 (defvar autoload-ensure-writable nil
393 "Non-nil means `autoload-ensure-default-file' makes existing file writable.")
394 ;; Just in case someone tries to get you to overwrite a file that you
395 ;; don't want to.
396 ;;;###autoload
397 (put 'autoload-ensure-writable 'risky-local-variable t)
398
399 (defun autoload-ensure-file-writeable (file)
400 ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
401 ;; which was designed to handle CVSREAD=1 and equivalent.
402 (and autoload-ensure-writable
403 (let ((modes (file-modes file)))
404 (if (zerop (logand modes #o0200))
405 ;; Ignore any errors here, and let subsequent attempts
406 ;; to write the file raise any real error.
407 (ignore-errors (set-file-modes file (logior modes #o0200))))))
408 file)
409
410 (defun autoload-ensure-default-file (file)
411 "Make sure that the autoload file FILE exists, creating it if needed.
412 If the file already exists and `autoload-ensure-writable' is non-nil,
413 make it writable."
414 (write-region (autoload-rubric file) nil file))
415
416 (defun autoload-insert-section-header (outbuf autoloads load-name file time)
417 "Insert the section-header line,
418 which lists the file name and which functions are in it, etc."
419 ;; (cl-assert ;Make sure we don't insert it in the middle of another section.
420 ;; (save-excursion
421 ;; (or (not (re-search-backward
422 ;; (concat "\\("
423 ;; (regexp-quote generate-autoload-section-header)
424 ;; "\\)\\|\\("
425 ;; (regexp-quote generate-autoload-section-trailer)
426 ;; "\\)")
427 ;; nil t))
428 ;; (match-end 2))))
429 (insert generate-autoload-section-header)
430 (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
431 outbuf)
432 (terpri outbuf)
433 ;; Break that line at spaces, to avoid very long lines.
434 ;; Make each sub-line into a comment.
435 (with-current-buffer outbuf
436 (save-excursion
437 (forward-line -1)
438 (while (not (eolp))
439 (move-to-column 64)
440 (skip-chars-forward "^ \n")
441 (or (eolp)
442 (insert "\n" generate-autoload-section-continuation))))))
443
444 (defun autoload-find-file (file)
445 "Fetch file and put it in a temp buffer. Return the buffer."
446 ;; It is faster to avoid visiting the file.
447 (setq file (expand-file-name file))
448 (with-current-buffer (get-buffer-create " *autoload-file*")
449 (kill-all-local-variables)
450 (erase-buffer)
451 (setq buffer-undo-list t
452 buffer-read-only nil)
453 (delay-mode-hooks (emacs-lisp-mode))
454 (setq default-directory (file-name-directory file))
455 (insert-file-contents file nil)
456 (let ((enable-local-variables :safe)
457 (enable-local-eval nil))
458 (hack-local-variables))
459 (current-buffer)))
460
461 (defvar no-update-autoloads nil
462 "File local variable to prevent scanning this file for autoload cookies.")
463
464 (defun autoload-file-load-name (file)
465 "Compute the name that will be used to load FILE."
466 ;; OUTFILE should be the name of the global loaddefs.el file, which
467 ;; is expected to be at the root directory of the files we're
468 ;; scanning for autoloads and will be in the `load-path'.
469 (let* ((outfile (default-value 'generated-autoload-file))
470 (name (file-relative-name file (file-name-directory outfile)))
471 (names '())
472 (dir (file-name-directory outfile)))
473 ;; If `name' has directory components, only keep the
474 ;; last few that are really needed.
475 (while name
476 (setq name (directory-file-name name))
477 (push (file-name-nondirectory name) names)
478 (setq name (file-name-directory name)))
479 (while (not name)
480 (cond
481 ((null (cdr names)) (setq name (car names)))
482 ((file-exists-p (expand-file-name "subdirs.el" dir))
483 ;; FIXME: here we only check the existence of subdirs.el,
484 ;; without checking its content. This makes it generate wrong load
485 ;; names for cases like lisp/term which is not added to load-path.
486 (setq dir (expand-file-name (pop names) dir)))
487 (t (setq name (mapconcat #'identity names "/")))))
488 (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
489 (substring name 0 (match-beginning 0))
490 name)))
491
492 (defun generate-file-autoloads (file)
493 "Insert at point a loaddefs autoload section for FILE.
494 Autoloads are generated for defuns and defmacros in FILE
495 marked by `generate-autoload-cookie' (which see).
496 If FILE is being visited in a buffer, the contents of the buffer
497 are used.
498 Return non-nil in the case where no autoloads were added at point."
499 (interactive "fGenerate autoloads for file: ")
500 (let ((generated-autoload-file buffer-file-name))
501 (autoload-generate-file-autoloads file (current-buffer))))
502
503 (defvar autoload-compute-prefixes t
504 "If non-nil, autoload will add code to register the prefixes used in a file.
505 Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
506 variables or functions that use \"foo-\" as prefix, that will not be registered.
507 But all other prefixes will be included.")
508
509 (defconst autoload-def-prefixes-max-entries 5
510 "Target length of the list of definition prefixes per file.
511 If set too small, the prefixes will be too generic (i.e. they'll use little
512 memory, we'll end up looking in too many files when we need a particular
513 prefix), and if set too large, they will be too specific (i.e. they will
514 cost more memory use).")
515
516 (defconst autoload-def-prefixes-max-length 12
517 "Target size of definition prefixes.
518 Don't try to split prefixes that are already longer than that.")
519
520 (require 'radix-tree)
521
522 (defun autoload--make-defs-autoload (defs file)
523
524 ;; Remove the defs that obey the rule that file foo.el (or
525 ;; foo-mode.el) uses "foo-" as prefix.
526 ;; FIXME: help--symbol-completion-table still doesn't know how to use
527 ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix.
528 ;;(let ((prefix
529 ;; (concat (substring file 0 (string-match "-mode\\'" file)) "-")))
530 ;; (dolist (def (prog1 defs (setq defs nil)))
531 ;; (unless (string-prefix-p prefix def)
532 ;; (push def defs))))
533
534 ;; Then compute a small set of prefixes that cover all the
535 ;; remaining definitions.
536 (let* ((tree (let ((tree radix-tree-empty))
537 (dolist (def defs)
538 (setq tree (radix-tree-insert tree def t)))
539 tree))
540 (prefixes nil))
541 ;; Get the root prefixes, that we should include in any case.
542 (radix-tree-iter-subtrees
543 tree (lambda (prefix subtree)
544 (push (cons prefix subtree) prefixes)))
545 ;; In some cases, the root prefixes are too short, e.g. if you define
546 ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
547 (dolist (pair (prog1 prefixes (setq prefixes nil)))
548 (let ((s (car pair)))
549 (if (or (> (length s) 2) ;Long enough!
550 (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
551 (radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
552 (push pair prefixes) ;Keep it as is.
553 (radix-tree-iter-subtrees
554 (cdr pair) (lambda (prefix subtree)
555 (push (cons (concat s prefix) subtree) prefixes))))))
556 ;; FIXME: The expansions done below are mostly pointless, such as
557 ;; for `yenc', where we replace "yenc-" with an exhaustive list (5
558 ;; elements).
559 ;; (while
560 ;; (let ((newprefixes nil)
561 ;; (changes nil))
562 ;; (dolist (pair prefixes)
563 ;; (let ((prefix (car pair)))
564 ;; (if (or (> (length prefix) autoload-def-prefixes-max-length)
565 ;; (radix-tree-lookup (cdr pair) ""))
566 ;; ;; No point splitting it any further.
567 ;; (push pair newprefixes)
568 ;; (setq changes t)
569 ;; (radix-tree-iter-subtrees
570 ;; (cdr pair) (lambda (sprefix subtree)
571 ;; (push (cons (concat prefix sprefix) subtree)
572 ;; newprefixes))))))
573 ;; (and changes
574 ;; (<= (length newprefixes)
575 ;; autoload-def-prefixes-max-entries)
576 ;; (let ((new nil)
577 ;; (old nil))
578 ;; (dolist (pair prefixes)
579 ;; (unless (memq pair newprefixes) ;Not old
580 ;; (push pair old)))
581 ;; (dolist (pair newprefixes)
582 ;; (unless (memq pair prefixes) ;Not new
583 ;; (push pair new)))
584 ;; (cl-assert new)
585 ;; (message "Expanding %S to %S"
586 ;; (mapcar #'car old) (mapcar #'car new))
587 ;; t)
588 ;; (setq prefixes newprefixes)
589 ;; (< (length prefixes) autoload-def-prefixes-max-entries))))
590
591 ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
592 (when prefixes
593 (let ((strings
594 (mapcar
595 (lambda (x)
596 (let ((prefix (car x)))
597 (if (or (> (length prefix) 2) ;Long enough!
598 (string-match ".[[:punct:]]\\'" prefix))
599 prefix
600 ;; Some packages really don't follow the rules.
601 ;; Drop the most egregious cases such as the
602 ;; one-letter prefixes.
603 (let ((dropped ()))
604 (radix-tree-iter-mappings
605 (cdr x) (lambda (s _)
606 (push (concat prefix s) dropped)))
607 (message "Not registering prefix \"%s\" from %s. Affects: %S"
608 prefix file dropped)
609 nil))))
610 prefixes)))
611 `(if (fboundp 'register-definition-prefixes)
612 (register-definition-prefixes ,file ',(delq nil strings)))))))
613
614 (defun autoload--setup-output (otherbuf outbuf absfile load-name)
615 (let ((outbuf
616 (or (if otherbuf
617 ;; A file-local setting of
618 ;; autoload-generated-file says we
619 ;; should ignore OUTBUF.
620 nil
621 outbuf)
622 (autoload-find-destination absfile load-name)
623 ;; The file has autoload cookies, but they're
624 ;; already up-to-date. If OUTFILE is nil, the
625 ;; entries are in the expected OUTBUF,
626 ;; otherwise they're elsewhere.
627 (throw 'done otherbuf))))
628 (with-current-buffer outbuf
629 (point-marker))))
630
631 (defun autoload--print-cookie-text (output-start load-name file)
632 (let ((standard-output (marker-buffer output-start)))
633 (search-forward generate-autoload-cookie)
634 (skip-chars-forward " \t")
635 (if (eolp)
636 (condition-case-unless-debug err
637 ;; Read the next form and make an autoload.
638 (let* ((form (prog1 (read (current-buffer))
639 (or (bolp) (forward-line 1))))
640 (autoload (make-autoload form load-name)))
641 (if autoload
642 nil
643 (setq autoload form))
644 (let ((autoload-print-form-outbuf
645 standard-output))
646 (autoload-print-form autoload)))
647 (error
648 (message "Autoload cookie error in %s:%s %S"
649 file (count-lines (point-min) (point)) err)))
650
651 ;; Copy the rest of the line to the output.
652 (princ (buffer-substring
653 (progn
654 ;; Back up over whitespace, to preserve it.
655 (skip-chars-backward " \f\t")
656 (if (= (char-after (1+ (point))) ? )
657 ;; Eat one space.
658 (forward-char 1))
659 (point))
660 (progn (forward-line 1) (point)))))))
661
662 (defvar autoload-builtin-package-versions nil)
663
664 ;; When called from `generate-file-autoloads' we should ignore
665 ;; `generated-autoload-file' altogether. When called from
666 ;; `update-file-autoloads' we don't know `outbuf'. And when called from
667 ;; `update-directory-autoloads' it's in between: we know the default
668 ;; `outbuf' but we should obey any file-local setting of
669 ;; `generated-autoload-file'.
670 (defun autoload-generate-file-autoloads (file &optional outbuf outfile)
671 "Insert an autoload section for FILE in the appropriate buffer.
672 Autoloads are generated for defuns and defmacros in FILE
673 marked by `generate-autoload-cookie' (which see).
674 If FILE is being visited in a buffer, the contents of the buffer are used.
675 OUTBUF is the buffer in which the autoload statements should be inserted.
676 If OUTBUF is nil, it will be determined by `autoload-generated-file'.
677
678 If provided, OUTFILE is expected to be the file name of OUTBUF.
679 If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
680 different from OUTFILE, then OUTBUF is ignored.
681
682 Return non-nil if and only if FILE adds no autoloads to OUTFILE
683 \(or OUTBUF if OUTFILE is nil). The actual return value is
684 FILE's modification time."
685 ;; Include the file name in any error messages
686 (condition-case err
687 (let (load-name
688 (print-length nil)
689 (print-level nil)
690 (float-output-format nil)
691 (visited (get-file-buffer file))
692 (otherbuf nil)
693 (absfile (expand-file-name file))
694 (defs '())
695 ;; nil until we found a cookie.
696 output-start)
697 (when
698 (catch 'done
699 (with-current-buffer (or visited
700 ;; It is faster to avoid visiting the file.
701 (autoload-find-file file))
702 ;; Obey the no-update-autoloads file local variable.
703 (unless no-update-autoloads
704 (or noninteractive (message "Generating autoloads for %s..." file))
705 (setq load-name
706 (if (stringp generated-autoload-load-name)
707 generated-autoload-load-name
708 (autoload-file-load-name absfile)))
709 ;; FIXME? Comparing file-names for equality with just equal
710 ;; is fragile, eg if one has an automounter prefix and one
711 ;; does not, but both refer to the same physical file.
712 (when (and outfile
713 (not
714 (if (memq system-type '(ms-dos windows-nt))
715 (equal (downcase outfile)
716 (downcase (autoload-generated-file)))
717 (equal outfile (autoload-generated-file)))))
718 (setq otherbuf t))
719 (save-excursion
720 (save-restriction
721 (widen)
722 (when autoload-builtin-package-versions
723 (let ((version (lm-header "version"))
724 package)
725 (and version
726 (setq version (ignore-errors (version-to-list version)))
727 (setq package (or (lm-header "package")
728 (file-name-sans-extension
729 (file-name-nondirectory file))))
730 (setq output-start (autoload--setup-output
731 otherbuf outbuf absfile load-name))
732 (let ((standard-output (marker-buffer output-start))
733 (print-quoted t))
734 (princ `(push (purecopy
735 ',(cons (intern package) version))
736 package--builtin-versions))
737 (princ "\n")))))
738
739 (goto-char (point-min))
740 (while (not (eobp))
741 (skip-chars-forward " \t\n\f")
742 (cond
743 ((looking-at (regexp-quote generate-autoload-cookie))
744 ;; If not done yet, figure out where to insert this text.
745 (unless output-start
746 (setq output-start (autoload--setup-output
747 otherbuf outbuf absfile load-name)))
748 (autoload--print-cookie-text output-start load-name file))
749 ((looking-at ";")
750 ;; Don't read the comment.
751 (forward-line 1))
752 (t
753 ;; Avoid (defvar <foo>) by requiring a trailing space.
754 ;; Also, ignore this prefix business
755 ;; for ;;;###tramp-autoload and friends.
756 (when (and (equal generate-autoload-cookie ";;;###autoload")
757 (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
758 (not (member
759 (match-string 1)
760 '("define-obsolete-function-alias"
761 "define-obsolete-variable-alias"
762 "define-category" "define-key"
763 "defgroup" "defface" "defadvice"
764 "def-edebug-spec"
765 ;; Hmm... this is getting ugly:
766 "define-widget"
767 "define-erc-response-handler"
768 "defun-rcirc-command"))))
769 (push (match-string 2) defs))
770 (forward-sexp 1)
771 (forward-line 1))))))
772
773 (when (and autoload-compute-prefixes defs)
774 ;; This output needs to always go in the main loaddefs.el,
775 ;; regardless of generated-autoload-file.
776 ;; FIXME: the files that don't have autoload cookies but
777 ;; do have definitions end up listed twice in loaddefs.el:
778 ;; once for their register-definition-prefixes and once in
779 ;; the list of "files without any autoloads".
780 (let ((form (autoload--make-defs-autoload defs load-name)))
781 (cond
782 ((null form)) ;All defs obey the default rule, yay!
783 ((not otherbuf)
784 (unless output-start
785 (setq output-start (autoload--setup-output
786 nil outbuf absfile load-name)))
787 (let ((autoload-print-form-outbuf
788 (marker-buffer output-start)))
789 (autoload-print-form form)))
790 (t
791 (let* ((other-output-start
792 ;; To force the output to go to the main loaddefs.el
793 ;; rather than to generated-autoload-file,
794 ;; there are two cases: if outbuf is non-nil,
795 ;; then passing otherbuf=nil is enough, but if
796 ;; outbuf is nil, that won't cut it, so we
797 ;; locally bind generated-autoload-file.
798 (let ((generated-autoload-file
799 (default-value 'generated-autoload-file)))
800 (autoload--setup-output nil outbuf absfile load-name)))
801 (autoload-print-form-outbuf
802 (marker-buffer other-output-start)))
803 (autoload-print-form form)
804 (with-current-buffer (marker-buffer other-output-start)
805 (save-excursion
806 ;; Insert the section-header line which lists
807 ;; the file name and which functions are in it, etc.
808 (goto-char other-output-start)
809 (let ((relfile (file-relative-name absfile)))
810 (autoload-insert-section-header
811 (marker-buffer other-output-start)
812 "actual autoloads are elsewhere" load-name relfile
813 (nth 5 (file-attributes absfile)))
814 (insert ";;; Generated autoloads from " relfile "\n")))
815 (insert generate-autoload-section-trailer)))))))
816
817 (when output-start
818 (let ((secondary-autoloads-file-buf
819 (if otherbuf (current-buffer))))
820 (with-current-buffer (marker-buffer output-start)
821 (cl-assert (> (point) output-start))
822 (save-excursion
823 ;; Insert the section-header line which lists the file name
824 ;; and which functions are in it, etc.
825 (goto-char output-start)
826 (let ((relfile (file-relative-name absfile)))
827 (autoload-insert-section-header
828 (marker-buffer output-start)
829 () load-name relfile
830 (if secondary-autoloads-file-buf
831 ;; MD5 checksums are much better because they do not
832 ;; change unless the file changes (so they'll be
833 ;; equal on two different systems and will change
834 ;; less often than time-stamps, thus leading to fewer
835 ;; unneeded changes causing spurious conflicts), but
836 ;; using time-stamps is a very useful optimization,
837 ;; so we use time-stamps for the main autoloads file
838 ;; (loaddefs.el) where we have special ways to
839 ;; circumvent the "random change problem", and MD5
840 ;; checksum in secondary autoload files where we do
841 ;; not need the time-stamp optimization because it is
842 ;; already provided by the primary autoloads file.
843 (md5 secondary-autoloads-file-buf
844 ;; We'd really want to just use
845 ;; `emacs-internal' instead.
846 nil nil 'emacs-mule-unix)
847 (if autoload-timestamps
848 (nth 5 (file-attributes relfile))
849 autoload--non-timestamp)))
850 (insert ";;; Generated autoloads from " relfile "\n")))
851 (insert generate-autoload-section-trailer))))
852 (or noninteractive
853 (message "Generating autoloads for %s...done" file)))
854 (or visited
855 ;; We created this buffer, so we should kill it.
856 (kill-buffer (current-buffer))))
857 (or (not output-start)
858 ;; If the entries were added to some other buffer, then the file
859 ;; doesn't add entries to OUTFILE.
860 otherbuf))
861 (nth 5 (file-attributes absfile))))
862 (error
863 ;; Probably unbalanced parens in forward-sexp. In that case, the
864 ;; condition is scan-error, and the signal data includes point
865 ;; where the error was found; we'd like to convert that to
866 ;; line:col, but line-number-at-pos gets the wrong line in batch
867 ;; mode for some reason.
868 ;;
869 ;; At least this gets the file name in the error message; the
870 ;; developer can use goto-char to get to the error position.
871 (error "%s:0:0: error: %s: %s" file (car err) (cdr err)))
872 ))
873 \f
874 (defun autoload-save-buffers ()
875 (while autoload-modified-buffers
876 (with-current-buffer (pop autoload-modified-buffers)
877 (let ((version-control 'never))
878 (save-buffer)))))
879
880 ;; FIXME This command should be deprecated.
881 ;; See http://debbugs.gnu.org/22213#41
882 ;;;###autoload
883 (defun update-file-autoloads (file &optional save-after outfile)
884 "Update the autoloads for FILE.
885 If prefix arg SAVE-AFTER is non-nil, save the buffer too.
886
887 If FILE binds `generated-autoload-file' as a file-local variable,
888 autoloads are written into that file. Otherwise, the autoloads
889 file is determined by OUTFILE. If called interactively, prompt
890 for OUTFILE; if called from Lisp with OUTFILE nil, use the
891 existing value of `generated-autoload-file'.
892
893 Return FILE if there was no autoload cookie in it, else nil."
894 (interactive (list (read-file-name "Update autoloads for file: ")
895 current-prefix-arg
896 (read-file-name "Write autoload definitions to file: ")))
897 (let* ((generated-autoload-file (or outfile generated-autoload-file))
898 (autoload-modified-buffers nil)
899 ;; We need this only if the output file handles more than one input.
900 ;; See http://debbugs.gnu.org/22213#38 and subsequent.
901 (autoload-timestamps t)
902 (no-autoloads (autoload-generate-file-autoloads file)))
903 (if autoload-modified-buffers
904 (if save-after (autoload-save-buffers))
905 (if (called-interactively-p 'interactive)
906 (message "Autoload section for %s is up to date." file)))
907 (if no-autoloads file)))
908
909 (defun autoload-find-destination (file load-name)
910 "Find the destination point of the current buffer's autoloads.
911 FILE is the file name of the current buffer.
912 LOAD-NAME is the name as it appears in the output.
913 Returns a buffer whose point is placed at the requested location.
914 Returns nil if the file's autoloads are up-to-date, otherwise
915 removes any prior now out-of-date autoload entries."
916 (catch 'up-to-date
917 (let* ((buf (current-buffer))
918 (existing-buffer (if buffer-file-name buf))
919 (output-file (autoload-generated-file))
920 (output-time (if (file-exists-p output-file)
921 (nth 5 (file-attributes output-file))))
922 (found nil))
923 (with-current-buffer (autoload-find-generated-file)
924 ;; This is to make generated-autoload-file have Unix EOLs, so
925 ;; that it is portable to all platforms.
926 (or (eq 0 (coding-system-eol-type buffer-file-coding-system))
927 (set-buffer-file-coding-system 'unix))
928 (or (> (buffer-size) 0)
929 (error "Autoloads file %s lacks boilerplate" buffer-file-name))
930 (or (file-writable-p buffer-file-name)
931 (error "Autoloads file %s is not writable" buffer-file-name))
932 (widen)
933 (goto-char (point-min))
934 ;; Look for the section for LOAD-NAME.
935 (while (and (not found)
936 (search-forward generate-autoload-section-header nil t))
937 (let ((form (autoload-read-section-header)))
938 (cond ((string= (nth 2 form) load-name)
939 ;; We found the section for this file.
940 ;; Check if it is up to date.
941 (let ((begin (match-beginning 0))
942 (last-time (nth 4 form))
943 (file-time (nth 5 (file-attributes file))))
944 (if (and (or (null existing-buffer)
945 (not (buffer-modified-p existing-buffer)))
946 (cond
947 ;; FIXME? Arguably we should throw a
948 ;; user error, or some kind of warning,
949 ;; if we were called from update-file-autoloads,
950 ;; which can update only a single input file.
951 ;; It's not appropriate to use the output
952 ;; file modtime in such a case,
953 ;; if there are multiple input files
954 ;; contributing to the output.
955 ((and output-time
956 (member last-time
957 (list t autoload--non-timestamp)))
958 (not (time-less-p output-time file-time)))
959 ;; last-time is the time-stamp (specifying
960 ;; the last time we looked at the file) and
961 ;; the file hasn't been changed since.
962 ((listp last-time)
963 (not (time-less-p last-time file-time)))
964 ;; last-time is an MD5 checksum instead.
965 ((stringp last-time)
966 (equal last-time
967 (md5 buf nil nil 'emacs-mule)))))
968 (throw 'up-to-date nil)
969 (autoload-remove-section begin)
970 (setq found t))))
971 ((string< load-name (nth 2 form))
972 ;; We've come to a section alphabetically later than
973 ;; LOAD-NAME. We assume the file is in order and so
974 ;; there must be no section for LOAD-NAME. We will
975 ;; insert one before the section here.
976 (goto-char (match-beginning 0))
977 (setq found t)))))
978 (or found
979 (progn
980 ;; No later sections in the file. Put before the last page.
981 (goto-char (point-max))
982 (search-backward "\f" nil t)))
983 (unless (memq (current-buffer) autoload-modified-buffers)
984 (push (current-buffer) autoload-modified-buffers))
985 (current-buffer)))))
986
987 (defun autoload-remove-section (begin)
988 (goto-char begin)
989 (search-forward generate-autoload-section-trailer)
990 (delete-region begin (point)))
991
992 ;;;###autoload
993 (defun update-directory-autoloads (&rest dirs)
994 "Update autoload definitions for Lisp files in the directories DIRS.
995 In an interactive call, you must give one argument, the name of a
996 single directory. In a call from Lisp, you can supply multiple
997 directories as separate arguments, but this usage is discouraged.
998
999 The function does NOT recursively descend into subdirectories of the
1000 directory or directories specified.
1001
1002 In an interactive call, prompt for a default output file for the
1003 autoload definitions, and temporarily bind the variable
1004 `generated-autoload-file' to this value. When called from Lisp,
1005 use the existing value of `generated-autoload-file'. If any Lisp
1006 file binds `generated-autoload-file' as a file-local variable,
1007 write its autoloads into the specified file instead."
1008 (interactive "DUpdate autoloads from directory: ")
1009 (let* ((files-re (let ((tmp nil))
1010 (dolist (suf (get-load-suffixes))
1011 (unless (string-match "\\.elc" suf) (push suf tmp)))
1012 (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
1013 (files (apply #'nconc
1014 (mapcar (lambda (dir)
1015 (directory-files (expand-file-name dir)
1016 t files-re))
1017 dirs)))
1018 (done ()) ;Files processed; to remove duplicates.
1019 (changed nil) ;Non-nil if some change occurred.
1020 (last-time)
1021 ;; Files with no autoload cookies or whose autoloads go to other
1022 ;; files because of file-local autoload-generated-file settings.
1023 (no-autoloads nil)
1024 (autoload-modified-buffers nil)
1025 (generated-autoload-file
1026 (if (called-interactively-p 'interactive)
1027 (read-file-name "Write autoload definitions to file: ")
1028 generated-autoload-file))
1029 (output-time
1030 (if (file-exists-p generated-autoload-file)
1031 (nth 5 (file-attributes generated-autoload-file)))))
1032
1033 (with-current-buffer (autoload-find-generated-file)
1034 (save-excursion
1035 ;; Canonicalize file names and remove the autoload file itself.
1036 (setq files (delete (file-relative-name buffer-file-name)
1037 (mapcar #'file-relative-name files)))
1038
1039 (goto-char (point-min))
1040 (while (search-forward generate-autoload-section-header nil t)
1041 (let* ((form (autoload-read-section-header))
1042 (file (nth 3 form)))
1043 (cond ((and (consp file) (stringp (car file)))
1044 ;; This is a list of files that have no autoload cookies.
1045 ;; There shouldn't be more than one such entry.
1046 ;; Remove the obsolete section.
1047 (autoload-remove-section (match-beginning 0))
1048 (setq last-time (nth 4 form))
1049 (if (member last-time (list t autoload--non-timestamp))
1050 (setq last-time output-time))
1051 (dolist (file file)
1052 (let ((file-time (nth 5 (file-attributes file))))
1053 (when (and file-time
1054 (not (time-less-p last-time file-time)))
1055 ;; file unchanged
1056 (push file no-autoloads)
1057 (setq files (delete file files))))))
1058 ((not (stringp file)))
1059 ((or (not (file-exists-p file))
1060 ;; Remove duplicates as well, just in case.
1061 (member file done)
1062 ;; If the file is actually excluded.
1063 (member (expand-file-name file) autoload-excludes))
1064 ;; Remove the obsolete section.
1065 (setq changed t)
1066 (autoload-remove-section (match-beginning 0)))
1067 ((not (time-less-p (let ((oldtime (nth 4 form)))
1068 (if (member oldtime
1069 (list
1070 t autoload--non-timestamp))
1071 output-time
1072 oldtime))
1073 (nth 5 (file-attributes file))))
1074 ;; File hasn't changed.
1075 nil)
1076 (t
1077 (setq changed t)
1078 (autoload-remove-section (match-beginning 0))
1079 (if (autoload-generate-file-autoloads
1080 ;; Passing `current-buffer' makes it insert at point.
1081 file (current-buffer) buffer-file-name)
1082 (push file no-autoloads))))
1083 (push file done)
1084 (setq files (delete file files)))))
1085 ;; Elements remaining in FILES have no existing autoload sections yet.
1086 (let ((no-autoloads-time (or last-time '(0 0 0 0))) file-time)
1087 (dolist (file files)
1088 (cond
1089 ((member (expand-file-name file) autoload-excludes) nil)
1090 ;; Passing nil as second argument forces
1091 ;; autoload-generate-file-autoloads to look for the right
1092 ;; spot where to insert each autoloads section.
1093 ((setq file-time
1094 (autoload-generate-file-autoloads file nil buffer-file-name))
1095 (push file no-autoloads)
1096 (if (time-less-p no-autoloads-time file-time)
1097 (setq no-autoloads-time file-time)))
1098 (t (setq changed t))))
1099
1100 (when no-autoloads
1101 ;; Sort them for better readability.
1102 (setq no-autoloads (sort no-autoloads 'string<))
1103 ;; Add the `no-autoloads' section.
1104 (goto-char (point-max))
1105 (search-backward "\f" nil t)
1106 (autoload-insert-section-header
1107 (current-buffer) nil nil no-autoloads (if autoload-timestamps
1108 no-autoloads-time
1109 autoload--non-timestamp))
1110 (insert generate-autoload-section-trailer)))
1111
1112 ;; Don't modify the file if its content has not been changed, so `make'
1113 ;; dependencies don't trigger unnecessarily.
1114 (when changed
1115 (let ((version-control 'never))
1116 (save-buffer)))
1117
1118 ;; In case autoload entries were added to other files because of
1119 ;; file-local autoload-generated-file settings.
1120 (autoload-save-buffers))))
1121
1122 (define-obsolete-function-alias 'update-autoloads-from-directories
1123 'update-directory-autoloads "22.1")
1124
1125 ;;;###autoload
1126 (defun batch-update-autoloads ()
1127 "Update loaddefs.el autoloads in batch mode.
1128 Calls `update-directory-autoloads' on the command line arguments.
1129 Definitions are written to `generated-autoload-file' (which
1130 should be non-nil)."
1131 ;; For use during the Emacs build process only.
1132 ;; Exclude those files that are preloaded on ALL platforms.
1133 ;; These are the ones in loadup.el where "(load" is at the start
1134 ;; of the line (crude, but it works).
1135 (unless autoload-excludes
1136 (let ((default-directory (file-name-directory generated-autoload-file))
1137 file)
1138 (when (file-readable-p "loadup.el")
1139 (with-temp-buffer
1140 (insert-file-contents "loadup.el")
1141 (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
1142 (setq file (match-string 1))
1143 (or (string-match "\\.el\\'" file)
1144 (setq file (format "%s.el" file)))
1145 (or (string-match "\\`site-" file)
1146 (push (expand-file-name file) autoload-excludes)))))))
1147 (let ((args command-line-args-left))
1148 (setq command-line-args-left nil)
1149 (apply #'update-directory-autoloads args)))
1150
1151 (provide 'autoload)
1152
1153 ;;; autoload.el ends here