home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / utils / autoload.el < prev    next >
Encoding:
Text File  |  1995-06-21  |  17.0 KB  |  499 lines
  1. ;;; autoload.el --- maintain autoloads in loaddefs.el.
  2.  
  3. ;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
  4. ;;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
  5.  
  6. ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
  7. ;; Keywords: maint
  8.  
  9. ;;; This program is free software; you can redistribute it and/or modify
  10. ;;; it under the terms of the GNU General Public License as published by
  11. ;;; the Free Software Foundation; either version 2, or (at your option)
  12. ;;; any later version.
  13. ;;;
  14. ;;; This program is distributed in the hope that it will be useful,
  15. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;;; GNU General Public License for more details.
  18. ;;;
  19. ;;; A copy of the GNU General Public License can be obtained from this
  20. ;;; program's author (send electronic mail to roland@ai.mit.edu) or from
  21. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  22. ;;; 02139, USA.
  23. ;;;
  24.  
  25. ;;; Synched up with: FSF 19.28.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
  30. ;; date.  It interprets magic cookies of the form ";;;###autoload" in
  31. ;; lisp source files in various useful ways.  To learn more, read the
  32. ;; source; if you're going to use this, you'd better be able to.
  33.  
  34. ;;; Code:
  35.  
  36. (defun make-autoload (form file)
  37.   "Turn FORM, a defun or defmacro, into an autoload for source file FILE.
  38. Returns nil if FORM is not a defun or defmacro."
  39.   (let ((car (car-safe form)))
  40.     (if (memq car '(defun defmacro))
  41.     (let ((macrop (eq car 'defmacro))
  42.           name doc)
  43.       (setq form (cdr form))
  44.       (setq name (car form))
  45.       ;; Ignore the arguments.
  46.       (setq form (cdr (cdr form)))
  47.       (setq doc (car form))
  48.       (if (stringp doc)
  49.           (setq form (cdr form))
  50.         (setq doc nil))
  51.       (list 'autoload (list 'quote name) file doc
  52.         (eq (car-safe (car form)) 'interactive)
  53.         (if macrop (list 'quote 'macro) nil)))
  54.       nil)))
  55.  
  56. (defconst generate-autoload-cookie ";;;###autoload"
  57.   "Magic comment indicating the following form should be autoloaded.
  58. Used by \\[update-file-autoloads].  This string should be
  59. meaningless to Lisp (e.g., a comment).
  60.  
  61. This string is used:
  62.  
  63. ;;;###autoload
  64. \(defun function-to-be-autoloaded () ...)
  65.  
  66. If this string appears alone on a line, the following form will be read and
  67. an autoload made for it.  If it is followed by the string \"immediate\",
  68. then the form on the following will be copied verbatim.  If there is further
  69. text on the line, that text will be copied verbatim to
  70. `generated-autoload-file'.")
  71.  
  72. (defconst generate-autoload-section-header "\f\n;;;### "
  73.   "String inserted before the form identifying
  74. the section of autoloads for a file.")
  75.  
  76. (defconst generate-autoload-section-trailer "\n;;;***\n"
  77.   "String which indicates the end of the section of autoloads for a file.")
  78.  
  79. ;;; Forms which have doc-strings which should be printed specially.
  80. ;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
  81. ;;; the doc-string in FORM.
  82. ;;;
  83. ;;; There used to be the following note here:
  84. ;;; ;;; Note: defconst and defvar should NOT be marked in this way.
  85. ;;; ;;; We don't want to produce defconsts and defvars that
  86. ;;; ;;; make-docfile can grok, because then it would grok them twice,
  87. ;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
  88. ;;; ;;; once in loaddefs.el.
  89. ;;;
  90. ;;; Counter-note: Yes, they should be marked in this way.
  91. ;;; make-docfile only processes those files that are loaded into the
  92. ;;; dumped Emacs, and those files should never have anything
  93. ;;; autoloaded here.  The above-feared problem only occurs with files
  94. ;;; which have autoloaded entries *and* are processed by make-docfile;
  95. ;;; there should be no such files.
  96.  
  97. (put 'autoload 'doc-string-elt 3)
  98. (put 'defun    'doc-string-elt 3)
  99. (put 'defvar   'doc-string-elt 3)
  100. (put 'defconst 'doc-string-elt 3)
  101. (put 'defmacro 'doc-string-elt 3)
  102.  
  103. (defun autoload-trim-file-name (file)
  104.   ;; returns a relative pathname of FILE including the last directory.
  105.   (setq file (expand-file-name file))
  106.   (file-relative-name file
  107.               (file-name-directory
  108.                (directory-file-name
  109.             (file-name-directory file)))))
  110.  
  111. (defun generate-file-autoloads (file)
  112.   "Insert at point a loaddefs autoload section for FILE.
  113. autoloads are generated for defuns and defmacros in FILE
  114. marked by `generate-autoload-cookie' (which see).
  115. If FILE is being visited in a buffer, the contents of the buffer
  116. are used."
  117.   (interactive "fGenerate autoloads for file: ")
  118.   (let ((outbuf (current-buffer))
  119.     (autoloads-done '())
  120.     (load-name (let ((name (file-name-nondirectory file)))
  121.              (if (string-match "\\.elc?$" name)
  122.              (substring name 0 (match-beginning 0))
  123.                name)))
  124.     (print-length nil)
  125.     (print-readably t) ; XEmacs
  126.     (float-output-format nil)
  127.     (done-any nil)
  128.     (visited (get-file-buffer file))
  129.     output-end)
  130.  
  131.     ;; If the autoload section we create here uses an absolute
  132.     ;; pathname for FILE in its header, and then Emacs is installed
  133.     ;; under a different path on another system,
  134.     ;; `update-autoloads-here' won't be able to find the files to be
  135.     ;; autoloaded.  So, if FILE is in the same directory or a
  136.     ;; subdirectory of the current buffer's directory, we'll make it
  137.     ;; relative to the current buffer's directory.
  138.     (setq file (expand-file-name file))
  139.     (let* ((source-truename (file-truename file))
  140.        (dir-truename (file-name-as-directory
  141.               (file-truename default-directory)))
  142.        (len (length dir-truename)))
  143.       (if (and (< len (length source-truename))
  144.            (string= dir-truename (substring source-truename 0 len)))
  145.       (setq file (substring source-truename len))))
  146.  
  147.     ;; XEmacs change -- we only print these messages in batch mode if
  148.     ;; we are actually doing something
  149.     (or noninteractive
  150.     (message "Generating autoloads for %s..." file))
  151.     (save-excursion
  152.       (unwind-protect
  153.       (progn
  154.         (set-buffer (find-file-noselect file))
  155.         (save-excursion
  156.           (save-restriction
  157.         (widen)
  158.         (goto-char (point-min))
  159.         (while (not (eobp))
  160.           (skip-chars-forward " \t\n\f")
  161.           (cond
  162.            ((looking-at (regexp-quote generate-autoload-cookie))
  163.             (search-forward generate-autoload-cookie)
  164.             (skip-chars-forward " \t")
  165.             (or done-any
  166.             (and noninteractive
  167.                  (message "Generating autoloads for %s..." file)))
  168.             (setq done-any t)
  169.             (if (eolp)
  170.             ;; Read the next form and make an autoload.
  171.             (let* ((form (prog1 (read (current-buffer))
  172.                        (or (bolp) (forward-line 1))))
  173.                    (autoload (make-autoload form load-name))
  174.                    (doc-string-elt (get (car-safe form)
  175.                             'doc-string-elt)))
  176.               (if autoload
  177.                   (setq autoloads-done (cons (nth 1 form)
  178.                              autoloads-done))
  179.                 (setq autoload form))
  180.               (if (and doc-string-elt
  181.                    (stringp (nth doc-string-elt autoload)))
  182.                   ;; We need to hack the printing because the
  183.                   ;; doc-string must be printed specially for
  184.                   ;; make-docfile (sigh).
  185.                   (let* ((p (nthcdr (1- doc-string-elt)
  186.                         autoload))
  187.                      (elt (cdr p)))
  188.                 (setcdr p nil)
  189.                 (princ "\n(" outbuf)
  190.                 ;; XEmacs change: don't let ^^L's get into
  191.                 ;; the file or sorting is hard.
  192.                 (let ((print-escape-newlines t)
  193.                       (p (save-excursion
  194.                        (set-buffer outbuf)
  195.                        (point)))
  196.                       p2)
  197.                   (mapcar (function (lambda (elt)
  198.                               (prin1 elt outbuf)
  199.                               (princ " " outbuf)))
  200.                       autoload)
  201.                   (save-excursion
  202.                     (set-buffer outbuf)
  203.                     (setq p2 (point-marker))
  204.                     (goto-char p)
  205.                     (save-match-data
  206.                       (while (search-forward "\^L" p2 t)
  207.                     (delete-char -1)
  208.                     (insert "\\^L")))
  209.                     (goto-char p2)
  210.                     ))
  211.                 (princ "\"\\\n" outbuf)
  212.                 (let ((begin (save-excursion
  213.                            (set-buffer outbuf)
  214.                            (point))))
  215.                   (princ (substring
  216.                       (prin1-to-string (car elt)) 1)
  217.                      outbuf)
  218.                   ;; Insert a backslash before each ( that
  219.                   ;; appears at the beginning of a line in
  220.                   ;; the doc string.
  221.                   (save-excursion
  222.                     (set-buffer outbuf)
  223.                     (save-excursion
  224.                       (while (search-backward "\n(" begin t)
  225.                     (forward-char 1)
  226.                     (insert "\\"))))
  227.                   (if (null (cdr elt))
  228.                       (princ ")" outbuf)
  229.                     (princ " " outbuf)
  230.                     (princ (substring
  231.                         (prin1-to-string (cdr elt))
  232.                         1)
  233.                        outbuf))
  234.                   (terpri outbuf)))
  235.                 ;; XEmacs change: another fucking ^L hack
  236.                 (let ((p (save-excursion
  237.                        (set-buffer outbuf)
  238.                        (point)))
  239.                   (print-escape-newlines t)
  240.                   p2)
  241.                   (print autoload outbuf)
  242.                   (save-excursion
  243.                 (set-buffer outbuf)
  244.                 (setq p2 (point-marker))
  245.                 (goto-char p)
  246.                 (save-match-data
  247.                   (while (search-forward "\^L" p2 t)
  248.                     (delete-char -1)
  249.                     (insert "\\^L")))
  250.                 (goto-char p2)
  251.                 ))
  252.                 ))
  253.               ;; Copy the rest of the line to the output.
  254.               (let ((begin (point)))
  255.             (terpri outbuf)
  256.             (cond ((looking-at "immediate\\s *$") ; XEmacs
  257.                    ;; This is here so that you can automatically
  258.                    ;; have small hook functions copied to
  259.                    ;; loaddefs.el so that it's not necessary to
  260.                    ;; load a whole file just to get a two-line
  261.                    ;; do-nothing find-file-hook... --Stig
  262.                    (forward-line 1)
  263.                    (setq begin (point))
  264.                    (forward-sexp)
  265.                    (forward-line 1))
  266.                   (t
  267.                    (forward-line 1)))
  268.             (princ (buffer-substring begin (point)) outbuf))))
  269.            ((looking-at ";")
  270.             ;; Don't read the comment.
  271.             (forward-line 1))
  272.            (t
  273.             (forward-sexp 1)
  274.             (forward-line 1)))))))
  275.     (or visited
  276.         ;; We created this buffer, so we should kill it.
  277.         (kill-buffer (current-buffer)))
  278.     (set-buffer outbuf)
  279.     (setq output-end (point-marker))))
  280.     (if done-any
  281.     (progn
  282.       (insert generate-autoload-section-header)
  283.       (prin1 (list 'autoloads autoloads-done load-name
  284.                (autoload-trim-file-name file)
  285.                (nth 5 (file-attributes file)))
  286.          outbuf)
  287.       (terpri outbuf)
  288.       (insert ";;; Generated autoloads from "
  289.           (autoload-trim-file-name file) "\n")
  290.       (goto-char output-end)
  291.       (insert generate-autoload-section-trailer)))
  292.     (or noninteractive ; XEmacs: only need one line in -batch mode.
  293.     (message "Generating autoloads for %s...done" file))))
  294.  
  295. (defconst generated-autoload-file "../prim/loaddefs.el"
  296.    "*File \\[update-file-autoloads] puts autoloads into.
  297. A .el file can set this in its local variables section to make its
  298. autoloads go somewhere else.")
  299.  
  300. ;;;###autoload
  301. (defun update-file-autoloads (file)
  302.   "Update the autoloads for FILE in `generated-autoload-file'
  303. \(which FILE might bind in its local variables)."
  304.   (interactive "fUpdate autoloads for file: ")
  305.   (let ((load-name (let ((name (file-name-nondirectory file)))
  306.              (if (string-match "\\.elc?$" name)
  307.              (substring name 0 (match-beginning 0))
  308.                name)))
  309.     (trim-name (autoload-trim-file-name file))
  310.     (found nil)
  311.     (pass 'first)
  312.     (existing-buffer (get-file-buffer file)))
  313.     (save-excursion
  314.       ;; We want to get a value for generated-autoload-file from
  315.       ;; the local variables section if it's there.
  316.       (set-buffer (find-file-noselect file))
  317.       (set-buffer (find-file-noselect generated-autoload-file))
  318.       (save-excursion
  319.     (save-restriction
  320.       (widen)
  321.       (while pass
  322.         ;; This is done in two passes:
  323.         ;;   1st pass:  Look for the section for LOAD-NAME anywhere in the file.
  324.         ;;   2st pass:  Find a place to insert it.  Use alphabetical order.
  325.         (goto-char (point-min))
  326.         (while (and (not found)
  327.             (search-forward generate-autoload-section-header nil t))
  328.           (let ((form (condition-case ()
  329.                   (read (current-buffer))
  330.                 (end-of-file nil))))
  331.         (cond ((and (eq pass 'first)
  332.                 (string= (nth 2 form) load-name))
  333.                ;; We found the section for this file.
  334.                ;; Check if it is up to date.
  335.                (let ((begin (match-beginning 0))
  336.                  (last-time (nth 4 form))
  337.                  (file-time (nth 5 (file-attributes file))))
  338.              (if (and (or (null existing-buffer)
  339.                       (not (buffer-modified-p existing-buffer)))
  340.                   (listp last-time) (= (length last-time) 2)
  341.                   (or (> (car last-time) (car file-time))
  342.                       (and (= (car last-time) (car file-time))
  343.                        (>= (nth 1 last-time)
  344.                            (nth 1 file-time)))))
  345.                  (progn
  346.                    (or noninteractive;; jwz: too loud in -batch mode
  347.                    (message
  348.                     "Autoload section for %s is up to date."
  349.                     file))
  350.                    (setq found 'up-to-date))
  351.                ;; Okay, we found it and it's not up to date...
  352.                (search-forward generate-autoload-section-trailer)
  353.                (delete-region begin (point))
  354.                ;; if the file has moved, then act like it hasn't
  355.                ;; been found and then reinsert it alphabetically.  
  356.                (setq found (string= trim-name (nth 3 form)))
  357.                )))
  358.               ;; XEmacs change -- we organize by sub-directories
  359.               ;; so inserting new autoload entries is a bit tricky...
  360.               ((and (eq pass 'last)
  361.                 (string< trim-name (nth 3 form)))
  362.                ;; We've come to a section alphabetically later than
  363.                ;; LOAD-NAME.  We assume the file is in order and so
  364.                ;; there must be no section for LOAD-NAME.  We will
  365.                ;; insert one before the section here.
  366.                (goto-char (match-beginning 0))
  367.                (setq found 'new))
  368.               )))
  369.         (cond (found
  370.            (setq pass nil))    ; success -- exit loop
  371.           ((eq pass 'first)
  372.            (setq pass 'last))
  373.           (t
  374.            ;; failure -- exit loop
  375.            (setq pass nil))))
  376.       (or (eq found 'up-to-date)
  377.           (and (eq found 'new)
  378.            ;; Check that FILE has any cookies before generating a
  379.            ;; new section for it.
  380.            (save-excursion
  381.              (set-buffer (find-file-noselect file))
  382.              (save-excursion
  383.                (widen)
  384.                (goto-char (point-min))
  385.                (if (search-forward (concat "\n"
  386.                            generate-autoload-cookie)
  387.                        nil t)
  388.                nil
  389.              (if (interactive-p)
  390.                  (message file " has no autoloads"))
  391.              t))))
  392.           (generate-file-autoloads file))))
  393.       (if (interactive-p) (save-buffer))
  394.       (if (and (null existing-buffer)
  395.            (setq existing-buffer (get-file-buffer file)))
  396.       (kill-buffer existing-buffer)))))
  397.  
  398. ;;;###autoload
  399. (defun update-autoloads-here ()
  400.   "\
  401. Update sections of the current buffer generated by \\[update-file-autoloads]."
  402.   (interactive)
  403.   (let ((generated-autoload-file (buffer-file-name)))
  404.     (save-excursion
  405.       (goto-char (point-min))
  406.       (while (search-forward generate-autoload-section-header nil t)
  407.     (let* ((form (condition-case ()
  408.              (read (current-buffer))
  409.                (end-of-file nil)))
  410.            (file (nth 3 form)))
  411.       ;; XEmacs change: if we can't find the file as specified, look
  412.       ;; around a bit more.
  413.       (cond ((and (stringp file)
  414.               (or (get-file-buffer file)
  415.               (file-exists-p file))))
  416.         ((and (stringp file)
  417.               (save-match-data
  418.             (let ((loc (locate-file (file-name-nondirectory file)
  419.                         load-path)))
  420.               (if (null loc)
  421.                   nil
  422.                 (setq loc (expand-file-name
  423.                        (autoload-trim-file-name loc)
  424.                        ".."))
  425.                 (if (or (get-file-buffer loc)
  426.                     (file-exists-p loc))
  427.                 (setq file loc)
  428.                   nil))))))
  429.         (t
  430.          (setq file (if (y-or-n-p (format "Can't find library `%s'; remove its autoloads? "
  431.                           (nth 2 form) file))
  432.                 t
  433.                   (condition-case ()
  434.                   (read-file-name
  435.                    (format "Find `%s' load file: "
  436.                        (nth 2 form))
  437.                    nil nil t)
  438.                 (quit nil))))))
  439.       (if file
  440.           (let ((begin (match-beginning 0)))
  441.         (search-forward generate-autoload-section-trailer)
  442.         (delete-region begin (point))))
  443.       (if (stringp file)
  444.           (generate-file-autoloads file)))))))
  445.  
  446. ;;;###autoload
  447. (defun update-directory-autoloads (dir)
  448.   "Run \\[update-file-autoloads] on each .el file in DIR."
  449.   (interactive "DUpdate autoloads for directory: ")
  450.   (let ((enable-local-eval nil))
  451.     (mapcar 'update-file-autoloads
  452.         (directory-files dir t "^[^=].*\\.el$")))
  453.   (if (interactive-p)
  454.       (save-excursion
  455.     (set-buffer (find-file-noselect generated-autoload-file))
  456.     (save-buffer))))
  457.  
  458. ;;;###autoload
  459. (defun batch-update-autoloads ()
  460.   "Update the autoloads for the files or directories on the command line.
  461. Runs \\[update-file-autoloads] on files and \\[update-directory-autoloads]
  462. on directories.  Must be used only with -batch, and kills Emacs on completion.
  463. Each file will be processed even if an error occurred previously.
  464. For example, invoke `emacs -batch -f batch-update-autoloads *.el'."
  465.   (if (not noninteractive)
  466.       (error "batch-update-autoloads is to be used only with -batch"))
  467.   (let ((lost nil)
  468.     (args command-line-args-left)
  469.     (enable-local-eval nil))    ;Don't query in batch mode.
  470.     (message "Updating autoloads in %s..." generated-autoload-file)
  471.     (let ((frob (function
  472.           (lambda (file)
  473.             (condition-case lossage
  474.                 (update-file-autoloads file)
  475.               (error
  476.                (princ ">>Error processing ")
  477.                (princ file)
  478.                (princ ": ")
  479.                (if (fboundp 'display-error)
  480.                (display-error lossage nil)
  481.              (prin1 lossage))
  482.                (princ "\n")
  483.                (setq lost t)))))))
  484.       (while args
  485.      (if (file-directory-p (expand-file-name (car args)))
  486.          (let ((rest (directory-files (car args) t "\\.el$")))
  487.            (while rest
  488.          (funcall frob (car rest))
  489.          (setq rest (cdr rest))))
  490.        (funcall frob (car args)))
  491.      (setq args (cdr args))))
  492.     (save-some-buffers t)
  493.     (message "Done")
  494.     (kill-emacs (if lost 1 0))))
  495.  
  496. (provide 'autoload)
  497.  
  498. ;;; autoload.el ends here
  499.