diff lisp/packages.el @ 215:1f0dabaa0855 r20-4b6

Import from CVS: tag r20-4b6
author cvs
date Mon, 13 Aug 2007 10:07:35 +0200
parents 78f53ef88e17
children d44af0c54775
line wrap: on
line diff
--- a/lisp/packages.el	Mon Aug 13 10:06:48 2007 +0200
+++ b/lisp/packages.el	Mon Aug 13 10:07:35 2007 +0200
@@ -137,9 +137,11 @@
   ;; Source directory may not be initialized yet.
   ;; (print (prin1-to-string load-path))
   (if (null source-directory)
-      (setq source-directory (concat (car load-path) "/./")))
+      (setq source-directory (concat (car load-path) "./")))
   (let ((files (directory-files (file-name-as-directory source-directory) t ".*"))
 	file autolist)
+    ;; (print (prin1-to-string source-directory))
+    ;; (print (prin1-to-string files))
     (while (setq file (car-safe files))
       (if (and (file-directory-p file)
 	       (file-exists-p (concat file "/" autoload-file-name)))
@@ -149,7 +151,7 @@
     autolist))
 
 ;; The following function is called from temacs
-(defun packages-find-packages-1 (package path-only user-package)
+(defun packages-find-packages-1 (package path-only append-p user-package)
   "Search the supplied directory for associated directories.
 The top level is assumed to look like:
 info/           Contain texinfo files for lisp installed in this hierarchy
@@ -157,6 +159,9 @@
 lisp/           Contain directories which either have straight lisp code
                 or are self-contained packages of their own.
 
+If the argument `append-p' is non-nil, the found directories will be
+appended to the paths, otherwise, they will be prepended.
+
 This is an internal function.  Do not call it after startup."
   ;; Info files
   (if (and (null path-only) (file-directory-p (concat package "/info")))
@@ -166,7 +171,9 @@
   ;; Data files
   (if (and (null path-only) (file-directory-p (concat package "/etc")))
       (setq data-directory-list
-	    (cons (concat package "/etc/") data-directory-list)))
+	    (if append-p
+		(append data-directory-list (list (concat package "/etc/")))
+	      (cons (concat package "/etc/") data-directory-list))))
   ;; Lisp files
   (if (file-directory-p (concat package "/lisp"))
       (progn
@@ -174,7 +181,10 @@
 ;		       (if user-package "[USER]" "")
 ;		       package
 ;		       "/lisp/"))
-	(setq load-path (cons (concat package "/lisp/") load-path))
+	(setq load-path
+	      (if append-p
+		  (append load-path (list (concat package "/lisp/")))
+		(cons (concat package "/lisp/") load-path)))
 	(if user-package
 	    (condition-case nil
 		(load (concat package "/lisp/"
@@ -186,7 +196,10 @@
 	  (while dirs
 	    (setq dir (car dirs))
 ;	    (print (concat "DIR: " dir "/"))
-	    (setq load-path (cons (concat dir "/") load-path))
+	    (setq load-path
+		  (if append-p
+		      (append load-path (list (concat dir "/")))
+		    (cons (concat dir "/") load-path)))
 	    (if user-package
 		(condition-case nil
 		    (progn
@@ -197,10 +210,31 @@
 		       (concat dir "/"
 			       (file-name-sans-extension autoload-file-name))))
 		  (t nil)))
-	    (packages-find-packages-1 dir path-only user-package)
+	    (packages-find-packages-1 dir path-only append-p user-package)
 	    (setq dirs (cdr dirs)))))))
 
 ;; The following function is called from temacs
+(defun packages-find-packages-2 (path path-only append-p suppress-user)
+  "Search the supplied path for associated directories.
+If the argument `append-p' is non-nil, the found directories will be
+appended to the paths, otherwise, they will be prepended.
+
+This is an internal function.  Do not call it after startup."
+  (let (dir)
+    (while path
+      (setq dir (car path))
+      ;; (prin1 (concat "Find: " (expand-file-name dir) "\n"))
+      (if (null (and (or suppress-user inhibit-package-init)
+		     (string-match "^~" dir)))
+	  (progn
+	    ;; (print dir)
+	    (packages-find-packages-1 (expand-file-name dir)
+				      path-only
+				      append-p
+				      (string-match "^~" dir))))
+      (setq path (cdr path)))))
+
+;; The following function is called from temacs
 (defun packages-find-packages (pkg-path path-only &optional suppress-user)
   "Search the supplied path for additional info/etc/lisp directories.
 Lisp directories if configured prior to build time will have equivalent
@@ -210,19 +244,13 @@
 If the optional argument `suppress-user' is non-nil, package directories
 rooted in a user login directory (like ~/.xemacs) will not be searched.
 This is used at dump time to suppress the builder's local environment."
-  (let ((path (reverse pkg-path))
-	dir)
-    (while path
-      (setq dir (car path))
-      ;; (prin1 (concat "Find: " (expand-file-name dir) "\n"))
-      (if (null (and (or suppress-user inhibit-package-init)
-		     (string-match "^~" dir)))
-	  (progn
-	    ;; (print dir)
-	    (packages-find-packages-1 (expand-file-name dir)
-				      path-only
-				      (string-match "^~" dir))))
-      (setq path (cdr path)))))
+  (let ((prefix-path nil))
+    (while (and pkg-path (car pkg-path))
+      (setq prefix-path (cons (car pkg-path) prefix-path)
+	    pkg-path (cdr pkg-path)))
+    (packages-find-packages-2 (cdr pkg-path) path-only t suppress-user)
+    (packages-find-packages-2 prefix-path path-only nil suppress-user)))
+
 
 ;; Data-directory is really a list now.  Provide something to search it for
 ;; directories.
@@ -241,6 +269,24 @@
       (setq dir-list (cdr dir-list)))
     found))
 
+;; Data-directory is really a list now.  Provide something to search it for
+;; files.
+
+(defun locate-data-file (name &optional dir-list)
+  "Locate a file in a search path DIR-LIST (a list of directories).
+If no DIR-LIST is supplied, it defaults to `data-directory-list'."
+  (unless dir-list
+    (setq dir-list data-directory-list))
+  (let (found found-file)
+    (while (and (null found-file) dir-list)
+      (setq found (concat (car dir-list) name)
+	    found-file (and (file-exists-p found)
+			    (not (file-directory-p found))))
+      (or found-file
+	  (setq found nil))
+      (setq dir-list (cdr dir-list)))
+    found))
+
 ;; If we are being loaded as part of being dumped, bootstrap the rest of the
 ;; load-path for loaddefs.
 (if (fboundp 'load-gc)