X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3fbca58aaed99714624a41bd76a8620435f92b7a..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/emacs-lisp/autoload.el diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 0e0832e61c..196786e917 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -1,8 +1,9 @@ -;;; autoload.el --- maintain autoloads in loaddefs.el. +;; autoload.el --- maintain autoloads in loaddefs.el -;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97 Free Software Foundation, Inc. +;; Copyright (C) 1991,92,93,94,95,96,97, 2001,02,03,04 +;; Free Software Foundation, Inc. -;; Author: Roland McGrath +;; Author: Roland McGrath ;; Keywords: maint ;; This file is part of GNU Emacs. @@ -31,35 +32,15 @@ ;;; Code: -(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, defmacro or defcustom." - (let ((car (car-safe form))) - (if (memq car '(defun define-skeleton defmacro)) - (let ((macrop (eq car 'defmacro)) - name doc) - (setq form (cdr form) - name (car form) - ;; Ignore the arguments. - form (cdr (if (eq car 'define-skeleton) - form - (cdr form))) - doc (car form)) - (if (stringp doc) - (setq form (cdr form)) - (setq doc nil)) - (list 'autoload (list 'quote name) file doc - (or (eq car 'define-skeleton) - (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)))))) - (list 'defvar varname init doc)) - nil)))) - -(put 'define-skeleton 'doc-string-elt 3) +(require 'lisp-mode) ;for `doc-string-elt' properties. +(require 'help-fns) ;for help-add-fundoc-usage. +(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. @@ -76,36 +57,82 @@ 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 inserted before the form identifying -the section of autoloads for a file.") + "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.") -;;; Forms which have doc-strings which should be printed specially. -;;; A doc-string-elt property of ELT says that (nth ELT FORM) is -;;; the doc-string in FORM. -;;; -;;; There used to be the following note here: -;;; ;;; Note: defconst and defvar should NOT be marked in this way. -;;; ;;; We don't want to produce defconsts and defvars that -;;; ;;; make-docfile can grok, because then it would grok them twice, -;;; ;;; once in foo.el (where they are given with ;;;###autoload) and -;;; ;;; once in loaddefs.el. -;;; -;;; Counter-note: Yes, they should be marked in this way. -;;; make-docfile only processes those files that are loaded into the -;;; dumped Emacs, and those files should never have anything -;;; autoloaded here. The above-feared problem only occurs with files -;;; which have autoloaded entries *and* are processed by make-docfile; -;;; there should be no such files. - -(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) +(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 + ;; For complex cases, try again on the macro-expansion. + ((and (memq car '(easy-mmode-define-global-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))) + ;; Cut-off anything after the :autoload-end marker. + (setcdr end nil) + (cons 'progn + (mapcar (lambda (form) (make-autoload form file)) + (cdr expand))))) + + ;; For special function-like operators, use the `autoload' function. + ((memq car '(defun define-skeleton defmacro define-derived-mode + define-compilation-mode + define-generic-mode easy-mmode-define-minor-mode + easy-mmode-define-global-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) + ;; Add the usage form at the end where describe-function-1 + ;; can recover it. + (setq doc (help-add-fundoc-usage doc args))) + ;; `define-generic-mode' quotes the name, so take care of that + (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 + easy-mmode-define-minor-mode + define-minor-mode)) t) + (eq (car-safe (car body)) 'interactive)) + (if macrop (list 'quote 'macro) nil)))) + + ;; Convert defcustom to less space-consuming data. + ((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))))) + ) + `(progn + (defvar ,varname ,init ,doc) + (custom-autoload ',varname ,file)))) + + ;; nil here indicates that this is not a special autoload form. + (t nil)))) + +;; Forms which have doc-strings which should be printed specially. +;; A doc-string-elt property of ELT says that (nth ELT FORM) is +;; the doc-string in FORM. +;; Those properties are now set in lisp-mode.el. + (defun autoload-trim-file-name (file) ;; Returns a relative pathname of FILE @@ -117,6 +144,114 @@ the section of autoloads for a 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) + +(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 + ;; If the form is a sequence, recurse. + ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form))) + ;; Symbols at the toplevel are meaningless. + ((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))) + ;; We need to hack the printing because the + ;; doc-string must be printed specially for + ;; make-docfile (sigh). + (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) + ;; Insert a backslash before each ( that + ;; appears at the beginning of a line in + ;; the doc string. + (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) + ;; Break that line at spaces, to avoid very long lines. + ;; Make each sub-line into a comment. + (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 generate-file-autoloads (file) "Insert at point a loaddefs autoload section for FILE. autoloads are generated for defuns and defmacros in FILE @@ -127,7 +262,7 @@ are used." (let ((outbuf (current-buffer)) (autoloads-done '()) (load-name (let ((name (file-name-nondirectory file))) - (if (string-match "\\.elc?$" name) + (if (string-match "\\.elc?\\(\\.\\|$\\)" name) (substring name 0 (match-beginning 0)) name))) (print-length nil) @@ -181,56 +316,16 @@ are used." (if (eolp) ;; Read the next form and make an autoload. (let* ((form (prog1 (read (current-buffer)) - (or (bolp) (forward-line 1)))) - (autoload (make-autoload form load-name)) - (doc-string-elt (get (car-safe form) - 'doc-string-elt))) + (or (bolp) (forward-line 1)))) + (autoload (make-autoload form load-name))) (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))) - ;; We need to hack the printing because the - ;; doc-string must be printed specially for - ;; make-docfile (sigh). - (let* ((p (nthcdr (1- doc-string-elt) - autoload)) - (elt (cdr p))) - (setcdr p nil) - (princ "\n(" outbuf) - (let ((print-escape-newlines 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) - ;; Insert a backslash before each ( that - ;; appears at the beginning of a line in - ;; the doc string. - (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 autoload outbuf)))) - ;; Copy the rest of the line to the output. + (let ((autoload-print-form-outbuf outbuf)) + (autoload-print-form autoload))) + + ;; Copy the rest of the line to the output. (princ (buffer-substring (progn ;; Back up over whitespace, to preserve it. @@ -254,53 +349,52 @@ are used." (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) + ;; Insert the section-header line + ;; which lists the file name and which functions are in it, etc. + (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") - ;; Warn if we put a line in loaddefs.el - ;; that is long enough to cause trouble. - (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))) -(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.") - ;;;###autoload -(defun update-file-autoloads (file) +(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)." - (interactive "fUpdate autoloads for 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) + (if (string-match "\\.elc?\\(\\.\\|$\\)" name) (substring name 0 (match-beginning 0)) name))) (found nil) - (existing-buffer (get-file-buffer file))) + (existing-buffer (get-file-buffer file)) + (no-autoloads nil)) (save-excursion ;; We want to get a value for generated-autoload-file from ;; the local variables section if it's there. (if existing-buffer (set-buffer existing-buffer)) - ;; We must read/write the file without any code conversion. - (let ((coding-system-for-read 'no-conversion)) - (set-buffer (find-file-noselect generated-autoload-file))) + ;; We must read/write the file without any code conversion, + ;; but still decode EOLs. + (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))))) + ;; This is to make generated-autoload-file have Unix EOLs, so + ;; that it is portable to all platforms. + (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) @@ -308,9 +402,7 @@ autoloads go somewhere else.") ;; Look for the section for LOAD-NAME. (while (and (not found) (search-forward generate-autoload-section-header nil t)) - (let ((form (condition-case () - (read (current-buffer)) - (end-of-file nil)))) + (let ((form (autoload-read-section-header))) (cond ((string= (nth 2 form) load-name) ;; We found the section for this file. ;; Check if it is up to date. @@ -320,10 +412,7 @@ autoloads go somewhere else.") (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))))) + (not (time-less-p last-time file-time))) (progn (if (interactive-p) (message "\ @@ -366,63 +455,116 @@ Autoload section for %s is up to date." (widen) (goto-char (point-min)) (prog1 - (if (search-forward - (concat "\n" generate-autoload-cookie) + (if (re-search-forward + (concat "^" (regexp-quote + generate-autoload-cookie)) nil t) nil (if (interactive-p) (message "%s has no autoloads" file)) + (setq no-autoloads t) t) (or existing-buffer (kill-buffer (current-buffer)))))))) (generate-file-autoloads file)))) - (if (interactive-p) (save-buffer))))) + (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))) ;;;###autoload -(defun update-autoloads-from-directories (&rest dirs) +(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) do its work." +This uses `update-file-autoloads' (which see) 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 (apply 'nconc - (mapcar (function (lambda (dir) - (directory-files (expand-file-name dir) - t - "^[^=].*\\.el$"))) - dirs))) - autoloads-file - top-dir) - (setq autoloads-file (locate-library generated-autoload-file)) - (setq top-dir (file-name-directory autoloads-file)) - (save-excursion - (set-buffer (find-file-noselect autoloads-file)) + (let* ((files-re (let ((tmp nil)) + (dolist (suf 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) ;files with no autoload cookies. + (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 + + ;; Canonicalize file names and remove the autoload file itself. + (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 (condition-case () - (read (current-buffer)) - (end-of-file nil))) + (let* ((form (autoload-read-section-header)) (file (nth 3 form))) - (cond ((not (stringp file))) + (cond ((and (consp file) (stringp (car file))) + ;; This is a list of files that have no autoload cookies. + ;; There shouldn't be more than one such entry. + ;; Remove the obsolete section. + (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))) + ;; file unchanged + (push file no-autoloads) + (setq files (delete file files))))))) + ((not (stringp file))) ((not (file-exists-p (expand-file-name file top-dir))) ;; Remove the obsolete section. - (let ((begin (match-beginning 0))) - (search-forward generate-autoload-section-trailer) - (delete-region begin (point)))) + (autoload-remove-section (match-beginning 0))) + ((equal (nth 4 form) (nth 5 (file-attributes file))) + ;; File hasn't changed. + nil) (t (update-file-autoloads file))) (setq files (delete file files))))) - ;; Elements remaining in FILES have no existing autoload sections. - (mapcar 'update-file-autoloads files) + ;; Elements remaining in FILES have no existing autoload sections yet. + (setq no-autoloads + (append no-autoloads + (delq nil (mapcar 'update-file-autoloads files)))) + (when no-autoloads + ;; Sort them for better readability. + (setq no-autoloads (sort no-autoloads 'string<)) + ;; Add the `no-autoloads' section. + (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)))) ;;;###autoload (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) +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) +;;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6 ;;; autoload.el ends here