comparison lisp/cus-dep.el @ 1298:1b4bc72f433e

[xemacs-hg @ 2003-02-14 12:05:06 by ben] speedups to build process autoload.el: Factor out common code in generate-{c-,}file-autoloads-1 into new function generate-autoload-ish-1. \(I was originally going to use this for custom as well but ended up thinking better of it.) cus-dep.el: Cache the old computed values in custom-load.el and reuse them as necessary, to speed up running cus-dep (which would take 25-30 seconds to do all files in lisp/*, lisp/*/* on my Pentium III 700). Use `message' not `princ' to get correct newline behavior. Output messages showing each file we do actually process. update-elc-2.el: Rewrite algorithm to be much faster -- cache calls to directory-files and don't make needless calls to file-exists-p, file-directory-p because they're way way slow. Autoload early and only when update-elc has told us to. update-elc.el: If no files need byte compilation, signal to update-elc-2 to do any necessary autoload updating (using the file REBUILD_AUTOLOADS) rather than doing it ourselves, which would be way slow. Ignore updates to custom-load.el and auto-autoloads.el when checking to see whether autoloads need updating. Optimize out many unnecessary calls to file-exists-p to speed it up somewhat. (#### The remaining time is 50% or more in locate-file; this is presumably because, even though it has a cache, it's still statting each file to determine it's actually there. By calling directory-files ourselves, building a tree, and then looking in that tree, we could drastically shorten the time needed to do the locate operation.)
author ben
date Fri, 14 Feb 2003 12:05:07 +0000
parents 78c3f60ba757
children b4a8cd0dd8df
comparison
equal deleted inserted replaced
1297:6c21360a544b 1298:1b4bc72f433e
1 ;;; cus-dep.el --- Find customization dependencies. 1 ;;; cus-dep.el --- Find customization dependencies.
2 ;; 2 ;;
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 2003 Ben Wing.
4 ;; 5 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>, then 6 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>, then
6 ;; Richard Stallman <rms@gnu.ai.mit.edu>, then 7 ;; Richard Stallman <rms@gnu.ai.mit.edu>, then
7 ;; Hrvoje Niksic <hniksic@xemacs.org> (rewritten for XEmacs) 8 ;; Hrvoje Niksic <hniksic@xemacs.org> (rewritten for XEmacs)
8 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> 9 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
74 75
75 ;; Obviously, this allows correct incremental loading of custom-load 76 ;; Obviously, this allows correct incremental loading of custom-load
76 ;; files. This is not necessary under FSF (they simply use `put'), 77 ;; files. This is not necessary under FSF (they simply use `put'),
77 ;; since they have only one file with custom dependencies. With the 78 ;; since they have only one file with custom dependencies. With the
78 ;; advent of packages, we cannot afford the same luxury. 79 ;; advent of packages, we cannot afford the same luxury.
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
79 85
80 86
81 ;;; Code: 87 ;;; Code:
82 88
83 (require 'cl) 89 (require 'cl)
88 ;; file to be required here. 94 ;; file to be required here.
89 ;; #### Compare this with the autoloads handling. 95 ;; #### Compare this with the autoloads handling.
90 ;; Don't change this, unless you plan to change the code in 96 ;; Don't change this, unless you plan to change the code in
91 ;; cus-start.el, too. 97 ;; cus-start.el, too.
92 (defconst cusload-base-file "custom-load.el") 98 (defconst cusload-base-file "custom-load.el")
99 (defconst cusload-hash-table-marker ";old-cus-dep-hash: ")
93 100
94 ;; Be very careful when changing this function. It looks easy to 101 ;; Be very careful when changing this function. It looks easy to
95 ;; understand, but is in fact very easy to break. Be sure to read and 102 ;; understand, but is in fact very easy to break. Be sure to read and
96 ;; understand the commentary above! 103 ;; understand the commentary above!
97 104
98 (defun Custom-make-dependencies-1 (subdirs) 105 (defun Custom-make-dependencies-1 (subdirs)
99 (setq subdirs (mapcar #'expand-file-name subdirs)) 106 (setq subdirs (mapcar #'expand-file-name subdirs))
100 (with-temp-buffer 107 (with-temp-buffer
101 (let ((enable-local-eval nil) 108 (let ((enable-local-eval nil)
102 (hash (make-hash-table :test 'eq))) 109 (hash (make-hash-table :test 'eq))
110 (hash-cache (make-hash-table :test 'equal))
111 old-hash)
103 (dolist (dir subdirs) 112 (dolist (dir subdirs)
104 (princ (format "Processing %s\n" dir)) 113 (message "Processing %s\n" dir)
105 (let ((cusload-file (expand-file-name cusload-base-file dir)) 114 (let ((cusload-file (expand-file-name cusload-base-file dir))
106 (files (directory-files dir t "\\`[^=].*\\.el\\'"))) 115 (files (directory-files dir t "\\`[^=].*\\.el\\'")))
107 ;; A trivial optimization: if no file in the directory is 116 ;; A trivial optimization: if no file in the directory is
108 ;; newer than custom-load.el, no need to do anything! 117 ;; newer than custom-load.el, no need to do anything!
109 (if (and (file-exists-p cusload-file) 118 (if (and (file-exists-p cusload-file)
110 (dolist (file files t) 119 (dolist (file files t)
111 (when (file-newer-than-file-p file cusload-file) 120 (when (file-newer-than-file-p file cusload-file)
112 (return nil)))) 121 (return nil))))
113 (princ "(No changes need to be written)\n") 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)))
114 ;; Process directory 130 ;; Process directory
115 (dolist (file files) 131 (dolist (file files)
116 (when (file-exists-p file) 132 (let ((old-cache (if (hash-table-p old-hash)
117 (erase-buffer) 133 (gethash file old-hash t)
118 (insert-file-contents file) 134 t)))
119 (goto-char (point-min)) 135 (if (and (not (file-newer-than-file-p file cusload-file))
120 (let ((name (file-name-sans-extension 136 (not (eq old-cache t)))
121 (file-name-nondirectory file)))) 137 (progn
122 ;; Search for defcustom/defface/defgroup 138 (dolist (c old-cache)
123 ;; expressions, and evaluate them. 139 (puthash (car c) (cdr c) hash))
124 (while (re-search-forward 140 (puthash file old-cache hash-cache))
125 "^(defcustom\\|^(defface\\|^(defgroup" 141 (erase-buffer)
126 nil t) 142 (insert-file-contents file)
127 (beginning-of-line) 143 (goto-char (point-min))
128 (let ((expr (read (current-buffer)))) 144 (let ((name (file-name-sans-extension
129 ;; We need to ignore errors here, so that 145 (file-name-nondirectory file)))
130 ;; defcustoms with :set don't bug out. Of 146 cache
131 ;; course, their values will not be assigned in 147 (first t))
132 ;; case of errors, but their `custom-group' 148 ;; Search for defcustom/defface/defgroup
133 ;; properties will by that time be in place, and 149 ;; expressions, and evaluate them.
134 ;; that's all we care about. 150 (while (re-search-forward
135 (ignore-errors 151 "^(defcustom\\|^(defface\\|^(defgroup"
136 (eval expr)) 152 nil t)
137 ;; Hash the file of the affected symbol. 153 (when first
138 (setf (gethash (nth 1 expr) hash) name)))))) 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 ))
139 (cond 174 (cond
140 ((zerop (hash-table-count hash)) 175 ((zerop (hash-table-count hash))
141 (princ "(No customization dependencies") 176 (if (not (file-exists-p cusload-file))
142 (when (file-exists-p cusload-file) 177 (message "(No customization dependencies)")
143 (princ (format ", deleting %s" cusload-file)) 178 (message "(No customization dependencies, deleting %s)"
144 (delete-file cusload-file)) 179 cusload-file)
145 (princ ")\n")) 180 (delete-file cusload-file)))
146 (t 181 (t
147 (princ (format "Generating %s...\n" cusload-base-file)) 182 (message "Generating %s...\n" cusload-base-file)
148 (with-temp-file cusload-file 183 (with-temp-file cusload-file
149 (insert ";;; " cusload-base-file 184 (insert ";;; " cusload-base-file
150 " --- automatically extracted custom dependencies\n" 185 " --- automatically extracted custom dependencies\n"
151 "\n;;; Code:\n\n" 186 "\n;;; Code:\n\n")
152 "(autoload 'custom-add-loads \"cus-load\")\n\n") 187 (insert cusload-hash-table-marker)
188 (let ((print-readably t)
189 (standard-output (current-buffer)))
190 (princ hash-cache)
191 (terpri))
192 (insert "(autoload 'custom-add-loads \"cus-load\")\n\n")
153 (mapatoms 193 (mapatoms
154 (lambda (sym) 194 (lambda (sym)
155 (let ((members (get sym 'custom-group)) 195 (let ((members (get sym 'custom-group))
156 item where found) 196 item where found)
157 (when members 197 (when members