;;; cus-dep.el --- Find customization dependencies. ;; ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 2003 Ben Wing. ;; ;; Author: Per Abrahamsen , then ;; Richard Stallman , then ;; Hrvoje Niksic (rewritten for XEmacs) ;; Maintainer: Hrvoje Niksic ;; Keywords: internal ;; This file is part of SXEmacs. ;; SXEmacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; SXEmacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Synched up with: Not synched with FSF. ;;; Commentary: ;; This file generates the custom-load files, loaded by cus-load.el. ;; Entry points are `Custom-make-dependencies' and ;; `Custom-make-one-dependency'. ;; It works by scanning all the `.el' files in a directory, and ;; evaluates any `defcustom', `defgroup', or `defface' expression that ;; it finds. The symbol changed by this expression is stored to a ;; hash table as the hash key, file name being the value. ;; After all the files have been examined, custom-loads.el is ;; generated by mapping all the atoms, and seeing if any of them ;; contains a `custom-group' property. This property is a list whose ;; each element's car is the "child" group symbol. If that property ;; is in the hash-table, the file name will be looked up from the ;; hash-table, and added to cusload-file. Because the hash-table is ;; cleared whenever we process a new directory, we cannot get confused ;; by custom-loads from another directory, or from a previous ;; installation. This is also why it is perfectly safe to have old ;; custom-loads around, and have them loaded by `cus-load.el' (as ;; invoked by `cus-edit.el'). ;; A trivial, but useful optimization is that if cusload-file exists, ;; and no .el files in the directory are newer than cusload-file, it ;; will not be generated. This means that the directories where ;; nothing has changed will be skipped. ;; The `custom-add-loads' function, used by files generated by ;; `Custom-make-dependencies', updates the symbol's `custom-loads' ;; property (a list of strings) with a new list of strings, ;; eliminating the duplicates. Additionally, it adds the symbol to ;; `custom-group-hash-table'. It is defined in `cus-load.el'. ;; Example: ;; (custom-add-loads 'foo 'custom-loads '("bar" "baz")) ;; (get 'foo 'custom-loads) ;; => ("bar" "baz") ;; ;; (custom-add-loads 'foo 'custom-loads '("hmph" "baz" "quz")) ;; (get 'foo 'custom-loads) ;; => ("bar" "baz" "hmph" "qux") ;; Obviously, this allows correct incremental loading of custom-load ;; files. This is not necessary under FSF (they simply use `put'), ;; since they have only one file with custom dependencies. With the ;; advent of packages, we cannot afford the same luxury. ;; ;; Feb 2003: Added code to speed up building by caching the values we've ;; constructed, and using them instead of scanning a file when custom-load ;; is up-to-date w.r.t. the file. Also use `message' not `princ' to print ;; out messages so nl's are correctly inserted when necessary. --ben ;;; Code: (require 'cl) (require 'widget) (require 'cus-face) ;; #### This and the autoloads file naming variables belong in a separate ;; file to be required here. ;; #### Compare this with the autoloads handling. ;; Don't change this, unless you plan to change the code in ;; cus-start.el, too. (defconst cusload-base-file "custom-load.el") (defconst cusload-hash-table-marker ";old-cus-dep-hash: ") ;; Be very careful when changing this function. It looks easy to ;; understand, but is in fact very easy to break. Be sure to read and ;; understand the commentary above! (defun Custom-make-dependencies-1 (subdirs &optional outfile) (setq subdirs (mapcar #'expand-file-name subdirs)) (with-temp-buffer (let ((enable-local-eval nil) (hash (make-hash-table :test 'eq)) (hash-cache (make-hash-table :test 'equal)) old-hash) (dolist (dir subdirs) (message "Processing %s\n" dir) (let ((cusload-file (or outfile (expand-file-name cusload-base-file dir))) (files (directory-files dir t #r"\`[^=].*\.el\'"))) ;; A trivial optimization: if no file in the directory is ;; newer than custom-load.el, no need to do anything! (if (and (file-exists-p cusload-file) (dolist (file files t) (when (file-newer-than-file-p file cusload-file) (return nil)))) (message "(No changes need to be written)") (when (file-exists-p cusload-file) (let ((buf (find-file-noselect cusload-file))) (with-current-buffer buf (goto-char (point-min)) (when (search-forward cusload-hash-table-marker nil t) (setq old-hash (read buf)))) (kill-buffer buf))) ;; Process directory (dolist (file files) (let ((old-cache (if (hash-table-p old-hash) (gethash file old-hash t) t))) (if (and (not (file-newer-than-file-p file cusload-file)) (not (eq old-cache t))) (progn (dolist (c old-cache) (puthash (car c) (cdr c) hash)) (puthash file old-cache hash-cache)) (erase-buffer) (insert-file-contents file) (goto-char (point-min)) (let ((name (file-name-sans-extension (file-name-nondirectory file))) cache (first t)) ;; Search for defcustom/defface/defgroup ;; expressions, and evaluate them. (while (re-search-forward #r"^(defcustom\|^(defface\|^(defgroup" nil t) (when first (message "Computing custom-loads for %s..." name) (setq first nil)) (beginning-of-line) (let ((expr (read (current-buffer)))) ;; We need to ignore errors here, so that ;; defcustoms with :set don't bug out. Of ;; course, their values will not be assigned in ;; case of errors, but their `custom-group' ;; properties will by that time be in place, and ;; that's all we care about. (ignore-errors (eval expr)) ;; Hash the file of the affected symbol. (setf (gethash (nth 1 expr) hash) name) ;; Remember the values computed. (push (cons (nth 1 expr) name) cache))) (or cache (message "No custom-loads for %s" name)) (puthash file cache hash-cache))) )) (cond ((zerop (hash-table-count hash)) (message "(No customization dependencies)") (write-region "" nil cusload-file)) (t (message "Generating %s...\n" cusload-base-file) (with-temp-file cusload-file (insert ";;; " cusload-base-file " --- automatically extracted custom dependencies\n" "\n;;; Code:\n\n") (insert cusload-hash-table-marker) (let ((print-readably t) (standard-output (current-buffer))) (princ hash-cache) (terpri)) (insert "(autoload 'custom-add-loads \"cus-load\")\n\n") (mapatoms (lambda (sym) (let ((members (get sym 'custom-group)) item where found) (when members (while members (setq item (car (car members)) members (cdr members) where (gethash item hash)) (unless (or (null where) (member where found)) (if found (insert " ") (insert "(custom-add-loads '" (prin1-to-string sym) " '(")) (prin1 where (current-buffer)) (push where found))) (when found (insert "))\n")))))) (insert "\n;;; custom-load.el ends here\n")) (clrhash hash))))))))) (defun Custom-make-one-dependency () "Extract custom dependencies from .el files in one dir, on the command line. Like `Custom-make-dependencies' but snarfs only one command-line argument, making it useful in a chain of batch commands in a single XEmacs invocation." (let ((subdir (car command-line-args-left))) (setq command-line-args-left (cdr command-line-args-left)) (Custom-make-dependencies-1 (list subdir)))) ;;;###autoload (defun Custom-make-dependencies (&optional subdirs outfile) "Extract custom dependencies from .el files in SUBDIRS. SUBDIRS is a list of directories. If it is nil, the command-line arguments are used. If it is a string, only that directory is processed. OUTFILE is for optionally setting where to put the output. This is most often used when building outside of a source tree and you want the custom-loads.el to be in the build tree. Be sure to call #'expand-file-name on OUTFILE to be safe. This function is especially useful in batch mode. Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS" (interactive "DDirectory: ") (and (stringp subdirs) (setq subdirs (list subdirs))) (or subdirs ;; Usurp the command-line-args (setq subdirs command-line-args-left command-line-args-left nil)) (Custom-make-dependencies-1 subdirs outfile)) (provide 'cus-dep) ;;; cus-dep.el ends here