Mercurial > hg > xemacs-beta

comparison lisp/utils/autoload.el @ 189:489f57a838ef r20-3b21

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b21
author cvs
date Mon, 13 Aug 2007 09:57:07 +0200
parents b405438285a2
children f53b5ca2e663
comparison
equal deleted inserted replaced
188:e29a8e7498d9 189:489f57a838ef
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 361
362 (defvar customized-symbols nil) 362 (defvar customized-symbols (make-hash-table :test 'eq))
363 363
364 ;; Written by Per Abrahamsen 364 ;; Written by Per Abrahamsen
365 (defun autoload-snarf-defcustom (file) 365 (defun autoload-snarf-defcustom (file)
366 "Snarf all customizations in the current buffer." 366 "Snarf all customizations in the current buffer."
367 (let ((visited (get-file-buffer file))) 367 (let ((visited (get-file-buffer file)))
369 (set-buffer (or visited (find-file-noselect file))) 369 (set-buffer (or visited (find-file-noselect file)))
370 (when (and file 370 (when (and file
371 (string-match "\\`\\(.*\\)\\.el\\'" file) 371 (string-match "\\`\\(.*\\)\\.el\\'" file)
372 (not (buffer-modified-p))) 372 (not (buffer-modified-p)))
373 (goto-char (point-min)) 373 (goto-char (point-min))
374 (condition-case nil 374 (let ((name (file-name-nondirectory (match-string 1 file))))
375 (let ((name (file-name-nondirectory (match-string 1 file)))) 375 (condition-case nil
376 (while t 376 (while (re-search-forward
377 "^(defcustom\\|^(defface\\|^(defgroup"
378 nil t)
379 (beginning-of-line)
377 (let ((expr (read (current-buffer)))) 380 (let ((expr (read (current-buffer))))
378 (when (and (listp expr) 381 (eval expr)
379 (memq (car expr) '(defcustom defface defgroup))) 382 (setf (gethash (nth 1 expr) customized-symbols) name)))
380 (eval expr) 383 (error nil))))
381 (put (nth 1 expr) 'custom-where name)
382 (pushnew (nth 1 expr) customized-symbols)))))
383 (error nil)))
384 (unless (buffer-modified-p) 384 (unless (buffer-modified-p)
385 (kill-buffer (current-buffer)))))) 385 (kill-buffer (current-buffer))))))
386 386
387 (defvar autoload-do-custom-save nil) 387 (defvar autoload-do-custom-save nil)
388 388
525 (save-excursion 525 (save-excursion
526 (set-buffer (find-file-noselect generated-custom-file)) 526 (set-buffer (find-file-noselect generated-custom-file))
527 (erase-buffer) 527 (erase-buffer)
528 (insert 528 (insert
529 (with-output-to-string 529 (with-output-to-string
530 (mapcar (lambda (symbol) 530 (mapatoms (lambda (sym)
531 (let ((members (condition-case nil 531 (let ((members (get sym 'custom-group))
532 (get symbol 'custom-group) 532 item where found)
533 (t (progn 533 (when members
534 (message "Bad plist in %s" 534 (while members
535 (symbol-name symbol))) 535 (setq item (car (car members))
536 nil))) 536 members (cdr members)
537 item where 537 where (gethash item customized-symbols))
538 (found (condition-case nil 538 (unless (or (null where)
539 (get symbol 'custom-loads) 539 (member where found))
540 (t nil))) 540 (if found
541 ) 541 (insert " ")
542 (when (or members found) 542 ;;; (insert "(custom-add-loads '" (symbol-name sym)
543 (princ "(custom-put '") 543 (insert "(custom-put '" (symbol-name sym)
544 (princ symbol) 544 " 'custom-loads '("))
545 (princ " 'custom-loads '(") 545 (prin1 where (current-buffer))
546 (when found 546 (push where found)))
547 ;; (message "found = `%s'" found) 547 (when found
548 (insert (mapconcat 'prin1-to-string found " "))) 548 (insert "))\n"))))))
549 (while members 549 ))
550 (setq item (car (car members))
551 members (cdr members)
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)) 550 (when (= (point-min) (point-max))
563 (set-buffer-modified-p nil)))) 551 (set-buffer-modified-p nil))))
564 552
565 ;;;###autoload 553 ;;;###autoload
566 (defun batch-update-autoloads () 554 (defun batch-update-autoloads ()
577 (enable-local-eval nil)) ; Don't query in batch mode. 565 (enable-local-eval nil)) ; Don't query in batch mode.
578 (when (file-exists-p generated-custom-file) 566 (when (file-exists-p generated-custom-file)
579 (flet ((custom-put (symbol property value) 567 (flet ((custom-put (symbol property value)
580 (progn 568 (progn
581 (put symbol property value) 569 (put symbol property value)
582 (pushnew symbol customized-symbols)))) 570 (setf (gethash symbol customized-symbols) value))))
583 (load generated-custom-file nil t))) 571 (load generated-custom-file nil t)))
584 ;; (message "Updating autoloads in %s..." generated-autoload-file) 572 ;; (message "Updating autoloads in %s..." generated-autoload-file)
585 (dolist (arg command-line-args-left) 573 (dolist (arg command-line-args-left)
586 (setq arg (expand-file-name arg defdir)) 574 (setq arg (expand-file-name arg defdir))
587 (cond 575 (cond
632 (progn 620 (progn
633 (put symbol property value) 621 (put symbol property value)
634 ;; (message "Loading %s = %s" 622 ;; (message "Loading %s = %s"
635 ;; (symbol-name symbol) 623 ;; (symbol-name symbol)
636 ;; (prin1-to-string value)) 624 ;; (prin1-to-string value))
637 (pushnew symbol customized-symbols)))) 625 (setf (gethash symbol customized-symbols)
626 value))))
638 (load generated-custom-file nil t))) 627 (load generated-custom-file nil t)))
639 (cond 628 (cond
640 ((file-directory-p arg) 629 ((file-directory-p arg)
641 (message "Updating autoloads in directory %s..." arg) 630 (message "Updating autoloads/custom in directory %s..." arg)
642 (update-autoloads-from-directory arg)) 631 (update-autoloads-from-directory arg))
643 (t (error "No such file or directory: %s" arg))) 632 (t (error "No such file or directory: %s" arg)))
644 (when autoload-do-custom-save 633 (when autoload-do-custom-save
645 (autoload-save-customization) 634 (autoload-save-customization)
646 (setq customized-symbols nil)) 635 (clrhash customized-symbols))
647 (fixup-autoload-buffer (concat (if autoload-package-name 636 (fixup-autoload-buffer (concat (if autoload-package-name
648 autoload-package-name 637 autoload-package-name
649 (file-name-nondirectory arg)) 638 (file-name-nondirectory arg))
650 "-autoloads")) 639 "-autoloads"))
651 (save-some-buffers t)) 640 (save-some-buffers t))