lisp/cus-dep.el

   1 ;;; cus-dep.el --- Find customization dependencies.
   2 ;;
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
   6 ;; Keywords: internal
   7
   8 ;;; Code:
   9
  10 (require 'cl)
  11 (load-file "widget.el")
  12 (load-file "custom.el")
  13 (load-file "cus-face.el")
  14
  15 (defun custom-make-dependencies ()
  16   "Batch function to extract custom dependencies from .el files.
  17 Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies"
  18   (let ((enable-local-eval nil)
  19         (files (directory-files "" nil "\\`[^=].*\\.el\\'" t))
  20         file)
  21     (while files
  22       (setq file (car files)
  23             files (cdr files))
  24       (message "Checking %s..." file)
  25       (set-buffer (find-file-noselect file))
  26       (goto-char (point-min))
  27       (string-match "\\`\\(.*\\)\\.el\\'" file)
  28       (condition-case nil
  29           (let ((name (file-name-nondirectory (match-string 1 file))))
  30             (while t
  31               (let ((expr (read (current-buffer))))
  32                 (when (and (listp expr)
  33                            (memq (car expr) '(defcustom defface defgroup)))
  34                   (eval expr)
  35                   (put (nth 1 expr) 'custom-where name)))))
  36         (error nil))
  37       (kill-buffer (current-buffer))))
  38   (message "Generating cus-load.el...")
  39   (find-file "cus-load.el")
  40   (erase-buffer)
  41   (insert "\
  42 ;;; cus-load.el --- automatically extracted custom dependencies
  43 ;;
  44 ;;; Code:
  45
  46 ")
  47   (mapatoms (lambda (symbol)
  48               (let ((members (get symbol 'custom-group))
  49                     item where found)
  50                 (when members
  51                   (while members
  52                     (setq item (car (car members))
  53                           members (cdr members)
  54                           where (get item 'custom-where))
  55                     (unless (or (null where)
  56                                 (member where found))
  57                       (if found
  58                           (insert " ")
  59                         (insert "(put '" (symbol-name symbol)
  60                                 " 'custom-loads '("))
  61                       (prin1 where (current-buffer))
  62                       (push where found)))
  63                   (when found
  64                     (insert "))\n"))))))
  65   (insert "\
  66
  67 \(provide 'cus-load)
  68
  69 ;;; cus-load.el ends here\n")
  70   (save-buffer)
  71   (message "Generating cus-load.el...done"))
  72
  73 ;;; cus-dep.el ends here