428
+ − 1 ;;; cus-dep.el --- Find customization dependencies.
+ − 2 ;;
+ − 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
1298
+ − 4 ;; Copyright (C) 2003 Ben Wing.
428
+ − 5 ;;
+ − 6 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>, then
+ − 7 ;; Richard Stallman <rms@gnu.ai.mit.edu>, then
+ − 8 ;; Hrvoje Niksic <hniksic@xemacs.org> (rewritten for XEmacs)
+ − 9 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
+ − 10 ;; Keywords: internal
+ − 11
+ − 12 ;; This file is part of XEmacs.
+ − 13
+ − 14 ;; XEmacs is free software; you can redistribute it and/or modify
+ − 15 ;; it under the terms of the GNU General Public License as published by
+ − 16 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 17 ;; any later version.
+ − 18
+ − 19 ;; XEmacs is distributed in the hope that it will be useful,
+ − 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ − 22 ;; GNU General Public License for more details.
+ − 23
+ − 24 ;; You should have received a copy of the GNU General Public License
+ − 25 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ − 27 ;; Boston, MA 02111-1307, USA.
+ − 28
+ − 29 ;;; Synched up with: Not synched with FSF.
+ − 30
+ − 31
+ − 32 ;;; Commentary:
+ − 33
+ − 34 ;; This file generates the custom-load files, loaded by cus-load.el.
442
+ − 35 ;; Entry points are `Custom-make-dependencies' and
+ − 36 ;; `Custom-make-one-dependency'.
428
+ − 37
+ − 38 ;; It works by scanning all the `.el' files in a directory, and
+ − 39 ;; evaluates any `defcustom', `defgroup', or `defface' expression that
+ − 40 ;; it finds. The symbol changed by this expression is stored to a
+ − 41 ;; hash table as the hash key, file name being the value.
+ − 42
+ − 43 ;; After all the files have been examined, custom-loads.el is
+ − 44 ;; generated by mapping all the atoms, and seeing if any of them
+ − 45 ;; contains a `custom-group' property. This property is a list whose
+ − 46 ;; each element's car is the "child" group symbol. If that property
+ − 47 ;; is in the hash-table, the file name will be looked up from the
+ − 48 ;; hash-table, and added to cusload-file. Because the hash-table is
+ − 49 ;; cleared whenever we process a new directory, we cannot get confused
+ − 50 ;; by custom-loads from another directory, or from a previous
+ − 51 ;; installation. This is also why it is perfectly safe to have old
+ − 52 ;; custom-loads around, and have them loaded by `cus-load.el' (as
+ − 53 ;; invoked by `cus-edit.el').
+ − 54
+ − 55 ;; A trivial, but useful optimization is that if cusload-file exists,
+ − 56 ;; and no .el files in the directory are newer than cusload-file, it
+ − 57 ;; will not be generated. This means that the directories where
+ − 58 ;; nothing has changed will be skipped.
+ − 59
+ − 60 ;; The `custom-add-loads' function, used by files generated by
+ − 61 ;; `Custom-make-dependencies', updates the symbol's `custom-loads'
+ − 62 ;; property (a list of strings) with a new list of strings,
+ − 63 ;; eliminating the duplicates. Additionally, it adds the symbol to
+ − 64 ;; `custom-group-hash-table'. It is defined in `cus-load.el'.
+ − 65
+ − 66 ;; Example:
+ − 67
+ − 68 ;; (custom-add-loads 'foo 'custom-loads '("bar" "baz"))
+ − 69 ;; (get 'foo 'custom-loads)
+ − 70 ;; => ("bar" "baz")
+ − 71 ;;
+ − 72 ;; (custom-add-loads 'foo 'custom-loads '("hmph" "baz" "quz"))
+ − 73 ;; (get 'foo 'custom-loads)
+ − 74 ;; => ("bar" "baz" "hmph" "qux")
+ − 75
+ − 76 ;; Obviously, this allows correct incremental loading of custom-load
+ − 77 ;; files. This is not necessary under FSF (they simply use `put'),
+ − 78 ;; since they have only one file with custom dependencies. With the
+ − 79 ;; advent of packages, we cannot afford the same luxury.
1298
+ − 80 ;;
+ − 81 ;; Feb 2003: Added code to speed up building by caching the values we've
+ − 82 ;; constructed, and using them instead of scanning a file when custom-load
+ − 83 ;; is up-to-date w.r.t. the file. Also use `message' not `princ' to print
+ − 84 ;; out messages so nl's are correctly inserted when necessary. --ben
428
+ − 85
+ − 86
+ − 87 ;;; Code:
+ − 88
+ − 89 (require 'cl)
+ − 90 (require 'widget)
+ − 91 (require 'cus-face)
+ − 92
1244
+ − 93 ;; #### This and the autoloads file naming variables belong in a separate
+ − 94 ;; file to be required here.
+ − 95 ;; #### Compare this with the autoloads handling.
428
+ − 96 ;; Don't change this, unless you plan to change the code in
+ − 97 ;; cus-start.el, too.
+ − 98 (defconst cusload-base-file "custom-load.el")
1298
+ − 99 (defconst cusload-hash-table-marker ";old-cus-dep-hash: ")
428
+ − 100
+ − 101 ;; Be very careful when changing this function. It looks easy to
+ − 102 ;; understand, but is in fact very easy to break. Be sure to read and
+ − 103 ;; understand the commentary above!
+ − 104
442
+ − 105 (defun Custom-make-dependencies-1 (subdirs)
428
+ − 106 (setq subdirs (mapcar #'expand-file-name subdirs))
+ − 107 (with-temp-buffer
+ − 108 (let ((enable-local-eval nil)
1298
+ − 109 (hash (make-hash-table :test 'eq))
+ − 110 (hash-cache (make-hash-table :test 'equal))
+ − 111 old-hash)
428
+ − 112 (dolist (dir subdirs)
1298
+ − 113 (message "Processing %s\n" dir)
428
+ − 114 (let ((cusload-file (expand-file-name cusload-base-file dir))
+ − 115 (files (directory-files dir t "\\`[^=].*\\.el\\'")))
+ − 116 ;; A trivial optimization: if no file in the directory is
+ − 117 ;; newer than custom-load.el, no need to do anything!
+ − 118 (if (and (file-exists-p cusload-file)
+ − 119 (dolist (file files t)
+ − 120 (when (file-newer-than-file-p file cusload-file)
+ − 121 (return nil))))
1298
+ − 122 (message "(No changes need to be written)")
+ − 123 (when (file-exists-p cusload-file)
+ − 124 (let ((buf (find-file-noselect cusload-file)))
+ − 125 (with-current-buffer buf
+ − 126 (goto-char (point-min))
+ − 127 (when (search-forward cusload-hash-table-marker nil t)
+ − 128 (setq old-hash (read buf))))
+ − 129 (kill-buffer buf)))
428
+ − 130 ;; Process directory
+ − 131 (dolist (file files)
1298
+ − 132 (let ((old-cache (if (hash-table-p old-hash)
+ − 133 (gethash file old-hash t)
+ − 134 t)))
+ − 135 (if (and (not (file-newer-than-file-p file cusload-file))
+ − 136 (not (eq old-cache t)))
+ − 137 (progn
+ − 138 (dolist (c old-cache)
+ − 139 (puthash (car c) (cdr c) hash))
+ − 140 (puthash file old-cache hash-cache))
+ − 141 (erase-buffer)
+ − 142 (insert-file-contents file)
+ − 143 (goto-char (point-min))
+ − 144 (let ((name (file-name-sans-extension
+ − 145 (file-name-nondirectory file)))
+ − 146 cache
+ − 147 (first t))
+ − 148 ;; Search for defcustom/defface/defgroup
+ − 149 ;; expressions, and evaluate them.
+ − 150 (while (re-search-forward
+ − 151 "^(defcustom\\|^(defface\\|^(defgroup"
+ − 152 nil t)
+ − 153 (when first
+ − 154 (message "Computing custom-loads for %s..." name)
+ − 155 (setq first nil))
+ − 156 (beginning-of-line)
+ − 157 (let ((expr (read (current-buffer))))
+ − 158 ;; We need to ignore errors here, so that
+ − 159 ;; defcustoms with :set don't bug out. Of
+ − 160 ;; course, their values will not be assigned in
+ − 161 ;; case of errors, but their `custom-group'
+ − 162 ;; properties will by that time be in place, and
+ − 163 ;; that's all we care about.
+ − 164 (ignore-errors
+ − 165 (eval expr))
+ − 166 ;; Hash the file of the affected symbol.
+ − 167 (setf (gethash (nth 1 expr) hash) name)
+ − 168 ;; Remember the values computed.
+ − 169 (push (cons (nth 1 expr) name) cache)))
+ − 170 (or cache
+ − 171 (message "No custom-loads for %s" name))
+ − 172 (puthash file cache hash-cache)))
+ − 173 ))
428
+ − 174 (cond
+ − 175 ((zerop (hash-table-count hash))
2544
+ − 176 (message "(No customization dependencies)")
+ − 177 (write-region "" nil cusload-file))
428
+ − 178 (t
1298
+ − 179 (message "Generating %s...\n" cusload-base-file)
428
+ − 180 (with-temp-file cusload-file
+ − 181 (insert ";;; " cusload-base-file
+ − 182 " --- automatically extracted custom dependencies\n"
1298
+ − 183 "\n;;; Code:\n\n")
+ − 184 (insert cusload-hash-table-marker)
+ − 185 (let ((print-readably t)
+ − 186 (standard-output (current-buffer)))
+ − 187 (princ hash-cache)
+ − 188 (terpri))
+ − 189 (insert "(autoload 'custom-add-loads \"cus-load\")\n\n")
428
+ − 190 (mapatoms
+ − 191 (lambda (sym)
+ − 192 (let ((members (get sym 'custom-group))
+ − 193 item where found)
+ − 194 (when members
+ − 195 (while members
+ − 196 (setq item (car (car members))
+ − 197 members (cdr members)
+ − 198 where (gethash item hash))
+ − 199 (unless (or (null where)
+ − 200 (member where found))
+ − 201 (if found
+ − 202 (insert " ")
+ − 203 (insert "(custom-add-loads '"
+ − 204 (prin1-to-string sym) " '("))
+ − 205 (prin1 where (current-buffer))
+ − 206 (push where found)))
+ − 207 (when found
+ − 208 (insert "))\n"))))))
+ − 209 (insert "\n;;; custom-load.el ends here\n"))
+ − 210 (clrhash hash)))))))))
+ − 211
442
+ − 212 (defun Custom-make-one-dependency ()
+ − 213 "Extract custom dependencies from .el files in one dir, on the command line.
+ − 214 Like `Custom-make-dependencies' but snarfs only one command-line argument,
+ − 215 making it useful in a chain of batch commands in a single XEmacs invocation."
+ − 216 (let ((subdir (car command-line-args-left)))
+ − 217 (setq command-line-args-left (cdr command-line-args-left))
+ − 218 (Custom-make-dependencies-1 (list subdir))))
+ − 219
+ − 220 ;;;###autoload
+ − 221 (defun Custom-make-dependencies (&optional subdirs)
+ − 222 "Extract custom dependencies from .el files in SUBDIRS.
+ − 223 SUBDIRS is a list of directories. If it is nil, the command-line
+ − 224 arguments are used. If it is a string, only that directory is
+ − 225 processed. This function is especially useful in batch mode.
+ − 226
+ − 227 Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS"
+ − 228 (interactive "DDirectory: ")
+ − 229 (and (stringp subdirs)
+ − 230 (setq subdirs (list subdirs)))
+ − 231 (or subdirs
+ − 232 ;; Usurp the command-line-args
+ − 233 (setq subdirs command-line-args-left
+ − 234 command-line-args-left nil))
+ − 235 (Custom-make-dependencies-1 subdirs))
+ − 236
428
+ − 237 (provide 'cus-dep)
+ − 238
+ − 239 ;;; cus-dep.el ends here
