Mercurial > hg > xemacs-beta

comparison lisp/autoload.el @ 996:25e260cb7994

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-09-10 15:27:02 by james] Enable unloading of dynamic modules. Create the first two internal XEmacs modules: LDAP and postgreSQL. Update the sample directory to contain a sample internal XEmacs module and a sample external XEmacs module. Improve support for autoloading modules. Make internal module code compile into the XEmacs binary if XEmacs is configured without module support. Make the internal module directories self-contained so that they can be distributed separately from XEmacs.
author james
date Tue, 10 Sep 2002 15:27:39 +0000
parents d41e92ee6d12
children edc95b5fe4cb
comparison
equal deleted inserted replaced
995:4575a219af58 996:25e260cb7994
33 ;; lisp source files in various useful ways. To learn more, read the 33 ;; lisp source files in various useful ways. To learn more, read the
34 ;; source; if you're going to use this, you'd better be able to. 34 ;; source; if you're going to use this, you'd better be able to.
35 35
36 ;; ChangeLog: 36 ;; ChangeLog:
37 37
38 ;; Jun-25-2002: Jerry James added code for processing C files, to
39 ;; support modularization
38 ;; Sep-26-1997: slb removed code dealing with customization. 40 ;; Sep-26-1997: slb removed code dealing with customization.
39 41
40 ;;; Code: 42 ;;; Code:
41 43
42 (defun make-autoload (form file) 44 (defun make-autoload (form file)
66 (eq car 'define-derived-mode) 68 (eq car 'define-derived-mode)
67 (eq (car-safe (car form)) 'interactive)) 69 (eq (car-safe (car form)) 'interactive))
68 (if macrop (list 'quote 'macro) nil))) 70 (if macrop (list 'quote 'macro) nil)))
69 nil))) 71 nil)))
70 72
73 (defun make-c-autoload (module)
74 "Make an autoload list for the DEFUN at point in MODULE.
75 Returns nil if the DEFUN is malformed."
76 (and
77 ;; Match the DEFUN
78 (search-forward "DEFUN" nil t)
79 ;; Match the opening parenthesis
80 (progn
81 (skip-syntax-forward " ")
82 (eq (char-after) ?\())
83 ;; Match the opening quote of the Lisp function name
84 (progn
85 (forward-char)
86 (skip-syntax-forward " ")
87 (eq (char-after) ?\"))
88 ;; Extract the Lisp function name, interactive indicator, and docstring
89 (let* ((func-name (let ((begin (progn (forward-char) (point))))
90 (search-forward "\"" nil t)
91 (backward-char)
92 (intern (buffer-substring begin (point)))))
93 (interact (progn
94 (search-forward "," nil t 4)
95 (skip-syntax-forward " ")
96 (not (eq (char-after) ?0))))
97 (begin (progn
98 (search-forward "/*" nil t)
99 (forward-line 1)
100 (point))))
101 (search-forward "*/" nil t)
102 (goto-char (match-beginning 0))
103 (skip-chars-backward " \t\n\f")
104 (list 'autoload (list 'quote func-name) module
105 (buffer-substring begin (point)) interact nil))))
106
71 (defvar generate-autoload-cookie ";;;###autoload" 107 (defvar generate-autoload-cookie ";;;###autoload"
72 "Magic comment indicating the following form should be autoloaded. 108 "Magic comment indicating the following form should be autoloaded.
73 Used by `update-file-autoloads'. This string should be 109 Used by `update-file-autoloads'. This string should be
74 meaningless to Lisp (e.g., a comment). 110 meaningless to Lisp (e.g., a comment).
75 111
81 If this string appears alone on a line, the following form will be 117 If this string appears alone on a line, the following form will be
82 read and an autoload made for it. If it is followed by the string 118 read and an autoload made for it. If it is followed by the string
83 \"immediate\", then the form on the following line will be copied 119 \"immediate\", then the form on the following line will be copied
84 verbatim. If there is further text on the line, that text will be 120 verbatim. If there is further text on the line, that text will be
85 copied verbatim to `generated-autoload-file'.") 121 copied verbatim to `generated-autoload-file'.")
122
123 (defvar generate-c-autoload-cookie "/* ###autoload"
124 "Magic C comment indicating the following form should be autoloaded.
125 Used by `update-file-autoloads'. This string should be
126 meaningless to C (e.g., a comment).
127
128 This string is used:
129
130 /* ###autoload */
131 DEFUN (\"function-to-be-autoloaded\", ... )
132
133 If this string appears alone on a line, the following form will be
134 read and an autoload made for it. If there is further text on the line,
135 that text will be copied verbatim to `generated-autoload-file'.")
136
137 (defvar generate-c-autoload-module "/* ###module"
138 "Magic C comment indicating the module containing autoloaded functions.
139 Since a module can consist of multiple C files, the module name may not be
140 the same as the C source file base name. In that case, use this comment to
141 indicate the actual name of the module from which to autoload functions.")
86 142
87 (defvar generate-autoload-section-header "\f\n;;;### " 143 (defvar generate-autoload-section-header "\f\n;;;### "
88 "String inserted before the form identifying 144 "String inserted before the form identifying
89 the section of autoloads for a file.") 145 the section of autoloads for a file.")
90 146
136 autoloads are generated for defuns and defmacros in FILE 192 autoloads are generated for defuns and defmacros in FILE
137 marked by `generate-autoload-cookie' (which see). 193 marked by `generate-autoload-cookie' (which see).
138 If FILE is being visited in a buffer, the contents of the buffer 194 If FILE is being visited in a buffer, the contents of the buffer
139 are used." 195 are used."
140 (interactive "fGenerate autoloads for file: ") 196 (interactive "fGenerate autoloads for file: ")
141 (generate-file-autoloads-1 file funlist)) 197 (if (string-match "\\.el$" file)
198 (generate-file-autoloads-1 file funlist)
199 (generate-c-file-autoloads-1 file funlist)))
142 200
143 (defun* generate-file-autoloads-1 (file funlist) 201 (defun* generate-file-autoloads-1 (file funlist)
144 "Insert at point a loaddefs autoload section for FILE. 202 "Insert at point a loaddefs autoload section for FILE.
145 autoloads are generated for defuns and defmacros in FILE 203 autoloads are generated for defuns and defmacros in FILE
146 marked by `generate-autoload-cookie' (which see). 204 marked by `generate-autoload-cookie' (which see).
212 'doc-string-elt))) 270 'doc-string-elt)))
213 (if autoload 271 (if autoload
214 (setq autoloads-done (cons (nth 1 form) 272 (setq autoloads-done (cons (nth 1 form)
215 autoloads-done)) 273 autoloads-done))
216 (setq autoload form)) 274 (setq autoload form))
217 (if (and doc-string-elt 275 (print-autoload autoload doc-string-elt outbuf))
218 (stringp (nth doc-string-elt autoload)))
219 ;; We need to hack the printing because the
220 ;; doc-string must be printed specially for
221 ;; make-docfile (sigh).
222 (let* ((p (nthcdr (1- doc-string-elt)
223 autoload))
224 (elt (cdr p)))
225 (setcdr p nil)
226 (princ "\n(" outbuf)
227 ;; XEmacs change: don't let ^^L's get into
228 ;; the file or sorting is hard.
229 (let ((print-escape-newlines t)
230 (p (save-excursion
231 (set-buffer outbuf)
232 (point)))
233 p2)
234 (mapcar (function (lambda (elt)
235 (prin1 elt outbuf)
236 (princ " " outbuf)))
237 autoload)
238 (save-excursion
239 (set-buffer outbuf)
240 (setq p2 (point-marker))
241 (goto-char p)
242 (save-match-data
243 (while (search-forward "\^L" p2 t)
244 (delete-char -1)
245 (insert "\\^L")))
246 (goto-char p2)
247 ))
248 (princ "\"\\\n" outbuf)
249 (let ((begin (save-excursion
250 (set-buffer outbuf)
251 (point))))
252 (princ (substring
253 (prin1-to-string (car elt)) 1)
254 outbuf)
255 ;; Insert a backslash before each ( that
256 ;; appears at the beginning of a line in
257 ;; the doc string.
258 (save-excursion
259 (set-buffer outbuf)
260 (save-excursion
261 (while (search-backward "\n(" begin t)
262 (forward-char 1)
263 (insert "\\"))))
264 (if (null (cdr elt))
265 (princ ")" outbuf)
266 (princ " " outbuf)
267 (princ (substring
268 (prin1-to-string (cdr elt))
269 1)
270 outbuf))
271 (terpri outbuf)))
272 ;; XEmacs change: another fucking ^L hack
273 (let ((p (save-excursion
274 (set-buffer outbuf)
275 (point)))
276 (print-escape-newlines t)
277 p2)
278 (print autoload outbuf)
279 (save-excursion
280 (set-buffer outbuf)
281 (setq p2 (point-marker))
282 (goto-char p)
283 (save-match-data
284 (while (search-forward "\^L" p2 t)
285 (delete-char -1)
286 (insert "\\^L")))
287 (goto-char p2)
288 ))
289 ))
290 ;; Copy the rest of the line to the output. 276 ;; Copy the rest of the line to the output.
291 (let ((begin (point))) 277 (let ((begin (point)))
292 ;; (terpri outbuf) 278 ;; (terpri outbuf)
293 (cond ((looking-at "immediate\\s *$") ; XEmacs 279 (cond ((looking-at "immediate\\s *$") ; XEmacs
294 ;; This is here so that you can automatically 280 ;; This is here so that you can automatically
344 (goto-char output-end) 330 (goto-char output-end)
345 (insert generate-autoload-section-trailer))) 331 (insert generate-autoload-section-trailer)))
346 (or noninteractive ; XEmacs: only need one line in -batch mode. 332 (or noninteractive ; XEmacs: only need one line in -batch mode.
347 (message "Generating autoloads for %s...done" file)))) 333 (message "Generating autoloads for %s...done" file))))
348 334
335 (defun* generate-c-file-autoloads-1 (file funlist)
336 "Insert at point a loaddefs autoload section for the C file FILE.
337 autoloads are generated for Defuns and defmacros in FILE
338 marked by `generate-c-autoload-cookie' (which see).
339 If FILE is being visited in a buffer, the contents of the buffer
340 are used."
341 (let ((outbuf (current-buffer))
342 (autoloads-done '())
343 (load-name (replace-in-string (file-name-nondirectory file)
344 "\\.c?$"
345 ""))
346 (trim-name (autoload-trim-file-name file))
347 (print-length nil)
348 (print-readably t)
349 (float-output-format nil)
350 ;; (done-any nil)
351 (visited (get-file-buffer file))
352 output-end)
353
354 ;; If the autoload section we create here uses an absolute
355 ;; pathname for FILE in its header, and then Emacs is installed
356 ;; under a different path on another system,
357 ;; `update-autoloads-here' won't be able to find the files to be
358 ;; autoloaded. So, if FILE is in the same directory or a
359 ;; subdirectory of the current buffer's directory, we'll make it
360 ;; relative to the current buffer's directory.
361 (setq file (expand-file-name file))
362
363 (save-excursion
364 (unwind-protect
365 (progn
366 (let ((find-file-hooks nil)
367 (enable-local-variables nil))
368 (set-buffer (or visited (find-file-noselect file t t)))
369 ;; This doesn't look right, but it is. The only place we need
370 ;; the syntax table is when snarfing the Lisp function name.
371 (set-syntax-table emacs-lisp-mode-syntax-table))
372 (save-excursion
373 (save-restriction
374 (widen)
375 (goto-char (point-min))
376 ;; Is there a module name comment?
377 (when (search-forward generate-c-autoload-module nil t)
378 (skip-chars-forward " \t")
379 (let ((begin (point)))
380 (skip-chars-forward "^ \t\n\f")
381 (setq load-name (buffer-substring begin (point)))))
382 (if funlist
383 (progn
384 (message "Generating autoloads for %s..." trim-name)
385 (dolist (arg funlist)
386 (goto-char (point-min))
387 (re-search-forward
388 (concat "DEFUN (\""
389 (regexp-quote (symbol-name arg))
390 "\""))
391 (goto-char (match-beginning 0))
392 (let ((autoload (make-c-autoload load-name)))
393 (when autoload
394 (push (nth 1 (nth 1 autoload)) autoloads-done)
395 (print-autoload autoload 3 outbuf)))))
396 (goto-char (point-min))
397 (let ((match
398 (search-forward generate-c-autoload-cookie nil t)))
399 (unless match
400 (message "No autoloads found in %s" trim-name)
401 (return-from generate-c-file-autoloads-1))
402
403 (message "Generating autoloads for %s..." trim-name)
404 (while match
405 (forward-line 1)
406 (let ((autoload (make-c-autoload load-name)))
407 (when autoload
408 (push (nth 1 (nth 1 autoload)) autoloads-done)
409 (print-autoload autoload 3 outbuf)))
410 (setq match
411 (search-forward generate-c-autoload-cookie nil t))
412 ))))))
413 (unless visited
414 ;; We created this buffer, so we should kill it.
415 (kill-buffer (current-buffer)))
416 (set-buffer outbuf)
417 (setq output-end (point-marker))))
418 (insert generate-autoload-section-header)
419 (prin1 (list 'autoloads autoloads-done load-name trim-name) outbuf)
420 (terpri outbuf)
421 (when (< output-end (point))
422 (setq output-end (point-marker)))
423 (goto-char output-end)
424 (insert generate-autoload-section-trailer)
425 (or noninteractive ; XEmacs: only need one line in -batch mode.
426 (message "Generating autoloads for %s...done" trim-name))))
427
428 (defun print-autoload (autoload doc-string-elt outbuf)
429 "Print an autoload form, handling special characters.
430 In particular, print docstrings with escapes inserted before left parentheses
431 at the beginning of lines and ^L characters."
432 (if (and doc-string-elt (stringp (nth doc-string-elt autoload)))
433 ;; We need to hack the printing because the doc-string must be
434 ;; printed specially for make-docfile (sigh).
435 (let* ((p (nthcdr (1- doc-string-elt) autoload))
436 (elt (cdr p)))
437 (setcdr p nil)
438 (princ "\n(" outbuf)
439 ;; XEmacs change: don't let ^^L's get into
440 ;; the file or sorting is hard.
441 (let ((print-escape-newlines t)
442 (p (save-excursion
443 (set-buffer outbuf)
444 (point)))
445 p2)
446 (mapcar #'(lambda (elt)
447 (prin1 elt outbuf)
448 (princ " " outbuf))
449 autoload)
450 (save-excursion
451 (set-buffer outbuf)
452 (setq p2 (point-marker))
453 (goto-char p)
454 (save-match-data
455 (while (search-forward "\^L" p2 t)
456 (delete-char -1)
457 (insert "\\^L")))
458 (goto-char p2)))
459 (princ "\"\\\n" outbuf)
460 (let ((begin (save-excursion
461 (set-buffer outbuf)
462 (point))))
463 (princ (substring (prin1-to-string (car elt)) 1) outbuf)
464 ;; Insert a backslash before each ( that appears at the beginning
465 ;; of a line in the doc string.
466 (save-excursion
467 (set-buffer outbuf)
468 (save-excursion
469 (while (search-backward "\n(" begin t)
470 (forward-char 1)
471 (insert "\\"))))
472 (if (null (cdr elt))
473 (princ ")" outbuf)
474 (princ " " outbuf)
475 (princ (substring (prin1-to-string (cdr elt)) 1) outbuf))
476 (terpri outbuf)))
477 ;; XEmacs change: another ^L hack
478 (let ((p (save-excursion
479 (set-buffer outbuf)
480 (point)))
481 (print-escape-newlines t)
482 p2)
483 (print autoload outbuf)
484 (save-excursion
485 (set-buffer outbuf)
486 (setq p2 (point-marker))
487 (goto-char p)
488 (save-match-data
489 (while (search-forward "\^L" p2 t)
490 (delete-char -1)
491 (insert "\\^L")))
492 (goto-char p2)))))
493
349 494
350 (defconst autoload-file-name "auto-autoloads.el" 495 (defconst autoload-file-name "auto-autoloads.el"
351 "Generic filename to put autoloads into. 496 "Generic filename to put autoloads into.
352 Unless you are an XEmacs maintainer, it is probably unwise to change this.") 497 Unless you are an XEmacs maintainer, it is probably unwise to change this.")
353 498
381 (when (and (file-newer-than-file-p file generated-autoload-file) 526 (when (and (file-newer-than-file-p file generated-autoload-file)
382 (not (member (file-name-nondirectory file) 527 (not (member (file-name-nondirectory file)
383 (list autoload-file-name)))) 528 (list autoload-file-name))))
384 529
385 (let ((load-name (replace-in-string (file-name-nondirectory file) 530 (let ((load-name (replace-in-string (file-name-nondirectory file)
386 "\\.elc?$" 531 "\\.\\(elc?\\|c\\)$"
387 "")) 532 ""))
388 (trim-name (autoload-trim-file-name file)) 533 (trim-name (autoload-trim-file-name file))
389 section-begin form) 534 section-begin form)
390 (save-excursion 535 (save-excursion
391 (let ((find-file-hooks nil)) 536 (let ((find-file-hooks nil))
471 (generate-file-autoloads file))))))) 616 (generate-file-autoloads file)))))))
472 617
473 ;;;###autoload 618 ;;;###autoload
474 (defun update-autoloads-from-directory (dir) 619 (defun update-autoloads-from-directory (dir)
475 "Update `generated-autoload-file' with all the current autoloads from DIR. 620 "Update `generated-autoload-file' with all the current autoloads from DIR.
476 This runs `update-file-autoloads' on each .el file in DIR. 621 This runs `update-file-autoloads' on each .el and .c file in DIR.
477 Obsolete autoload entries for files that no longer exist are deleted. 622 Obsolete autoload entries for files that no longer exist are deleted.
478 Note that, if this function is called from `batch-update-directory', 623 Note that, if this function is called from `batch-update-directory',
479 `generated-autoload-file' was rebound in that function. 624 `generated-autoload-file' was rebound in that function.
480 625
481 You don't really want to be calling this function. Try using 626 You don't really want to be calling this function. Try using
503 (file-name-nondirectory file) dir)))) 648 (file-name-nondirectory file) dir))))
504 ;; Remove the obsolete section. 649 ;; Remove the obsolete section.
505 (search-forward generate-autoload-section-trailer) 650 (search-forward generate-autoload-section-trailer)
506 (delete-region begin (point))))) 651 (delete-region begin (point)))))
507 ;; Update or create autoload sections for existing files. 652 ;; Update or create autoload sections for existing files.
508 (mapcar 'update-file-autoloads (directory-files dir t "^[^=].*\\.el$")) 653 (mapcar 'update-file-autoloads
654 (directory-files dir t "^[^=].*\\.\\(el\\|c\\)$"))
509 (unless noninteractive 655 (unless noninteractive
510 (save-buffer))))) 656 (save-buffer)))))
511 657
512 (defun fixup-autoload-buffer (sym) 658 (defun fixup-autoload-buffer (sym)
513 (save-excursion 659 (save-excursion