diff lisp/packages.el @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 6240c7796c7a
children 501cfd01ee6d
line wrap: on
line diff
--- a/lisp/packages.el	Mon Aug 13 11:12:06 2007 +0200
+++ b/lisp/packages.el	Mon Aug 13 11:13:30 2007 +0200
@@ -2,8 +2,8 @@
 
 ;; Copyright (C) 1997 Free Software Foundation, Inc.
 
-;; Author: Steven L Baur <steve@altair.xemacs.org>
-;; Maintainer: Steven L Baur <steve@altair.xemacs.org>
+;; Author: Steven L Baur <steve@xemacs.org>
+;; Maintainer: Steven L Baur <steve@xemacs.org>
 ;; Keywords: internal, lisp, dumped
 
 ;; This file is part of XEmacs.
@@ -55,7 +55,7 @@
 ;;; Package versioning
 
 (defvar packages-package-list nil
-  "database of loaded packages and version numbers")
+  "Database of loaded packages and version numbers")
 
 (defvar packages-hierarchy-depth 1
   "Depth of package hierarchies.")
@@ -84,16 +84,8 @@
 (defvar last-package-load-path nil
   "Load path for packages last in the load path.")
 
-(defvar package-locations
-  (list
-   (list (paths-construct-path '("~" ".xemacs"))
-                             'early #'(lambda () t))
-   (list "site-packages"     'late  #'(lambda () t))
-   (list "infodock-packages" 'late  #'(lambda () (featurep 'infodock)))
-   (list "mule-packages"     'late  #'(lambda () (featurep 'mule)))
-   (list "xemacs-packages"   'late  #'(lambda () t))
-   (list "packages"          'late  #'(lambda () t)))
-  "Locations of the various package directories.
+(defun packages-compute-package-locations (user-init-directory)
+  "Compute locations of the various package directories.
 This is a list each of whose elements describes one directory.
 A directory description is a three-element list.
 The first element is either an absolute path or a subdirectory
@@ -102,7 +94,16 @@
 depending on the load-path segment the hierarchy is supposed to
 show up in.
 The third component is a thunk which, if it returns NIL, causes
-the directory to be ignored.")
+the directory to be ignored."
+  (list
+   (list (paths-construct-path (list user-init-directory "mule-packages"))
+	 'early #'(lambda () (featurep 'mule)))
+   (list (paths-construct-path (list user-init-directory "xemacs-packages"))
+	 'early #'(lambda () t))
+   (list "site-packages"     'late  #'(lambda () t))
+   (list "infodock-packages" 'late  #'(lambda () (featurep 'infodock)))
+   (list "mule-packages"     'late  #'(lambda () (featurep 'mule)))
+   (list "xemacs-packages"   'late  #'(lambda () t))))
 
 (defun package-get-key-1 (info key)
   "Locate keyword `key' in list."
@@ -122,9 +123,8 @@
   (let ((info (if (and attributes (floatp (car attributes)))
 		  (list :version (car attributes))
 		attributes)))
-    (remassq name packages-package-list)
     (setq packages-package-list
-	  (cons (cons name info) packages-package-list))))
+	  (cons (cons name info) (remassq name packages-package-list)))))
 
 (defun package-require (name version)
   (let ((pkg (assq name packages-package-list)))
@@ -173,8 +173,7 @@
     "dumped-lisp.el"
     "dumped-pkg-lisp.el"
     "version.el"
-    "very-early-lisp.el"
-    "Installation.el")
+    "very-early-lisp.el")
   "Lisp packages that should not be byte compiled.")
 
 
@@ -203,14 +202,13 @@
 			  (member 'crypt-find-file-hook find-file-hooks)))
 		 ;; Compression involved.
 		 (if nosuffix
-		     ":.gz:.Z"
-		   ".elc:.elc.gz:elc.Z:.el:.el.gz:.el.Z::.gz:.Z"))
+		     '("" ".gz" ".Z")
+		   '(".elc" ".elc.gz" "elc.Z" ".el" ".el.gz" ".el.Z" "" ".gz" ".Z")))
 		(t
 		 ;; No compression.
 		 (if nosuffix
 		     ""
-		   ".elc:.el:")))
-	  4)))
+		   '(".elc" ".el" "")))))))
     (and interactive-call
 	 (if result
 	     (message "Library is file %s" result)
@@ -343,9 +341,7 @@
   "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'.
 This function is basically a wrapper over `locate-file'."
-  (unless dir-list
-    (setq dir-list data-directory-list))
-  (locate-file name dir-list))
+  (locate-file name (or dir-list data-directory-list)))
 
 ;; Path setup
 
@@ -433,7 +429,7 @@
 	  (setq package-locations (cdr package-locations)))
 	packages)))
 
-(defun packages-find-packages (roots)
+(defun packages-find-packages (roots package-locations)
   "Find the packages."
   (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
     (if envvar-value
@@ -456,7 +452,7 @@
 SUFFIXES is a list of names of package subdirectories to look for."
   (let ((directories
 	 (apply
-	  #'append
+	  #'nconc
 	  (mapcar #'(lambda (package)
 		      (mapcar #'(lambda (suffix)
 				  (file-name-as-directory (concat package suffix)))
@@ -498,7 +494,7 @@
 (defun packages-load-package-lisps (package-load-path base)
   "Load all Lisp files of a certain name along a load path.
 BASE is the base name of the files."
-  (mapc #'(lambda (dir)
+  (mapcar #'(lambda (dir)
 	    (let ((file-name (expand-file-name base dir)))
 	      (condition-case error
 		  (load file-name t t)
@@ -517,7 +513,7 @@
 (defun packages-handle-package-dumped-lisps (handle package-load-path)
   "Load dumped-lisp.el files along a load path.
 Call HANDLE on each file off definitions of PACKAGE-LISP there."
-  (mapc #'(lambda (dir)
+  (mapcar #'(lambda (dir)
 	    (let ((file-name (expand-file-name "dumped-lisp.el" dir)))
 	      (if (file-exists-p file-name)
 		  (let (package-lisp
@@ -526,7 +522,7 @@
 		    (load file-name)
 		    ;; dumped-lisp.el could have set this ...
 		    (if package-lisp
-			(mapc #'(lambda (base)
+			(mapcar #'(lambda (base)
 				  (funcall handle base))
 			      package-lisp))))))
 	package-load-path))