diff lisp/packages.el @ 276:6330739388db r21-0b36

Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents ca9a9ec9c1c1
children 90d73dddcdc4
line wrap: on
line diff
--- a/lisp/packages.el	Mon Aug 13 10:29:43 2007 +0200
+++ b/lisp/packages.el	Mon Aug 13 10:30:37 2007 +0200
@@ -57,6 +57,12 @@
 (defvar packages-package-list nil
   "database of loaded packages and version numbers")
 
+(defvar packages-hierarchy-depth 1
+  "Depth of package hierarchies.")
+
+(defvar packages-load-path-depth 1
+  "Depth of load-path search in package hierarchies.")
+
 (defvar early-packages nil
   "Packages early in the load path.")
 
@@ -77,7 +83,9 @@
 
 (defvar package-locations
   (list
-   (list "~/.xemacs"         'early #'(lambda () t))
+   (list (paths-construct-path '("~" ".xemacs"))
+                             'early #'(lambda () t))
+   (list "site-packages"     'late  #'(lambda () t))
    (list "mule-packages"     'late  #'(lambda () (featurep 'mule)))
    (list "packages"          'late  #'(lambda () t))
    (list "infodock-packages" 'late  #'(lambda () (featurep 'infodock))))
@@ -216,7 +224,7 @@
   ;; 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 (car load-path)))
   (let ((files (directory-files (file-name-as-directory source-directory)
 				t ".*"))
 	file autolist)
@@ -224,8 +232,10 @@
     ;; (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)))
-	  (setq autolist (cons (concat file "/" autoload-file-name)
+	       (file-exists-p (concat (file-name-as-directory file)
+				      autoload-file-name)))
+	  (setq autolist (cons (concat (file-name-as-directory file)
+				       autoload-file-name)
 			       autolist)))
       (setq files (cdr files)))
     autolist))
@@ -278,13 +288,6 @@
 	  (t nil)))
       (setq autoload-list (cdr autoload-list)))))
 
-;; The following function cannot be called from a bare temacs
-(defun packages-reload-dumped-lisp ()
-  "Reload new or updated dumped lisp files (with exceptions).
-This is an extremely dangerous function to call at any time."
-  ;; Nothing for the moment
-  nil)
-
 ;; Data-directory is really a list now.  Provide something to search it for
 ;; directories.
 
