From aa6e960244c869fb0629d136c1b48ff4213af727 Mon Sep 17 00:00:00 2001
From: "Tom Breton (Tehom)" <tehom@panix.com>
Date: Fri, 12 Nov 2010 18:50:36 -0500
Subject: [PATCH] New function elinstall-actions-for-dir factored.

---
 elinstall.el | 164 +++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 103 insertions(+), 61 deletions(-)

diff --git a/elinstall.el b/elinstall.el
index 9813d75..6834ecc 100644
--- a/elinstall.el
+++ b/elinstall.el
@@ -831,6 +831,7 @@ DIR should be an absolute path."
 ;;load-path-element - The relevant element of load-path
 ;;def-file - The file the autoload definitions etc will go into.
 ;;add-to-load-path-p - Controls whether to add to load-path.
+;;recurse-dirs-p - Whether to recurse into subdirectories.
 
 ;;;_    . elinstall-actions-for-source-file
 (defun elinstall-actions-for-source-file (filename dir)
@@ -899,16 +900,98 @@ Special variables are as noted in \"List of special variables\"."
 			buf def-file load-path-element full-path)
 		     nil))
 	       (unless visited (kill-buffer-if-not-modified buf)))))))
+;;;_    . elinstall-actions-for-dir
+(defun elinstall-actions-for-dir (dirname &optional recurse-dirs-p)
+   "Make actions for DIR.
+Recurse just if RECURSE-DIRS-P"
+   (declare (special
+	       load-path-element def-file add-to-load-path-p))
+   ;;This does not treat symlinks specially.  $$IMPROVE ME it could
+   ;;treat/not treat them conditional on control variables.
+   (let*
+      (
+	 ;;Relative filenames of the source files.  We know our
+	 ;;loaddefs.el isn't really source so remove it.  We'd have
+	 ;;removed it anyways after seeing file local vars.
+
+	 (elisp-source-files
+	    (remove def-file
+	       (directory-files
+		  dirname 
+		  nil 
+		  elinstall-elisp-regexp)))
+	 ;;Absolute filenames of subdirectories.
+	 ;;Don't accept any directories beginning with dot.  If user
+	 ;;really wants to explore one he can use `(dir ".NAME")'.
+	 (sub-dirs
+	    (if recurse-dirs-p
+	       (delq nil
+		  (mapcar
+		     #'(lambda (filename)
+			  (if
+			     (file-directory-p filename)
+			     filename
+			     nil))
+		     (directory-files
+			dirname t
+			"[^\\.]")))
+	       '()))
+		  
+	 (load-path-here
+	    (and 
+	       elisp-source-files ;;If list is not empty.
+	       add-to-load-path-p))
+	 (load-path-element
+	    (if load-path-here
+	       dirname
+	       load-path-element)))
+	       
+      (append
+	 ;;Sometimes arrange to add this directory to load-path.
+	 (if load-path-here
+	    `((add-to-load-path
+		 ,def-file
+		 ,load-path-element))
+	    '())
+
+	 ;;$$IMPROVE ME - be controlled by a control variable.
+	 ;;Sometimes add this directory to info path.
+	 (if
+	    (elinstall-dir-has-info dirname)
+	    `((add-to-info-path
+		 ,def-file
+		 "."))
+	    '())
+
+	 (apply #'nconc
+	    (mapcar
+	       #'(lambda (filename)
+		    (elinstall-actions-for-source-file
+		       filename 
+		       dirname))
+	       elisp-source-files))
+
+	 (if recurse-dirs-p
+	    (apply #'nconc
+	       (mapcar
+		  #'(lambda (filename)
+		       (elinstall-find-actions-by-spec-x
+			  t
+			  (expand-file-name
+			     filename 
+			     dirname)))
+		  sub-dirs))
+	    '()))))
 
 ;;;_    . elinstall-find-actions-by-spec-x
 
 (defun elinstall-find-actions-by-spec-x (spec dir)
    "Return a list of actions to do, controlled by SPEC."
    (declare (special
-	       load-path-element def-file add-to-load-path-p))
+	       load-path-element def-file add-to-load-path-p
+	       recurse-dirs-p)) 
 
    (if (consp spec)
-      ;;$$IMPROVE ME by adding the other cases in the design.
       (case (car spec)
 	 (in
 	    (let
@@ -938,58 +1021,12 @@ Special variables are as noted in \"List of special variables\"."
 	 ;;unwind-protect. 
 
 	 (dir
-	    (let*
-	       ((dirname 
-		   (expand-file-name
-		      (second spec) 
-		      dir))
-		  ;;Relative filenames
-		  (elisp-source-files
-		     (directory-files
-			dirname 
-			nil 
-			elinstall-elisp-regexp))
-		  (load-path-here
-		     (and 
-			elisp-source-files ;;List not empty.
-			add-to-load-path-p))
-		  (load-path-element
-		     (if load-path-here
-			dirname
-			load-path-element)))
-	       
-	       (append
-		  ;;$$IMPROVE ME - remove the current deffile from
-		  ;;this list.
-		  ;;Maybe arrange to add this directory to load-path.
-		  (if load-path-here
-		     `((add-to-load-path
-			  ,def-file
-			  ,load-path-element))
-		     '())
-
-		  ;;$$IMPROVE ME - be controlled by a control variable.
-		  ;;If any info files are present, do add-to-info-path
-		  ;;too. 
-		  (if
-		     (elinstall-dir-has-info dirname)
-		     `((add-to-info-path
-			  ,def-file
-			  "."))
-		     '())
-		  
-
-
-		  ;;$$FIXME Don't do directories, but maybe recurse on
-		  ;;them, if a flag is set.  
-		  ;;Maybe could follow/not symlinks similarly.
-		  (apply #'nconc
-		     (mapcar
-			#'(lambda (filename)
-			     (elinstall-actions-for-source-file
-				filename 
-				dirname))
-			elisp-source-files)))))
+	    (elinstall-actions-for-dir
+	       (expand-file-name
+		  (second spec) 
+		  dir)
+	       recurse-dirs-p))
+	 
 
 	 (load-path
 	    (append
@@ -1019,20 +1056,25 @@ Special variables are as noted in \"List of special variables\"."
 		  
 		  (elinstall-find-actions-by-spec-x
 		     (fourth spec) dir)))))
-      
-      ;;$$IMPROVE ME by adding the other cases in the design.
+
       (case spec
-	 (t))))
+	 (dir
+	    (elinstall-actions-for-dir dir nil))
+	 ((t)
+	    (elinstall-actions-for-dir dir t)))))
+
 ;;;_    . elinstall-find-actions-by-spec
 (defun elinstall-find-actions-by-spec (spec load-path-element dir def-file)
    ""
 
    (let
-      ((load-path-element load-path-element)
-	 (def-file def-file)
-	 (add-to-load-path-p t))
+      ((load-path-element    load-path-element)
+	 (def-file           def-file)
+	 (add-to-load-path-p t)
+	 (recurse-dirs-p     t))
       (declare (special
-		  load-path-element def-file add-to-load-path-p))
+		  load-path-element def-file add-to-load-path-p
+		  recurse-dirs-p)) 
       
       (elinstall-find-actions-by-spec-x
 	 spec dir)))
-- 
2.11.4.GIT