]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/autoload.el
(make-autoload): Handle `define-compilation-mode'.
[gnu-emacs] / lisp / emacs-lisp / autoload.el
index 37bc21fab18752108e7fb0cdf71e82b6a49ba1c1..5a5eb55a2a255465fbbbaf47730ea9136f79723a 100644 (file)
@@ -1,6 +1,6 @@
-;;; autoload.el --- maintain autoloads in loaddefs.el
+;; autoload.el --- maintain autoloads in loaddefs.el
 
-;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001
+;; Copyright (C) 1991,92,93,94,95,96,97, 2001,02,03,04
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>
 
 ;;; Code:
 
+(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
@@ -82,13 +86,24 @@ or macro definition or a defcustom)."
 
      ;; 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*))
-      (let* ((macrop (eq car 'defmacro))
+                  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
@@ -99,58 +114,24 @@ or macro definition or a defcustom)."
                  (eq (car-safe (car body)) 'interactive))
              (if macrop (list 'quote 'macro) nil))))
 
-     ;; Convert defcustom to a simpler (and less space-consuming) defvar,
-     ;; but add some extra stuff if it uses :require.
+     ;; 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))))))
-       (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))))))
+           ;; (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.
-;;;
-;;; 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 '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 'defsubst 'doc-string-elt 3)
-(put 'define-skeleton 'doc-string-elt 2)
-(put 'define-derived-mode 'doc-string-elt 4)
-(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
-(put 'define-minor-mode 'doc-string-elt 2)
-(put 'define-generic-mode 'doc-string-elt 7)
-;; defin-global-mode has no explicit docstring.
-(put 'easy-mmode-define-global-mode 'doc-string-elt 1000)
+;; 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)
@@ -184,16 +165,20 @@ markers before we call `read'."
        (goto-char (point-min))
        (read (current-buffer))))))
 
-;; !! Requires OUTBUF to be bound !!
+(defvar autoload-print-form-outbuf)
+
 (defun autoload-print-form (form)
-  "Print FORM such that make-docfile will find the docstrings."
+  "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)))
+    (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
@@ -204,10 +189,9 @@ markers before we call `read'."
            (princ "\n(" outbuf)
            (let ((print-escape-newlines t)
                  (print-escape-nonascii t))
-             (mapcar (lambda (elt)
-                       (prin1 elt outbuf)
-                       (princ " " outbuf))
-                     form))
+             (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)
@@ -217,7 +201,7 @@ markers before we call `read'."
              ;; the doc string.
              (with-current-buffer outbuf
                (save-excursion
-                 (while (search-backward "\n(" begin t)
+                 (while (re-search-backward "\n[[(]" begin t)
                    (forward-char 1)
                    (insert "\\"))))
              (if (null (cdr elt))
@@ -230,6 +214,44 @@ markers before we call `read'."
              (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"
+            "\f\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
@@ -240,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)
@@ -300,8 +322,9 @@ are used."
                              (setq autoloads-done (cons (nth 1 form)
                                                         autoloads-done))
                            (setq autoload form))
-                         (autoload-print-form autoload))
-        
+                         (let ((autoload-print-form-outbuf outbuf))
+                           (autoload-print-form autoload)))
+
                      ;; Copy the rest of the line to the output.
                      (princ (buffer-substring
                              (progn
@@ -328,22 +351,8 @@ are used."
        (progn
          ;; 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-done load-name
-                      (autoload-trim-file-name file)
-                      (nth 5 (file-attributes file)))
-                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)))))
+         (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")
          (goto-char output-end)
@@ -353,14 +362,16 @@ are used."
 ;;;###autoload
 (defun update-file-autoloads (file)
   "Update the autoloads for FILE in `generated-autoload-file'
-\(which FILE might bind in its local variables)."
+\(which FILE might bind in its local variables).
+Return FILE if there was no autoload cookie in it."
   (interactive "fUpdate autoloads for file: ")
   (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.
@@ -370,9 +381,10 @@ are used."
       ;; but still decode EOLs.
       (let ((coding-system-for-read 'raw-text))
        (set-buffer (find-file-noselect
-                    (expand-file-name generated-autoload-file
-                                      (expand-file-name "lisp"
-                                                        source-directory))))
+                    (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))
@@ -397,10 +409,7 @@ are used."
                       (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 "\
@@ -450,60 +459,109 @@ Autoload section for %s is up to date."
                                 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))))
       (and (interactive-p)
           (buffer-modified-p)
-          (save-buffer)))))
+          (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
+  (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)))
-    (setq top-dir (file-name-directory autoloads-file))
-    (save-excursion
-      (set-buffer (find-file-noselect autoloads-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 (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