Mercurial > hg > xemacs-beta
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 |