(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 `defun', `define-skeleton',
`define-derived-mode', `define-generic-mode', `defmacro', `defcustom'
or `easy-mmode-define-minor-mode'."
(let ((car (car-safe form)))
(if (memq car '(defun define-skeleton defmacro define-derived-mode
define-generic-mode easy-mmode-define-minor-mode))
(let ((macrop (eq car 'defmacro))
name doc)
(setq form (cdr form)
name (car form)
form (cdr (cond
((memq car '(define-skeleton
easy-mmode-define-minor-mode)) form)
((eq car 'define-derived-mode) (cdr (cdr form)))
((eq car 'define-generic-mode)
(cdr (cdr (cdr (cdr (cdr form))))))
(t (cdr form))))
doc (car form))
(if (stringp doc)
(setq form (cdr form))
(setq doc nil))
(list 'autoload (if (listp name) name (list 'quote name)) file doc
(or (eq car 'define-skeleton) (eq car 'define-derived-mode)
(eq car 'define-generic-mode)
(eq car 'easy-mmode-define-minor-mode)
(eq (car-safe (car form)) 'interactive))
(if macrop (list 'quote 'macro) nil)))
(if (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)))))
(rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))))
(if (not (plist-get rest :require))
`(defvar ,varname ,init ,doc)
`(progn
(defvar ,varname ,init ,doc)
(custom-add-to-group ,(plist-get rest :group)
',varname 'custom-variable)
(custom-add-load ',varname
,(plist-get rest :require)))))
nil))))
(put 'autoload 'doc-string-elt 3)
(put 'defun 'doc-string-elt 3)
(put 'defvar 'doc-string-elt 3)
(put 'defcustom 'doc-string-elt 3)
(put 'defconst 'doc-string-elt 3)
(put 'defmacro 'doc-string-elt 3)
(put 'define-skeleton 'doc-string-elt 3)
(put 'define-derived-mode 'doc-string-elt 3)
(put 'easy-mmode-define-minor-mode 'doc-string-elt 3)
(put 'define-generic-mode 'doc-string-elt 3)
(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))))))
(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."
(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-end)
(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))))
(message "Generating autoloads for %s..." file)
(save-excursion
(unwind-protect
(progn
(if visited
(set-buffer visited)
(set-buffer (get-buffer-create " *generate-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))
(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-1 (make-autoload form load-name))
(autoload (if (eq (car autoload-1) 'progn)
(cadr autoload-1)
autoload-1))
(doc-string-elt (get (car-safe form)
'doc-string-elt)))
(if autoload
(setq autoloads-done (cons (nth 1 form)
autoloads-done))
(setq autoload form))
(if (and doc-string-elt
(stringp (nth doc-string-elt autoload)))
(let* ((p (nthcdr (1- doc-string-elt)
autoload))
(elt (cdr p)))
(setcdr p nil)
(princ "\n(" outbuf)
(let ((print-escape-newlines t)
(print-escape-nonascii t))
(mapcar (function (lambda (elt)
(prin1 elt outbuf)
(princ " " outbuf)))
autoload))
(princ "\"\\\n" outbuf)
(let ((begin (save-excursion
(set-buffer outbuf)
(point))))
(princ (substring
(prin1-to-string (car elt)) 1)
outbuf)
(save-excursion
(set-buffer outbuf)
(save-excursion
(while (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 autoload outbuf)))
(if (eq (car autoload-1) 'progn)
(let ((print-escape-newlines t)
(print-escape-nonascii t))
(mapcar (function (lambda (elt)
(print elt outbuf)))
(cddr autoload-1)))))
(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)))))))
(or visited
(kill-buffer (current-buffer)))
(set-buffer outbuf)
(setq output-end (point-marker))))
(if done-any
(progn
(insert generate-autoload-section-header)
(prin1 (list 'autoloads autoloads-done load-name
(autoload-trim-file-name file)
(nth 5 (file-attributes file)))
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)))))
(insert ";;; Generated autoloads from "
(autoload-trim-file-name file) "\n")
(while (< (point) output-end)
(let ((beg (point)))
(end-of-line)
(if (> (- (point) beg) 900)
(progn
(message "A line is too long--over 900 characters")
(sleep-for 2)
(goto-char output-end))))
(forward-line 1))
(goto-char output-end)
(insert generate-autoload-section-trailer)))
(message "Generating autoloads for %s...done" file)))
(defun update-file-autoloads (file)
"Update the autoloads for FILE in `generated-autoload-file'
\(which FILE might bind in its local variables)."
(interactive "fUpdate autoloads for file: ")
(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)))
(save-excursion
(if existing-buffer
(set-buffer existing-buffer))
(let ((coding-system-for-read 'no-conversion))
(set-buffer (find-file-noselect
(expand-file-name generated-autoload-file
(expand-file-name "lisp"
source-directory)))))
(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)
(or (> (car last-time) (car file-time))
(and (= (car last-time) (car file-time))
(>= (nth 1 last-time)
(nth 1 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)
(and (eq found 'new)
(save-excursion
(if existing-buffer
(set-buffer existing-buffer)
(set-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))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(prog1
(if (re-search-forward
(concat "^" (regexp-quote
generate-autoload-cookie))
nil t)
nil
(if (interactive-p)
(message "%s has no autoloads" file))
t)
(or existing-buffer
(kill-buffer (current-buffer))))))))
(generate-file-autoloads file))))
(and (interactive-p)
(buffer-modified-p)
(save-buffer)))))
(defun update-autoloads-from-directories (&rest dirs)
"\
Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
This uses `update-file-autoloads' (which see) do its work."
(interactive "DUpdate autoloads from directory: ")
(let ((files (apply 'nconc
(mapcar (function (lambda (dir)
(directory-files (expand-file-name dir)
t
"^[^=.].*\\.el$")))
dirs)))
autoloads-file
top-dir)
(setq autoloads-file
(expand-file-name generated-autoload-file
(expand-file-name "lisp"
source-directory)))
(setq top-dir (file-name-directory autoloads-file))
(save-excursion
(set-buffer (find-file-noselect autoloads-file))
(save-excursion
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(let* ((form (autoload-read-section-header))
(file (nth 3 form)))
(cond ((not (stringp file)))
((not (file-exists-p (expand-file-name file top-dir)))
(let ((begin (match-beginning 0)))
(search-forward generate-autoload-section-trailer)
(delete-region begin (point))))
(t
(update-file-autoloads file)))
(setq files (delete file files)))))
(mapcar 'update-file-autoloads files)
(save-buffer))))
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
Calls `update-autoloads-from-directories' on the command line arguments."
(apply 'update-autoloads-from-directories command-line-args-left)
(setq command-line-args-left nil))
(provide 'autoload)