Merge from origin/emacs-25
[emacs.git] / lisp / cus-dep.el
blobb31c60f98ebeebe0d24ea21046e0b9f28a7ad448
1 ;;; cus-dep.el --- find customization dependencies
2 ;;
3 ;; Copyright (C) 1997, 2001-2016 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: internal
7 ;; Package: emacs
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;;; Code:
28 (require 'widget)
29 (require 'cus-face)
31 (defvar generated-custom-dependencies-file "cus-load.el"
32 "Output file for `custom-make-dependencies'.")
34 ;; See finder-no-scan-regexp in finder.el.
35 (defvar custom-dependencies-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|\
36 ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
37 "Regexp matching file names not to scan for `custom-make-dependencies'.")
39 (require 'autoload)
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)))
53 (defun custom-make-dependencies ()
54 "Batch function to extract custom dependencies from .el files.
55 Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
56 (let ((enable-local-eval nil)
57 (enable-local-variables :safe)
58 subdir)
59 (with-temp-buffer
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))
63 (message "Scanning %s for custom" subdir)
64 (let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'"))
65 (default-directory
66 (file-name-as-directory (expand-file-name subdir)))
67 (preloaded (concat "\\`\\(\\./+\\)?"
68 (regexp-opt preloaded-file-list t)
69 "\\.el\\'")))
70 (dolist (file files)
71 (unless (or (string-match custom-dependencies-no-scan-regexp file)
72 (string-match preloaded (format "%s/%s" subdir file))
73 (not (file-exists-p file)))
74 (erase-buffer)
75 (kill-all-local-variables)
76 (insert-file-contents file)
77 (hack-local-variables)
78 (goto-char (point-min))
79 (string-match "\\`\\(.*\\)\\.el\\'" file)
80 (let ((name (or generated-autoload-load-name ; see bug#5277
81 (file-name-nondirectory (match-string 1 file))))
82 (load-file-name file))
83 (if (save-excursion
84 (re-search-forward
85 (concat "(\\(cc-\\)?provide[ \t\n]+\\('\\|(quote[ \t\n]\\)[ \t\n]*"
86 (regexp-quote name) "[ \t\n)]")
87 nil t))
88 (setq name (intern name)))
89 (condition-case nil
90 (while (re-search-forward
91 "^(def\\(custom\\|face\\|group\\)" nil t)
92 (beginning-of-line)
93 (let ((type (match-string 1))
94 (expr (read (current-buffer))))
95 (condition-case nil
96 (let ((custom-dont-initialize t))
97 ;; Eval to get the 'custom-group, -tag,
98 ;; -version, group-documentation etc properties.
99 (put (nth 1 expr) 'custom-where name)
100 (eval expr))
101 ;; Eval failed for some reason. Eg maybe the
102 ;; defcustom uses something defined earlier
103 ;; in the file (we haven't loaded the file).
104 ;; In most cases, we can still get the :group.
105 (error
106 (ignore-errors
107 (let ((group (cadr (memq :group expr))))
108 (and group
109 (eq (car group) 'quote)
110 (custom-add-to-group
111 (cadr group)
112 (nth 1 expr)
113 (intern (format "custom-%s"
114 (if (equal type "custom")
115 "variable"
116 type)))))))))))
117 (error nil)))))))))
118 (message "Generating %s..." generated-custom-dependencies-file)
119 (set-buffer (find-file-noselect generated-custom-dependencies-file))
120 (setq buffer-undo-list t)
121 (erase-buffer)
122 (insert (autoload-rubric generated-custom-dependencies-file
123 "custom dependencies" t))
124 (search-backward "\f")
125 (let (alist)
126 (mapatoms (lambda (symbol)
127 (let ((members (get symbol 'custom-group))
128 where found)
129 (when members
130 (dolist (member (mapcar 'car members))
131 (setq where (get member 'custom-where))
132 (unless (or (null where)
133 (member where found))
134 (push where found)))
135 (when found
136 (push (cons (symbol-name symbol)
137 (with-output-to-string
138 (prin1 (sort found 'string<)))) alist))))))
139 (dolist (e (sort alist (lambda (e1 e2) (string< (car e1) (car e2)))))
140 (insert "(put '" (car e) " 'custom-loads '" (cdr e) ")\n")))
141 (insert "\
143 ;; The remainder of this file is for handling :version.
144 ;; We provide a minimum of information so that `customize-changed-options'
145 ;; can do its job.
147 ;; For groups we set `custom-version', `group-documentation' and
148 ;; `custom-tag' (which are shown in the customize buffer), so we
149 ;; don't have to load the file containing the group.
151 ;; This macro is used so we don't modify the information about
152 ;; variables and groups if it's already set. (We don't know when
153 ;; " (file-name-nondirectory generated-custom-dependencies-file)
154 " is going to be loaded and at that time some of the
155 ;; files might be loaded and some others might not).
156 \(defmacro custom-put-if-not (symbol propname value)
157 `(unless (get ,symbol ,propname)
158 (put ,symbol ,propname ,value)))
161 (let ((version-alist nil)
162 groups)
163 (mapatoms (lambda (symbol)
164 (let ((version (get symbol 'custom-version))
165 where)
166 (when version
167 (setq where (get symbol 'custom-where))
168 (when where
169 (if (or (custom-variable-p symbol)
170 (custom-facep symbol))
171 ;; This means it's a variable or a face.
172 (progn
173 (if (assoc version version-alist)
174 (unless
175 (member where
176 (cdr (assoc version version-alist)))
177 (push where (cdr (assoc version version-alist))))
178 (push (list version where) version-alist)))
179 ;; This is a group
180 (push (list (symbol-name symbol)
181 (with-output-to-string (prin1 version))
182 (with-output-to-string
183 (prin1 (get symbol 'group-documentation)))
184 (if (get symbol 'custom-tag)
185 (with-output-to-string
186 (prin1 (get symbol 'custom-tag)))))
187 groups)))))))
188 (dolist (e (sort groups (lambda (e1 e2) (string< (car e1) (car e2)))))
189 (insert "(custom-put-if-not '" (car e) " 'custom-version '"
190 (nth 1 e) ")\n")
191 (insert "(custom-put-if-not '" (car e) " 'group-documentation "
192 (nth 2 e) ")\n")
193 (if (nth 3 e)
194 (insert "(custom-put-if-not '" (car e) " 'custom-tag "
195 (nth 3 e) ")\n")))
197 (insert "\n(defvar custom-versions-load-alist "
198 (if version-alist "'" ""))
199 (prin1 (sort version-alist (lambda (e1 e2) (version< (car e1) (car e2))))
200 (current-buffer))
201 (insert "\n \"For internal use by custom.
202 This is an alist whose members have as car a version string, and as
203 elements the files that have variables or faces that contain that
204 version. These files should be loaded before showing the customization
205 buffer that `customize-changed-options' generates.\")\n\n"))
206 (save-buffer)
207 (message "Generating %s...done" generated-custom-dependencies-file))
210 (provide 'cus-dep)
212 ;;; cus-dep.el ends here