Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; cus-dep.el --- find customization dependencies |
860af8ec | 2 | ;; |
ba318903 | 3 | ;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. |
860af8ec PA |
4 | ;; |
5 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> | |
6 | ;; Keywords: internal | |
bd78fa1d | 7 | ;; Package: emacs |
860af8ec | 8 | |
c2383d2d RS |
9 | ;; This file is part of GNU Emacs. |
10 | ||
eb3fa2cf | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
c2383d2d | 12 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
c2383d2d RS |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
c2383d2d | 23 | |
e8af40ee PJ |
24 | ;;; Commentary: |
25 | ||
860af8ec PA |
26 | ;;; Code: |
27 | ||
c9aadf03 RS |
28 | (require 'widget) |
29 | (require 'cus-face) | |
860af8ec | 30 | |
b1d7940f | 31 | (defvar generated-custom-dependencies-file "cus-load.el" |
9b3cd5b4 GM |
32 | "Output file for `custom-make-dependencies'.") |
33 | ||
34 | ;; See finder-no-scan-regexp in finder.el. | |
35 | (defvar custom-dependencies-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|\ | |
3c0d7a5e | 36 | ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)" |
9b3cd5b4 GM |
37 | "Regexp matching file names not to scan for `custom-make-dependencies'.") |
38 | ||
e065ba74 | 39 | (require 'autoload) |
b1d7940f | 40 | |
f4c7dfd2 GM |
41 | ;; Hack workaround for bug#14384. |
42 | ;; Define defcustom-mh as an alias for defcustom, etc. | |
43 | ;; Only do this in batch mode to avoid messing up a normal Emacs session. | |
44 | ;; Alternative would be to load mh-e when making cus-load. | |
45 | ;; (Would be better to split just the necessary parts of mh-e into a | |
46 | ;; separate file and only load that.) | |
47 | (when (and noninteractive) | |
48 | (mapc (lambda (e) (let ((sym (intern (format "%s-mh" e)))) | |
49 | (or (fboundp sym) | |
50 | (defalias sym e)))) | |
51 | '(defcustom defface defgroup))) | |
52 | ||
860af8ec PA |
53 | (defun custom-make-dependencies () |
54 | "Batch function to extract custom dependencies from .el files. | |
efbdca12 | 55 | Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" |
d647b7c4 | 56 | (let ((enable-local-eval nil) |
3191b52f | 57 | (enable-local-variables :safe) |
d647b7c4 | 58 | subdir) |
9b3cd5b4 | 59 | (with-temp-buffer |
d647b7c4 GM |
60 | ;; Use up command-line-args-left else Emacs can try to open |
61 | ;; the args as directories after we are done. | |
62 | (while (setq subdir (pop command-line-args-left)) | |
9b3cd5b4 | 63 | (message "Directory %s" subdir) |
f5ba00a6 | 64 | (let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'")) |
9b3cd5b4 | 65 | (default-directory (expand-file-name subdir)) |
f5ba00a6 GM |
66 | (preloaded (concat "\\`\\(\\./+\\)?" |
67 | (regexp-opt preloaded-file-list t) | |
9b3cd5b4 GM |
68 | "\\.el\\'"))) |
69 | (dolist (file files) | |
70 | (unless (or (string-match custom-dependencies-no-scan-regexp file) | |
f5ba00a6 | 71 | (string-match preloaded (format "%s/%s" subdir file)) |
9b3cd5b4 GM |
72 | (not (file-exists-p file))) |
73 | (erase-buffer) | |
e065ba74 | 74 | (kill-all-local-variables) |
9b3cd5b4 | 75 | (insert-file-contents file) |
e065ba74 | 76 | (hack-local-variables) |
9b3cd5b4 GM |
77 | (goto-char (point-min)) |
78 | (string-match "\\`\\(.*\\)\\.el\\'" file) | |
e065ba74 KR |
79 | (let ((name (or generated-autoload-load-name ; see bug#5277 |
80 | (file-name-nondirectory (match-string 1 file)))) | |
9b3cd5b4 GM |
81 | (load-file-name file)) |
82 | (if (save-excursion | |
83 | (re-search-forward | |
3191b52f | 84 | (concat "(\\(cc-\\)?provide[ \t\n]+\\('\\|(quote[ \t\n]\\)[ \t\n]*" |
5188f2eb SM |
85 | (regexp-quote name) "[ \t\n)]") |
86 | nil t)) | |
9b3cd5b4 GM |
87 | (setq name (intern name))) |
88 | (condition-case nil | |
89 | (while (re-search-forward | |
90 | "^(def\\(custom\\|face\\|group\\)" nil t) | |
91 | (beginning-of-line) | |
82a7c41b GM |
92 | (let ((type (match-string 1)) |
93 | (expr (read (current-buffer)))) | |
9b3cd5b4 GM |
94 | (condition-case nil |
95 | (let ((custom-dont-initialize t)) | |
82a7c41b GM |
96 | ;; Eval to get the 'custom-group, -tag, |
97 | ;; -version, group-documentation etc properties. | |
98 | (put (nth 1 expr) 'custom-where name) | |
99 | (eval expr)) | |
100 | ;; Eval failed for some reason. Eg maybe the | |
101 | ;; defcustom uses something defined earlier | |
102 | ;; in the file (we haven't loaded the file). | |
103 | ;; In most cases, we can still get the :group. | |
104 | (error | |
105 | (ignore-errors | |
106 | (let ((group (cadr (memq :group expr)))) | |
107 | (and group | |
108 | (eq (car group) 'quote) | |
109 | (custom-add-to-group | |
110 | (cadr group) | |
111 | (nth 1 expr) | |
112 | (intern (format "custom-%s" | |
113 | (if (equal type "custom") | |
114 | "variable" | |
115 | type))))))))))) | |
9b3cd5b4 | 116 | (error nil))))))))) |
b1d7940f AS |
117 | (message "Generating %s..." generated-custom-dependencies-file) |
118 | (set-buffer (find-file-noselect generated-custom-dependencies-file)) | |
9b3cd5b4 | 119 | (setq buffer-undo-list t) |
860af8ec | 120 | (erase-buffer) |
9b3cd5b4 | 121 | (insert (autoload-rubric generated-custom-dependencies-file |
60878f2d | 122 | "custom dependencies" t)) |
9b3cd5b4 | 123 | (search-backward "\f") |
521a54c5 GM |
124 | (let (alist) |
125 | (mapatoms (lambda (symbol) | |
126 | (let ((members (get symbol 'custom-group)) | |
127 | where found) | |
128 | (when members | |
129 | (dolist (member (mapcar 'car members)) | |
130 | (setq where (get member 'custom-where)) | |
131 | (unless (or (null where) | |
132 | (member where found)) | |
133 | (push where found))) | |
134 | (when found | |
135 | (push (cons (symbol-name symbol) | |
136 | (with-output-to-string | |
137 | (prin1 (sort found 'string<)))) alist)))))) | |
138 | (dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2))))) | |
139 | (insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n"))) | |
8cd58e14 | 140 | (insert "\ |
521a54c5 GM |
141 | |
142 | ;; The remainder of this file is for handling :version. | |
143 | ;; We provide a minimum of information so that `customize-changed-options' | |
144 | ;; can do its job. | |
e2dc1f61 SM |
145 | |
146 | ;; For groups we set `custom-version', `group-documentation' and | |
147 | ;; `custom-tag' (which are shown in the customize buffer), so we | |
148 | ;; don't have to load the file containing the group. | |
149 | ||
e2dc1f61 SM |
150 | ;; This macro is used so we don't modify the information about |
151 | ;; variables and groups if it's already set. (We don't know when | |
152 | ;; " (file-name-nondirectory generated-custom-dependencies-file) | |
b1d7940f | 153 | " is going to be loaded and at that time some of the |
e2dc1f61 | 154 | ;; files might be loaded and some others might not). |
a313af11 | 155 | \(defmacro custom-put-if-not (symbol propname value) |
1e484d64 DN |
156 | `(unless (get ,symbol ,propname) |
157 | (put ,symbol ,propname ,value))) | |
158 | ||
159 | ") | |
521a54c5 GM |
160 | (let ((version-alist nil) |
161 | groups) | |
1e484d64 DN |
162 | (mapatoms (lambda (symbol) |
163 | (let ((version (get symbol 'custom-version)) | |
164 | where) | |
71296446 | 165 | (when version |
1e484d64 | 166 | (setq where (get symbol 'custom-where)) |
052b7009 | 167 | (when where |
d5680815 MR |
168 | (if (or (custom-variable-p symbol) |
169 | (custom-facep symbol)) | |
170 | ;; This means it's a variable or a face. | |
1e484d64 | 171 | (progn |
1e484d64 | 172 | (if (assoc version version-alist) |
71296446 JB |
173 | (unless |
174 | (member where | |
1e484d64 DN |
175 | (cdr (assoc version version-alist))) |
176 | (push where (cdr (assoc version version-alist)))) | |
526af3b0 | 177 | (push (list version where) version-alist))) |
1e484d64 | 178 | ;; This is a group |
521a54c5 GM |
179 | (push (list (symbol-name symbol) |
180 | (with-output-to-string (prin1 version)) | |
181 | (with-output-to-string | |
182 | (prin1 (get symbol 'group-documentation))) | |
183 | (if (get symbol 'custom-tag) | |
184 | (with-output-to-string | |
185 | (prin1 (get symbol 'custom-tag))))) | |
186 | groups))))))) | |
187 | (dolist (e (sort groups (lambda (e1 e2) (string< (car e1) (car e2))))) | |
188 | (insert "(custom-put-if-not '" (car e) " 'custom-version '" | |
189 | (nth 1 e) ")\n") | |
190 | (insert "(custom-put-if-not '" (car e) " 'group-documentation " | |
191 | (nth 2 e) ")\n") | |
192 | (if (nth 3 e) | |
193 | (insert "(custom-put-if-not '" (car e) " 'custom-tag " | |
194 | (nth 3 e) ")\n"))) | |
1e484d64 DN |
195 | |
196 | (insert "\n(defvar custom-versions-load-alist " | |
197 | (if version-alist "'" "")) | |
521a54c5 GM |
198 | (prin1 (sort version-alist (lambda (e1 e2) (version< (car e1) (car e2)))) |
199 | (current-buffer)) | |
200 | (insert "\n \"For internal use by custom. | |
201 | This is an alist whose members have as car a version string, and as | |
202 | elements the files that have variables or faces that contain that | |
203 | version. These files should be loaded before showing the customization | |
204 | buffer that `customize-changed-options' generates.\")\n\n")) | |
9b3cd5b4 GM |
205 | (save-buffer) |
206 | (message "Generating %s...done" generated-custom-dependencies-file)) | |
860af8ec | 207 | |
6a7ceddc | 208 | \f |
82a7c41b | 209 | (provide 'cus-dep) |
ab5796a9 | 210 | |
860af8ec | 211 | ;;; cus-dep.el ends here |