Mercurial > hg > xemacs-beta

comparison lisp/utils/autoload.el @ 169:15872534500d r20-3b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b11
author cvs
date Mon, 13 Aug 2007 09:46:53 +0200
parents 85ec50267440
children e121b013d1f0
comparison
equal deleted inserted replaced
168:9851d5c6556e 169:15872534500d
315 ;; Warn if we put a line in loaddefs.el 315 ;; Warn if we put a line in loaddefs.el
316 ;; that is long enough to cause trouble. 316 ;; that is long enough to cause trouble.
317 (when (< output-end (point)) 317 (when (< output-end (point))
318 (setq output-end (point-marker))) 318 (setq output-end (point-marker)))
319 (while (< (point) output-end) 319 (while (< (point) output-end)
320 (let ((beg (point))) 320 ;; (let ((beg (point)))
321 (end-of-line) 321 (end-of-line)
322 ;; Emacs -- I still haven't figured this one out. 322 ;; Emacs -- I still haven't figured this one out.
323 ;; (if (> (- (point) beg) 900) 323 ;; (if (> (- (point) beg) 900)
324 ;; (progn 324 ;; (progn
325 ;; (message "A line is too long--over 900 characters") 325 ;; (message "A line is too long--over 900 characters")
326 ;; (sleep-for 2) 326 ;; (sleep-for 2)
327 ;; (goto-char output-end))) 327 ;; (goto-char output-end)))
328 ) 328 ;; )
329 (forward-line 1)) 329 (forward-line 1))
330 (goto-char output-end) 330 (goto-char output-end)
331 (insert generate-autoload-section-trailer))) 331 (insert generate-autoload-section-trailer)))
332 (or noninteractive ; XEmacs: only need one line in -batch mode. 332 (or noninteractive ; XEmacs: only need one line in -batch mode.
333 (message "Generating autoloads for %s...done" file)))) 333 (message "Generating autoloads for %s...done" file))))
356 (defvar generated-custom-file 356 (defvar generated-custom-file
357 (expand-file-name (concat autoload-target-directory 357 (expand-file-name (concat autoload-target-directory
358 cusload-file-name) 358 cusload-file-name)
359 data-directory) 359 data-directory)
360 "*File `update-file-autoloads' puts customization into.") 360 "*File `update-file-autoloads' puts customization into.")
361
362 (defvar customized-symbols nil)
361 363
362 ;; Written by Per Abrahamsen 364 ;; Written by Per Abrahamsen
363 (defun autoload-snarf-defcustom (file) 365 (defun autoload-snarf-defcustom (file)
364 "Snarf all customizations in the current buffer." 366 "Snarf all customizations in the current buffer."
365 (let ((visited (get-file-buffer file))) 367 (let ((visited (get-file-buffer file)))
374 (while t 376 (while t
375 (let ((expr (read (current-buffer)))) 377 (let ((expr (read (current-buffer))))
376 (when (and (listp expr) 378 (when (and (listp expr)
377 (memq (car expr) '(defcustom defface defgroup))) 379 (memq (car expr) '(defcustom defface defgroup)))
378 (eval expr) 380 (eval expr)
379 (put (nth 1 expr) 'custom-where name))))) 381 (put (nth 1 expr) 'custom-where name)
382 (pushnew (nth 1 expr) customized-symbols)))))
380 (error nil))) 383 (error nil)))
381 (unless (buffer-modified-p) 384 (unless (buffer-modified-p)
382 (kill-buffer (current-buffer)))))) 385 (kill-buffer (current-buffer))))))
383 386
387 (defvar autoload-do-custom-save nil)
388
384 ;;;###autoload 389 ;;;###autoload
385 (defun update-file-autoloads (file) 390 (defun update-file-autoloads (file)
386 "Update the autoloads for FILE in `generated-autoload-file' 391 "Update the autoloads for FILE in `generated-autoload-file'
387 \(which FILE might bind in its local variables)." 392 \(which FILE might bind in its local variables).
393 This functions refuses to update autolaods files and custom loads."
388 (interactive "fUpdate autoloads for file: ") 394 (interactive "fUpdate autoloads for file: ")
389 (setq file (expand-file-name file)) 395 (setq file (expand-file-name file))
390 (let ((load-name (replace-in-string (file-name-nondirectory file) 396 (when (and (file-newer-than-file-p file generated-autoload-file)
391 "\\.elc?$" 397 (not (member (file-name-nondirectory file)
392 "")) 398 (list autoload-file-name cusload-file-name))))
393 (trim-name (autoload-trim-file-name file)) 399
394 section-begin form) 400 (setq autoload-do-custom-save t)
395 (save-excursion 401 (let ((load-name (replace-in-string (file-name-nondirectory file)
396 (let ((find-file-hooks nil)) 402 "\\.elc?$"
397 (set-buffer (or (get-file-buffer generated-autoload-file) 403 ""))
398 (find-file-noselect generated-autoload-file)))) 404 (trim-name (autoload-trim-file-name file))
399 ;; First delete all sections for this file. 405 section-begin form)
400 (goto-char (point-min)) 406 (save-excursion
401 (while (search-forward generate-autoload-section-header nil t) 407 (let ((find-file-hooks nil))
402 (setq section-begin (match-beginning 0)) 408 (set-buffer (or (get-file-buffer generated-autoload-file)
403 (setq form (read (current-buffer))) 409 (find-file-noselect generated-autoload-file))))
404 (when (string= (nth 2 form) load-name) 410 ;; First delete all sections for this file.
405 (search-forward generate-autoload-section-trailer)
406 (delete-region section-begin (point))))
407
408 ;; Now find insertion point for new section
409 (block find-insertion-point
410 (goto-char (point-min)) 411 (goto-char (point-min))
411 (while (search-forward generate-autoload-section-header nil t) 412 (while (search-forward generate-autoload-section-header nil t)
413 (setq section-begin (match-beginning 0))
412 (setq form (read (current-buffer))) 414 (setq form (read (current-buffer)))
413 (when (string< trim-name (nth 3 form)) 415 (when (string= (nth 2 form) load-name)
414 ;; Found alphabetically correct insertion point 416 (search-forward generate-autoload-section-trailer)
415 (goto-char (match-beginning 0)) 417 (delete-region section-begin (point))))
416 (return-from find-insertion-point)) 418
417 (search-forward generate-autoload-section-trailer)) 419 ;; Now find insertion point for new section
418 (when (eq (point) (point-min)) ; No existing entries? 420 (block find-insertion-point
419 (goto-char (point-max)))) ; Append. 421 (goto-char (point-min))
420 422 (while (search-forward generate-autoload-section-header nil t)
421 ;; Add in new sections for file 423 (setq form (read (current-buffer)))
422 (generate-file-autoloads file) 424 (when (string< trim-name (nth 3 form))
423 (autoload-snarf-defcustom file)) 425 ;; Found alphabetically correct insertion point
424 426 (goto-char (match-beginning 0))
425 (when (interactive-p) (save-buffer)))) 427 (return-from find-insertion-point))
428 (search-forward generate-autoload-section-trailer))
429 (when (eq (point) (point-min)) ; No existing entries?
430 (goto-char (point-max)))) ; Append.
431
432 ;; Add in new sections for file
433 (generate-file-autoloads file)
434 (autoload-snarf-defcustom file))
435
436 (when (interactive-p) (save-buffer)))))
426 437
427 ;;;###autoload 438 ;;;###autoload
428 (defun update-autoloads-here () 439 (defun update-autoloads-here ()
429 "Update sections of the current buffer generated by `update-file-autoloads'." 440 "Update sections of the current buffer generated by `update-file-autoloads'."
430 (interactive) 441 (interactive)
478 (defun update-autoloads-from-directory (dir) 489 (defun update-autoloads-from-directory (dir)
479 "Update `generated-autoload-file' with all the current autoloads from DIR. 490 "Update `generated-autoload-file' with all the current autoloads from DIR.
480 This runs `update-file-autoloads' on each .el file in DIR. 491 This runs `update-file-autoloads' on each .el file in DIR.
481 Obsolete autoload entries for files that no longer exist are deleted." 492 Obsolete autoload entries for files that no longer exist are deleted."
482 (interactive "DUpdate autoloads for directory: ") 493 (interactive "DUpdate autoloads for directory: ")
494 (setq autoload-do-custom-save nil)
483 (setq dir (expand-file-name dir)) 495 (setq dir (expand-file-name dir))
484 (let ((simple-dir (file-name-as-directory 496 (let ((simple-dir (file-name-as-directory
485 (file-name-nondirectory 497 (file-name-nondirectory
486 (directory-file-name dir)))) 498 (directory-file-name dir))))
487 (enable-local-eval nil)) 499 (enable-local-eval nil))
513 (save-excursion 525 (save-excursion
514 (set-buffer (find-file-noselect generated-custom-file)) 526 (set-buffer (find-file-noselect generated-custom-file))
515 (erase-buffer) 527 (erase-buffer)
516 (insert 528 (insert
517 (with-output-to-string 529 (with-output-to-string
518 (mapatoms (lambda (symbol) 530 (mapcar (lambda (symbol)
519 (let ((members (condition-case nil 531 (let ((members (condition-case nil
520 (get symbol 'custom-group) 532 (get symbol 'custom-group)
521 (t (progn 533 (t (progn
522 (message "Bad plist in %s" 534 (message "Bad plist in %s"
523 (symbol-name symbol))) 535 (symbol-name symbol)))
524 nil))) 536 nil)))
525 item where found) 537 item where
526 (when members 538 (found (condition-case nil
527 (princ "(put '") 539 (get symbol 'custom-loads)
528 (princ symbol) 540 (t nil)))
529 (princ " 'custom-loads '(") 541 )
530 (while members 542 (when (or members found)
531 (setq item (car (car members)) 543 (princ "(custom-put '")
532 members (cdr members) 544 (princ symbol)
533 where (get item 'custom-where)) 545 (princ " 'custom-loads '(")
534 (unless (or (null where) 546 (when found
535 (member where found)) 547 ;; (message "found = `%s'" found)
536 (when found 548 (insert (mapconcat 'prin1-to-string found " ")))
537 (princ " ")) 549 (while members
538 (prin1 where) 550 (setq item (car (car members))
539 (push where found))) 551 members (cdr members)
540 (princ "))\n"))))))))) 552 where (get item 'custom-where))
553 (unless (or (null where)
554 (member where found))
555 ;; (message "where = `%s', found = `%s'" where found)
556 (when found
557 (princ " "))
558 (prin1 where)
559 (push where found)))
560 (princ "))\n"))))
561 customized-symbols)))
562 (when (= (point-min) (point-max))
563 (set-buffer-modified-p nil))))
541 564
542 ;;;###autoload 565 ;;;###autoload
543 (defun batch-update-autoloads () 566 (defun batch-update-autoloads ()
544 "Update the autoloads for the files or directories on the command line. 567 "Update the autoloads for the files or directories on the command line.
545 Runs `update-file-autoloads' on files and `update-directory-autoloads' 568 Runs `update-file-autoloads' on files and `update-directory-autoloads'
546 on directories. Must be used only with -batch, and kills Emacs on completion. 569 on directories. Must be used only with -batch, and kills Emacs on completion.
547 Each file will be processed even if an error occurred previously. 570 Each file will be processed even if an error occurred previously.
548 For example, invoke `xemacs -batch -f batch-update-autoloads *.el'." 571 For example, invoke `xemacs -batch -f batch-update-autoloads *.el'.
572 The directory to which the auto-autoloads.el and custom-load.el files must
573 be the first parameter on the command line."
549 (unless noninteractive 574 (unless noninteractive
550 (error "batch-update-autoloads is to be used only with -batch")) 575 (error "batch-update-autoloads is to be used only with -batch"))
551 (let ((defdir default-directory) 576 (let ((defdir default-directory)
552 (enable-local-eval nil)) ; Don't query in batch mode. 577 (enable-local-eval nil)) ; Don't query in batch mode.
553 (message "Updating autoloads in %s..." generated-autoload-file) 578 (when (file-exists-p generated-custom-file)
579 (flet ((custom-put (symbol property value)
580 (progn
581 (put symbol property value)
582 (pushnew symbol customized-symbols))))
583 (load generated-custom-file nil t)))
584 ;; (message "Updating autoloads in %s..." generated-autoload-file)
554 (dolist (arg command-line-args-left) 585 (dolist (arg command-line-args-left)
555 (setq arg (expand-file-name arg defdir)) 586 (setq arg (expand-file-name arg defdir))
556 (cond 587 (cond
557 ((file-directory-p arg) 588 ((file-directory-p arg)
558 (message "Updating autoloads for directory %s..." arg) 589 (message "Updating autoloads for directory %s..." arg)
559 (update-autoloads-from-directory arg)) 590 (update-autoloads-from-directory arg))
560 ((file-exists-p arg) 591 ((file-exists-p arg)
561 (update-file-autoloads arg)) 592 (update-file-autoloads arg))
562 (t (error "No such file or directory: %s" arg)))) 593 (t (error "No such file or directory: %s" arg))))
563 (autoload-save-customization) 594 (when autoload-do-custom-save
595 (autoload-save-customization))
596 (fixup-autoload-buffer (concat (file-name-nondirectory defdir)
597 "-autoloads"))
564 (save-some-buffers t) 598 (save-some-buffers t)
565 (message "Done") 599 ;; (message "Done")
566 (kill-emacs 0))) 600 (kill-emacs 0)))
567 601
568 (defun fixup-autoload-buffer (sym) 602 (defun fixup-autoload-buffer (sym)
569 (save-excursion 603 (save-excursion
570 (set-buffer (find-file-noselect generated-autoload-file)) 604 (set-buffer (find-file-noselect generated-autoload-file))
582 (defun batch-update-directory () 616 (defun batch-update-directory ()
583 "Update the autoloads for the directory on the command line. 617 "Update the autoloads for the directory on the command line.
584 Runs `update-file-autoloads' on each file in the given directory, and must 618 Runs `update-file-autoloads' on each file in the given directory, and must
585 be used only with -batch, and kills XEmacs on completion." 619 be used only with -batch, and kills XEmacs on completion."
586 (unless noninteractive 620 (unless noninteractive
587 (error "batch-update-autoloads is to be used only with -batch")) 621 (error "batch-update-directory is to be used only with -batch"))
588 (let ((defdir default-directory) 622 (let ((defdir default-directory)
589 (enable-local-eval nil)) ; Don't query in batch mode. 623 (enable-local-eval nil)) ; Don't query in batch mode.
590 (dolist (arg command-line-args-left) 624 (dolist (arg command-line-args-left)
591 (setq arg (expand-file-name arg defdir)) 625 (setq arg (expand-file-name arg defdir))
592 (let ((generated-autoload-file (concat arg "/" autoload-file-name)) 626 (let ((generated-autoload-file (concat arg "/" autoload-file-name))
593 (generated-custom-file (concat arg "/" cusload-file-name))) 627 (generated-custom-file (concat arg "/" cusload-file-name)))
628 (when (file-exists-p generated-custom-file)
629 (flet ((custom-put (symbol property value)
630 (progn
631 (put symbol property value)
632 ;; (message "Loading %s = %s"
633 ;; (symbol-name symbol)
634 ;; (prin1-to-string value))
635 (pushnew symbol customized-symbols))))
636 (load generated-custom-file nil t)))
594 (cond 637 (cond
595 ((file-directory-p arg) 638 ((file-directory-p arg)
596 (message "Updating autoloads in directory %s..." arg) 639 (message "Updating autoloads in directory %s..." arg)
597 (update-autoloads-from-directory arg)) 640 (update-autoloads-from-directory arg))
598 (t (error "No such file or directory: %s" arg))) 641 (t (error "No such file or directory: %s" arg)))
599 (autoload-save-customization) 642 (when autoload-do-custom-save
643 (autoload-save-customization)
644 (setq customized-symbols nil))
600 (fixup-autoload-buffer (concat (file-name-nondirectory arg) 645 (fixup-autoload-buffer (concat (file-name-nondirectory arg)
601 "-autoloads")) 646 "-autoloads"))
602 (save-some-buffers t)) 647 (save-some-buffers t))
603 (message "Done") 648 ;; (message "Done")
604 ;; (kill-emacs 0) 649 ;; (kill-emacs 0)
605 ) 650 )
606 (setq command-line-args-left nil))) 651 (setq command-line-args-left nil)))
607 652
608 (provide 'autoload) 653 (provide 'autoload)