comparison lisp/autoload.el @ 1298:1b4bc72f433e

[xemacs-hg @ 2003-02-14 12:05:06 by ben] speedups to build process autoload.el: Factor out common code in generate-{c-,}file-autoloads-1 into new function generate-autoload-ish-1. \(I was originally going to use this for custom as well but ended up thinking better of it.) cus-dep.el: Cache the old computed values in custom-load.el and reuse them as necessary, to speed up running cus-dep (which would take 25-30 seconds to do all files in lisp/*, lisp/*/* on my Pentium III 700). Use `message' not `princ' to get correct newline behavior. Output messages showing each file we do actually process. update-elc-2.el: Rewrite algorithm to be much faster -- cache calls to directory-files and don't make needless calls to file-exists-p, file-directory-p because they're way way slow. Autoload early and only when update-elc has told us to. update-elc.el: If no files need byte compilation, signal to update-elc-2 to do any necessary autoload updating (using the file REBUILD_AUTOLOADS) rather than doing it ourselves, which would be way slow. Ignore updates to custom-load.el and auto-autoloads.el when checking to see whether autoloads need updating. Optimize out many unnecessary calls to file-exists-p to speed it up somewhat. (#### The remaining time is 50% or more in locate-file; this is presumably because, even though it has a cache, it's still statting each file to determine it's actually there. By calling directory-files ourselves, building a tree, and then looking in that tree, we could drastically shorten the time needed to do the locate operation.)
author ben
date Fri, 14 Feb 2003 12:05:07 +0000
parents c08a6fa181d1
children 781dc6d5baba
comparison
equal deleted inserted replaced
1297:6c21360a544b 1298:1b4bc72f433e
1 ;;; autoload.el --- maintain autoloads in auto-autoloads files. 1 ;;; autoload.el --- maintain autoloads in auto-autoloads files.
2 2
3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. 4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
5 ;; Copyright (C) 1996, 2000, 2002 Ben Wing. 5 ;; Copyright (C) 1996, 2000, 2002, 2003 Ben Wing.
6 6
7 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu> 7 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
8 ;; Keywords: maint 8 ;; Keywords: maint
9 9
10 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
289 marked by `generate-autoload-cookie' (which see). 289 marked by `generate-autoload-cookie' (which see).
290 If FILE is being visited in a buffer, the contents of the buffer 290 If FILE is being visited in a buffer, the contents of the buffer
291 are used." 291 are used."
292 (interactive "fGenerate autoloads for file: ") 292 (interactive "fGenerate autoloads for file: ")
293 (cond ((string-match "\\.el$" file) 293 (cond ((string-match "\\.el$" file)
294 (generate-file-autoloads-1 file funlist)) 294 (generate-autoload-ish-1
295 file
296 (replace-in-string (file-name-nondirectory file) "\\.elc?$" "")
297 nil #'generate-file-autoloads-1
298 funlist))
295 ;; #### jj, are C++ modules possible? 299 ;; #### jj, are C++ modules possible?
296 ((string-match "\\.c$" file) 300 ((string-match "\\.c$" file)
297 (generate-c-file-autoloads-1 file funlist)) 301 (generate-autoload-ish-1
302 file
303 (replace-in-string (file-name-nondirectory file) "\\.c$" "")
304 t #'generate-c-file-autoloads-1))
298 (t 305 (t
299 (error 'wrong-type-argument file "not a C or Elisp source file")))) 306 (error 'wrong-type-argument file "not a C or Elisp source file"))))
300 307
301 (defun* generate-file-autoloads-1 (file funlist) 308 (defun* generate-autoload-ish-1 (file load-name literal fun-to-call &rest args)
302 "Insert at point an autoload section for FILE. 309 "Insert at point an autoload-type section for FILE.
303 autoloads are generated for defuns and defmacros in FILE 310 If LITERAL, open the file literally, without decoding.
304 marked by `generate-autoload-cookie' (which see). 311 Calls FUN-TO-CALL to compute the autoloads, passing it OUTBUF, LOAD-NAME,
305 If FILE is being visited in a buffer, the contents of the buffer 312 TRIM-NAME, and ARGS."
306 are used."
307 (let ((outbuf (current-buffer)) 313 (let ((outbuf (current-buffer))
314 (trim-name (autoload-trim-file-name file))
308 (autoloads-done '()) 315 (autoloads-done '())
309 (load-name (replace-in-string (file-name-nondirectory file)
310 "\\.elc?$"
311 ""))
312 (trim-name (autoload-trim-file-name file))
313 (dofiles (not (null funlist)))
314 (print-length nil) 316 (print-length nil)
315 (print-readably t) ; XEmacs 317 (print-readably t) ; XEmacs
316 (float-output-format nil) 318 (float-output-format nil)
319 (visited (get-file-buffer file))
317 ;; (done-any nil) 320 ;; (done-any nil)
318 (visited (get-file-buffer file))
319 output-end) 321 output-end)
320 322
321 ;; If the autoload section we create here uses an absolute 323 ;; If the autoload section we create here uses an absolute
322 ;; pathname for FILE in its header, and then Emacs is installed 324 ;; pathname for FILE in its header, and then Emacs is installed
323 ;; under a different path on another system, 325 ;; under a different path on another system,
330 (save-excursion 332 (save-excursion
331 (unwind-protect 333 (unwind-protect
332 (progn 334 (progn
333 (let ((find-file-hooks nil) 335 (let ((find-file-hooks nil)
334 (enable-local-variables nil)) 336 (enable-local-variables nil))
335 (set-buffer (or visited (find-file-noselect file))) 337 (set-buffer (or visited (find-file-noselect file literal literal
338 )))
339 ;; This doesn't look right for C files, but it is. The only
340 ;; place we need the syntax table is when snarfing the Lisp
341 ;; function name.
336 (set-syntax-table emacs-lisp-mode-syntax-table)) 342 (set-syntax-table emacs-lisp-mode-syntax-table))
337 (save-excursion 343 (unless (setq autoloads-done
338 (save-restriction 344 (apply fun-to-call outbuf load-name trim-name args))
339 (widen) 345 (return-from generate-autoload-ish-1))
340 (goto-char (point-min)) 346 )
341 (unless (search-forward generate-autoload-cookie nil t)
342 (message "No autoloads found in %s" trim-name)
343 (return-from generate-file-autoloads-1))
344
345 (message "Generating autoloads for %s..." trim-name)
346 (goto-char (point-min))
347 (while (if dofiles funlist (not (eobp)))
348 (if (not dofiles)
349 (skip-chars-forward " \t\n\f")
350 (goto-char (point-min))
351 (re-search-forward
352 (concat "(def\\(un\\|var\\|const\\|macro\\) "
353 (regexp-quote (symbol-name (car funlist)))
354 "\\s "))
355 (goto-char (match-beginning 0)))
356 (cond
357 ((or dofiles
358 (looking-at (regexp-quote generate-autoload-cookie)))
359 (if dofiles
360 nil
361 (search-forward generate-autoload-cookie)
362 (skip-chars-forward " \t"))
363 ;; (setq done-any t)
364 (if (or dofiles (eolp))
365 ;; Read the next form and make an autoload.
366 (let* ((form (prog1 (read (current-buffer))
367 (or (bolp) (forward-line 1))))
368 (autoload (make-autoload form load-name))
369 (doc-string-elt (get (car-safe form)
370 'doc-string-elt)))
371 (if autoload
372 (setq autoloads-done (cons (nth 1 form)
373 autoloads-done))
374 (setq autoload form))
375 (print-autoload autoload doc-string-elt outbuf ""))
376 ;; Copy the rest of the line to the output.
377 (let ((begin (point)))
378 ;; (terpri outbuf)
379 (cond ((looking-at "immediate\\s *$") ; XEmacs
380 ;; This is here so that you can automatically
381 ;; have small hook functions copied to
382 ;; auto-autoloads.el so that it's not necessary
383 ;; to load a whole file just to get a two-line
384 ;; do-nothing find-file-hook... --Stig
385 (forward-line 1)
386 (setq begin (point))
387 (forward-sexp)
388 (forward-line 1))
389 (t
390 (forward-line 1)))
391 (princ (buffer-substring begin (point)) outbuf))))
392 ((looking-at ";")
393 ;; Don't read the comment.
394 (forward-line 1))
395 (t
396 (forward-sexp 1)
397 (forward-line 1)))
398 (if dofiles
399 (setq funlist (cdr funlist)))))))
400 (unless visited 347 (unless visited
401 ;; We created this buffer, so we should kill it. 348 ;; We created this buffer, so we should kill it.
402 (kill-buffer (current-buffer))) 349 (kill-buffer (current-buffer)))
403 (set-buffer outbuf) 350 (set-buffer outbuf)
404 (setq output-end (point-marker)))) 351 (setq output-end (point-marker))))
405 (if t ;; done-any 352 (if t ;; done-any
406 ;; XEmacs -- always do this so that we cache the information 353 ;; XEmacs -- always do this so that we cache the information
407 ;; that we've processed the file already. 354 ;; that we've processed the file already.
430 (goto-char output-end) 377 (goto-char output-end)
431 (insert generate-autoload-section-trailer))) 378 (insert generate-autoload-section-trailer)))
432 (or noninteractive ; XEmacs: only need one line in -batch mode. 379 (or noninteractive ; XEmacs: only need one line in -batch mode.
433 (message "Generating autoloads for %s...done" file)))) 380 (message "Generating autoloads for %s...done" file))))
434 381
435 (defun* generate-c-file-autoloads-1 (file funlist) 382 (defun* generate-file-autoloads-1 (outbuf load-name trim-name funlist)
383 "Insert at point an autoload section for FILE.
384 autoloads are generated for defuns and defmacros in FILE
385 marked by `generate-autoload-cookie' (which see).
386 If FILE is being visited in a buffer, the contents of the buffer
387 are used."
388 (let ((autoloads-done '())
389 (dofiles (not (null funlist)))
390 )
391
392 (save-excursion
393 (save-restriction
394 (widen)
395 (goto-char (point-min))
396 (unless (search-forward generate-autoload-cookie nil t)
397 (message "No autoloads found in %s" trim-name)
398 (return-from generate-file-autoloads-1 nil))
399
400 (message "Generating autoloads for %s..." trim-name)
401 (goto-char (point-min))
402 (while (if dofiles funlist (not (eobp)))
403 (if (not dofiles)
404 (skip-chars-forward " \t\n\f")
405 (goto-char (point-min))
406 (re-search-forward
407 (concat "(def\\(un\\|var\\|const\\|macro\\) "
408 (regexp-quote (symbol-name (car funlist)))
409 "\\s "))
410 (goto-char (match-beginning 0)))
411 (cond
412 ((or dofiles
413 (looking-at (regexp-quote generate-autoload-cookie)))
414 (if dofiles
415 nil
416 (search-forward generate-autoload-cookie)
417 (skip-chars-forward " \t"))
418 ;; (setq done-any t)
419 (if (or dofiles (eolp))
420 ;; Read the next form and make an autoload.
421 (let* ((form (prog1 (read (current-buffer))
422 (or (bolp) (forward-line 1))))
423 (autoload (make-autoload form load-name))
424 (doc-string-elt (get (car-safe form)
425 'doc-string-elt)))
426 (if autoload
427 (setq autoloads-done (cons (nth 1 form)
428 autoloads-done))
429 (setq autoload form))
430 (print-autoload autoload doc-string-elt outbuf ""))
431 ;; Copy the rest of the line to the output.
432 (let ((begin (point)))
433 ;; (terpri outbuf)
434 (cond ((looking-at "immediate\\s *$") ; XEmacs
435 ;; This is here so that you can automatically
436 ;; have small hook functions copied to
437 ;; auto-autoloads.el so that it's not necessary
438 ;; to load a whole file just to get a two-line
439 ;; do-nothing find-file-hook... --Stig
440 (forward-line 1)
441 (setq begin (point))
442 (forward-sexp)
443 (forward-line 1))
444 (t
445 (forward-line 1)))
446 (princ (buffer-substring begin (point)) outbuf))))
447 ((looking-at ";")
448 ;; Don't read the comment.
449 (forward-line 1))
450 (t
451 (forward-sexp 1)
452 (forward-line 1)))
453 (if dofiles
454 (setq funlist (cdr funlist))))))
455 autoloads-done))
456
457 (defun* generate-c-file-autoloads-1 (outbuf load-name trim-name funlist)
436 "Insert at point an autoload section for the C file FILE. 458 "Insert at point an autoload section for the C file FILE.
437 autoloads are generated for defuns and defmacros in FILE 459 autoloads are generated for defuns and defmacros in FILE
438 marked by `generate-c-autoload-cookie' (which see). 460 marked by `generate-c-autoload-cookie' (which see).
439 If FILE is being visited in a buffer, the contents of the buffer 461 If FILE is being visited in a buffer, the contents of the buffer
440 are used." 462 are used."
441 (let ((outbuf (current-buffer)) 463 (let ((exists-p-format
464 "(file-exists-p (expand-file-name \"%s.%s\" module-directory))")
442 (autoloads-done '()) 465 (autoloads-done '())
443 (load-name (replace-in-string (file-name-nondirectory file) 466 )
444 "\\.c?$"
445 ""))
446 (exists-p-format
447 "(file-exists-p (expand-file-name \"%s.%s\" module-directory))")
448 (trim-name (autoload-trim-file-name file))
449 (print-length nil)
450 (print-readably t)
451 (float-output-format nil)
452 ;; (done-any nil)
453 (visited (get-file-buffer file))
454 output-end)
455
456 ;; If the autoload section we create here uses an absolute
457 ;; pathname for FILE in its header, and then Emacs is installed
458 ;; under a different path on another system,
459 ;; `update-autoloads-here' won't be able to find the files to be
460 ;; autoloaded. So, if FILE is in the same directory or a
461 ;; subdirectory of the current buffer's directory, we'll make it
462 ;; relative to the current buffer's directory.
463 (setq file (expand-file-name file))
464 467
465 (save-excursion 468 (save-excursion
466 (unwind-protect 469 (save-restriction
467 (progn 470 (widen)
468 (let ((find-file-hooks nil) 471 (goto-char (point-min))
469 (enable-local-variables nil)) 472 ;; Is there a module name comment?
470 (set-buffer (or visited (find-file-noselect file t t))) 473 (when (search-forward generate-c-autoload-module nil t)
471 ;; This doesn't look right, but it is. The only place we need 474 (skip-chars-forward " \t")
472 ;; the syntax table is when snarfing the Lisp function name. 475 (let ((begin (point)))
473 (set-syntax-table emacs-lisp-mode-syntax-table)) 476 (skip-chars-forward "^ \t\n\f")
474 (save-excursion 477 (setq load-name (buffer-substring begin (point)))))
475 (save-restriction 478 (if funlist
476 (widen) 479 (progn
480 (message "Generating autoloads for %s..." trim-name)
481 (princ "(when (or\n " outbuf)
482 (princ (format exists-p-format load-name "ell") outbuf)
483 (princ "\n " outbuf)
484 (princ (format exists-p-format load-name "dll") outbuf)
485 (princ "\n " outbuf)
486 (princ (format exists-p-format load-name "so") outbuf)
487 ;; close the princ'd `or' form
488 (princ ")\n " outbuf)
489 (dolist (arg funlist)
477 (goto-char (point-min)) 490 (goto-char (point-min))
478 ;; Is there a module name comment? 491 (re-search-forward
479 (when (search-forward generate-c-autoload-module nil t) 492 (concat "DEFUN (\""
480 (skip-chars-forward " \t") 493 (regexp-quote (symbol-name arg))
481 (let ((begin (point))) 494 "\""))
482 (skip-chars-forward "^ \t\n\f") 495 (goto-char (match-beginning 0))
483 (setq load-name (buffer-substring begin (point))))) 496 (let ((autoload (make-c-autoload load-name)))
484 (if funlist 497 (when autoload
485 (progn 498 (push (nth 1 (nth 1 autoload)) autoloads-done)
486 (message "Generating autoloads for %s..." trim-name) 499 (print-autoload autoload 3 outbuf " "))))
487 (princ "(when (or\n " outbuf) 500 ;; close the princ'd `when' form
488 (princ (format exists-p-format load-name "ell") outbuf) 501 (princ ")" outbuf))
489 (princ "\n " outbuf) 502 (goto-char (point-min))
490 (princ (format exists-p-format load-name "dll") outbuf) 503 (let ((match
491 (princ "\n " outbuf) 504 (search-forward generate-c-autoload-cookie nil t)))
492 (princ (format exists-p-format load-name "so") outbuf) 505 (unless match
493 ;; close the princ'd `or' form 506 (message "No autoloads found in %s" trim-name)
494 (princ ")\n " outbuf) 507 (return-from generate-c-file-autoloads-1 nil))
495 (dolist (arg funlist) 508
496 (goto-char (point-min)) 509 (message "Generating autoloads for %s..." trim-name)
497 (re-search-forward 510 (princ "(when (or\n " outbuf)
498 (concat "DEFUN (\"" 511 (princ (format exists-p-format load-name "ell") outbuf)
499 (regexp-quote (symbol-name arg)) 512 (princ "\n " outbuf)
500 "\"")) 513 (princ (format exists-p-format load-name "dll") outbuf)
501 (goto-char (match-beginning 0)) 514 (princ "\n " outbuf)
502 (let ((autoload (make-c-autoload load-name))) 515 (princ (format exists-p-format load-name "so") outbuf)
503 (when autoload 516 ;; close the princ'd `or' form
504 (push (nth 1 (nth 1 autoload)) autoloads-done) 517 (princ ")\n " outbuf)
505 (print-autoload autoload 3 outbuf " ")))) 518 (while match
506 ;; close the princ'd `when' form 519 (forward-line 1)
507 (princ ")" outbuf)) 520 (let ((autoload (make-c-autoload load-name)))
508 (goto-char (point-min)) 521 (when autoload
509 (let ((match 522 (push (nth 1 (nth 1 autoload)) autoloads-done)
510 (search-forward generate-c-autoload-cookie nil t))) 523 (print-autoload autoload 3 outbuf " ")))
511 (unless match 524 (setq match
512 (message "No autoloads found in %s" trim-name) 525 (search-forward generate-c-autoload-cookie nil t)))
513 (return-from generate-c-file-autoloads-1)) 526 ;; close the princ'd `when' form
514 527 (princ ")" outbuf)))))
515 (message "Generating autoloads for %s..." trim-name) 528 autoloads-done))
516 (princ "(when (or\n " outbuf)
517 (princ (format exists-p-format load-name "ell") outbuf)
518 (princ "\n " outbuf)
519 (princ (format exists-p-format load-name "dll") outbuf)
520 (princ "\n " outbuf)
521 (princ (format exists-p-format load-name "so") outbuf)
522 ;; close the princ'd `or' form
523 (princ ")\n " outbuf)
524 (while match
525 (forward-line 1)
526 (let ((autoload (make-c-autoload load-name)))
527 (when autoload
528 (push (nth 1 (nth 1 autoload)) autoloads-done)
529 (print-autoload autoload 3 outbuf " ")))
530 (setq match
531 (search-forward generate-c-autoload-cookie nil t)))
532 ;; close the princ'd `when' form
533 (princ ")" outbuf))))))
534 (unless visited
535 ;; We created this buffer, so we should kill it.
536 (kill-buffer (current-buffer)))
537 (set-buffer outbuf)
538 (setq output-end (point-marker))))
539 (insert generate-autoload-section-header)
540 (prin1 (list 'autoloads autoloads-done load-name trim-name) outbuf)
541 (terpri outbuf)
542 (when (< output-end (point))
543 (setq output-end (point-marker)))
544 (goto-char output-end)
545 (insert generate-autoload-section-trailer)
546 (or noninteractive ; XEmacs: only need one line in -batch mode.
547 (message "Generating autoloads for %s...done" trim-name))))
548 529
549 ;; Assorted utilities for generating autoloads and pieces thereof 530 ;; Assorted utilities for generating autoloads and pieces thereof
550 531
551 (defun print-autoload (autoload doc-string-elt outbuf margin) 532 (defun print-autoload (autoload doc-string-elt outbuf margin)
552 "Print an autoload form, handling special characters. 533 "Print an autoload form, handling special characters.