changeset 1483:410360d3e34e

[xemacs-hg @ 2003-05-14 23:57:34 by youngs] 2003-05-15 Steve Youngs <youngs@xemacs.org> * package-get.el (package-get-package-index-file-location): New, so it is possible to specify a location for the index file. (package-get-locate-index-file): Use it. (package-get-maybe-save-index): Ditto. (package-get-user-index-filename): Remove.
author youngs
date Wed, 14 May 2003 23:57:35 +0000
parents e849de92ffef
children adeb93de1d44
files lisp/ChangeLog lisp/package-get.el
diffstat 2 files changed, 52 insertions(+), 13 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed May 14 21:52:22 2003 +0000
+++ b/lisp/ChangeLog	Wed May 14 23:57:35 2003 +0000
@@ -1,3 +1,11 @@
+2003-05-15  Steve Youngs  <youngs@xemacs.org>
+
+	* package-get.el (package-get-package-index-file-location): New,
+	so it is possible to specify a location for the index file.
+	(package-get-locate-index-file): Use it.
+	(package-get-maybe-save-index): Ditto.
+	(package-get-user-index-filename): Remove.
+
 2003-05-14  Steve Youngs  <youngs@xemacs.org>
 
 	* package-get.el (package-get-require-signed-base-updates): Turn
--- a/lisp/package-get.el	Wed May 14 21:52:22 2003 +0000
+++ b/lisp/package-get.el	Wed May 14 23:57:35 2003 +0000
@@ -170,6 +170,14 @@
   :group 'package-get)
 
 ;;;###autoload
+(defcustom package-get-package-index-file-location 
+  (or (getenv "EMACSPACKAGEPATH")
+      user-init-directory)
+  "*The directory where the package-index file can be found."
+  :type 'directory
+  :group 'package-get)
+
+;;;###autoload
 (defcustom package-get-install-to-user-init-directory nil
   "*If non-nil install packages under `user-init-directory'."
   :type 'boolean
@@ -372,10 +380,6 @@
   :type 'file
   :group 'package-get)
 
-(defvar package-get-user-index-filename
-  (paths-construct-path (list user-init-directory package-get-base-filename))
-  "Name for the user-specific location of the package-get database file.")
-
 (defcustom package-get-always-update nil
   "*If Non-nil always make sure we are using the latest package index (base).
 Otherwise respect the `force-current' argument of `package-get-require-base'."
@@ -489,14 +493,35 @@
                file)))))
 
 (defun package-get-locate-index-file (no-remote)
-  "Locate the package-get index file.  Do not return remote paths if NO-REMOTE
-is non-nil."
+  "Locate the package-get index file.  
+
+Do not return remote paths if NO-REMOTE is non-nil.  If the index
+file doesn't exist in `package-get-package-index-file-location', ask
+the user if one should be created using the index file in core as a
+template."
   (or (package-get-locate-file package-get-base-filename t no-remote)
-      (if (file-exists-p package-get-user-index-filename)
-	  package-get-user-index-filename)
-      (locate-data-file package-get-base-filename)
-      (error 'search-failed
-	     "Can't locate a package index file.")))
+      (if (file-exists-p (expand-file-name package-get-base-filename
+					   package-get-package-index-file-location))
+	  (expand-file-name package-get-base-filename
+			    package-get-package-index-file-location)
+	(if (y-or-n-p (format "No index file, shall I create one in %s? "
+			      package-get-package-index-file-location))
+	    (progn
+	      (save-excursion
+		(set-buffer 
+		 (find-file-noselect (expand-file-name
+				      package-get-base-filename
+				      package-get-package-index-file-location)))
+		(let ((coding-system-for-write 'binary))
+		  (erase-buffer)
+		  (insert-file-contents-literally
+		   (locate-data-file package-get-base-filename))
+		  (save-buffer (current-buffer))
+		  (kill-buffer (current-buffer))))
+	      (expand-file-name package-get-base-filename
+				package-get-package-index-file-location))
+	  (error 'search-failed
+		 "Can't locate a package index file.")))))
 
 (defun package-get-maybe-save-index (filename)
   "Offer to save the current buffer as the local package index file,
@@ -508,8 +533,14 @@
 			  (with-temp-buffer
 			    (insert-file-contents-literally location)
 			    (md5 (current-buffer)))))
-	(unless (and location (file-writable-p location))
-	  (setq location package-get-user-index-filename))
+	(when (not (file-writable-p location))
+	  (if (y-or-n-p (format "Sorry, %s is read-only, can I use %s? "
+				location user-init-directory))
+	      (setq location (expand-file-name
+			      package-get-base-filename
+			      package-get-package-index-file-location))
+	    (error 'file-error
+		   (format "%s is read-only" location))))
 	(when (y-or-n-p (concat "Update package index in " location "? "))
 	  (let ((coding-system-for-write 'binary))
 	    (write-file location)))))))