(U-000278B8): Apply new conventions for glyph granularity.

[chise/xemacs-chise.git.1] / lisp / autoload.el

diff --git a/lisp/autoload.el b/lisp/autoload.el
index a4b68da..aa5d530 100644 (file)
--- a/lisp/autoload.el
+++ b/lisp/autoload.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
 
 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.

-;; Copyright (C) 1996 Ben Wing.
+;; Copyright (C) 1996, 2000 Ben Wing.

 
 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
 ;; Keywords: maint
 
 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
 ;; Keywords: maint

@@ -39,30 +39,100 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+;; Need to load easy-mmode because we expand macro calls to easy-mmode
+;; macros in make-autoloads below.
+(require 'easy-mmode)
+
+; Add operator definitions to autoload-operators.el in the xemacs-base
+; package.
+(eval-when-compile (load "cl-macs"))
+(ignore-errors (require 'autoload-operators))
+
+; As autoload-operators is new, provide stopgap measure for a while.
+(if (not (boundp 'autoload-make-autoload-operators))
+    (progn
+      (defvar autoload-make-autoload-operators
+       '(defun define-skeleton defmacro define-derived-mode define-generic-mode
+         easy-mmode-define-minor-mode easy-mmode-define-global-mode
+         define-minor-mode defun* defmacro*)
+       "`defun'-like operators that use `autoload' to load the library.")
+      
+      (defvar autoload-make-autoload-complex-operators
+       '(easy-mmode-define-minor-mode easy-mmode-define-global-mode
+         define-minor-mode)
+       "`defun'-like operators to macroexpand before using `autoload'.")
+      
+      (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 '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)))
+

 (defun make-autoload (form file)
 (defun make-autoload (form file)

-  "Turn FORM, a defun or defmacro, into an autoload for source file FILE.
-Returns nil if FORM is not a defun, define-skeleton or defmacro."
-  (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)))
-      nil)))
-
-(put 'define-skeleton 'doc-string-elt 3)
+  "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 autoload-make-autoload-complex-operators)
+          (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 autoload-make-autoload-operators)
+      (let* ((macrop (memq car '(defmacro defmacro*)))
+            (name (nth 1 form))
+            (body (nthcdr (get car 'doc-string-elt) form))
+            (doc (if (stringp (car body)) (pop body))))
+       ;; `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 a simpler (and less space-consuming) defvar,
+     ;; but add some extra stuff if it uses :require.
+     ((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))))))
+     ;; Coding systems. #### Would be nice to handle the docstring here too.
+     ((memq car '(make-coding-system make-8-bit-coding-system))
+      `(autoload-coding-system ,(nth 1 form) '(load ,file)))
+     ;; nil here indicates that this is not a special autoload form.
+     (t nil))))

 
 (defvar generate-autoload-cookie ";;;###autoload"
   "Magic comment indicating the following form should be autoloaded.
 
 (defvar generate-autoload-cookie ";;;###autoload"
   "Magic comment indicating the following form should be autoloaded.

@@ -87,36 +157,16 @@ the section of autoloads for a file.")
 (defvar generate-autoload-section-trailer "\n;;;***\n"
   "String which indicates the end of the section of autoloads for a file.")
 
 (defvar 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 'defconst 'doc-string-elt 3)
-(put 'defmacro 'doc-string-elt 3)
+(defvar autoload-package-name nil)

 
 (defun autoload-trim-file-name (file)
   "Returns a relative pathname of FILE including the last directory."
   (setq file (expand-file-name file))
 
 (defun autoload-trim-file-name (file)
   "Returns a relative pathname of FILE including the last directory."
   (setq file (expand-file-name file))

-  (file-relative-name file (file-name-directory
-                           (directory-file-name
-                            (file-name-directory file)))))
+  (replace-in-string
+   (file-relative-name file (file-name-directory
+                            (directory-file-name
+                             (file-name-directory file))))
+   "\\\\" "/"))

 
 ;;;###autoload
 (defun generate-file-autoloads (file &optional funlist)
 
 ;;;###autoload
 (defun generate-file-autoloads (file &optional funlist)

@@ -163,7 +213,7 @@ are used."
            (let ((find-file-hooks nil)
                  (enable-local-variables nil))
              (set-buffer (or visited (find-file-noselect file)))
            (let ((find-file-hooks nil)
                  (enable-local-variables nil))
              (set-buffer (or visited (find-file-noselect file)))

-             (set-syntax-table lisp-mode-syntax-table))
+             (set-syntax-table emacs-lisp-mode-syntax-table))

            (save-excursion
              (save-restriction
                (widen)
            (save-excursion
              (save-restriction
                (widen)

@@ -339,7 +389,7 @@ are used."
   "Generic filename to put autoloads into.
 Unless you are an XEmacs maintainer, it is probably unwise to change this.")
 
   "Generic filename to put autoloads into.
 Unless you are an XEmacs maintainer, it is probably unwise to change this.")
 

-(defvar autoload-target-directory "../lisp/prim/"
+(defvar autoload-target-directory "../lisp/"

   "Directory to put autoload declaration file into.
 Unless you know what you're doing, don't mess with this.")
 
   "Directory to put autoload declaration file into.
 Unless you know what you're doing, don't mess with this.")
 

@@ -349,17 +399,21 @@ Unless you know what you're doing, don't mess with this.")
                    data-directory)
   "*File `update-file-autoloads' puts autoloads into.
 A .el file can set this in its local variables section to make its
                    data-directory)
   "*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.")
+autoloads go somewhere else.
+
+Note that `batch-update-directory' binds this variable to its own value,
+generally the file named `autoload-file-name' in the directory being
+updated.")

 
 (defconst cusload-file-name "custom-load.el"
 
 (defconst cusload-file-name "custom-load.el"

-  "Generic filename ot put custom loads into.
-Unless you are an XEmacs maintainr, it is probably unwise to change this.")
+  "Generic filename to put custom loads into.
+Unless you are an XEmacs maintainer, it is probably unwise to change this.")

 
 ;;;###autoload
 (defun update-file-autoloads (file)
   "Update the autoloads for FILE in `generated-autoload-file'
 \(which FILE might bind in its local variables).
 
 ;;;###autoload
 (defun update-file-autoloads (file)
   "Update the autoloads for FILE in `generated-autoload-file'
 \(which FILE might bind in its local variables).

-This functions refuses to update autoloads files."
+This function refuses to update autoloads files."

   (interactive "fUpdate autoloads for file: ")
   (setq file (expand-file-name file))
   (when (and (file-newer-than-file-p file generated-autoload-file)
   (interactive "fUpdate autoloads for file: ")
   (setq file (expand-file-name file))
   (when (and (file-newer-than-file-p file generated-autoload-file)

@@ -375,6 +429,8 @@ This functions refuses to update autoloads files."
        (let ((find-file-hooks nil))
          (set-buffer (or (get-file-buffer generated-autoload-file)
                          (find-file-noselect generated-autoload-file))))
        (let ((find-file-hooks nil))
          (set-buffer (or (get-file-buffer generated-autoload-file)
                          (find-file-noselect generated-autoload-file))))

+       ;; Make sure we can scribble in it.
+       (setq buffer-read-only nil)

        ;; First delete all sections for this file.
        (goto-char (point-min))
        (while (search-forward generate-autoload-section-header nil t)
        ;; First delete all sections for this file.
        (goto-char (point-min))
        (while (search-forward generate-autoload-section-header nil t)

@@ -456,7 +512,9 @@ This functions refuses to update autoloads files."
 (defun update-autoloads-from-directory (dir)
   "Update `generated-autoload-file' with all the current autoloads from DIR.
 This runs `update-file-autoloads' on each .el file in DIR.
 (defun update-autoloads-from-directory (dir)
   "Update `generated-autoload-file' with all the current autoloads from DIR.
 This runs `update-file-autoloads' on each .el file in DIR.

-Obsolete autoload entries for files that no longer exist are deleted."
+Obsolete autoload entries for files that no longer exist are deleted.
+Note that, if this function is called from `batch-update-directory',
+`generated-autoload-file' was rebound in that function."

   (interactive "DUpdate autoloads for directory: ")
   (setq dir (expand-file-name dir))
   (let ((simple-dir (file-name-as-directory
   (interactive "DUpdate autoloads for directory: ")
   (setq dir (expand-file-name dir))
   (let ((simple-dir (file-name-as-directory

@@ -497,7 +555,7 @@ The directory to which the auto-autoloads.el file must be the first parameter
 on the command line."
   (unless noninteractive
     (error "batch-update-autoloads is to be used only with -batch"))
 on the command line."
   (unless noninteractive
     (error "batch-update-autoloads is to be used only with -batch"))

-  (let ((defdir default-directory)
+  (let ((defdir (directory-file-name default-directory))

        (enable-local-eval nil))        ; Don't query in batch mode.
     ;; (message "Updating autoloads in %s..." generated-autoload-file)
     (dolist (arg command-line-args-left)
        (enable-local-eval nil))        ; Don't query in batch mode.
     ;; (message "Updating autoloads in %s..." generated-autoload-file)
     (dolist (arg command-line-args-left)

@@ -532,18 +590,25 @@ on the command line."
 
 (defvar autoload-package-name nil)
 
 
 (defvar autoload-package-name nil)
 

+;; #### this function is almost identical to, but subtly different from,
+;; batch-update-autoloads.  Both of these functions, unfortunately, are
+;; used in various build scripts in xemacs-packages.  They should be
+;; merged. (However, it looks like no scripts pass more than one arg,
+;; making merging easy.) --ben
+

 ;;;###autoload
 (defun batch-update-directory ()
 ;;;###autoload
 (defun batch-update-directory ()

-  "Update the autoloads for the directory on the command line.
-Runs `update-file-autoloads' on each file in the given directory, must
-be used only with -batch and kills XEmacs on completion."
+  "Update the autoloads for the directories on the command line.
+Runs `update-file-autoloads' on each file in the given directory, and must
+be used only with -batch."

   (unless noninteractive
     (error "batch-update-directory is to be used only with -batch"))
   (let ((defdir default-directory)
        (enable-local-eval nil))        ; Don't query in batch mode.
     (dolist (arg command-line-args-left)
       (setq arg (expand-file-name arg defdir))
   (unless noninteractive
     (error "batch-update-directory is to be used only with -batch"))
   (let ((defdir default-directory)
        (enable-local-eval nil))        ; Don't query in batch mode.
     (dolist (arg command-line-args-left)
       (setq arg (expand-file-name arg defdir))

-      (let ((generated-autoload-file (concat arg "/" autoload-file-name)))
+      (let ((generated-autoload-file (expand-file-name autoload-file-name
+                                                       arg)))

        (cond
         ((file-directory-p arg)
          (message "Updating autoloads in directory %s..." arg)
        (cond
         ((file-directory-p arg)
          (message "Updating autoloads in directory %s..." arg)

@@ -559,6 +624,36 @@ be used only with -batch and kills XEmacs on completion."
       )
     (setq command-line-args-left nil)))
 
       )
     (setq command-line-args-left nil)))
 

+;; #### i created the following.  this one and the last should be merged into
+;; batch-update-autoloads and batch-update-one-directory. --ben
+
+;;;###autoload
+(defun batch-update-one-directory ()
+  "Update the autoloads for a single directory on the command line.
+Runs `update-file-autoloads' on each file in the given directory, and must
+be used only with -batch."
+  (unless noninteractive
+    (error "batch-update-directory is to be used only with -batch"))
+  (let ((defdir default-directory)
+       (enable-local-eval nil))        ; Don't query in batch mode.
+    (let ((arg (car command-line-args-left)))
+      (setq command-line-args-left (cdr command-line-args-left))
+      (setq arg (expand-file-name arg defdir))
+      (let ((generated-autoload-file (expand-file-name autoload-file-name
+                                                       arg)))
+       (cond
+        ((file-directory-p arg)
+         (message "Updating autoloads in directory %s..." arg)
+         (update-autoloads-from-directory arg))
+        (t (error "No such file or directory: %s" arg)))
+       (fixup-autoload-buffer (concat (if autoload-package-name
+                                          autoload-package-name
+                                        (file-name-nondirectory arg))
+                               "-autoloads"))
+       (save-some-buffers t))
+      ;; (message "Done")
+      )))
+

 (provide 'autoload)
 
 ;;; autoload.el ends here
 (provide 'autoload)
 
 ;;; autoload.el ends here