| 1 | ;;; cus-dep.el --- find customization dependencies |
| 2 | ;; |
| 3 | ;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc. |
| 4 | ;; |
| 5 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
| 6 | ;; Keywords: internal |
| 7 | ;; Package: emacs |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 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. |
| 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 |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;;; Code: |
| 27 | |
| 28 | (eval-when-compile (require 'cl)) |
| 29 | (require 'widget) |
| 30 | (require 'cus-face) |
| 31 | |
| 32 | (defvar generated-custom-dependencies-file "cus-load.el" |
| 33 | "Output file for `custom-make-dependencies'.") |
| 34 | |
| 35 | ;; See finder-no-scan-regexp in finder.el. |
| 36 | (defvar custom-dependencies-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|\ |
| 37 | ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)" |
| 38 | "Regexp matching file names not to scan for `custom-make-dependencies'.") |
| 39 | |
| 40 | (autoload 'autoload-rubric "autoload") |
| 41 | |
| 42 | (defun custom-make-dependencies () |
| 43 | "Batch function to extract custom dependencies from .el files. |
| 44 | Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" |
| 45 | (let ((enable-local-eval nil)) |
| 46 | (with-temp-buffer |
| 47 | (dolist (subdir command-line-args-left) |
| 48 | (message "Directory %s" subdir) |
| 49 | (let ((files (directory-files subdir nil "\\`[^=].*\\.el\\'")) |
| 50 | (default-directory (expand-file-name subdir)) |
| 51 | (preloaded (concat "\\`" |
| 52 | (regexp-opt (mapcar |
| 53 | (lambda (f) |
| 54 | (file-name-sans-extension |
| 55 | (file-name-nondirectory f))) |
| 56 | preloaded-file-list) t) |
| 57 | "\\.el\\'"))) |
| 58 | (dolist (file files) |
| 59 | (unless (or (string-match custom-dependencies-no-scan-regexp file) |
| 60 | (string-match preloaded file) |
| 61 | (not (file-exists-p file))) |
| 62 | (erase-buffer) |
| 63 | (insert-file-contents file) |
| 64 | (goto-char (point-min)) |
| 65 | (string-match "\\`\\(.*\\)\\.el\\'" file) |
| 66 | (let ((name (file-name-nondirectory (match-string 1 file))) |
| 67 | (load-file-name file)) |
| 68 | (if (save-excursion |
| 69 | (re-search-forward |
| 70 | (concat "(provide[ \t\n]+\\('\\|(quote[ \t\n]\\)[ \t\n]*" |
| 71 | (regexp-quote name) "[ \t\n)]") |
| 72 | nil t)) |
| 73 | (setq name (intern name))) |
| 74 | (condition-case nil |
| 75 | (while (re-search-forward |
| 76 | "^(def\\(custom\\|face\\|group\\)" nil t) |
| 77 | (beginning-of-line) |
| 78 | (let ((expr (read (current-buffer)))) |
| 79 | (condition-case nil |
| 80 | (let ((custom-dont-initialize t)) |
| 81 | (eval expr) |
| 82 | (put (nth 1 expr) 'custom-where name)) |
| 83 | (error nil)))) |
| 84 | (error nil))))))))) |
| 85 | (message "Generating %s..." generated-custom-dependencies-file) |
| 86 | (set-buffer (find-file-noselect generated-custom-dependencies-file)) |
| 87 | (setq buffer-undo-list t) |
| 88 | (erase-buffer) |
| 89 | (insert (autoload-rubric generated-custom-dependencies-file |
| 90 | "custom dependencies" t)) |
| 91 | (search-backward "\f") |
| 92 | (mapatoms (lambda (symbol) |
| 93 | (let ((members (get symbol 'custom-group)) |
| 94 | where found) |
| 95 | (when members |
| 96 | (dolist (member |
| 97 | ;; So x and no-x builds won't differ. |
| 98 | (sort (mapcar 'car members) 'string<)) |
| 99 | (setq where (get member 'custom-where)) |
| 100 | (unless (or (null where) |
| 101 | (member where found)) |
| 102 | (push where found))) |
| 103 | (when found |
| 104 | (insert "(put '" (symbol-name symbol) |
| 105 | " 'custom-loads '") |
| 106 | (prin1 (nreverse found) (current-buffer)) |
| 107 | (insert ")\n")))))) |
| 108 | (insert "\ |
| 109 | ;; These are for handling :version. We need to have a minimum of |
| 110 | ;; information so `customize-changed-options' could do its job. |
| 111 | |
| 112 | ;; For groups we set `custom-version', `group-documentation' and |
| 113 | ;; `custom-tag' (which are shown in the customize buffer), so we |
| 114 | ;; don't have to load the file containing the group. |
| 115 | |
| 116 | ;; `custom-versions-load-alist' is an alist that has as car a version |
| 117 | ;; number and as elts the files that have variables or faces that |
| 118 | ;; contain that version. These files should be loaded before showing |
| 119 | ;; the customization buffer that `customize-changed-options' |
| 120 | ;; generates. |
| 121 | |
| 122 | ;; This macro is used so we don't modify the information about |
| 123 | ;; variables and groups if it's already set. (We don't know when |
| 124 | ;; " (file-name-nondirectory generated-custom-dependencies-file) |
| 125 | " is going to be loaded and at that time some of the |
| 126 | ;; files might be loaded and some others might not). |
| 127 | \(defmacro custom-put-if-not (symbol propname value) |
| 128 | `(unless (get ,symbol ,propname) |
| 129 | (put ,symbol ,propname ,value))) |
| 130 | |
| 131 | ") |
| 132 | (let ((version-alist nil)) |
| 133 | (mapatoms (lambda (symbol) |
| 134 | (let ((version (get symbol 'custom-version)) |
| 135 | where) |
| 136 | (when version |
| 137 | (setq where (get symbol 'custom-where)) |
| 138 | (when where |
| 139 | (if (or (custom-variable-p symbol) |
| 140 | (custom-facep symbol)) |
| 141 | ;; This means it's a variable or a face. |
| 142 | (progn |
| 143 | (if (assoc version version-alist) |
| 144 | (unless |
| 145 | (member where |
| 146 | (cdr (assoc version version-alist))) |
| 147 | (push where (cdr (assoc version version-alist)))) |
| 148 | (push (list version where) version-alist))) |
| 149 | ;; This is a group |
| 150 | (insert "(custom-put-if-not '" (symbol-name symbol) |
| 151 | " 'custom-version ") |
| 152 | (prin1 version (current-buffer)) |
| 153 | (insert ")\n") |
| 154 | (insert "(custom-put-if-not '" (symbol-name symbol)) |
| 155 | (insert " 'group-documentation ") |
| 156 | (prin1 (get symbol 'group-documentation) (current-buffer)) |
| 157 | (insert ")\n") |
| 158 | (when (get symbol 'custom-tag) |
| 159 | (insert "(custom-put-if-not '" (symbol-name symbol)) |
| 160 | (insert " 'custom-tag ") |
| 161 | (prin1 (get symbol 'custom-tag) (current-buffer)) |
| 162 | (insert ")\n")) |
| 163 | )))))) |
| 164 | |
| 165 | (insert "\n(defvar custom-versions-load-alist " |
| 166 | (if version-alist "'" "")) |
| 167 | (prin1 version-alist (current-buffer)) |
| 168 | (insert "\n \"For internal use by custom.\")\n")) |
| 169 | (save-buffer) |
| 170 | (message "Generating %s...done" generated-custom-dependencies-file)) |
| 171 | |
| 172 | \f |
| 173 | |
| 174 | ;;; cus-dep.el ends here |