1 ;;; cus-dep.el --- Find customization dependencies.
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 2003 Ben Wing.
6 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>, then
7 ;; Richard Stallman <rms@gnu.ai.mit.edu>, then
8 ;; Hrvoje Niksic <hniksic@xemacs.org> (rewritten for XEmacs)
9 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
12 ;; This file is part of SXEmacs.
14 ;; SXEmacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; SXEmacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
27 ;;; Synched up with: Not synched with FSF.
32 ;; This file generates the custom-load files, loaded by cus-load.el.
33 ;; Entry points are `Custom-make-dependencies' and
34 ;; `Custom-make-one-dependency'.
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.
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').
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.
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'.
66 ;; (custom-add-loads 'foo 'custom-loads '("bar" "baz"))
67 ;; (get 'foo 'custom-loads)
70 ;; (custom-add-loads 'foo 'custom-loads '("hmph" "baz" "quz"))
71 ;; (get 'foo 'custom-loads)
72 ;; => ("bar" "baz" "hmph" "qux")
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.
79 ;; Feb 2003: Added code to speed up building by caching the values we've
80 ;; constructed, and using them instead of scanning a file when custom-load
81 ;; is up-to-date w.r.t. the file. Also use `message' not `princ' to print
82 ;; out messages so nl's are correctly inserted when necessary. --ben
91 ;; #### This and the autoloads file naming variables belong in a separate
92 ;; file to be required here.
93 ;; #### Compare this with the autoloads handling.
94 ;; Don't change this, unless you plan to change the code in
96 (defconst cusload-base-file "custom-load.el")
97 (defconst cusload-hash-table-marker ";old-cus-dep-hash: ")
99 ;; Be very careful when changing this function. It looks easy to
100 ;; understand, but is in fact very easy to break. Be sure to read and
101 ;; understand the commentary above!
103 (defun Custom-make-dependencies-1 (subdirs &optional outfile)
104 (setq subdirs (mapcar #'expand-file-name subdirs))
106 (let ((enable-local-eval nil)
107 (hash (make-hash-table :test 'eq))
108 (hash-cache (make-hash-table :test 'equal))
110 (dolist (dir subdirs)
111 (message "Processing %s\n" dir)
112 (let ((cusload-file (or outfile
113 (expand-file-name cusload-base-file dir)))
114 (files (directory-files dir t #r"\`[^=].*\.el\'")))
115 ;; A trivial optimization: if no file in the directory is
116 ;; newer than custom-load.el, no need to do anything!
117 (if (and (file-exists-p cusload-file)
118 (dolist (file files t)
119 (when (file-newer-than-file-p file cusload-file)
121 (message "(No changes need to be written)")
122 (when (file-exists-p cusload-file)
123 (let ((buf (find-file-noselect cusload-file)))
124 (with-current-buffer buf
125 (goto-char (point-min))
126 (when (search-forward cusload-hash-table-marker nil t)
127 (setq old-hash (read buf))))
131 (let ((old-cache (if (hash-table-p old-hash)
132 (gethash file old-hash t)
134 (if (and (not (file-newer-than-file-p file cusload-file))
135 (not (eq old-cache t)))
137 (dolist (c old-cache)
138 (puthash (car c) (cdr c) hash))
139 (puthash file old-cache hash-cache))
141 (insert-file-contents file)
142 (goto-char (point-min))
143 (let ((name (file-name-sans-extension
144 (file-name-nondirectory file)))
147 ;; Search for defcustom/defface/defgroup
148 ;; expressions, and evaluate them.
149 (while (re-search-forward
150 #r"^(defcustom\|^(defface\|^(defgroup"
153 (message "Computing custom-loads for %s..." name)
156 (let ((expr (read (current-buffer))))
157 ;; We need to ignore errors here, so that
158 ;; defcustoms with :set don't bug out. Of
159 ;; course, their values will not be assigned in
160 ;; case of errors, but their `custom-group'
161 ;; properties will by that time be in place, and
162 ;; that's all we care about.
165 ;; Hash the file of the affected symbol.
166 (setf (gethash (nth 1 expr) hash) name)
167 ;; Remember the values computed.
168 (push (cons (nth 1 expr) name) cache)))
170 (message "No custom-loads for %s" name))
171 (puthash file cache hash-cache)))
174 ((zerop (hash-table-count hash))
175 (message "(No customization dependencies)")
176 (write-region "" nil cusload-file))
178 (message "Generating %s...\n" cusload-base-file)
179 (with-temp-file cusload-file
180 (insert ";;; " cusload-base-file
181 " --- automatically extracted custom dependencies\n"
183 (insert cusload-hash-table-marker)
184 (let ((print-readably t)
185 (standard-output (current-buffer)))
188 (insert "(autoload 'custom-add-loads \"cus-load\")\n\n")
191 (let ((members (get sym 'custom-group))
195 (setq item (car (car members))
196 members (cdr members)
197 where (gethash item hash))
198 (unless (or (null where)
199 (member where found))
202 (insert "(custom-add-loads '"
203 (prin1-to-string sym) " '("))
204 (prin1 where (current-buffer))
208 (insert "\n;;; custom-load.el ends here\n"))
209 (clrhash hash)))))))))
211 (defun Custom-make-one-dependency ()
212 "Extract custom dependencies from .el files in one dir, on the command line.
213 Like `Custom-make-dependencies' but snarfs only one command-line argument,
214 making it useful in a chain of batch commands in a single XEmacs invocation."
215 (let ((subdir (car command-line-args-left)))
216 (setq command-line-args-left (cdr command-line-args-left))
217 (Custom-make-dependencies-1 (list subdir))))
220 (defun Custom-make-dependencies (&optional subdirs outfile)
221 "Extract custom dependencies from .el files in SUBDIRS.
223 SUBDIRS is a list of directories. If it is nil, the command-line
224 arguments are used. If it is a string, only that directory is
227 OUTFILE is for optionally setting where to put the output. This
228 is most often used when building outside of a source tree and you
229 want the custom-loads.el to be in the build tree. Be sure to call
230 #'expand-file-name on OUTFILE to be safe.
232 This function is especially useful in batch mode.
234 Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
235 (interactive "DDirectory: ")
236 (and (stringp subdirs)
237 (setq subdirs (list subdirs)))
239 ;; Usurp the command-line-args
240 (setq subdirs command-line-args-left
241 command-line-args-left nil))
242 (Custom-make-dependencies-1 subdirs outfile))
246 ;;; cus-dep.el ends here