Mercurial > hg > xemacs-beta

comparison lisp/prim/cus-dep.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
children
comparison
equal deleted inserted replaced
188:e29a8e7498d9 189:489f57a838ef
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>, then
6 ;; Richar Stallman <rms@gnu.ai.mit.edu>, then
7 ;; Hrvoje Niksic <hniksic@srce.hr>
8 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
9 ;; Keywords: internal
10
11 ;; This file is part of XEmacs.
12
13 ;; XEmacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; any later version.
17
18 ;; XEmacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with XEmacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
27
28 ;;; Synched up with: Not synched with FSF.
29
30 ;;; Code:
31
32 (require 'cl)
33 (require 'widget)
34 (require 'cus-edit)
35 (require 'cus-face)
36
37 (defconst cusload-base-file "custom-load.el")
38
39 ;;;###autoload
40 (defun custom-make-dependencies (&optional subdirs)
41 "Extract custom dependencies from .el files in SUBDIRS.
42 SUBDIRS is a list of directories. If it is nil, the command-line
43 arguments are used. If it is a string, only that directory is
44 processed. This function is especially useful in batch mode.
45
46 Batch usage: xemacs -batch -l cus-dep.el -f custom-make-dependencies DIRS"
47 (interactive "DDirectory: ")
48 (and (stringp subdirs)
49 (setq subdirs (list subdirs)))
50 (or subdirs
51 (setq subdirs command-line-args-left))
52 (setq subdirs (mapcar #'expand-file-name subdirs))
53 (with-temp-buffer
54 (let ((enable-local-eval nil)
55 (hash (make-hash-table :test 'eq)))
56 (dolist (dir subdirs)
57 (message "Processing %s" dir)
58 (let ((cusload-file (expand-file-name cusload-base-file dir)))
59 (dolist (file (directory-files dir t "\\`[^=].*\\.el\\'"))
60 (when (file-exists-p file)
61 (erase-buffer)
62 (insert-file-contents file)
63 (goto-char (point-min))
64 (let ((name (file-name-sans-extension
65 (file-name-nondirectory file))))
66 (condition-case nil
67 (while (re-search-forward
68 "^(defcustom\\|^(defface\\|^(defgroup"
69 nil t)
70 (beginning-of-line)
71 (let ((expr (read (current-buffer))))
72 (eval expr)
73 (setf (gethash (nth 1 expr) hash) name)))
74 (error nil)))))
75 (message "Generating %s..." cusload-base-file)
76 (with-temp-file cusload-file
77 (insert ";;; " cusload-base-file
78 " --- automatically extracted custom dependencies\n"
79 ";;\n;;; Code:\n\n")
80 (mapatoms (lambda (sym)
81 (let ((members (get sym 'custom-group))
82 item where found)
83 (when members
84 (while members
85 (setq item (car (car members))
86 members (cdr members)
87 where (gethash item hash))
88 (unless (or (null where)
89 (member where found))
90 (if found
91 (insert " ")
92 ;;; (insert "(custom-add-loads '" (symbol-name sym)
93 (insert "(custom-put '" (symbol-name sym)
94 " '("))
95 (prin1 where (current-buffer))
96 (push where found)))
97 (when found
98 (insert "))\n"))))))
99 (insert "\n;;; custom-load.el ends here\n"))
100 (clrhash hash))))))
101
102 (provide 'cus-dep)
103
104 ;;; cus-dep.el ends here