Mercurial > hg > xemacs-beta

comparison lisp/cus-dep.el @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children abe6d1db359e
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
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 ;; Richard Stallman <rms@gnu.ai.mit.edu>, then
7 ;; Hrvoje Niksic <hniksic@xemacs.org> (rewritten for XEmacs)
8 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
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
31 ;;; Commentary:
32
33 ;; This file generates the custom-load files, loaded by cus-load.el.
34 ;; The only entry point is `Custom-make-dependencies'.
35
36 ;; It works by scanning all the `.el' files in a directory, and
37 ;; evaluates any `defcustom', `defgroup', or `defface' expression that
38 ;; it finds. The symbol changed by this expression is stored to a
39 ;; hash table as the hash key, file name being the value.
40
41 ;; After all the files have been examined, custom-loads.el is
42 ;; generated by mapping all the atoms, and seeing if any of them
43 ;; contains a `custom-group' property. This property is a list whose
44 ;; each element's car is the "child" group symbol. If that property
45 ;; is in the hash-table, the file name will be looked up from the
46 ;; hash-table, and added to cusload-file. Because the hash-table is
47 ;; cleared whenever we process a new directory, we cannot get confused
48 ;; by custom-loads from another directory, or from a previous
49 ;; installation. This is also why it is perfectly safe to have old
50 ;; custom-loads around, and have them loaded by `cus-load.el' (as
51 ;; invoked by `cus-edit.el').
52
53 ;; A trivial, but useful optimization is that if cusload-file exists,
54 ;; and no .el files in the directory are newer than cusload-file, it
55 ;; will not be generated. This means that the directories where
56 ;; nothing has changed will be skipped.
57
58 ;; The `custom-add-loads' function, used by files generated by
59 ;; `Custom-make-dependencies', updates the symbol's `custom-loads'
60 ;; property (a list of strings) with a new list of strings,
61 ;; eliminating the duplicates. Additionally, it adds the symbol to
62 ;; `custom-group-hash-table'. It is defined in `cus-load.el'.
63
64 ;; Example:
65
66 ;; (custom-add-loads 'foo 'custom-loads '("bar" "baz"))
67 ;; (get 'foo 'custom-loads)
68 ;; => ("bar" "baz")
69 ;;
70 ;; (custom-add-loads 'foo 'custom-loads '("hmph" "baz" "quz"))
71 ;; (get 'foo 'custom-loads)
72 ;; => ("bar" "baz" "hmph" "qux")
73
74 ;; Obviously, this allows correct incremental loading of custom-load
75 ;; files. This is not necessary under FSF (they simply use `put'),
76 ;; since they have only one file with custom dependencies. With the
77 ;; advent of packages, we cannot afford the same luxury.
78
79
80 ;;; Code:
81
82 (require 'cl)
83 (require 'widget)
84 (require 'cus-face)
85
86 ;; Don't change this, unless you plan to change the code in
87 ;; cus-start.el, too.
88 (defconst cusload-base-file "custom-load.el")
89
90 ;; Be very careful when changing this function. It looks easy to
91 ;; understand, but is in fact very easy to break. Be sure to read and
92 ;; understand the commentary above!
93
94 ;;;###autoload
95 (defun Custom-make-dependencies (&optional subdirs)
96 "Extract custom dependencies from .el files in SUBDIRS.
97 SUBDIRS is a list of directories. If it is nil, the command-line
98 arguments are used. If it is a string, only that directory is
99 processed. This function is especially useful in batch mode.
100
101 Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
102 (interactive "DDirectory: ")
103 (and (stringp subdirs)
104 (setq subdirs (list subdirs)))
105 (or subdirs
106 ;; Usurp the command-line-args
107 (setq subdirs command-line-args-left
108 command-line-args-left nil))
109 (setq subdirs (mapcar #'expand-file-name subdirs))
110 (with-temp-buffer
111 (let ((enable-local-eval nil)
112 (hash (make-hash-table :test 'eq)))
113 (dolist (dir subdirs)
114 (princ (format "Processing %s\n" dir))
115 (let ((cusload-file (expand-file-name cusload-base-file dir))
116 (files (directory-files dir t "\\`[^=].*\\.el\\'")))
117 ;; A trivial optimization: if no file in the directory is
118 ;; newer than custom-load.el, no need to do anything!
119 (if (and (file-exists-p cusload-file)
120 (dolist (file files t)
121 (when (file-newer-than-file-p file cusload-file)
122 (return nil))))
123 (princ "(No changes need to be written)\n")
124 ;; Process directory
125 (dolist (file files)
126 (when (file-exists-p file)
127 (erase-buffer)
128 (insert-file-contents file)
129 (goto-char (point-min))
130 (let ((name (file-name-sans-extension
131 (file-name-nondirectory file))))
132 ;; Search for defcustom/defface/defgroup
133 ;; expressions, and evaluate them.
134 (while (re-search-forward
135 "^(defcustom\\|^(defface\\|^(defgroup"
136 nil t)
137 (beginning-of-line)
138 (let ((expr (read (current-buffer))))
139 ;; We need to ignore errors here, so that
140 ;; defcustoms with :set don't bug out. Of
141 ;; course, their values will not be assigned in
142 ;; case of errors, but their `custom-group'
143 ;; properties will by that time be in place, and
144 ;; that's all we care about.
145 (ignore-errors
146 (eval expr))
147 ;; Hash the file of the affected symbol.
148 (setf (gethash (nth 1 expr) hash) name))))))
149 (cond
150 ((zerop (hash-table-count hash))
151 (princ "(No customization dependencies")
152 (when (file-exists-p cusload-file)
153 (princ (format ", deleting %s" cusload-file))
154 (delete-file cusload-file))
155 (princ ")\n"))
156 (t
157 (princ (format "Generating %s...\n" cusload-base-file))
158 (with-temp-file cusload-file
159 (insert ";;; " cusload-base-file
160 " --- automatically extracted custom dependencies\n"
161 "\n;;; Code:\n\n")
162 (mapatoms
163 (lambda (sym)
164 (let ((members (get sym 'custom-group))
165 item where found)
166 (when members
167 (while members
168 (setq item (car (car members))
169 members (cdr members)
170 where (gethash item hash))
171 (unless (or (null where)
172 (member where found))
173 (if found
174 (insert " ")
175 (insert "(custom-add-loads '"
176 (prin1-to-string sym) " '("))
177 (prin1 where (current-buffer))
178 (push where found)))
179 (when found
180 (insert "))\n"))))))
181 (insert "\n;;; custom-load.el ends here\n"))
182 (clrhash hash)))))))))
183
184 (provide 'cus-dep)
185
186 ;;; cus-dep.el ends here