@@ -295,7 +298,7 @@
     (setq dir-list data-directory-list))
   (let (found found-dir)
     (while (and (null found-dir) dir-list)
-      (setq found (concat (car dir-list) name "/")
+      (setq found (file-name-as-directory (concat (car dir-list) name))
 	    found-dir (file-directory-p found))
       (or found-dir
 	  (setq found nil))
@@ -329,15 +332,16 @@
 (defun packages-find-packages-in-directories (directories)
   "Find all packages underneath directories in DIRECTORIES."
   (paths-find-recursive-path directories
+			     packages-hierarchy-depth
 			     (append paths-version-control-bases
 				     packages-special-bases)))
 
 (defun packages-split-path (path)
-  "Split PATH at \"/\", return pair with two components.
+  "Split PATH at \"\", return pair with two components.
 The second component is shared with PATH."
   (let ((reverse-tail '())
 	(rest path))
-    (while (and rest (null (string-equal "/" (car rest))))
+    (while (and rest (null (string-equal "" (car rest))))
       (setq reverse-tail (cons (car rest) reverse-tail))
       (setq rest (cdr rest)))
     (if (null rest)
@@ -346,7 +350,7 @@
 
 (defun packages-split-package-path (package-path)
   "Split up PACKAGE-PATH into early, late and last components.
-The separation is by \"/\" components.
+The separation is by \"\" components.
 This returns (LIST EARLY-PACKAGES LATE-PACKAGES LAST-PACKAGES)."
   ;; When in doubt, it's late
   (let* ((stuff (packages-split-path package-path))
@@ -377,38 +381,36 @@
 For the format of PACKAGE-LOCATIONS, see the global variable of the same name.
 TIME is either 'EARLY, 'LATE, or 'LAST.
 DEFAULT is a default list of packages."
-  (let ((packages '()))
-    (while package-locations
-      (packages-deconstruct 
-       (car package-locations)
-       #'(lambda (name a-time thunk)
-	   (if (and (eq time a-time)
-		    (funcall thunk))
-	       (setq packages
-		     (nconc packages
-			    (packages-find-packages-by-name roots name))))))
-      (setq package-locations (cdr package-locations)))
-    (paths-uniq-append packages
-		       default)))
+  (or default
+      (let ((packages '()))
+	(while package-locations
+	  (packages-deconstruct 
+	   (car package-locations)
+	   #'(lambda (name a-time thunk)
+	       (if (and (eq time a-time)
+			(funcall thunk))
+		   (setq packages
+			 (nconc packages
+				(packages-find-packages-by-name roots name))))))
+	  (setq package-locations (cdr package-locations)))
+	packages)))
 
-(defun packages-find-packages (roots &optional inhibit)
+(defun packages-find-packages (roots)
   "Find the packages."
-  (if inhibit
-      (list '() '() '())
-    (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
-      (if envvar-value
-	  (packages-split-package-path envvar-value)
-	(packages-deconstruct
-	 (packages-split-package-path configure-package-path)
-	 #'(lambda (configure-early-packages
-		    configure-late-packages
-		    configure-last-packages)
-	     (list (packages-find-packages-at-time roots package-locations 'early
-						   configure-early-packages)
-		   (packages-find-packages-at-time roots package-locations 'late
-						   configure-late-packages)
-		   (packages-find-packages-at-time roots package-locations 'last
-						   configure-last-packages))))))))
+  (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
+    (if envvar-value
+	(packages-split-package-path (paths-decode-directory-path envvar-value))
+      (packages-deconstruct
+       (packages-split-package-path configure-package-path)
+       #'(lambda (configure-early-packages
+		  configure-late-packages
+		  configure-last-packages)
+	   (list (packages-find-packages-at-time roots package-locations 'early
+						 configure-early-packages)
+		 (packages-find-packages-at-time roots package-locations 'late
+						 configure-late-packages)
+		 (packages-find-packages-at-time roots package-locations 'last
+						 configure-last-packages)))))))
 
 (defun packages-find-package-library-path (packages suffixes)
   "Construct a path into a component of the packages hierarchy.
@@ -419,7 +421,7 @@
 	  #'append
 	  (mapcar #'(lambda (package)
 		      (mapcar #'(lambda (suffix)
-				  (concat package suffix))
+				  (file-name-as-directory (concat package suffix)))
 			      suffixes))
 		  packages))))
     (paths-directories-which-exist directories)))
@@ -428,18 +430,21 @@
   "Construct the load-path component for packages.
 PACKAGES is a list of package directories."
   (paths-find-recursive-load-path
-   (packages-find-package-library-path packages '("lisp/"))))
+   (packages-find-package-library-path packages
+				       '("lisp"))
+   packages-load-path-depth))
 
 (defun packages-find-package-exec-path (packages)
   (packages-find-package-library-path packages
-				   (list (concat "bin/" system-configuration "/")
-					 "lib-src/")))
+				      (list (paths-construct-path
+					     (list "bin" system-configuration))
+					    "lib-src")))
 
 (defun packages-find-package-info-path (packages)
-  (packages-find-package-library-path packages '("info/")))
+  (packages-find-package-library-path packages '("info")))
 
 (defun packages-find-package-data-path (packages)
-  (packages-find-package-library-path packages '("etc/")))
+  (packages-find-package-library-path packages '("etc")))
 
 ;; Loading package initialization files
 
@@ -448,14 +453,13 @@
 BASE is the base name of the files."
   (mapc #'(lambda (dir)
 	    (let ((file-name (expand-file-name base dir)))
-	      (if (file-exists-p file-name)
-		  (condition-case error
-		      (load file-name)
-		    (error
-		     (warn (format "Autoload error in: %s:\n\t%s"
-				   file-name
-				   (with-output-to-string
-				     (display-error error nil)))))))))
+	      (condition-case error
+		  (load file-name t t)
+		(error
+		 (warn (format "Autoload error in: %s:\n\t%s"
+			       file-name
+			       (with-output-to-string
+				 (display-error error nil))))))))
 	package-load-path))
 
 (defun packages-load-package-auto-autoloads (package-load-path)
@@ -478,7 +482,7 @@
 			(mapc #'(lambda (base)
 				  (funcall handle base))
 			      package-lisp))))))
-	  package-load-path))
+	package-load-path))
 
 (defun packages-load-package-dumped-lisps (package-load-path)
   "Load dumped-lisp.el files along a load path.