(require 'lisp-mode) (require 'help-fns) (eval-when-compile (require 'cl))
(defvar generated-autoload-file "loaddefs.el"
"*File \\[update-file-autoloads] puts autoloads into.
A `.el' file can set this in its local variables section to make its
autoloads go somewhere else. The autoload file is assumed to contain a
trailer starting with a FormFeed character.")
(defconst generate-autoload-cookie ";;;###autoload"
"Magic comment indicating the following form should be autoloaded.
Used by \\[update-file-autoloads]. This string should be
meaningless to Lisp (e.g., a comment).
This string is used:
;;;###autoload
\(defun function-to-be-autoloaded () ...)
If this string appears alone on a line, the following form will be
read and an autoload made for it. If there is further text on the line,
that text will be copied verbatim to `generated-autoload-file'.")
(defconst generate-autoload-section-header "\f\n;;;### "
"String that marks the form at the start of a new file's autoload section.")
(defconst generate-autoload-section-trailer "\n;;;***\n"
"String which indicates the end of the section of autoloads for a file.")
(defconst generate-autoload-section-continuation ";;;;;; "
"String to add on each continuation of the section header form.")
(defun make-autoload (form file)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
or macro definition or a defcustom)."
(let ((car (car-safe form)) expand)
(cond
((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode define-minor-mode))
(setq expand (let ((load-file-name file)) (macroexpand form)))
(eq (car expand) 'progn)
(memq :autoload-end expand))
(let ((end (memq :autoload-end expand)))
(setcdr end nil)
(cons 'progn
(mapcar (lambda (form) (make-autoload form file))
(cdr expand)))))
((memq car '(defun define-skeleton defmacro define-derived-mode
define-compilation-mode define-generic-mode
easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode define-minor-mode
defun* defmacro*))
(let* ((macrop (memq car '(defmacro defmacro*)))
(name (nth 1 form))
(args (case car
((defun defmacro defun* defmacro*) (nth 2 form))
((define-skeleton) '(&optional str arg))
((define-generic-mode define-derived-mode
define-compilation-mode) nil)
(t)))
(body (nthcdr (get car 'doc-string-elt) form))
(doc (if (stringp (car body)) (pop body))))
(when (listp args)
(setq doc (help-add-fundoc-usage doc args)))
(list 'autoload (if (listp name) name (list 'quote name)) file doc
(or (and (memq car '(define-skeleton define-derived-mode
define-generic-mode
easy-mmode-define-global-mode
define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode
define-minor-mode)) t)
(eq (car-safe (car body)) 'interactive))
(if macrop (list 'quote 'macro) nil))))
((eq car 'defcustom)
(let ((varname (car-safe (cdr-safe form)))
(init (car-safe (cdr-safe (cdr-safe form))))
(doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
)
`(progn
(defvar ,varname ,init ,doc)
(custom-autoload ',varname ,file
,(condition-case nil
(null (cadr (memq :set form)))
(error nil))))))
((eq car 'defgroup)
(let ((groupname (nth 1 form)))
`(let ((loads (get ',groupname 'custom-loads)))
(if (member ',file loads) nil
(put ',groupname 'custom-loads (cons ',file loads))))))
(t nil))))
(defun autoload-trim-file-name (file)
(setq file (expand-file-name file))
(file-relative-name file
(file-name-directory generated-autoload-file)))
(defun autoload-read-section-header ()
"Read a section header form.
Since continuation lines have been marked as comments,
we must copy the text of the form and remove those comment
markers before we call `read'."
(save-match-data
(let ((beginning (point))
string)
(forward-line 1)
(while (looking-at generate-autoload-section-continuation)
(forward-line 1))
(setq string (buffer-substring beginning (point)))
(with-current-buffer (get-buffer-create " *autoload*")
(erase-buffer)
(insert string)
(goto-char (point-min))
(while (search-forward generate-autoload-section-continuation nil t)
(replace-match " "))
(goto-char (point-min))
(read (current-buffer))))))
(defvar autoload-print-form-outbuf nil
"Buffer which gets the output of `autoload-print-form'.")
(defun autoload-print-form (form)
"Print FORM such that `make-docfile' will find the docstrings.
The variable `autoload-print-form-outbuf' specifies the buffer to
put the output in."
(cond
((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
((symbolp form) nil)
(t
(let ((doc-string-elt (get (car-safe form) 'doc-string-elt))
(outbuf autoload-print-form-outbuf))
(if (and doc-string-elt (stringp (nth doc-string-elt form)))
(let* ((p (nthcdr (1- doc-string-elt) form))
(elt (cdr p)))
(setcdr p nil)
(princ "\n(" outbuf)
(let ((print-escape-newlines t)
(print-escape-nonascii t))
(dolist (elt form)
(prin1 elt outbuf)
(princ " " outbuf)))
(princ "\"\\\n" outbuf)
(let ((begin (with-current-buffer outbuf (point))))
(princ (substring (prin1-to-string (car elt)) 1)
outbuf)
(with-current-buffer outbuf
(save-excursion
(while (re-search-backward "\n[[(]" begin t)
(forward-char 1)
(insert "\\"))))
(if (null (cdr elt))
(princ ")" outbuf)
(princ " " outbuf)
(princ (substring (prin1-to-string (cdr elt)) 1)
outbuf))
(terpri outbuf)))
(let ((print-escape-newlines t)
(print-escape-nonascii t))
(print form outbuf)))))))
(defun autoload-ensure-default-file (file)
"Make sure that the autoload file FILE exists and if not create it."
(unless (file-exists-p file)
(write-region
(concat ";;; " (file-name-nondirectory file)
" --- automatically extracted autoloads\n"
";;\n"
";;; Code:\n\n"
"\n;; Local Variables:\n"
";; version-control: never\n"
";; no-byte-compile: t\n"
";; no-update-autoloads: t\n"
";; End:\n"
";;; " (file-name-nondirectory file)
" ends here\n")
nil file))
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."
(insert generate-autoload-section-header)
(prin1 (list 'autoloads autoloads load-name
(if (stringp file) (autoload-trim-file-name file) file)
time)
outbuf)
(terpri outbuf)
(with-current-buffer outbuf
(save-excursion
(forward-line -1)
(while (not (eolp))
(move-to-column 64)
(skip-chars-forward "^ \n")
(or (eolp)
(insert "\n" generate-autoload-section-continuation))))))
(defun autoload-find-file (file)
"Fetch file and put it in a temp buffer. Return the buffer."
(with-current-buffer (get-buffer-create " *autoload-file*")
(kill-all-local-variables)
(erase-buffer)
(setq buffer-undo-list t
buffer-read-only nil)
(emacs-lisp-mode)
(insert-file-contents file nil)
(let ((enable-local-variables :safe))
(hack-local-variables))
(current-buffer)))
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
(defun generate-file-autoloads (file)
"Insert at point a loaddefs autoload section for FILE.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
If FILE is being visited in a buffer, the contents of the buffer
are used.
Return non-nil in the case where no autoloads were added at point."
(interactive "fGenerate autoloads for file: ")
(let ((outbuf (current-buffer))
(autoloads-done '())
(load-name (let ((name (file-name-nondirectory file)))
(if (string-match "\\.elc?\\(\\.\\|$\\)" name)
(substring name 0 (match-beginning 0))
name)))
(print-length nil)
(print-readably t) (float-output-format nil)
(done-any nil)
(visited (get-file-buffer file))
output-start)
(setq file (expand-file-name file))
(let* ((source-truename (file-truename file))
(dir-truename (file-name-as-directory
(file-truename default-directory)))
(len (length dir-truename)))
(if (and (< len (length source-truename))
(string= dir-truename (substring source-truename 0 len)))
(setq file (substring source-truename len))))
(with-current-buffer (or visited
(autoload-find-file file))
(unless no-update-autoloads
(message "Generating autoloads for %s..." file)
(setq output-start (with-current-buffer outbuf (point)))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward " \t\n\f")
(cond
((looking-at (regexp-quote generate-autoload-cookie))
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(setq done-any t)
(if (eolp)
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
(autoload (make-autoload form load-name)))
(if autoload
(push (nth 1 form) autoloads-done)
(setq autoload form))
(let ((autoload-print-form-outbuf outbuf))
(autoload-print-form autoload)))
(princ (buffer-substring
(progn
(skip-chars-backward " \f\t")
(if (= (char-after (1+ (point))) ? )
(forward-char 1))
(point))
(progn (forward-line 1) (point)))
outbuf)))
((looking-at ";")
(forward-line 1))
(t
(forward-sexp 1)
(forward-line 1))))))
(when done-any
(with-current-buffer outbuf
(save-excursion
(goto-char output-start)
(autoload-insert-section-header
outbuf autoloads-done load-name file
(nth 5 (file-attributes file)))
(insert ";;; Generated autoloads from "
(autoload-trim-file-name file) "\n"))
(insert generate-autoload-section-trailer)))
(message "Generating autoloads for %s...done" file))
(or visited
(kill-buffer (current-buffer))))
(not done-any)))
(defun update-file-autoloads (file &optional save-after)
"Update the autoloads for FILE in `generated-autoload-file'
\(which FILE might bind in its local variables).
If SAVE-AFTER is non-nil (which is always, when called interactively),
save the buffer too.
Return FILE if there was no autoload cookie in it, else nil."
(interactive "fUpdate autoloads for file: \np")
(let ((load-name (let ((name (file-name-nondirectory file)))
(if (string-match "\\.elc?\\(\\.\\|$\\)" name)
(substring name 0 (match-beginning 0))
name)))
(found nil)
(existing-buffer (get-file-buffer file))
(no-autoloads nil))
(save-excursion
(if existing-buffer
(set-buffer existing-buffer))
(let ((coding-system-for-read 'raw-text))
(set-buffer (find-file-noselect
(autoload-ensure-default-file
(expand-file-name generated-autoload-file
(expand-file-name "lisp"
source-directory)))))
(setq buffer-file-coding-system 'raw-text-unix))
(or (> (buffer-size) 0)
(error "Autoloads file %s does not exist" buffer-file-name))
(or (file-writable-p buffer-file-name)
(error "Autoloads file %s is not writable" buffer-file-name))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(while (and (not found)
(search-forward generate-autoload-section-header nil t))
(let ((form (autoload-read-section-header)))
(cond ((string= (nth 2 form) load-name)
(let ((begin (match-beginning 0))
(last-time (nth 4 form))
(file-time (nth 5 (file-attributes file))))
(if (and (or (null existing-buffer)
(not (buffer-modified-p existing-buffer)))
(listp last-time) (= (length last-time) 2)
(not (time-less-p last-time file-time)))
(progn
(if (interactive-p)
(message "\
Autoload section for %s is up to date."
file))
(setq found 'up-to-date))
(search-forward generate-autoload-section-trailer)
(delete-region begin (point))
(setq found t))))
((string< load-name (nth 2 form))
(goto-char (match-beginning 0))
(setq found 'new)))))
(or found
(progn
(setq found 'new)
(goto-char (point-max))
(search-backward "\f" nil t)))
(or (eq found 'up-to-date)
(setq no-autoloads (generate-file-autoloads file)))))
(and save-after
(buffer-modified-p)
(save-buffer))
(if no-autoloads file))))
(defun autoload-remove-section (begin)
(goto-char begin)
(search-forward generate-autoload-section-trailer)
(delete-region begin (point)))
(defun update-directory-autoloads (&rest dirs)
"\
Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
This uses `update-file-autoloads' (which see) to do its work.
In an interactive call, you must give one argument, the name
of a single directory. In a call from Lisp, you can supply multiple
directories as separate arguments, but this usage is discouraged.
The function does NOT recursively descend into subdirectories of the
directory or directories specified."
(interactive "DUpdate autoloads from directory: ")
(let* ((files-re (let ((tmp nil))
(dolist (suf (get-load-suffixes)
(concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
(unless (string-match "\\.elc" suf) (push suf tmp)))))
(files (apply 'nconc
(mapcar (lambda (dir)
(directory-files (expand-file-name dir)
t files-re))
dirs)))
(this-time (current-time))
(no-autoloads nil) (autoloads-file
(expand-file-name generated-autoload-file
(expand-file-name "lisp" source-directory)))
(top-dir (file-name-directory autoloads-file)))
(with-current-buffer
(find-file-noselect (autoload-ensure-default-file autoloads-file))
(save-excursion
(setq files (delete (autoload-trim-file-name buffer-file-name)
(mapcar 'autoload-trim-file-name files)))
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(let* ((form (autoload-read-section-header))
(file (nth 3 form)))
(cond ((and (consp file) (stringp (car file)))
(autoload-remove-section (match-beginning 0))
(let ((last-time (nth 4 form)))
(dolist (file file)
(let ((file-time (nth 5 (file-attributes file))))
(when (and file-time
(not (time-less-p last-time file-time)))
(push file no-autoloads)
(setq files (delete file files)))))))
((not (stringp file)))
((not (file-exists-p (expand-file-name file top-dir)))
(autoload-remove-section (match-beginning 0)))
((equal (nth 4 form) (nth 5 (file-attributes file)))
nil)
(t
(update-file-autoloads file)))
(setq files (delete file files)))))
(setq no-autoloads
(append no-autoloads
(delq nil (mapcar 'update-file-autoloads files))))
(when no-autoloads
(setq no-autoloads (sort no-autoloads 'string<))
(goto-char (point-max))
(search-backward "\f" nil t)
(autoload-insert-section-header
(current-buffer) nil nil no-autoloads this-time)
(insert generate-autoload-section-trailer))
(save-buffer))))
(define-obsolete-function-alias 'update-autoloads-from-directories
'update-directory-autoloads "22.1")
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
Calls `update-directory-autoloads' on the command line arguments."
(apply 'update-directory-autoloads command-line-args-left)
(setq command-line-args-left nil))
(provide 'autoload)