changeset 17685:3a1471ba9387

(custom-make-dependencies): Don't use NOSORT in directory-files. Don't actually visit the files. Use re-search to search contents fast. Search the subdirs of `lisp'. Bind kept-new-versions when saving.

--- a/lisp/cus-dep.el	Tue May 06 19:42:05 1997 +0000
+++ b/lisp/cus-dep.el	Tue May 06 21:14:20 1997 +0000
@@ -25,33 +25,69 @@
 ;;; Code:
 
 (require 'cl)
-(load-file "widget.el")
-(load-file "custom.el")
-(load-file "cus-face.el")
+(require 'widget)
+(require 'cus-face)
 
 (defun custom-make-dependencies ()
   "Batch function to extract custom dependencies from .el files.
 Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies"
   (let ((enable-local-eval nil)
-	(files (directory-files "" nil "\\`[^=].*\\.el\\'" t))
-	file)
-    (while files
-      (setq file (car files)
-	    files (cdr files))
-      (message "Checking %s..." file)
-      (set-buffer (find-file-noselect file))
-      (goto-char (point-min))
-      (string-match "\\`\\(.*\\)\\.el\\'" file)
-      (condition-case nil
+	all-subdirs pending
+	(start-directory default-directory))
+    (get-buffer-create " cus-dep temp")
+    (set-buffer " cus-dep temp")
+    (setq pending '("."))
+    (while pending
+      (let ((this (car pending))
+	    this-subdirs
+	    default-directory)
+	(setq all-subdirs (cons this all-subdirs))
+	(setq pending (cdr pending))
+	(setq default-directory
+	      (expand-file-name this start-directory))
+	(message "Finding subdirs of %s" this)
+	(erase-buffer)
+	(condition-case nil
+	    (progn
+	      (insert-file-contents "subdirs.el")
+	      (goto-char (point-min))
+	      (search-forward "'(")
+	      (forward-char -1)
+	      (setq this-subdirs (read (current-buffer)))
+	      (setq pending (nconc pending
+				   (mapcar 
+				    (function (lambda (dir)
+						(file-relative-name
+						 (file-name-as-directory
+						  (expand-file-name dir this))
+						 start-directory)))
+				    this-subdirs))))
+	  (error nil))))
+
+    (while all-subdirs
+      (message "Directory %s" (car all-subdirs))
+      (let ((files (directory-files (car all-subdirs) nil "\\`[^=].*\\.el\\'"))
+	    (default-directory default-directory)
+	    file)
+	(cd (car all-subdirs))
+	(while files
+	  (setq file (car files)
+		files (cdr files))
+	  (message "Checking %s..." file)
+	  (erase-buffer)
+	  (insert-file-contents file)
+	  (goto-char (point-min))
+	  (string-match "\\`\\(.*\\)\\.el\\'" file)
 	  (let ((name (file-name-nondirectory (match-string 1 file))))
-	    (while t
-	      (let ((expr (read (current-buffer))))
-		(when (and (listp expr)
-			   (memq (car expr) '(defcustom defface defgroup)))
-		  (eval expr)
-		  (put (nth 1 expr) 'custom-where name)))))
-	(error nil))
-      (kill-buffer (current-buffer))))
+	    (condition-case nil
+		(while (re-search-forward "^(defcustom\\|^(defface\\|^(defgroup"
+					  nil t)
+		  (beginning-of-line)
+		  (let ((expr (read (current-buffer))))
+		    (eval expr)
+		    (put (nth 1 expr) 'custom-where name)))
+	      (error nil))))
+	(setq all-subdirs (cdr all-subdirs)))))
   (message "Generating cus-load.el...")
   (find-file "cus-load.el")
   (erase-buffer)
@@ -84,7 +120,8 @@
 \(provide 'cus-load)
 
 ;;; cus-load.el ends here\n")
-  (save-buffer)
+  (let ((kept-new-versions 10000000))
+    (save-buffer))
   (message "Generating cus-load.el...done"))
 
 ;;; cus-dep.el ends here