Mercurial > hg > xemacs-beta

comparison lisp/custom/cus-dep.el @ 195:a2f645c6b9f8 r20-3b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b24
author cvs
date Mon, 13 Aug 2007 09:59:05 +0200
parents
children 169c0442b401
comparison
equal deleted inserted replaced
194:2947057885e5 195:a2f645c6b9f8
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> (rewritten for XEmacs)
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
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 so that it scans 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 crucial 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-put' function, generated by this file, is a specialized
59 ;; form of `put' that deals with lists, eliminating the duplicates.
60 ;; For instance:
61
62 ;; (custom-put 'foo 'custom-loads '("bar" "baz"))
63 ;; (get 'foo 'custom-loads)
64 ;; => ("bar" "baz")
65 ;;
66 ;; (custom-put 'foo 'custom-loads '("hmph" "baz" "quz"))
67 ;; (get 'foo 'custom-loads)
68 ;; => ("bar" "baz" "hmph" "qux")
69
70 ;; Obviously, this allows correct incremental loading of custom-load
71 ;; files. This is not necessary under FSF (they use a simple `put'),
72 ;; since they have only *one* file. With the advent of packages, we
73 ;; cannot afford the same luxury.
74
75
76 ;;; Code:
77
78 (require 'cl)
79 (require 'widget)
80 (require 'cus-edit)
81 (require 'cus-face)
82
83 ;; Don't change this, unless you plan to change the code in
84 ;; cus-start.el, too.
85 (defconst cusload-base-file "custom-load.el")
86
87 ;;;###autoload
88 (defun Custom-make-dependencies (&optional subdirs)
89 "Extract custom dependencies from .el files in SUBDIRS.
90 SUBDIRS is a list of directories. If it is nil, the command-line
91 arguments are used. If it is a string, only that directory is
92 processed. This function is especially useful in batch mode.
93
94 Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
95 (interactive "DDirectory: ")
96 (and (stringp subdirs)
97 (setq subdirs (list subdirs)))
98 (or subdirs
99 ;; Usurp the command-line-args
100 (setq subdirs command-line-args-left
101 command-line-args-left nil))
102 (setq subdirs (mapcar #'expand-file-name subdirs))
103 (with-temp-buffer
104 (let ((enable-local-eval nil)
105 (hash (make-hash-table :test 'eq)))
106 (dolist (dir subdirs)
107 (message "Processing %s" dir)
108 (let ((cusload-file (expand-file-name cusload-base-file dir))
109 (files (directory-files dir t "\\`[^=].*\\.el\\'")))
110 ;; A trivial optimization: if no files in the directory is
111 ;; newer than custom-load.el, no need to do anything!
112 (if (and (file-exists-p cusload-file)
113 (dolist (file files t)
114 (when (file-newer-than-file-p file cusload-file)
115 (return nil))))
116 (message "No changes need to be written.")
117 ;; Process directory
118 (dolist (file files)
119 (when (file-exists-p file)
120 (erase-buffer)
121 (insert-file-contents file)
122 (goto-char (point-min))
123 (let ((name (file-name-sans-extension
124 (file-name-nondirectory file))))
125 (condition-case nil
126 (while (re-search-forward
127 "^(defcustom\\|^(defface\\|^(defgroup"
128 nil t)
129 (beginning-of-line)
130 (let ((expr (read (current-buffer))))
131 (eval expr)
132 (setf (gethash (nth 1 expr) hash) name)))
133 (error nil)))))
134 (message "Generating %s..." cusload-base-file)
135 (with-temp-file cusload-file
136 (insert ";;; " cusload-base-file
137 " --- automatically extracted custom dependencies\n"
138 "\n;; Created by " (user-full-name) " on "
139 (current-time-string) "\n\n;;; Code:\n\n")
140 (mapatoms
141 (lambda (sym)
142 (let ((members (get sym 'custom-group))
143 item where found)
144 (when members
145 (while members
146 (setq item (car (car members))
147 members (cdr members)
148 where (gethash item hash))
149 (unless (or (null where)
150 (member where found))
151 (if found
152 (insert " ")
153 (insert "(custom-put '" (symbol-name sym)
154 " 'custom-loads '("))
155 (prin1 where (current-buffer))
156 (push where found)))
157 (when found
158 (insert "))\n"))))))
159 (insert "\n;;; custom-load.el ends here\n"))
160 (clrhash hash)))))))
161
162 (provide 'cus-dep)
163
164 ;;; cus-dep.el ends here