Mercurial > hg > xemacs-beta
annotate lisp/autoload.el @ 4332:6ad202d453cb
Insert <immediate> into section header for immediate autoloads.
2007-12-18 Mike Sperber <mike@xemacs.org>
* autoload.el (process-one-lisp-autoload): Insert <immediate> into
the section header for immediate autoloads, to make sure the
upstream doesn't think there aren't any autoloads at all.
| author | Mike Sperber <sperber@deinprogramm.de> |
|---|---|
| date | Thu, 20 Dec 2007 08:49:38 +0100 |
| parents | cee827542370 |
| children | d2f4dd8611d9 |
| rev | line source |
|---|---|
| 1232 | 1 ;;; autoload.el --- maintain autoloads in auto-autoloads files. |
| 428 | 2 |
| 1753 | 3 ;; Copyright (C) 1991-1994, 1997, 2003 Free Software Foundation, Inc. |
| 428 | 4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. |
| 2548 | 5 ;; Copyright (C) 1996, 2000, 2002, 2003, 2004 Ben Wing. |
| 428 | 6 |
| 2548 | 7 ;; Original Author: Roland McGrath <roland@gnu.ai.mit.edu> |
| 8 ;; Heavily Modified: XEmacs Maintainers | |
| 428 | 9 ;; Keywords: maint |
| 10 | |
| 11 ;; This file is part of XEmacs. | |
| 12 | |
| 13 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 14 ;; under the terms of the GNU General Public License as published by | |
| 15 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 16 ;; any later version. | |
| 17 | |
| 18 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 21 ;; General Public License for more details. | |
| 22 | |
| 23 ;; You should have received a copy of the GNU General Public License | |
| 24 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 26 ;; 02111-1307, USA. | |
| 27 | |
| 2548 | 28 ;;; Synched up with: FSF 21.2 by Ben Wing. |
| 29 ;;; Note that update-file-autoloads is seriously modified and not really | |
| 30 ;;; syncable. | |
| 428 | 31 |
| 32 ;;; Commentary: | |
| 33 | |
| 1232 | 34 ;; This code keeps auto-autoloads.el files up to date. It interprets |
| 35 ;; magic cookies (of the form ";;;###autoload" in Lisp source files | |
| 36 ;; and "/* ###autoload */" in C source files) in various useful ways. | |
| 2548 | 37 ;; It is also used to maintain custom-defines.el files, since most of |
| 38 ;; the logic for computing them is the same as for auto-autoloads.el. | |
| 1232 | 39 |
| 40 ;; Usage | |
| 41 ;; ===== | |
| 42 | |
| 43 ;; Recommended usage for this library, as implemented in the core | |
| 44 ;; build process, is | |
| 45 | |
| 46 ;; xemacs -no-packages -batch \ | |
| 2548 | 47 ;; -l autoload -f batch-update-directory-autoloads PREFIX DIRECTORY |
| 1232 | 48 |
| 49 ;; which causes XEmacs to update the file named by PATH from the .el | |
| 50 ;; files in DIRECTORY (but not recursing into subdirectories) and (if | |
| 51 ;; the autoload file is not already protected with a feature test) add | |
| 52 ;; a check and provide for 'PREFIX-autoloads. Currently there is no | |
| 53 ;; sanity check for the provided feature; it is recommended that you | |
| 54 ;; nuke any existing auto-autoloads.el before running the command. | |
| 55 | |
| 56 ;; There is not yet a recommended API for updating multiple directories | |
| 57 ;; into a single auto-autoloads file. Using the recipe above for each | |
| 58 ;; DIRECTORY with the same PATH should work but has not been tested. | |
| 59 ;; There is no API for recursing into subdirectories. There probably | |
| 60 ;; won't be; given the wide variety of ways that existing Lisp packages | |
| 61 ;; arrange their files, and the fact that source packages and installed | |
| 62 ;; packages have a somewhat different directory structure, this seems far | |
| 63 ;; too risky. Use a script or a Lisp library with an explicit list of | |
| 64 ;; PATHs; see update-elc.el for how to do this without recursive invocation | |
| 65 ;; of XEmacs). | |
| 66 | |
| 67 ;; The probable next step is to fix up the packages to use the | |
| 2548 | 68 ;; `batch-update-directory-autoloads' API. However, for backward |
| 1232 | 69 ;; compatibility with XEmacs 21.4 and 21.1, this can't be done quickly. |
| 70 | |
| 71 ;; For backward compatibility the API used in the packages/XEmacs.rules: | |
| 72 | |
| 73 ;; xemacs -vanilla -batch -eval "$(AUTOLOAD_PACKAGE_NAME)" \ | |
| 2548 | 74 ;; -l autoload -f batch-update-autoloads $(AUTOLOAD_PATH) |
| 1232 | 75 |
| 76 ;; is supported, and the implementation is unchanged. However, | |
| 77 ;; revision of the API (in a backward compatible way) and the | |
| 78 ;; implementation are planned, and until those stabilize it is too | |
| 79 ;; risky to use this version of XEmacs for package releases. | |
| 80 | |
| 81 ;; Implementation: | |
| 82 ;; =============== | |
| 83 | |
| 84 ;; #### This section should be moved to the Internals manual, or | |
| 85 ;; (maybe) the Lispref, and integrated with the information above. | |
| 86 ;; Don't believe anything written here; the code is still a mess, and | |
| 87 ;; this is a lot of guesswork. | |
| 88 | |
| 89 ;; Autoloads are used in a number of contexts, including core Lisp, | |
| 90 ;; packaged Lisp, and ELLs (dynamically loadable compiled objects | |
| 91 ;; providing Lisp functionality). There two general strategies for | |
| 92 ;; collecting autoloads. The first is to put autoloads for a package | |
| 93 ;; in a package-specific auto-autoloads file. This is easy to | |
| 94 ;; implement, and allows packages to be distributed with prebuilt | |
| 95 ;; auto-autoloads files. The second is to collect all the autoloads | |
| 96 ;; in a single global auto-autoloads file. This is alleged to speed | |
| 97 ;; up initialization significantly, but requires care to ensure that | |
| 98 ;; auto-autoloads files remain synchronized with the libraries. | |
| 99 | |
| 100 ;; The traditional logic for determining where to put autoload | |
| 101 ;; definitions is complex and is now deprecated. The special variable | |
| 102 ;; `generated-autoload-file' is used to hold the path to the file, and | |
| 103 ;; is initialized to the traditional (well, it's a new tradition with | |
| 104 ;; XEmacs 20) $blddir/lisp/auto-autoloads.el. However, this variable | |
| 105 ;; may be bound by calling code, or may be generated at collect time | |
| 106 ;; and I'm not even sure the initialized value was ever used any more. | |
| 107 | |
| 108 ;; Because there may be multiple auto-autoloads files in use (in XEmacs | |
| 109 ;; 21.x with a full complement of packages there are dozens), and they may | |
| 110 ;; contain initializations that would be dangerous to reexecute, each is | |
| 111 ;; protected by a feature test. By convention, the feature symbol is of | |
| 112 ;; the form "NAME-autoloads". For packages, the special variable | |
| 113 ;; `autoload-package-name' is used to determine NAME. In the core, | |
| 114 ;; autoloads are defined in the modules (all of which are collected in a | |
| 115 ;; single auto-autoloads file), using NAME=modules, in the lisp directory | |
| 116 ;; using NAME=lisp, and in the lisp/mule directory, using NAME=mule, for | |
| 117 ;; the autoloads feature. These latter are computed by the autoloads | |
| 118 ;; function at collect time. | |
| 428 | 119 |
| 120 ;; ChangeLog: | |
| 121 | |
| 1232 | 122 ;; See ./ChangeLog. |
| 428 | 123 |
| 124 ;;; Code: | |
| 125 | |
| 2548 | 126 ;; Need to load easy-mmode because we expand macro calls to easy-mmode |
| 127 ;; macros in make-autoloads below. | |
| 128 (require 'easy-mmode) | |
| 129 | |
| 1232 | 130 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 131 ;; Standard file and directory names | |
| 132 | |
| 133 ;; `autoload-file-name' is defvar'd and initialized in packages.el, | |
| 134 ;; which is loaded (and dumped) very early. If you find it isn't, you | |
| 135 ;; know what you're doing. | |
| 136 | |
| 137 (defconst autoload-target-directory "../lisp/" | |
| 138 "Standard directory containing autoload declaration file. | |
| 139 | |
| 140 Use `generated-autoload-file' (q.v.) to change its installation location.") | |
| 141 | |
| 142 ;; Dynamic variables for communication among functions | |
| 143 | |
| 2548 | 144 ;; FSF 21.2: |
| 145 ;; The autoload file is assumed to contain a trailer starting with a FormFeed | |
| 146 ;; character. | |
| 147 | |
| 1232 | 148 (defvar generated-autoload-file |
| 149 (expand-file-name autoload-file-name lisp-directory) | |
| 150 "*File `update-file-autoloads' puts autoloads into. | |
| 151 A .el file can set this in its local variables section to make its | |
| 152 autoloads go somewhere else. | |
| 153 | |
| 154 Note that `batch-update-directory' binds this variable to its own value, | |
| 155 generally the file named by `autoload-file-name' in the directory being | |
| 156 updated. XEmacs.rules setq's this variable for package autoloads.") | |
| 157 | |
| 2548 | 158 (defvar generate-autoload-function |
| 159 #'generate-file-autoloads | |
| 160 "Function to generate the autoloads for a file and insert at point. | |
| 161 Called with one argument, the file.") | |
| 162 | |
| 1232 | 163 (define-obsolete-variable-alias 'autoload-package-name |
| 164 'autoload-feature-prefix) | |
| 165 (defvar autoload-feature-prefix nil | |
| 166 "If non-nil, use this string to prefix the autoload feature name. | |
| 167 | |
| 168 Usually a package name (from AUTOLOAD_PACKAGE_NAME, defined in XEmacs.rules | |
| 169 in the top of the package hierarchy), or \"auto\" (reserved for the core Lisp | |
| 170 auto-autoloads file). Highest priority candidate except for an explicit | |
| 171 argument to `autoload-make-feature-name' (q.v.).") | |
| 172 | |
| 2548 | 173 (defvar autoload-feature-suffix "-autoloads" |
| 174 "String added to `autoload-feature-prefix' to create the autoload feature name.") | |
| 175 | |
| 1232 | 176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 177 ;; Magic strings in source files | |
| 178 | |
| 179 (defconst generate-autoload-cookie ";;;###autoload" | |
| 180 "Magic comment indicating the following form should be autoloaded. | |
| 181 Used by `update-file-autoloads'. This string should be | |
| 182 meaningless to Lisp (e.g., a comment). | |
| 183 | |
| 184 This string is used: | |
| 185 | |
| 186 ;;;###autoload | |
| 187 \(defun function-to-be-autoloaded () ...) | |
| 188 | |
| 189 If this string appears alone on a line, the following form will be | |
| 190 read and an autoload made for it. If it is followed by the string | |
| 191 \"immediate\", then the form on the following line will be copied | |
| 192 verbatim. If there is further text on the line, that text will be | |
| 193 copied verbatim to `generated-autoload-file'.") | |
| 194 | |
| 195 (defconst generate-c-autoload-cookie "/* ###autoload" | |
| 196 "Magic C comment indicating the following form should be autoloaded. | |
| 197 Used by `update-file-autoloads'. This string should be | |
| 198 meaningless to C (e.g., a comment). | |
| 199 | |
| 200 This string is used: | |
| 201 | |
| 202 /* ###autoload */ | |
| 203 DEFUN (\"function-to-be-autoloaded\", ... ) | |
| 204 | |
| 205 If this string appears alone on a line, the following form will be | |
| 206 read and an autoload made for it. If there is further text on the line, | |
| 207 that text will be copied verbatim to `generated-autoload-file'.") | |
| 208 | |
| 209 (defconst generate-c-autoload-module "/* ###module" | |
| 210 "Magic C comment indicating the module containing autoloaded functions. | |
| 211 Since a module can consist of multiple C files, the module name may not be | |
| 212 the same as the C source file base name. In that case, use this comment to | |
| 213 indicate the actual name of the module from which to autoload functions.") | |
| 214 | |
| 215 (defconst generate-autoload-section-header "\f\n;;;### " | |
| 216 "String inserted before the form identifying | |
| 217 the section of autoloads for a file.") | |
| 218 | |
| 219 (defconst generate-autoload-section-trailer "\n;;;***\n" | |
| 220 "String which indicates the end of the section of autoloads for a file.") | |
| 221 | |
| 2548 | 222 (defconst generate-autoload-section-continuation ";;;;;; " |
| 223 "String to add on each continuation of the section header form.") | |
| 224 | |
| 1232 | 225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 226 ;; Parsing the source file text. | |
| 2548 | 227 ;; Autoloads in C source differ from those in Lisp source. |
| 1232 | 228 |
| 428 | 229 (defun make-autoload (form file) |
| 2548 | 230 "Turn FORM into an autoload or defvar for source file FILE. |
| 231 Returns nil if FORM is not a special autoload form (i.e. a function definition | |
| 232 or macro definition or a defcustom)." | |
| 233 (let ((car (car-safe form)) expand) | |
| 234 (cond | |
| 235 ;; For complex cases, try again on the macro-expansion. | |
| 236 ((and (memq car '(easy-mmode-define-global-mode | |
| 237 easy-mmode-define-minor-mode define-minor-mode)) | |
| 238 (setq expand (let ((load-file-name file)) (macroexpand form))) | |
| 239 (eq (car expand) 'progn) | |
| 240 (memq :autoload-end expand)) | |
| 241 (let ((end (memq :autoload-end expand))) | |
| 242 ;; Cut-off anything after the :autoload-end marker. | |
| 243 (setcdr end nil) | |
| 244 (cons 'progn | |
| 245 (mapcar (lambda (form) (make-autoload form file)) | |
| 246 (cdr expand))))) | |
| 247 | |
| 248 ;; For special function-like operators, use the `autoload' function. | |
| 249 ((memq car '(defun define-skeleton defmacro define-derived-mode | |
| 250 define-generic-mode easy-mmode-define-minor-mode | |
| 251 easy-mmode-define-global-mode | |
| 4256 | 252 define-minor-mode defun* defmacro* |
| 253 defclass defmethod)) ; from the EIEIO package | |
| 2548 | 254 (let* ((macrop (memq car '(defmacro defmacro*))) |
| 255 (name (nth 1 form)) | |
| 256 (body (nthcdr (get car 'doc-string-elt) form)) | |
| 257 (doc (if (stringp (car body)) (pop body)))) | |
| 258 ;; `define-generic-mode' quotes the name, so take care of that | |
| 259 (list 'autoload (if (listp name) name (list 'quote name)) file doc | |
| 260 (or (and (memq car '(define-skeleton define-derived-mode | |
| 261 define-generic-mode | |
| 262 easy-mmode-define-global-mode | |
| 263 easy-mmode-define-minor-mode | |
| 264 define-minor-mode)) t) | |
| 265 (eq (car-safe (car body)) 'interactive)) | |
| 266 (if macrop (list 'quote 'macro) nil)))) | |
| 267 | |
| 268 ;; Convert defcustom to a simpler (and less space-consuming) defvar, | |
| 269 ;; but add some extra stuff if it uses :require. | |
| 270 ((eq car 'defcustom) | |
| 271 (let ((varname (car-safe (cdr-safe form))) | |
| 272 (init (car-safe (cdr-safe (cdr-safe form)))) | |
| 273 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) | |
| 274 (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))) | |
| 275 (if (not (plist-get rest :require)) | |
| 276 `(defvar ,varname ,init ,doc) | |
| 277 `(progn | |
| 278 (defvar ,varname ,init ,doc) | |
| 279 (custom-add-to-group ,(plist-get rest :group) | |
| 280 ',varname 'custom-variable) | |
| 281 (custom-add-load ',varname | |
| 282 ,(plist-get rest :require)))))) | |
| 4303 | 283 ;; Coding systems. #### Would be nice to handle the docstring here too. |
| 284 ((memq car '(make-coding-system make-8-bit-coding-system)) | |
| 285 `(autoload-coding-system ,(nth 1 form) '(load ,file))) | |
| 2548 | 286 ;; nil here indicates that this is not a special autoload form. |
| 287 (t nil)))) | |
| 428 | 288 |
| 996 | 289 (defun make-c-autoload (module) |
| 290 "Make an autoload list for the DEFUN at point in MODULE. | |
| 291 Returns nil if the DEFUN is malformed." | |
| 292 (and | |
| 293 ;; Match the DEFUN | |
| 294 (search-forward "DEFUN" nil t) | |
| 295 ;; Match the opening parenthesis | |
| 296 (progn | |
| 297 (skip-syntax-forward " ") | |
| 298 (eq (char-after) ?\()) | |
| 299 ;; Match the opening quote of the Lisp function name | |
| 300 (progn | |
| 301 (forward-char) | |
| 302 (skip-syntax-forward " ") | |
| 303 (eq (char-after) ?\")) | |
| 304 ;; Extract the Lisp function name, interactive indicator, and docstring | |
| 305 (let* ((func-name (let ((begin (progn (forward-char) (point)))) | |
| 306 (search-forward "\"" nil t) | |
| 307 (backward-char) | |
| 308 (intern (buffer-substring begin (point))))) | |
| 309 (interact (progn | |
| 310 (search-forward "," nil t 4) | |
| 311 (skip-syntax-forward " ") | |
| 312 (not (eq (char-after) ?0)))) | |
| 313 (begin (progn | |
| 314 (search-forward "/*" nil t) | |
| 315 (forward-line 1) | |
| 316 (point)))) | |
| 317 (search-forward "*/" nil t) | |
| 318 (goto-char (match-beginning 0)) | |
| 319 (skip-chars-backward " \t\n\f") | |
| 320 (list 'autoload (list 'quote func-name) module | |
| 321 (buffer-substring begin (point)) interact nil)))) | |
| 322 | |
| 1232 | 323 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 324 ;; Generating autoloads for a single file | |
| 428 | 325 |
| 326 ;;;###autoload | |
| 2548 | 327 (defun generate-file-autoloads (file) |
| 1232 | 328 "Insert at point an autoload section for FILE. |
| 428 | 329 autoloads are generated for defuns and defmacros in FILE |
| 330 marked by `generate-autoload-cookie' (which see). | |
| 331 If FILE is being visited in a buffer, the contents of the buffer | |
| 332 are used." | |
| 333 (interactive "fGenerate autoloads for file: ") | |
| 1232 | 334 (cond ((string-match "\\.el$" file) |
| 2548 | 335 (generate-autoload-type-section |
| 1298 | 336 file |
| 337 (replace-in-string (file-name-nondirectory file) "\\.elc?$" "") | |
| 2548 | 338 nil #'generate-lisp-file-autoloads-1)) |
| 1232 | 339 ;; #### jj, are C++ modules possible? |
| 340 ((string-match "\\.c$" file) | |
| 2548 | 341 (generate-autoload-type-section |
| 1298 | 342 file |
| 343 (replace-in-string (file-name-nondirectory file) "\\.c$" "") | |
| 2548 | 344 t #'generate-c-file-autoloads-1)) |
| 1232 | 345 (t |
| 346 (error 'wrong-type-argument file "not a C or Elisp source file")))) | |
| 428 | 347 |
| 2548 | 348 (defun* generate-autoload-type-section (file load-name literal fun-to-call) |
| 1298 | 349 "Insert at point an autoload-type section for FILE. |
| 2548 | 350 LOAD-NAME is the non-directory portion of the name, with the final .el, .elc |
| 351 or .c section removed. If LITERAL, open the file literally, without decoding. | |
| 352 Calls FUN-TO-CALL to compute the autoloads, with the loaded file in the | |
| 353 current buffer, passing it OUTBUF (where to write the autoloads), LOAD-NAME, | |
| 354 and TRIM-NAME (result of calling `autoload-trim-file-name' on FILE)." | |
| 428 | 355 (let ((outbuf (current-buffer)) |
| 1298 | 356 (trim-name (autoload-trim-file-name file)) |
| 428 | 357 (autoloads-done '()) |
| 358 (print-length nil) | |
| 359 (print-readably t) ; XEmacs | |
| 360 (float-output-format nil) | |
| 1298 | 361 (visited (get-file-buffer file)) |
| 2548 | 362 suppress-form |
| 428 | 363 ;; (done-any nil) |
| 364 output-end) | |
| 365 | |
| 366 ;; If the autoload section we create here uses an absolute | |
| 367 ;; pathname for FILE in its header, and then Emacs is installed | |
| 368 ;; under a different path on another system, | |
| 369 ;; `update-autoloads-here' won't be able to find the files to be | |
| 370 ;; autoloaded. So, if FILE is in the same directory or a | |
| 371 ;; subdirectory of the current buffer's directory, we'll make it | |
| 372 ;; relative to the current buffer's directory. | |
| 373 (setq file (expand-file-name file)) | |
| 2548 | 374 ;; #### FSF 21.2. Do we want this? |
| 375 ; (let* ((source-truename (file-truename file)) | |
| 376 ; (dir-truename (file-name-as-directory | |
| 377 ; (file-truename default-directory))) | |
| 378 ; (len (length dir-truename))) | |
| 379 ; (if (and (< len (length source-truename)) | |
| 380 ; (string= dir-truename (substring source-truename 0 len))) | |
| 381 ; (setq file (substring source-truename len)))) | |
| 382 | |
| 383 ;; Check for suppression form (XEmacs) | |
| 384 (let* ((dir (file-name-directory file)) | |
| 385 (_pkg (expand-file-name "_pkg.el" dir)) | |
| 386 (pkg-vis (get-file-buffer _pkg)) | |
| 387 pkg-buf) | |
| 388 (save-excursion | |
| 389 (when (file-readable-p _pkg) | |
| 390 (unwind-protect | |
| 391 (progn | |
| 392 (let ((find-file-hooks nil) | |
| 393 (enable-local-variables nil)) | |
| 394 (set-buffer (or pkg-vis (find-file-noselect _pkg))) | |
| 395 (set-syntax-table emacs-lisp-mode-syntax-table)) | |
| 396 (save-excursion | |
| 397 (save-restriction | |
| 398 (widen) | |
| 399 (goto-char (point-min)) | |
| 400 (block nil | |
| 401 (while (search-forward "(package-suppress" nil t) | |
| 402 ;; skip over package-name | |
| 403 (forward-sexp 1) | |
| 404 (let ((supfile (read (current-buffer)))) | |
| 405 (when (equal supfile load-name) | |
| 406 (setq suppress-form (eval (read (current-buffer)))) | |
| 407 (return)))))))) | |
| 408 (unless pkg-vis | |
| 409 ;; We created this buffer, so we should kill it. | |
| 410 (if pkg-buf (kill-buffer pkg-buf))))))) | |
| 428 | 411 |
| 412 (save-excursion | |
| 413 (unwind-protect | |
| 414 (progn | |
| 2548 | 415 (let (;(find-file-hooks nil) |
| 416 ;(enable-local-variables nil) | |
| 417 ) | |
| 1298 | 418 (set-buffer (or visited (find-file-noselect file literal literal |
| 419 ))) | |
| 420 ;; This doesn't look right for C files, but it is. The only | |
| 421 ;; place we need the syntax table is when snarfing the Lisp | |
| 422 ;; function name. | |
| 460 | 423 (set-syntax-table emacs-lisp-mode-syntax-table)) |
| 2548 | 424 ; (if visited |
| 425 ; (set-buffer visited) | |
| 426 ; ;; It is faster to avoid visiting the file. | |
| 427 ; (set-buffer (get-buffer-create " *generate-autoload-file*")) | |
| 428 ; (kill-all-local-variables) | |
| 429 ; (erase-buffer) | |
| 430 ; (setq buffer-undo-list t | |
| 431 ; buffer-read-only nil) | |
| 432 ; ;; This doesn't look right for C files, but it is. The only | |
| 433 ; ;; place we need the syntax table is when snarfing the Lisp | |
| 434 ; ;; function name. | |
| 435 ; (emacs-lisp-mode) | |
| 436 ; (if literal | |
| 437 ; (insert-file-contents-literally file nil) | |
| 438 ; (insert-file-contents file nil))) | |
| 1298 | 439 (unless (setq autoloads-done |
| 2548 | 440 (funcall fun-to-call outbuf load-name trim-name)) |
| 441 (return-from generate-autoload-type-section)) | |
| 1298 | 442 ) |
| 428 | 443 (unless visited |
| 1298 | 444 ;; We created this buffer, so we should kill it. |
| 445 (kill-buffer (current-buffer))) | |
| 428 | 446 (set-buffer outbuf) |
| 447 (setq output-end (point-marker)))) | |
| 448 (if t ;; done-any | |
| 449 ;; XEmacs -- always do this so that we cache the information | |
| 450 ;; that we've processed the file already. | |
| 451 (progn | |
| 2548 | 452 ;; Insert the section-header line |
| 453 ;; which lists the file name and which functions are in it, etc. | |
| 428 | 454 (insert generate-autoload-section-header) |
| 2548 | 455 (prin1 (list 'autoloads autoloads-done load-name trim-name |
| 456 ;; In FSF 21.2. Also in FSF 19.30. Presumably | |
| 457 ;; deleted from XEmacs. | |
| 458 ;; (nth 5 (file-attributes file)) | |
| 459 ) | |
| 428 | 460 outbuf) |
| 461 (terpri outbuf) | |
| 2548 | 462 ;; #### Alas, we will have to think about this. Adding this means |
| 463 ;; that, once we have created or maintained an auto-autoloads file, | |
| 464 ;; we alone and our successors can update the file. The file itself | |
| 465 ;; will work fine in older XEmacsen, but they won't be able to | |
| 466 ;; update autoloads -- hence, to build. | |
| 467 ; ;; Break that line at spaces, to avoid very long lines. | |
| 468 ; ;; Make each sub-line into a comment. | |
| 469 ; (with-current-buffer outbuf | |
| 470 ; (save-excursion | |
| 471 ; (forward-line -1) | |
| 472 ; (while (not (eolp)) | |
| 473 ; (move-to-column 64) | |
| 474 ; (skip-chars-forward "^ \n") | |
| 475 ; (or (eolp) | |
| 476 ; (insert "\n" generate-autoload-section-continuation))))) | |
| 477 ;; XEmacs: This was commented out before. #### Correct? | |
| 478 ; (insert ";;; Generated autoloads from " | |
| 479 ; (autoload-trim-file-name file) "\n") | |
| 480 ;; XEmacs -- handle suppression | |
| 481 (when suppress-form | |
| 482 (insert "\n;;; Suppress form from _pkg.el\n") | |
| 483 (insert "(unless " (prin1-to-string suppress-form) "\n\n")) | |
| 428 | 484 (goto-char output-end) |
| 2548 | 485 ;; XEmacs -- handle suppression |
| 486 (when suppress-form | |
| 487 (insert "\n) ;; unless (suppressed)\n")) | |
| 428 | 488 (insert generate-autoload-section-trailer))) |
| 2548 | 489 )) |
| 490 | |
| 428 | 491 |
| 2548 | 492 (defun process-one-lisp-autoload (autoloads-done outbuf load-name) |
| 493 "Process a single autoload at point and write to OUTBUF. | |
| 494 Point should be just after a magic cookie string (e.g. ;;;###autoload). | |
| 495 Updates AUTOLOADS-DONE and returns the new value." | |
| 496 (skip-chars-forward " \t") | |
| 497 ;; (setq done-any t) | |
| 498 (if (eolp) | |
| 499 ;; Read the next form and make an autoload. | |
| 500 (let* ((form (prog1 (read (current-buffer)) | |
| 501 (or (bolp) (forward-line 1)))) | |
| 502 (autoload (make-autoload form load-name))) | |
| 503 (if autoload | |
| 504 (setq autoloads-done (cons (nth 1 form) | |
| 505 autoloads-done)) | |
| 506 (setq autoload form)) | |
| 507 (autoload-print-form autoload outbuf "")) | |
| 508 ;; Copy the rest of the line to the output. | |
| 509 (cond ((looking-at "immediate\\s *$") ; XEmacs | |
| 510 ;; This is here so that you can automatically | |
| 511 ;; have small hook functions copied to | |
| 512 ;; auto-autoloads.el so that it's not necessary | |
| 513 ;; to load a whole file just to get a two-line | |
| 514 ;; do-nothing find-file-hook... --Stig | |
| 515 (forward-line 1) | |
| 516 (let ((begin (point))) | |
| 517 (forward-sexp) | |
| 518 (forward-line 1) | |
|
4332
6ad202d453cb
Insert <immediate> into section header for immediate autoloads.
Mike Sperber <sperber@deinprogramm.de>
parents:
4303
diff
changeset
|
519 (princ (buffer-substring begin (point)) outbuf)) |
|
6ad202d453cb
Insert <immediate> into section header for immediate autoloads.
Mike Sperber <sperber@deinprogramm.de>
parents:
4303
diff
changeset
|
520 (setq autoloads-done (cons '<immediate> autoloads-done))) |
| 2548 | 521 (t |
| 522 (princ (buffer-substring | |
| 523 (progn | |
| 524 ;; Back up over whitespace, to preserve it. | |
| 525 (skip-chars-backward " \f\t") | |
| 526 (if (= (char-after (1+ (point))) ? ) | |
| 527 ;; Eat one space. | |
| 528 (forward-char 1)) | |
| 529 (point)) | |
| 530 (progn (forward-line 1) (point))) | |
| 531 outbuf)))) | |
| 532 autoloads-done) | |
| 533 | |
| 534 (defun* generate-lisp-file-autoloads-1 (outbuf load-name trim-name) | |
| 535 "Insert at point in OUTBUF an autoload section for an Elisp file. | |
| 536 The file is assumed to be already loaded and in the current buffer. | |
| 537 autoloads are generated for defuns and defmacros marked by | |
| 538 `generate-autoload-cookie' (which see)." | |
| 1298 | 539 (let ((autoloads-done '()) |
| 540 ) | |
| 541 (save-excursion | |
| 542 (save-restriction | |
| 543 (widen) | |
| 544 (goto-char (point-min)) | |
| 545 (unless (search-forward generate-autoload-cookie nil t) | |
| 546 (message "No autoloads found in %s" trim-name) | |
| 2548 | 547 (return-from generate-lisp-file-autoloads-1 nil)) |
| 1298 | 548 |
| 549 (message "Generating autoloads for %s..." trim-name) | |
| 550 (goto-char (point-min)) | |
| 2548 | 551 (while (not (eobp)) |
| 552 (skip-chars-forward " \t\n\f") | |
| 1298 | 553 (cond |
| 2548 | 554 ((looking-at (regexp-quote generate-autoload-cookie)) |
| 555 (search-forward generate-autoload-cookie) | |
| 556 (setq autoloads-done | |
| 557 (process-one-lisp-autoload autoloads-done outbuf load-name))) | |
| 1298 | 558 ((looking-at ";") |
| 559 ;; Don't read the comment. | |
| 560 (forward-line 1)) | |
| 561 (t | |
| 562 (forward-sexp 1) | |
| 563 (forward-line 1))) | |
| 2548 | 564 ))) |
| 565 (or noninteractive ; XEmacs: only need one line in -batch mode. | |
| 566 (message "Generating autoloads for %s...done" trim-name)) | |
| 1298 | 567 autoloads-done)) |
| 568 | |
| 2548 | 569 (defun* generate-c-file-autoloads-1 (outbuf load-name trim-name |
| 570 &optional funlist) | |
| 1232 | 571 "Insert at point an autoload section for the C file FILE. |
| 1048 | 572 autoloads are generated for defuns and defmacros in FILE |
| 996 | 573 marked by `generate-c-autoload-cookie' (which see). |
| 574 If FILE is being visited in a buffer, the contents of the buffer | |
| 575 are used." | |
| 1733 | 576 (let ((exists-p-format |
| 577 "(when (locate-file \"%s\" module-load-path module-extensions)\n") | |
| 578 autoloads-done) | |
| 996 | 579 (save-excursion |
| 1298 | 580 (save-restriction |
| 581 (widen) | |
| 582 (goto-char (point-min)) | |
| 583 ;; Is there a module name comment? | |
| 584 (when (search-forward generate-c-autoload-module nil t) | |
| 585 (skip-chars-forward " \t") | |
| 586 (let ((begin (point))) | |
| 587 (skip-chars-forward "^ \t\n\f") | |
| 588 (setq load-name (buffer-substring begin (point))))) | |
| 589 (if funlist | |
| 590 (progn | |
| 591 (message "Generating autoloads for %s..." trim-name) | |
| 1733 | 592 (princ (format exists-p-format load-name) outbuf) |
| 1298 | 593 (dolist (arg funlist) |
| 996 | 594 (goto-char (point-min)) |
| 1298 | 595 (re-search-forward |
| 596 (concat "DEFUN (\"" | |
| 597 (regexp-quote (symbol-name arg)) | |
| 598 "\"")) | |
| 599 (goto-char (match-beginning 0)) | |
| 600 (let ((autoload (make-c-autoload load-name))) | |
| 601 (when autoload | |
| 602 (push (nth 1 (nth 1 autoload)) autoloads-done) | |
| 2548 | 603 (autoload-print-form autoload outbuf " ")))) |
| 1298 | 604 ;; close the princ'd `when' form |
| 605 (princ ")" outbuf)) | |
| 606 (goto-char (point-min)) | |
| 607 (let ((match | |
| 608 (search-forward generate-c-autoload-cookie nil t))) | |
| 609 (unless match | |
| 610 (message "No autoloads found in %s" trim-name) | |
| 611 (return-from generate-c-file-autoloads-1 nil)) | |
| 612 | |
| 613 (message "Generating autoloads for %s..." trim-name) | |
| 1733 | 614 (princ (format exists-p-format load-name) outbuf) |
| 1298 | 615 (while match |
| 616 (forward-line 1) | |
| 617 (let ((autoload (make-c-autoload load-name))) | |
| 618 (when autoload | |
| 619 (push (nth 1 (nth 1 autoload)) autoloads-done) | |
| 2548 | 620 (autoload-print-form autoload outbuf " "))) |
| 1298 | 621 (setq match |
| 622 (search-forward generate-c-autoload-cookie nil t))) | |
| 623 ;; close the princ'd `when' form | |
| 624 (princ ")" outbuf))))) | |
| 2548 | 625 (or noninteractive ; XEmacs: only need one line in -batch mode. |
| 626 (message "Generating autoloads for %s...done" trim-name)) | |
| 1298 | 627 autoloads-done)) |
| 996 | 628 |
| 2548 | 629 ;;;###autoload |
| 630 (defun generate-custom-defines (file) | |
| 631 "Insert at point a custom-define section for FILE. | |
| 632 If FILE is being visited in a buffer, the contents of the buffer | |
| 633 are used." | |
| 634 (interactive "fGenerate custom defines for file: ") | |
| 635 (cond ((string-match "\\.el$" file) | |
| 636 (generate-autoload-type-section | |
| 637 file | |
| 638 (replace-in-string (file-name-nondirectory file) "\\.elc?$" "") | |
| 639 nil #'generate-custom-defines-1)) | |
| 640 ((string-match "\\.c$" file) | |
| 641 ;; no way to generate custom-defines for C files (currently?), | |
| 642 ;; but cannot signal an error. | |
| 643 nil) | |
| 644 (t | |
| 645 (error 'wrong-type-argument file "not a C or Elisp source file")))) | |
| 1232 | 646 |
| 2548 | 647 (defun* generate-custom-defines-1 (outbuf load-name trim-name) |
| 648 "Insert at point in OUTBUF a custom-define section for an Elisp file. | |
| 649 This contains all defcustoms and defgroups in the file. | |
| 650 The file is assumed to be already loaded and in the current buffer." | |
| 651 (let* ((search-regexp-1 "^(\\(defcustom\\|defgroup\\) ") | |
| 652 (search-string-2 ";;;###custom-define") | |
| 653 (search-regexp-2 (regexp-quote search-string-2)) | |
| 654 (autoloads-done '())) | |
| 655 (save-excursion | |
| 656 (save-restriction | |
| 657 (widen) | |
| 658 (goto-char (point-min)) | |
| 659 (unless (or (re-search-forward search-regexp-1 nil t) | |
| 660 (re-search-forward search-regexp-2 nil t)) | |
| 661 (message "No custom defines found in %s" trim-name) | |
| 662 (return-from generate-custom-defines-1 nil)) | |
| 663 (message "Generating custom defines for %s..." trim-name) | |
| 664 (princ "(defconst custom-define-current-source-file " outbuf) | |
| 665 (prin1 (file-relative-name (buffer-file-name) | |
| 666 (symbol-value-in-buffer 'default-directory | |
| 667 outbuf)) outbuf) | |
| 668 (princ ")\n" outbuf) | |
| 669 | |
| 670 (goto-char (point-min)) | |
| 671 (while (not (eobp)) | |
| 672 (skip-chars-forward " \t\n\f") | |
| 673 (cond | |
| 674 ((looking-at search-regexp-1) | |
| 675 ;; Read the next form and copy it to make an autoload. | |
| 676 (let* ((form (prog1 (read (current-buffer)) | |
| 677 (or (bolp) (forward-line 1)))) | |
| 678 (autoload form ;(make-autoload form load-name) | |
| 679 )) | |
| 680 (if autoload | |
| 681 (setq autoloads-done (cons (nth 1 form) | |
| 682 autoloads-done)) | |
| 683 (setq autoload form)) | |
| 684 (autoload-print-form autoload outbuf "")) | |
| 685 ) | |
| 686 ((looking-at search-regexp-2) | |
| 687 (search-forward search-string-2) | |
| 688 (beep) | |
| 689 (setq autoloads-done | |
| 690 (process-one-lisp-autoload autoloads-done outbuf load-name))) | |
| 691 ((looking-at ";") | |
| 692 ;; Don't read the comment. | |
| 693 (forward-line 1)) | |
| 694 (t | |
| 695 (forward-sexp 1) | |
| 696 (forward-line 1))) | |
| 697 ))) | |
| 698 (or noninteractive ; XEmacs: only need one line in -batch mode. | |
| 699 (message "Generating custom defines for %s...done" trim-name)) | |
| 700 autoloads-done)) | |
| 701 | |
| 702 ;; Assorted utilities for generating autoloads and pieces thereof | |
| 703 | |
| 704 (defun autoload-print-form (form outbuf margin) | |
| 996 | 705 "Print an autoload form, handling special characters. |
| 706 In particular, print docstrings with escapes inserted before left parentheses | |
| 707 at the beginning of lines and ^L characters." | |
| 2548 | 708 (cond |
| 709 ;; If the form is a sequence, recurse. | |
| 710 ((eq (car form) 'progn) | |
| 711 (mapcar #'(lambda (x) (autoload-print-form x outbuf margin)) | |
| 712 (cdr form))) | |
| 713 ;; Symbols at the toplevel are meaningless. | |
| 714 ((symbolp form) nil) | |
| 715 (t | |
| 716 (let ((doc-string-elt (get (car-safe form) 'doc-string-elt))) | |
| 717 (if (and doc-string-elt (stringp (nth doc-string-elt form))) | |
| 718 ;; We need to hack the printing because the doc-string must be | |
| 719 ;; printed specially for make-docfile (sigh). | |
| 720 (let* ((p (nthcdr (1- doc-string-elt) form)) | |
| 721 (elt (cdr p)) | |
| 722 (start-string (format "\n%s(" margin))) | |
| 723 (setcdr p nil) | |
| 724 (princ start-string outbuf) | |
| 725 ;; XEmacs change: don't let ^^L's get into | |
| 726 ;; the file or sorting is hard. | |
| 727 (let ((print-escape-newlines t) | |
| 728 ;;#### FSF 21.2 (print-escape-nonascii t) | |
| 729 (p (point outbuf)) | |
| 730 p2) | |
| 731 (mapcar #'(lambda (elt) | |
| 732 (prin1 elt outbuf) | |
| 733 (princ " " outbuf)) | |
| 734 form) | |
| 735 (with-current-buffer outbuf | |
| 736 (setq p2 (point-marker)) | |
| 737 (goto-char p) | |
| 738 (save-match-data | |
| 739 (while (search-forward "\^L" p2 t) | |
| 740 (delete-char -1) | |
| 741 (insert "\\^L"))) | |
| 742 (goto-char p2))) | |
| 743 (princ "\"\\\n" outbuf) | |
| 744 (let ((begin (point outbuf))) | |
| 745 (princ (substring (prin1-to-string (car elt)) 1) outbuf) | |
| 746 ;; Insert a backslash before each ( that appears at the beginning | |
| 747 ;; of a line in the doc string. | |
| 748 (with-current-buffer outbuf | |
| 749 (save-excursion | |
| 750 (while (search-backward start-string begin t) | |
| 751 (forward-char 1) | |
| 752 (insert "\\")))) | |
| 753 (if (null (cdr elt)) | |
| 754 (princ ")" outbuf) | |
| 755 (princ " " outbuf) | |
| 756 (princ (substring (prin1-to-string (cdr elt)) 1) outbuf)) | |
| 757 (terpri outbuf) | |
| 758 (princ margin outbuf))) | |
| 759 ;; XEmacs change: another ^L hack | |
| 760 (let ((p (point outbuf)) | |
| 761 (print-escape-newlines t) | |
| 762 ;;#### FSF 21.2 (print-escape-nonascii t) | |
| 996 | 763 p2) |
| 2548 | 764 (print form outbuf) |
| 765 (with-current-buffer outbuf | |
| 996 | 766 (setq p2 (point-marker)) |
| 767 (goto-char p) | |
| 768 (save-match-data | |
| 769 (while (search-forward "\^L" p2 t) | |
| 770 (delete-char -1) | |
| 771 (insert "\\^L"))) | |
| 2548 | 772 (goto-char p2)))))))) |
| 996 | 773 |
| 1232 | 774 ;;; Forms which have doc-strings which should be printed specially. |
| 775 ;;; A doc-string-elt property of ELT says that (nth ELT FORM) is | |
| 776 ;;; the doc-string in FORM. | |
| 777 ;;; | |
| 2548 | 778 ;;; There used to be the following note here: |
| 779 ;;; ;;; Note: defconst and defvar should NOT be marked in this way. | |
| 780 ;;; ;;; We don't want to produce defconsts and defvars that | |
| 781 ;;; ;;; make-docfile can grok, because then it would grok them twice, | |
| 782 ;;; ;;; once in foo.el (where they are given with ;;;###autoload) and | |
| 783 ;;; ;;; once in loaddefs.el. | |
| 784 ;;; | |
| 785 ;;; Counter-note: Yes, they should be marked in this way. | |
| 786 ;;; make-docfile only processes those files that are loaded into the | |
| 787 ;;; dumped Emacs, and those files should never have anything | |
| 788 ;;; autoloaded here. The above-feared problem only occurs with files | |
| 1232 | 789 ;;; which have autoloaded entries *and* are processed by make-docfile; |
| 790 ;;; there should be no such files. | |
| 428 | 791 |
| 1232 | 792 (put 'autoload 'doc-string-elt 3) |
| 793 (put 'defun 'doc-string-elt 3) | |
| 794 (put 'defun* 'doc-string-elt 3) | |
| 795 (put 'defvar 'doc-string-elt 3) | |
| 2548 | 796 (put 'defcustom 'doc-string-elt 3) |
| 1232 | 797 (put 'defconst 'doc-string-elt 3) |
| 798 (put 'defmacro 'doc-string-elt 3) | |
| 799 (put 'defmacro* 'doc-string-elt 3) | |
| 2548 | 800 (put 'defsubst 'doc-string-elt 3) |
| 801 (put 'define-skeleton 'doc-string-elt 2) | |
| 1232 | 802 (put 'define-derived-mode 'doc-string-elt 4) |
| 2548 | 803 (put 'easy-mmode-define-minor-mode 'doc-string-elt 2) |
| 804 (put 'define-minor-mode 'doc-string-elt 2) | |
| 805 (put 'define-generic-mode 'doc-string-elt 7) | |
| 4256 | 806 (put 'defclass 'doc-string-elt 4) |
| 807 (put 'defmethod 'doc-string-elt 3) | |
| 2548 | 808 ;; defin-global-mode has no explicit docstring. |
| 809 (put 'easy-mmode-define-global-mode 'doc-string-elt 1000) | |
| 442 | 810 |
| 1232 | 811 (defun autoload-trim-file-name (file) |
| 812 "Returns relative pathname of FILE including the last directory. | |
| 428 | 813 |
| 1232 | 814 Hard-codes the directory separator as a forward slash." |
| 815 (setq file (expand-file-name file)) | |
| 816 (replace-in-string | |
| 817 (file-relative-name file (file-name-directory | |
| 818 (directory-file-name | |
| 819 (file-name-directory file)))) | |
| 820 ;; #### is this a good idea? | |
| 821 "\\\\" "/")) | |
| 428 | 822 |
| 2548 | 823 (defun autoload-read-section-header () |
| 824 "Read a section header form. | |
| 825 Since continuation lines have been marked as comments, | |
| 826 we must copy the text of the form and remove those comment | |
| 827 markers before we call `read'." | |
| 828 (save-match-data | |
| 829 (let ((beginning (point)) | |
| 830 string) | |
| 831 (forward-line 1) | |
| 832 (while (looking-at generate-autoload-section-continuation) | |
| 833 (forward-line 1)) | |
| 834 (setq string (buffer-substring beginning (point))) | |
| 835 (with-current-buffer (get-buffer-create " *autoload*") | |
| 836 (erase-buffer) | |
| 837 (insert string) | |
| 838 (goto-char (point-min)) | |
| 839 (while (search-forward generate-autoload-section-continuation nil t) | |
| 840 (replace-match " ")) | |
| 841 (goto-char (point-min)) | |
| 842 (read (current-buffer)))))) | |
| 843 | |
| 428 | 844 ;;;###autoload |
| 845 (defun update-file-autoloads (file) | |
| 846 "Update the autoloads for FILE in `generated-autoload-file' | |
| 847 \(which FILE might bind in its local variables). | |
| 1232 | 848 This function is a no-op for an autoloads file (ie, a file whose name is |
| 849 equal to `autoload-file-name')." | |
| 428 | 850 (interactive "fUpdate autoloads for file: ") |
| 851 (setq file (expand-file-name file)) | |
| 852 (when (and (file-newer-than-file-p file generated-autoload-file) | |
| 853 (not (member (file-name-nondirectory file) | |
| 854 (list autoload-file-name)))) | |
| 855 | |
| 856 (let ((load-name (replace-in-string (file-name-nondirectory file) | |
| 996 | 857 "\\.\\(elc?\\|c\\)$" |
| 428 | 858 "")) |
| 859 (trim-name (autoload-trim-file-name file)) | |
| 860 section-begin form) | |
| 861 (save-excursion | |
| 2548 | 862 ;; FSF has: [[ We want to get a value for generated-autoload-file |
| 863 ;; from the local variables section if it's there. ]] Not | |
| 864 ;; applicable in XEmacs, since we always keep the autoloads | |
| 865 ;; up-to-date. | |
| 866 | |
| 867 ;; #### FSF 21.2 adds: [[ We must read/write the file without any | |
| 868 ;; code conversion, but still decode EOLs. ]] Not clear if we need | |
| 869 ;; this. --ben | |
| 870 ;; (let ((coding-system-for-read 'raw-text)) | |
| 428 | 871 (let ((find-file-hooks nil)) |
| 872 (set-buffer (or (get-file-buffer generated-autoload-file) | |
| 873 (find-file-noselect generated-autoload-file)))) | |
| 2548 | 874 ;; FSF 21.2 says: |
| 875 | |
| 876 ;; [[ This is to make generated-autoload-file have Unix EOLs, so | |
| 877 ;; that it is portable to all platforms. ]] | |
| 878 ;; (setq buffer-file-coding-system 'raw-text-unix)) | |
| 879 ;; Not applicable in XEmacs, since we always keep the autoloads | |
| 880 ;; up-to-date and recompile when we build. | |
| 881 | |
| 882 ;; FSF 21.2: [not applicable to XEmacs] | |
| 883 ; (or (> (buffer-size) 0) | |
| 884 ; (error "Autoloads file %s does not exist" buffer-file-name)) | |
| 885 ; (or (file-writable-p buffer-file-name) | |
| 886 ; (error "Autoloads file %s is not writable" buffer-file-name)) | |
| 887 | |
| 888 ;; NOTE: The rest of this function is totally changed from FSF. | |
| 889 ;; Hence, not synched. | |
| 890 | |
| 428 | 891 ;; Make sure we can scribble in it. |
| 892 (setq buffer-read-only nil) | |
| 893 ;; First delete all sections for this file. | |
| 894 (goto-char (point-min)) | |
| 895 (while (search-forward generate-autoload-section-header nil t) | |
| 896 (setq section-begin (match-beginning 0)) | |
| 2548 | 897 (setq form (autoload-read-section-header)) |
| 428 | 898 (when (string= (nth 2 form) load-name) |
| 899 (search-forward generate-autoload-section-trailer) | |
| 900 (delete-region section-begin (point)))) | |
| 901 | |
| 902 ;; Now find insertion point for new section | |
| 903 (block find-insertion-point | |
| 904 (goto-char (point-min)) | |
| 905 (while (search-forward generate-autoload-section-header nil t) | |
| 2548 | 906 (setq form (autoload-read-section-header)) |
| 428 | 907 (when (string< trim-name (nth 3 form)) |
| 908 ;; Found alphabetically correct insertion point | |
| 909 (goto-char (match-beginning 0)) | |
| 910 (return-from find-insertion-point)) | |
| 911 (search-forward generate-autoload-section-trailer)) | |
| 912 (when (eq (point) (point-min)) ; No existing entries? | |
| 913 (goto-char (point-max)))) ; Append. | |
| 914 | |
| 915 ;; Add in new sections for file | |
| 2548 | 916 (funcall generate-autoload-function file)) |
| 428 | 917 |
| 918 (when (interactive-p) (save-buffer))))) | |
| 919 | |
| 1232 | 920 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 921 ;; Utilities for batch updates | |
| 922 | |
| 923 ;;;###autoload | |
| 2548 | 924 (defun batch-update-directory-autoloads () |
| 1232 | 925 "Update the autoloads for a directory, using a specified feature prefix. |
| 926 Must be used only with -batch. The feature prefix and directory to update | |
| 927 are taken from the first and second elements of `command-line-args-left', | |
| 928 respectively, and they are then removed from `command-line-args-left'. | |
| 929 | |
| 930 Runs `update-file-autoloads' on each file in the given directory. Always | |
| 931 rewrites the autoloads file, even if unchanged. Makes a feature name by | |
| 932 applying `autoload-make-feature-name' to the specified feature prefix. | |
| 933 | |
| 934 #### The API and semantics of this function are subject to change." | |
| 935 (unless noninteractive | |
| 2548 | 936 (error "batch-update-directory-autoloads: may be used only with -batch")) |
| 937 (update-autoload-files (list (cadr command-line-args-left)) | |
| 938 (car command-line-args-left) nil t) | |
| 939 (setq command-line-args-left (cddr command-line-args-left))) | |
| 1232 | 940 |
| 941 ;;;###autoload | |
| 2548 | 942 (defun batch-update-directory-custom-defines () |
| 943 "Update the custom defines for a directory, using a specified feature prefix. | |
| 944 Must be used only with -batch. The feature prefix and directory to update | |
| 945 are taken from the first and second elements of `command-line-args-left', | |
| 946 respectively, and they are then removed from `command-line-args-left'. | |
| 947 | |
| 948 Runs `update-file-autoloads' on each file in the given directory. Always | |
| 949 rewrites the autoloads file, even if unchanged. Makes a feature name by | |
| 950 applying `autoload-make-feature-name' to the specified feature prefix. | |
| 951 | |
| 952 #### The API and semantics of this function are subject to change." | |
| 953 (unless noninteractive | |
| 954 (error "batch-update-directory-custom-defines: may be used only with -batch")) | |
| 955 (update-custom-define-files (list (cadr command-line-args-left)) | |
| 956 (car command-line-args-left) nil t) | |
| 957 (setq command-line-args-left (cddr command-line-args-left))) | |
| 958 | |
| 959 ;;;###autoload | |
| 960 (defun update-autoload-files (files-or-dirs feature-prefix | |
| 961 &optional into-file force) | |
| 1232 | 962 "Update all the autoload files associated with FILES-OR-DIRS. |
| 963 FILES-OR-DIRS is a list of files and/or directories to be processed. | |
| 964 | |
| 965 An appropriate autoload file is chosen and a feature constructed for | |
| 966 each element of FILES-OR-DIRS. Fixup code testing for the autoload file's | |
| 967 feature and to provide the feature is added. | |
| 968 | |
| 2548 | 969 If optional INTO-FILE is non-`nil', it should specify a file into which |
| 970 the autoloads will be placed. Otherwise, the autoloads will be placed into | |
| 971 a file named `auto-autoloads.el' in the directory of each element in | |
| 972 FILES-OR-DIRS. | |
| 973 | |
| 974 FEATURE-PREFIX should be set to an appropriate prefix which will | |
| 975 be concatenated with \"-autoloads\" to produce the feature name. Otherwise | |
| 976 the appropriate autoload file for each file or directory (located in that | |
| 977 directory, or in the directory of the specified file) will be updated with | |
| 978 the directory's or file's autoloads and the protective forms will be added, | |
| 979 and the files will be saved. Use of the default here is unreliable, and | |
| 980 therefore deprecated. | |
| 1232 | 981 |
| 982 Note that if some of FILES-OR-DIRS are directories, recursion goes only | |
| 983 one level deep. | |
| 984 | |
| 985 If FORCE is non-nil, always save out the autoload files even if unchanged." | |
| 2548 | 986 (or (listp files-or-dirs) (setq files-or-dirs (list files-or-dirs))) |
| 1232 | 987 (let ((defdir (directory-file-name default-directory)) |
| 988 ;; value for all-into-one-file | |
| 2548 | 989 (autoload-feature-name (autoload-make-feature-name feature-prefix)) |
| 990 (enable-local-eval nil) ; Don't query in batch mode. | |
| 991 (autoload-feature-prefix feature-prefix) | |
| 992 ;; protect from change | |
| 993 (generated-autoload-file generated-autoload-file)) | |
| 1232 | 994 (dolist (arg files-or-dirs) |
| 995 (setq arg (expand-file-name arg defdir)) | |
| 996 (cond | |
| 997 ((file-directory-p arg) | |
| 2548 | 998 (setq generated-autoload-file |
| 999 (or into-file (expand-file-name autoload-file-name arg))) | |
| 1232 | 1000 (message "Updating autoloads for directory %s..." arg) |
| 2548 | 1001 (let ((simple-dir (file-name-as-directory |
| 1002 (file-name-nondirectory | |
| 1003 (directory-file-name arg)))) | |
| 1004 (enable-local-eval nil)) | |
| 1005 (save-excursion | |
| 1006 (let ((find-file-hooks nil)) | |
| 1007 (set-buffer (find-file-noselect generated-autoload-file))) | |
| 1008 (goto-char (point-min)) | |
| 1009 (while (search-forward generate-autoload-section-header nil t) | |
| 1010 (let* ((begin (match-beginning 0)) | |
| 1011 (form (autoload-read-section-header)) | |
| 1012 (file (nth 3 form))) | |
| 1013 (when (and (stringp file) | |
| 1014 (string= (file-name-directory file) simple-dir) | |
| 1015 (not (file-exists-p | |
| 1016 (expand-file-name | |
| 1017 (file-name-nondirectory file) arg)))) | |
| 1018 ;; Remove the obsolete section. | |
| 1019 (search-forward generate-autoload-section-trailer) | |
| 1020 (delete-region begin (point))))) | |
| 1021 ;; Update or create autoload sections for existing files. | |
| 1022 (mapcar 'update-file-autoloads | |
| 1023 (directory-files arg t "^[^=].*\\.\\(el\\|c\\)$"))))) | |
| 1232 | 1024 ((file-exists-p arg) |
| 2548 | 1025 (setq generated-autoload-file |
| 1026 (or into-file (expand-file-name autoload-file-name | |
| 1027 (file-name-directory arg)))) | |
| 1232 | 1028 (update-file-autoloads arg)) |
| 1029 (t (error "No such file or directory: %s" arg))) | |
| 2548 | 1030 (when (not into-file) |
| 1232 | 1031 (autoload-featurep-protect-autoloads |
| 1032 (autoload-make-feature-name | |
| 2548 | 1033 (or feature-prefix |
| 1034 (file-name-nondirectory (directory-file-name arg))))) | |
| 1232 | 1035 (if force (set-buffer-modified-p |
| 1036 t (find-file-noselect generated-autoload-file))))) | |
| 2548 | 1037 (when into-file |
| 1232 | 1038 (autoload-featurep-protect-autoloads autoload-feature-name) |
| 1039 (if force (set-buffer-modified-p | |
| 2548 | 1040 t (find-file-noselect into-file)))) |
| 1232 | 1041 (save-some-buffers t) |
| 1042 )) | |
| 1043 | |
| 428 | 1044 ;;;###autoload |
| 2548 | 1045 (defun update-custom-define-files (files-or-dirs feature-prefix |
| 1046 &optional into-file force) | |
| 1047 "Update all the custom-define files associated with FILES-OR-DIRS. | |
| 1048 Works just like `update-file-autoloads'." | |
| 1049 (let* ((autoload-feature-suffix "-custom-defines") | |
| 1050 (autoload-file-name "custom-defines.el") | |
| 1051 (generate-autoload-function #'generate-custom-defines)) | |
| 1052 (update-autoload-files files-or-dirs feature-prefix into-file force))) | |
| 428 | 1053 |
| 1232 | 1054 (defun autoload-featurep-protect-autoloads (sym) |
| 428 | 1055 (save-excursion |
| 1056 (set-buffer (find-file-noselect generated-autoload-file)) | |
| 1057 (goto-char (point-min)) | |
| 2548 | 1058 (cond ((eq (point-min) (point-max)) nil) |
| 1059 ;; if there's some junk in the file but no sections, just | |
| 1060 ;; delete everything. the junk might be stuff inserted by | |
| 1061 ;; an older version of this function. | |
| 1062 ((not (search-forward generate-autoload-section-header nil t)) | |
| 1063 (delete-region (point-min) (point-max))) | |
| 1064 (t | |
| 1065 (goto-char (point-min)) | |
| 1066 (when (looking-at ";;; DO NOT MODIFY THIS FILE") | |
| 1067 (delete-region (point-min) | |
| 1068 (progn | |
| 1069 (search-forward generate-autoload-section-header) | |
| 1070 (match-beginning 0)))) | |
| 1071 ;; Determine and set the coding system for the file if under Mule. | |
| 1072 ;; If there are any extended characters in the input file, use | |
| 1073 ;; `escape-quoted' to make sure that both binary and extended | |
| 1074 ;; characters are output properly and distinguished properly. | |
| 1075 ;; Otherwise, use `raw-text' for maximum portability with non-Mule | |
| 1076 ;; Emacsen. | |
| 1077 (if (or (featurep '(not mule)) ;; Don't scan if no Mule support | |
| 1078 (progn | |
| 1079 (goto-char (point-min)) | |
| 1080 ;; mrb- There must be a better way than skip-chars-forward | |
| 1081 (skip-chars-forward (concat (char-to-string 0) "-" | |
| 1082 (char-to-string 255))) | |
| 1083 (eq (point) (point-max)))) | |
| 1084 (setq buffer-file-coding-system 'raw-text-unix) | |
| 1085 (setq buffer-file-coding-system 'escape-quoted)) | |
| 1086 (goto-char (point-min)) | |
| 1087 (insert ";;; DO NOT MODIFY THIS FILE") | |
| 1088 ;; NOTE: XEmacs prior to 21.5.12 or so had a bug in that it | |
| 1089 ;; recognized only one of the two magic-cookie styles (the -*- kind) | |
| 1090 ;; in find-file, but both of them in load. We go ahead and put both | |
| 1091 ;; in, just to be safe. | |
| 1092 (when (eq buffer-file-coding-system 'escape-quoted) | |
| 1093 (insert " -*- coding: escape-quoted; -*- | |
| 1094 \(or (featurep 'mule) (error \"Loading this file requires Mule support\")) | |
| 1095 ;;;###coding system: escape-quoted")) | |
| 1096 (insert "\n(if (featurep '" sym ")") | |
| 1097 (insert " (error \"Feature " sym " already loaded\"))\n") | |
| 1098 (goto-char (point-max)) | |
| 1099 (save-excursion | |
| 1100 (forward-line -1) | |
| 1101 (when (looking-at "(provide") | |
| 1102 (delete-region (point) (point-max)))) | |
| 1103 (unless (bolp) (insert "\n")) | |
| 1104 (unless (eq (char-before (1- (point))) ?\^L) | |
| 1105 (insert "\^L\n")) | |
| 1106 (insert "(provide '" sym ")\n"))))) | |
| 428 | 1107 |
| 1232 | 1108 (defun autoload-make-feature-name (&optional prefix) |
| 1109 "Generate the feature name to protect this auto-autoloads file from PREFIX. | |
| 428 | 1110 |
| 1232 | 1111 If PREFIX is nil, it defaults to the value of `autoload-feature-prefix' if |
| 1112 that is non-nil. | |
| 1113 | |
| 1114 The feature name must be globally unique for this version of XEmacs, | |
| 1115 including packages. | |
| 528 | 1116 |
| 1232 | 1117 For backward compatibility, if PREFIX and `autoload-feature-prefix' are both |
| 1118 `nil', PREFIX is computed as the last directory component of | |
| 1119 `generated-autoload-file'. This is likely to result in non-uniqueness, so | |
| 1120 do not use this feature." | |
| 1121 (concat | |
| 1122 (cond (prefix) | |
| 1123 (autoload-feature-prefix) | |
| 1124 ((stringp generated-autoload-file) | |
| 1125 (message "Warning: autoload computing feature prefix. | |
| 1126 You should specify it as an argument to `autoload-make-feature-name'.") | |
| 1127 (file-name-nondirectory | |
| 1128 (directory-file-name | |
| 1129 (file-name-directory generated-autoload-file)))) | |
| 1130 (t (error 'invalid-argument | |
| 1131 "Could not compute a feature name"))) | |
| 2548 | 1132 autoload-feature-suffix)) |
| 1232 | 1133 |
| 1134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 1135 ;; Deprecated entry points | |
| 1136 | |
| 1137 ;; A grep of the core and packages shows use of `batch-update-autoloads' | |
| 1138 ;; by XEmacs.rules, pcomplete, eshell, oort-gnus; `batch-update-directory' | |
| 2548 | 1139 ;; by liece. The other two entry points (`batch-update-one-directory', |
| 1140 ;; `batch-force-update-one-directory') were not used at all. | |
| 1141 ;; | |
| 1142 ;; All except the first are now history. liece has been updated. | |
| 1143 ;; XEmacs.rules has been updated. The others will be, eventually. | |
| 528 | 1144 |
| 2548 | 1145 ;; There don't seem to be very many packages that use the first one (the |
| 1146 ;; "all-into-one-file" variety), and do they actually rely on this | |
| 1147 ;; functionality? --ben | |
| 1148 | |
| 1232 | 1149 ;; but XEmacs.rules does, though maybe it doesn't "rely" on it, and |
| 1150 ;; modules do now, and that relies on it. --sjt | |
| 528 | 1151 |
| 1152 ;;;###autoload | |
| 1153 (defun batch-update-autoloads () | |
| 1154 "Update the autoloads for the files or directories on the command line. | |
| 1155 Runs `update-file-autoloads' on files and `update-directory-autoloads' | |
| 1156 on directories. Must be used only with -batch, and kills Emacs on completion. | |
| 1157 Each file will be processed even if an error occurred previously. | |
| 1158 For example, invoke `xemacs -batch -f batch-update-autoloads *.el'. | |
| 1159 The directory to which the auto-autoloads.el file must be the first parameter | |
| 1160 on the command line." | |
| 1161 (unless noninteractive | |
| 1162 (error "batch-update-autoloads is to be used only with -batch")) | |
| 3431 | 1163 (update-autoload-files command-line-args-left autoload-feature-prefix |
| 1164 generated-autoload-file t) | |
| 528 | 1165 (kill-emacs 0)) |
| 442 | 1166 |
| 1232 | 1167 ;; Declare obsolescence |
| 1168 | |
| 1169 (make-obsolete-variable 'autoload-target-directory | |
| 1170 "Don't use this. Bind `generated-autoload-file' to an absolute path.") | |
| 1171 (make-obsolete 'batch-update-autoloads | |
| 1172 'autoload-update-directory-autoloads) | |
| 1173 | |
| 428 | 1174 (provide 'autoload) |
| 1175 | |
| 1176 ;;; autoload.el ends here |