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