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