Mercurial > hg > xemacs-beta

changeset 1365:02909207294a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-03-20 13:19:56 by youngs] 2003-03-20 Steve Youngs <youngs@xemacs.org> * menubar-items.el (default-menubar): Add a "Pre-Release Download Sites" submenu to "Tools -> Packages" menu. Filter the package download sites menus through `menu-split-long-menu'. * obsolete.el (pui-add-install-directory): New. (package-get-download-menu): New. * package-admin.el: (package-admin-add-single-file-package): Removed. (package-admin-get-install-dir): Don't rely on an installed xemacs-base package to guess where a package needs to be installed to. (package-admin-get-manifest-file): Whitespace clean up. (package-admin-check-manifest): Use `directory-sep-char' to compute regexp. Only search 'lisp' and 'man' directories to determine package name. Don't error is xemacs-base package isn't installed, just don't sort the MANIFEST file and issue a warning. (package-admin-add-binary-package): Whitespace clean up. (package-admin-get-lispdir): Ditto. (package-admin-delete-binary-package): Use `with-temp-buffer' instead of creating a temporary buffer manually. * package-get.el: (package-get-remote): Change custom type so that only either a single directory or remote host:directory can be selected. (package-get-download-sites): Put the sites into alphabetical order of country. Make the description element be "Country (site)" instead of the other way around. (package-get-pre-release-download-sites): New. (package-get-require-signed-base-updates): Default to t. (package-get-download-menu): Removed. (package-get-locate-file): Change to reflect new format of 'package-get-remote'. (package-get-update-base-from-buffer): Whitespace clean up and remove an unneccessary 'when'. (package-get-interactive-package-query): Whitespace clean up. (package-get-update-all): Ditto. (package-get-all): Ditto. (package-get-init-package): Ditto. (package-get-info): New. (package-get): Bring into line with new format of 'package-get-remote'. Error if non-Mule XEmacsen try to install Mule packages. Don't rely on a Mule package having 'mule-base' in its "REQUIRES" to determine if it is a Mule package or not, instead we test "CATEGORY". Better handling of the situation where a partial package tarball exists on the local hard drive from a previous interupted download. Clean up after a failed package install. (package-get-set-version-prop): Removed. (package-get-installedp): Whitespace clean up. * package-ui.el: Whitespace clean up. (pui-info-buffer): Make it a defcustom. (pui-directory-exists): Removed. (pui-package-dir-list): Removed. (pui-add-install-directory): Removed. (package-ui-download-menu): New. (package-ui-pre-release-download-menu): New. (pui-set-local-package-get-directory): New. (pui-package-symbol-char): Whitespace clean up. (pui-update-package-display): Ditto. (pui-toggle-package): Ditto. (pui-toggle-package-key): Ditto. (pui-toggle-package-delete): Ditto. (pui-toggle-package-delete-key): Ditto. (pui-toggle-package-event): Ditto. (pui-toggle-verbosity-redisplay): Ditto. (pui-install-selected-packages): Ditto. (pui-help-echo): Ditto. (pui-display-info): Ditto. (pui-list-packages): Ditto. * packages.el: Whitespace clean up.
author youngs
date Thu, 20 Mar 2003 13:19:59 +0000
parents 29e39e3ac319
children eaba5c93c383
files lisp/ChangeLog lisp/menubar-items.el lisp/obsolete.el lisp/package-admin.el lisp/package-get.el lisp/package-ui.el lisp/packages.el
diffstat 7 files changed, 501 insertions(+), 488 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/ChangeLog	Thu Mar 20 13:19:59 2003 +0000
@@ -1,3 +1,93 @@
+2003-03-20  Steve Youngs  <youngs@xemacs.org>
+
+	* menubar-items.el (default-menubar): Add a "Pre-Release Download
+	Sites" submenu to "Tools -> Packages" menu.
+
+	Filter the package download sites menus through
+	`menu-split-long-menu'.
+	
+	* obsolete.el (pui-add-install-directory): New.
+	(package-get-download-menu): New.
+
+	* package-admin.el: (package-admin-add-single-file-package):
+	Removed.
+	(package-admin-get-install-dir): Don't rely on an installed
+	xemacs-base package to guess where a package needs to be installed
+	to.
+	(package-admin-get-manifest-file): Whitespace clean up.
+	(package-admin-check-manifest): Use `directory-sep-char' to
+	compute regexp.  
+
+	Only search 'lisp' and 'man' directories to determine package
+	name.
+
+	Don't error is xemacs-base package isn't installed, just don't
+	sort the MANIFEST file and issue a warning.
+	(package-admin-add-binary-package): Whitespace clean up.
+	(package-admin-get-lispdir): Ditto.
+	(package-admin-delete-binary-package): Use `with-temp-buffer'
+	instead of creating a temporary buffer manually.
+
+	* package-get.el: (package-get-remote): Change custom type so that
+	only either a single directory or remote host:directory can be
+	selected. 
+	(package-get-download-sites): Put the sites into alphabetical
+	order of country.  
+
+	Make the description element be "Country (site)" instead of the
+	other way around. 
+	(package-get-pre-release-download-sites): New.
+	(package-get-require-signed-base-updates): Default to t.
+	(package-get-download-menu): Removed.
+	(package-get-locate-file): Change to reflect new format of
+	'package-get-remote'. 
+	(package-get-update-base-from-buffer): Whitespace clean up and
+	remove an unneccessary 'when'.
+	(package-get-interactive-package-query): Whitespace clean up.
+	(package-get-update-all): Ditto.
+	(package-get-all): Ditto.
+	(package-get-init-package): Ditto.
+	(package-get-info): New.
+	(package-get): Bring into line with new format of
+	'package-get-remote'.  
+
+	Error if non-Mule XEmacsen try to install Mule packages.  
+
+	Don't rely on a Mule package having 'mule-base' in its
+	"REQUIRES" to determine if it is a Mule package or not,
+	instead we test "CATEGORY".  
+
+	Better handling of the situation where a partial package tarball
+	exists on the local hard drive from a previous interupted
+	download.
+
+	Clean up after a failed package install.
+	(package-get-set-version-prop): Removed.
+	(package-get-installedp): Whitespace clean up.
+
+	* package-ui.el: Whitespace clean up.
+	(pui-info-buffer): Make it a defcustom.
+	(pui-directory-exists): Removed.
+	(pui-package-dir-list): Removed.
+	(pui-add-install-directory): Removed.
+	(package-ui-download-menu): New.
+	(package-ui-pre-release-download-menu): New.
+	(pui-set-local-package-get-directory): New.
+	(pui-package-symbol-char): Whitespace clean up.
+	(pui-update-package-display): Ditto.
+	(pui-toggle-package): Ditto.
+	(pui-toggle-package-key): Ditto.
+	(pui-toggle-package-delete): Ditto.
+	(pui-toggle-package-delete-key): Ditto.
+	(pui-toggle-package-event): Ditto.
+	(pui-toggle-verbosity-redisplay): Ditto.
+	(pui-install-selected-packages): Ditto.
+	(pui-help-echo): Ditto.
+	(pui-display-info): Ditto.
+	(pui-list-packages): Ditto.
+
+	* packages.el: Whitespace clean up.
+
 2003-03-18  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* gutter-items.el (buffers-tab-filter-functions): Improve docstring.
--- a/lisp/menubar-items.el	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/menubar-items.el	Thu Mar 20 13:19:59 2003 +0000
@@ -568,9 +568,16 @@
      ("%_Tools"
       ("%_Packages"
        ("%_Add Download Site"
-        :filter (lambda (&rest junk)
-                  (submenu-generate-accelerator-spec
-		   (package-get-download-menu))))
+	:filter (lambda (&rest junk)
+		  (menu-split-long-menu
+		   (submenu-generate-accelerator-spec
+		    (package-ui-download-menu)))))
+       ("%_Pre-Release Download Sites"
+	:filter (lambda (&rest junk)
+		  (menu-split-long-menu
+		   (submenu-generate-accelerator-spec
+		    (package-ui-pre-release-download-menu)))))
+       "--:shadowEtchedIn"
        ["%_Update Package Index" package-get-update-base]
        ["%_List and Install" pui-list-packages]
        ["U%_pdate Installed Packages" package-get-update-all]
--- a/lisp/obsolete.el	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/obsolete.el	Thu Mar 20 13:19:59 2003 +0000
@@ -184,6 +184,8 @@
   "This used to be the name of the user whose init file was read at startup.")
 (make-obsolete-variable 'init-file-user 'load-user-init-file-p)
 
+(define-obsolete-function-alias 'pui-add-install-directory
+  'pui-set-local-package-get-directory) ; misleading name
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks
 
 (make-compatible-variable 'lisp-indent-hook 'lisp-indent-function)
@@ -234,6 +236,9 @@
 ;; Can't make this obsolete.  easymenu depends on it.
 (make-compatible 'add-menu 'add-submenu)
 
+(define-obsolete-function-alias 'package-get-download-menu 
+  'package-ui-download-menu)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer
 
 (define-compatible-function-alias 'read-minibuffer
--- a/lisp/package-admin.el	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/package-admin.el	Thu Mar 20 13:19:59 2003 +0000
@@ -114,25 +114,6 @@
 hook is called *before* the package is deleted. The hook function is passed
 two arguments: the package name, and the install directory.")
 
-;;;###autoload
-(defun package-admin-add-single-file-package (file destdir &optional pkg-dir)
-  "Install a single file Lisp package into XEmacs package hierarchy.
-`file' should be the full path to the lisp file to install.
-`destdir' should be a simple directory name.
-The optional `pkg-dir' can be used to override the default package hierarchy
-\(car \(last late-packages))."
-  (interactive "fLisp File: \nsDestination: ")
-  (when (null pkg-dir)
-    (setq pkg-dir (car (last late-packages))))
-  (let ((destination (concat pkg-dir "/lisp/" destdir))
-	(buf (get-buffer-create package-admin-temp-buffer)))
-    (call-process "add-little-package.sh"
-		  nil
-		  buf
-		  t
-		  ;; rest of command line follows
-		  package-admin-xemacs file destination)))
-
 (defun package-admin-install-function-mswindows (file pkg-dir buffer)
   "Install function for mswindows."
   (let ((default-directory (file-name-as-directory pkg-dir)))
@@ -152,15 +133,7 @@
     ;; Don't assume GNU tar.
     (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer)
 	0
-      1)
-    ))
-
-;  (call-process "add-big-package.sh"
-;		nil
-;		buffer
-;		t
-;		;; rest of command line follows
-;		package-admin-xemacs file pkg-dir))
+      1)))
 
 (defun package-admin-get-install-dir (package pkg-dir &optional mule-related)
   "If PKG-DIR is non-nil return that,
@@ -187,45 +160,35 @@
 	;; Ok we need to guess
 	(if mule-related
 	    (package-admin-get-install-dir 'mule-base nil nil)
-	  (if (eq package 'xemacs-base)
-	      (car (last late-packages))
-	    (package-admin-get-install-dir 'xemacs-base nil nil)))))))
-
-
+	  (car (last late-packages)))))))
 
 (defun package-admin-get-manifest-file (pkg-topdir package)
   "Return the name of the MANIFEST file for package PACKAGE.
 Note that PACKAGE is a symbol, and not a string."
-  (let (dir)
-    (setq dir (expand-file-name "pkginfo" pkg-topdir))
-    (expand-file-name (concat "MANIFEST." (symbol-name package)) dir)
-    ))
+  (let ((dir (file-name-as-directory
+	      (expand-file-name "pkginfo" pkg-topdir))))
+    (expand-file-name (concat "MANIFEST." (symbol-name package)) dir)))
 
 (defun package-admin-check-manifest (pkg-outbuf pkg-topdir)
   "Check for a MANIFEST.<package> file in the package distribution.
 If it doesn't exist, create and write one.
 PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR
 is the top-level directory under which the package was installed."
-  (let ( (manifest-buf " *pkg-manifest*")
-	 old-case-fold-search regexp package-name pathname regexps)
-    ;; Save and restore the case-fold-search status.
-    ;; We do this in case we have to screw with it (as it the case of
-    ;; case-insensitive filesystems such as MS Windows).
-    (setq old-case-fold-search case-fold-search)
+  (let ((manifest-buf " *pkg-manifest*")
+	(old-case-fold-search case-fold-search)
+	regexp package-name pathname regexps)
     (unwind-protect
 	(save-excursion				;; Probably redundant.
-	  (set-buffer (get-buffer pkg-outbuf))	;; Probably already the
-						;; current buffer.
+	  (set-buffer (get-buffer pkg-outbuf))	;; Probably already the current buffer.
 	  (goto-char (point-min))
 
 	  ;; Make filenames case-insensitive, if necessary
 	  (if (eq system-type 'windows-nt)
 	      (setq case-fold-search t))
 
-	  ;; We really should compute the regexp.
-	  ;; However, directory-sep-char is currently broken, but we need
-	  ;; functional code *NOW*.
-	  (setq regexp "\\bpkginfo[\\/]MANIFEST\\...*")
+	  (setq regexp (concat "\\bpkginfo" 
+			       (char-to-string directory-sep-char)
+			       "MANIFEST\\...*"))
 
 	  ;; Look for the manifest.
 	  (if (not (re-search-forward regexp nil t))
@@ -234,22 +197,18 @@
 
 		;; Yuk.  We weren't passed the package name, and so we have
 		;; to dig for it.  Look for it as the subdirectory name below
-		;; "lisp", "man", "info", or "etc".
+		;; "lisp", or "man".
 		;; Here, we don't use a single regexp because we want to search
 		;; the directories for a package name in a particular order.
-		;; The problem is that packages could have directories like
-		;; "etc/sounds/" or "etc/photos/" and we don't want to get
-		;; these confused with the actual package name (although, in
-		;; the case of "etc/sounds/", it's probably correct).
 		(if (catch 'done
-		      (let ( (dirs '("lisp" "info" "man" "etc")) rexp)
+		      (let ((dirs '("lisp" "man")) 
+			    rexp)
 			(while dirs
 			  (setq rexp (concat "\\b" (car dirs)
 					     "[\\/]\\([^\\/]+\\)[\//]"))
 			  (if (re-search-forward rexp nil t)
 			      (throw 'done t))
-			  (setq dirs (cdr dirs))
-			  )))
+			  (setq dirs (cdr dirs)))))
 		    (progn
 		      (setq package-name (buffer-substring (match-beginning 1)
 							   (match-end 1)))
@@ -277,22 +236,16 @@
 					    (buffer-substring
 					     (match-beginning 1)
 					     (match-end 1)))
-				      (throw 'found-path t)
-				      ))
-				(setq regexps (cdr regexps))
-				)
-			      )
+				      (throw 'found-path t)))
+				(setq regexps (cdr regexps))))
 			    (progn
 			      ;; found a pathname -- add it to the manifest
 			      ;; buffer
 			      (save-excursion
 				(set-buffer manifest-buf)
 				(goto-char (point-max))
-				(insert pathname "\n")
-				)
-			      ))
-			(forward-line 1)
-			)
+				(insert pathname "\n"))))
+			(forward-line 1))
 
 		      ;; Processed all lines.
 		      ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
@@ -312,25 +265,16 @@
 			;; Put the files in sorted order
 			(if-fboundp 'sort-lines
 			    (sort-lines nil (point-min) (point-max))
-			  (error 'unimplemented
-				 "`xemacs-base' not installed?"))
+			  (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
+				package-name))
 			;; Write the file.
 			;; Note that using `write-region' *BYPASSES* any check
 			;; to see if XEmacs is currently editing/visiting the
 			;; file.
-			(write-region (point-min) (point-max) pathname)
-			)
-		      (kill-buffer manifest-buf)
-		      )
-		  (progn
-		    ;; We can't determine the package name from an extracted
-		    ;; file in the tar output buffer.
-		    ))
-		))
-	  )
+			(write-region (point-min) (point-max) pathname))
+		      (kill-buffer manifest-buf))))))
       ;; Restore old case-fold-search status
-      (setq case-fold-search old-case-fold-search))
-    ))
+      (setq case-fold-search old-case-fold-search))))
 
 ;;;###autoload
 (defun package-admin-add-binary-package (file &optional pkg-dir)
@@ -338,8 +282,7 @@
   (interactive "fPackage tarball: ")
   (let ((buf (get-buffer-create package-admin-temp-buffer))
 	(status 1)
-	start err-list
-	)
+	start err-list)
     (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir))
     ;; Ensure that the current directory doesn't change
     (save-excursion
@@ -361,17 +304,11 @@
 		(if (re-search-forward (car err-list) nil t)
 		    (progn
 		      (setq status 1)
-		      (throw 'done nil)
-		      ))
-		(setq err-list (cdr err-list))
-		)
-	      )
+		      (throw 'done nil)))
+		(setq err-list (cdr err-list))))
 	    ;; Make sure that the MANIFEST file exists
-	    (package-admin-check-manifest buf pkg-dir)
-	    ))
-      )
-    status
-    ))
+	    (package-admin-check-manifest buf pkg-dir))))
+    status))
 
 (defun package-admin-rmtree (directory)
   "Delete a directory and all of its contents, recursively.
@@ -406,13 +343,12 @@
 	     (setq package-lispdir (expand-file-name (symbol-name package)
 						     package-lispdir))
 	     (file-accessible-directory-p package-lispdir))
-	package-lispdir)
-    ))
+	package-lispdir)))
 
 (defun package-admin-delete-binary-package (package pkg-topdir)
   "Delete a binary installation of PACKAGE below directory PKG-TOPDIR.
 PACKAGE is a symbol, not a string."
-  (let ( (tmpbuf " *pkg-manifest*") manifest-file package-lispdir dirs file)
+  (let (manifest-file package-lispdir dirs file)
     (setq pkg-topdir (package-admin-get-install-dir package pkg-topdir))
     (setq manifest-file (package-admin-get-manifest-file pkg-topdir package))
     (run-hook-with-args 'package-delete-hook package pkg-topdir)
@@ -421,8 +357,7 @@
 	  ;; The manifest file exists!  Use it to delete the old distribution.
 	  (message "Removing old files for package \"%s\" ..." package)
 	  (sit-for 0)
-	  (setq tmpbuf (get-buffer-create tmpbuf))
-	  (with-current-buffer tmpbuf
+	  (with-temp-buffer
 	    (buffer-disable-undo)
 	    (erase-buffer)
 	    (insert-file-contents manifest-file)
@@ -454,66 +389,30 @@
 
 	    ;; Delete empty directories.
 	    (if dirs
-		(let ( (orig-default-directory default-directory)
-		       ;; directory files file
-		       )
-		  ;; Make sure we preserve the existing `default-directory'.
-		  ;; JV, why does this change the default directory? Does it indeed?
-		  (unwind-protect
-		      (progn
-			;; Warning: destructive sort!
-			(setq dirs (nreverse (sort dirs 'string<)))
-;			;; For each directory ...
-;			(while dirs
-;			  (setq directory (file-name-as-directory (car dirs)))
-;			  (setq files (directory-files directory))
-;			  ;; Delete the directory if it's empty.
-;			  (if (catch 'done
-;				(while files
-;				  (setq file (car files))
-;				  (if (and (not (string= file "."))
-;					   (not (string= file "..")))
-;				      (throw 'done nil))
-;				  (setq files (cdr files))
-;				  )
-;				t)
-;			      (
-;			      (delete-directory directory))
-;			  (setq dirs (cdr dirs))
-;			  )
-			;; JV, On all OS's that I know of delete-directory fails on
-			;; on non-empty dirs anyway
-			(mapc
-			   (lambda (dir)
-			     (condition-case ()
-				 (delete-directory dir)))
-			   dirs))
-		    (setq default-directory orig-default-directory)
-		    )))
-	    )
-	  (kill-buffer tmpbuf)
+		(progn
+		  (mapc
+		   (lambda (dir)
+		     (condition-case ()
+			 (delete-directory dir)))
+		   dirs)))
 	  ;; Delete the MANIFEST file
 	  ;; (set-file-modes manifest-file 438) ;; 438 -> #o666
 	  ;; Note. Packages can have MANIFEST in MANIFEST.
 	  (condition-case ()
 	      (delete-file manifest-file)
 	    (error nil)) ;; Do warning?
-	  (message "Removing old files for package \"%s\" ... done" package))
-	;; The manifest file doesn't exist.  Fallback to just deleting the
-	;; package-specific lisp directory, if it exists.
-	;;
-	;; Delete old lisp directory, if any
-	;; Gads, this is ugly.  However, we're not supposed to use `concat'
-	;; in the name of portability.
-	(when (setq package-lispdir (package-admin-get-lispdir pkg-topdir
-							     package))
-	      (message "Removing old lisp directory \"%s\" ..."
-		       package-lispdir)
-	      (sit-for 0)
-	      (package-admin-rmtree package-lispdir)
-	      (message "Removing old lisp directory \"%s\" ... done"
-		       package-lispdir)
-	      ))
+	  (message "Removing old files for package \"%s\" ... done" package)))
+      ;; The manifest file doesn't exist.  Fallback to just deleting the
+      ;; package-specific lisp directory, if it exists.
+      ;;
+      ;; Delete old lisp directory, if any
+      ;; Gads, this is ugly.  However, we're not supposed to use `concat'
+      ;; in the name of portability.
+      (setq package-lispdir (package-admin-get-lispdir pkg-topdir package))
+      (message "Removing old lisp directory \"%s\" ..." package-lispdir)
+      (sit-for 0)
+      (package-admin-rmtree package-lispdir)
+      (message "Removing old lisp directory \"%s\" ... done" package-lispdir))
     ;; Delete the package from the database of installed packages.
     (package-delete-name package)))
 
--- a/lisp/package-get.el	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/package-get.el	Thu Mar 20 13:19:59 2003 +0000
@@ -172,76 +172,58 @@
   :tag "Host")
 
 (defcustom package-get-remote nil
-  "*List of remote sites to contact for downloading packages.
-List format is '(site-name directory-on-site).  Each site is tried in
-order until the package is found.  As a special case, `site-name' can be
-`nil', in which case `directory-on-site' is treated as a local directory."
+  "*The remote site to contact for downloading packages.
+Format is '(site-name directory-on-site).  As a special case, `site-name'
+can be `nil', in which case `directory-on-site' is treated as a local
+directory."
   :tag "Package repository"
-  :type '(repeat (choice (list :tag "Local" (const :tag "Local" nil) directory )
-			 (list :tag "Remote" host-name directory) ))
+  :type '(set (choice (const :tag "None" nil)
+		      (list :tag "Local" (const :tag "Local" nil) directory)
+		      (list :tag "Remote" host-name directory)))
   :group 'package-get)
 
 ;;;###autoload
 (defcustom package-get-download-sites
   '(
-    ;; North America
-    ("Pre-Releases" "ftp.xemacs.org" "pub/xemacs/beta/experimental/packages")
-    ("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages")
-    ("ca.xemacs.org (Canada)" "ftp.ca.xemacs.org" "pub/Mirror/xemacs/packages")
-    ("crc.ca (Canada)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages")
-    ("us.xemacs.org (United States)" "ftp.us.xemacs.org" "pub/xemacs/packages")
-    ("ibiblio.org (United States)" "ibiblio.org" "pub/packages/editors/xemacs/packages")
-    ("stealth.net (United States)" "ftp.stealth.net" "pub/mirrors/ftp.xemacs.org/pub/xemacs/packages")
-    ;("uiuc.edu (United States)" "uiarchive.uiuc.edu" "pub/packages/xemacs/packages")
-
-    ;; South America
-    ("br.xemacs.org (Brazil)" "ftp.br.xemacs.org" "pub/xemacs/packages")
-
-    ;; Europe
-    ("at.xemacs.org (Austria)" "ftp.at.xemacs.org" "editors/xemacs/packages")
-    ("be.xemacs.org (Belgium)" "ftp.be.xemacs.org" "xemacs/packages")
-    ("cz.xemacs.org (Czech Republic)" "ftp.cz.xemacs.org" "MIRRORS/ftp.xemacs.org/pub/xemacs/packages")
-    ("dk.xemacs.org (Denmark)" "ftp.dk.xemacs.org" "pub/emacs/xemacs/packages")
-    ("fi.xemacs.org (Finland)" "ftp.fi.xemacs.org" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages")
-    ("fr.xemacs.org (France)" "ftp.fr.xemacs.org" "pub/xemacs/packages")
-    ("pasteur.fr (France)" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
-    ("de.xemacs.org (Germany)" "ftp.de.xemacs.org" "pub/ftp.xemacs.org/tux/xemacs/packages")
-    ("tu-darmstadt.de (Germany)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages")
-    ;("hu.xemacs.org (Hungary)" "ftp.hu.xemacs.org" "pub/packages/xemacs/packages")
-    ("ie.xemacs.org (Ireland)" "ftp.ie.xemacs.org" "mirrors/ftp.xemacs.org/pub/xemacs/packages")
-    ("it.xemacs.org (Italy)" "ftp.it.xemacs.org" "unix/packages/XEMACS/packages")
-    ("no.xemacs.org (Norway)" "ftp.no.xemacs.org" "pub/xemacs/packages")
-    ("pl.xemacs.org (Poland)" "ftp.pl.xemacs.org" "pub/unix/editors/xemacs/packages")
-    ("ru.xemacs.org (Russia)" "ftp.ru.xemacs.org" "pub/xemacs/packages")
-    ("sk.xemacs.org (Slovakia)" "ftp.sk.xemacs.org" "pub/mirrors/xemacs/packages")
-    ("se.xemacs.org (Sweden)" "ftp.se.xemacs.org" "pub/gnu/xemacs/packages")
-    ("ch.xemacs.org (Switzerland)" "ftp.ch.xemacs.org" "mirror/xemacs/packages")
-    ("uk.xemacs.org (United Kingdom)" "ftp.uk.xemacs.org" "sites/ftp.xemacs.org/pub/xemacs/packages")
-
-    ;; Asia
-    ("jp.xemacs.org (Japan)" "ftp.jp.xemacs.org" "pub/GNU/xemacs/packages")
-    ("aist.go.jp (Japan)" "ring.aist.go.jp" "pub/text/xemacs/packages")
-    ("asahi-net.or.jp (Japan)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages")
-    ("dti.ad.jp (Japan)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages")
-    ("jaist.ac.jp (Japan)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages")
-    ("nucba.ac.jp (Japan)" "mirror.nucba.ac.jp" "mirror/xemacs/packages")
-    ("sut.ac.jp (Japan)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages")
-    ("kr.xemacs.org (Korea)" "ftp.kr.xemacs.org" "pub/tools/emacs/xemacs/packages")
-    ;("tw.xemacs.org (Taiwan)" "ftp.tw.xemacs.org" "Editors/xemacs/packages")
-
-    ;; Africa
-    ("za.xemacs.org (South Africa)" "ftp.za.xemacs.org" "mirrorsites/ftp.xemacs.org/packages")
-
-    ;; Middle East
-    ("sa.xemacs.org (Saudi Arabia)" "ftp.sa.xemacs.org" "pub/mirrors/ftp.xemacs.org/xemacs/packages")
-
-    ;; Australia
-    ("au.xemacs.org (Australia)" "ftp.au.xemacs.org" "pub/xemacs/packages")
-    ("aarnet.edu.au (Australia)" "mirror.aarnet.edu.au" "pub/xemacs/packages")
-
-    ;; Oceania
-    ("nz.xemacs.org (New Zealand)" "ftp.nz.xemacs.org" "mirror/ftp.xemacs.org/packages")
-    )
+    ;; Main XEmacs Site (ftp.xemacs.org)
+    ("US (Main XEmacs Site)" 
+     "ftp.xemacs.org" "pub/xemacs/packages")
+    ;; In alphabetical order of Country, our mirrors...
+    ("Australia (aarnet.edu.au)" "mirror.aarnet.edu.au" "pub/xemacs/packages")
+    ("Australia (au.xemacs.org)" "ftp.au.xemacs.org" "pub/xemacs/packages")
+    ("Austria (at.xemacs.org)" "ftp.at.xemacs.org" "editors/xemacs/packages")
+    ("Belgium (be.xemacs.org)" "ftp.be.xemacs.org" "xemacs/packages")
+    ("Brazil (br.xemacs.org)" "ftp.br.xemacs.org" "pub/xemacs/packages")
+    ("Canada (ca.xemacs.org)" "ftp.ca.xemacs.org" "pub/Mirror/xemacs/packages")
+    ("Canada (crc.ca)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages")
+    ("Czech Republic (cz.xemacs.org)" "ftp.cz.xemacs.org" "MIRRORS/ftp.xemacs.org/pub/xemacs/packages")
+    ("Denmark (dk.xemacs.org)" "ftp.dk.xemacs.org" "pub/emacs/xemacs/packages")
+    ("Finland (fi.xemacs.org)" "ftp.fi.xemacs.org" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages")
+    ("France (fr.xemacs.org)" "ftp.fr.xemacs.org" "pub/xemacs/packages")
+    ("France (pasteur.fr)" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
+    ("Germany (de.xemacs.org)" "ftp.de.xemacs.org" "pub/ftp.xemacs.org/tux/xemacs/packages")
+    ("Germany (tu-darmstadt.de)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages")
+    ("Ireland (ie.xemacs.org)" "ftp.ie.xemacs.org" "mirrors/ftp.xemacs.org/pub/xemacs/packages")
+    ("Italy (it.xemacs.org)" "ftp.it.xemacs.org" "unix/packages/XEMACS/packages")
+    ("Japan (aist.go.jp)" "ring.aist.go.jp" "pub/text/xemacs/packages")
+    ("Japan (asahi-net.or.jp)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages")
+    ("Japan (dti.ad.jp)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages")
+    ("Japan (jaist.ac.jp)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages")
+    ("Japan (jp.xemacs.org)" "ftp.jp.xemacs.org" "pub/GNU/xemacs/packages")
+    ("Japan (nucba.ac.jp)" "mirror.nucba.ac.jp" "mirror/xemacs/packages")
+    ("Japan (sut.ac.jp)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages")
+    ("Korea (kr.xemacs.org))" "ftp.kr.xemacs.org" "pub/tools/emacs/xemacs/packages")
+    ("Norway (no.xemacs.org)" "ftp.no.xemacs.org" "pub/xemacs/packages")
+    ("Poland (pl.xemacs.org)" "ftp.pl.xemacs.org" "pub/unix/editors/xemacs/packages")
+    ("Russia (ru.xemacs.org)" "ftp.ru.xemacs.org" "pub/xemacs/packages")
+    ("Slovakia (sk.xemacs.org)" "ftp.sk.xemacs.org" "pub/mirrors/xemacs/packages")
+    ("South Africa (za.xemacs.org)" "ftp.za.xemacs.org" "mirrorsites/ftp.xemacs.org/packages")
+    ("Sweden (se.xemacs.org)" "ftp.se.xemacs.org" "pub/gnu/xemacs/packages")
+    ("Switzerland (ch.xemacs.org)" "ftp.ch.xemacs.org" "mirror/xemacs/packages")
+    ("UK (uk.xemacs.org)" "ftp.uk.xemacs.org" "sites/ftp.xemacs.org/pub/xemacs/packages")
+    ("US (ibiblio.org)" "ibiblio.org" "pub/packages/editors/xemacs/packages")
+    ("US (stealth.net)" "ftp.stealth.net" "pub/mirrors/ftp.xemacs.org/pub/xemacs/packages")
+    ("US (us.xemacs.org)" "ftp.us.xemacs.org" "pub/xemacs/packages"))
   "*List of remote sites available for downloading packages.
 List format is '(site-description site-name directory-on-site).
 SITE-DESCRIPTION is a textual description of the site.  SITE-NAME
@@ -253,6 +235,90 @@
   :type '(repeat (list (string :tag "Name") host-name directory))
   :group 'package-get)
 
+;;;###autoload
+(defcustom package-get-pre-release-download-sites
+  '(
+    ;; Main XEmacs Site (ftp.xemacs.org)
+    ("Pre-Releases (Main XEmacs Site)" "ftp.xemacs.org" 
+     "pub/xemacs/beta/experimental/packages")
+    ;; In alphabetical order of Country, our mirrors...
+    ("Australia Pre-Releases (aarnet.edu.au)" "mirror.aarnet.edu.au" 
+     "pub/xemacs/beta/experimental/packages")
+    ("Australia Pre-Releases (au.xemacs.org)" "ftp.au.xemacs.org" 
+     "pub/xemacs/beta/experimental/packages")
+    ("Austria Pre-Releases (at.xemacs.org)" "ftp.at.xemacs.org" 
+     "editors/xemacs/beta/experimentsl/packages")
+    ("Brazil Pre-Releases (br.xemacs.org)" "ftp.br.xemacs.org" 
+     "pub/xemacs/xemacs-21.5/experimental/packages")
+    ("Canada Pre-Releases (ca.xemacs.org)" "ftp.ca.xemacs.org" 
+     "pub/Mirror/xemacs/beta/experimental/packages")
+    ("Canada Pre-Releases (crc.ca)" "ftp.crc.ca" 
+     "pub/packages/editors/xemacs/beta/experimental/packages")
+    ("Czech Republic Pre-Releases (cz.xemacs.org)" "ftp.cz.xemacs.org" 
+     "MIRRORS/ftp.xemacs.org/pub/xemacs/xemacs-21.5/experimental/packages")
+    ("Denmark Pre-Releases (dk.xemacs.org)" "ftp.dk.xemacs.org" 
+     "pub/emacs/xemacs/beta/experimental/packages")
+    ("Finland Pre-Releases (fi.xemacs.org)" "ftp.fi.xemacs.org" 
+     "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/beta/experimental/packages")
+    ("France Pre-Releases (fr.xemacs.org)" "ftp.fr.xemacs.org" 
+     "pub/xemacs/beta/experimental/packages")
+    ("France Pre-Releases (pasteur.fr)" "ftp.pasteur.fr" 
+     "pub/computing/xemacs/beta/experimental/packages")
+    ("Germany Pre-Releases (de.xemacs.org)" "ftp.de.xemacs.org" 
+     "pub/ftp.xemacs.org/tux/xemacs/beta/experimental/packages")
+    ("Germany Pre-Releases (tu-darmstadt.de)" "ftp.tu-darmstadt.de" 
+     "pub/editors/xemacs/beta/experimental/packages")
+    ("Ireland Pre-Releases (ie.xemacs.org)" "ftp.ie.xemacs.org" 
+     "mirrors/ftp.xemacs.org/pub/xemacs/beta/experimental/packages")
+    ("Italy Pre-Releases (it.xemacs.org)" "ftp.it.xemacs.org" 
+     "unix/packages/XEMACS/beta/experimental/packages")
+    ("Japan Pre-Releases (aist.go.jp)" "ring.aist.go.jp" 
+     "pub/text/xemacs/beta/experimental/packages")
+    ("Japan Pre-Releases (asahi-net.or.jp)" "ring.asahi-net.or.jp" 
+     "pub/text/xemacs/beta/experimental/packages")
+    ("Japan Pre-Releases (dti.ad.jp)" "ftp.dti.ad.jp" 
+     "pub/unix/editor/xemacs/beta/experimental/packages")
+    ("Japan Pre-Releases (jaist.ac.jp)" "ftp.jaist.ac.jp" 
+     "pub/GNU/xemacs/beta/experimental/packages")
+    ("Japan Pre-Releases (jp.xemacs.org)" "ftp.jp.xemacs.org" 
+     "pub/GNU/xemacs/beta/experimental/packages")
+    ("Japan Pre-Releases (sut.ac.jp)" "sunsite.sut.ac.jp" 
+     "pub/archives/packages/xemacs/xemacs-21.5/experimental/packages")
+    ("Norway Pre-Releases (no.xemacs.org)" "ftp.no.xemacs.org" 
+     "pub/xemacs/beta/experimental/packages")
+    ("Poland Pre-Releases (pl.xemacs.org)" "ftp.pl.xemacs.org" 
+     "pub/unix/editors/xemacs/beta/experimental/packages")
+    ("Russia Pre-Releases (ru.xemacs.org)" "ftp.ru.xemacs.org" 
+     "pub/xemacs/beta/experimental/packages")
+    ("Saudi Arabia Pre-Releases (sa.xemacs.org)" "ftp.sa.xemacs.org" 
+     "pub/mirrors/ftp.xemacs.org/xemacs/xemacs-21.5/experimental/packages")
+    ("Slovakia Pre-Releases (sk.xemacs.org)" "ftp.sk.xemacs.org" 
+     "pub/mirrors/xemacs/beta/experimental/packages")
+    ("South Africa Pre-Releases (za.xemacs.org)" "ftp.za.xemacs.org" 
+     "mirrorsites/ftp.xemacs.org/beta/experimental/packages")
+    ("Sweden Pre-Releases (se.xemacs.org)" "ftp.se.xemacs.org" 
+     "pub/gnu/xemacs/beta/experimental/packages")
+    ("Switzerland Pre-Releases (ch.xemacs.org)" "ftp.ch.xemacs.org" 
+     "mirror/xemacs/beta/experimental/packages")
+    ("UK Pre-Releases (uk.xemacs.org)" "ftp.uk.xemacs.org" 
+     "sites/ftp.xemacs.org/pub/xemacs/beta/experimental/packages")
+    ("US Pre-Releases (ibiblio.org)" "ibiblio.org" 
+     "pub/packages/editors/xemacs/beta/experimental/packages")
+    ("US Pre-Releases (stealth.net)" "ftp.stealth.net" 
+     "pub/mirrors/ftp.xemacs.org/pub/xemacs/beta/experimental/packages")
+    ("US Pre-Releases (us.xemacs.org)" "ftp.us.xemacs.org" 
+     "pub/xemacs/beta/experimental/packages"))
+  "*List of remote sites available for downloading \"Pre-Release\" packages.
+List format is '(site-description site-name directory-on-site).
+SITE-DESCRIPTION is a textual description of the site.  SITE-NAME
+is the internet address of the download site.  DIRECTORY-ON-SITE
+is the directory on the site in which packages may be found.
+This variable is used to initialize `package-get-remote', the
+variable actually used to specify package download sites."
+  :tag "Pre-Release Package download sites"
+  :type '(repeat (list (string :tag "Name") host-name directory))
+  :group 'package-get)
+
 (defcustom package-get-remove-copy t
   "*After copying and installing a package, if this is t, then remove the
 copy.  Otherwise, keep it around."
@@ -279,7 +345,7 @@
   :type 'boolean
   :group 'package-get)
 
-(defcustom package-get-require-signed-base-updates nil
+(defcustom package-get-require-signed-base-updates t
   "*If set to a non-nil value, require explicit user confirmation for updates
 to the package-get database which cannot have their signature verified via PGP.
 When nil, no PGP verification will be done."
@@ -295,24 +361,6 @@
 (defvar package-get-was-current nil
   "Non-nil we did our best to fetch a current database.")
 
-
-;Shouldn't this be in package-ui?
-;;;###autoload
-(defun package-get-download-menu ()
-  "Build the `Add Download Site' menu."
-  (mapcar (lambda (site)
-	    (vector (car site)
-		    `(if (member (quote ,(cdr site))
-				 package-get-remote)
-			 (setq package-get-remote
-			       (delete (quote ,(cdr site))
-				       package-get-remote))
-		       (package-ui-add-site (quote ,(cdr site))))
-		    :style 'toggle
-		    :selected `(member (quote ,(cdr site))
-				       package-get-remote)))
-	  package-get-download-sites))
-
 ;;;###autoload
 (defun package-get-require-base (&optional force-current)
   "Require that a package-get database has been loaded.
@@ -356,15 +404,14 @@
 If NO-REMOTE is non-nil never search remote locations."
   (if (file-name-absolute-p file)
       file
-    (let ((entries package-get-remote)
+    (let ((site package-get-remote)
           (expanded nil))
-      (while entries
-	(unless (and no-remote (caar entries))
-	  (let ((expn (package-get-remote-filename (car entries) file)))
+      (when site
+	(unless (and no-remote (caar (list site)))
+	  (let ((expn (package-get-remote-filename (car (list site)) file)))
 	    (if (and expn (file-exists-p expn))
-		(setq entries  nil
-		      expanded expn))))
-        (setq entries (cdr entries)))
+		(setq site nil
+		      expanded expn)))))
       (or expanded
           (and (not nil-if-not-found)
                file)))))
@@ -394,7 +441,6 @@
 	  (let ((coding-system-for-write 'binary))
 	    (write-file location)))))))
 
-
 ;;;###autoload
 (defun package-get-update-base (&optional db-file force-current)
   "Update the package-get database file with entries from DB-FILE.
@@ -431,22 +477,18 @@
 used interactively, for example from a mail or news buffer."
   (interactive)
   (setq buf (or buf (current-buffer)))
-  (let (content-beg content-end ;beg end
-		    )
+  (let (content-beg content-end)
     (save-excursion
       (set-buffer buf)
       (goto-char (point-min))
       (setq content-beg (point))
       (setq content-end (save-excursion (goto-char (point-max)) (point)))
       (when (re-search-forward package-get-pgp-signed-begin-line nil t)
-        ;(setq beg (match-beginning 0))
         (setq content-beg (match-end 0)))
       (when (re-search-forward package-get-pgp-signature-begin-line nil t)
         (setq content-end (match-beginning 0))
 	(setq package-entries-are-signed t))
-      (when (re-search-forward package-get-pgp-signature-end-line nil t)
-        ;(setq end (point))
-	)
+      (re-search-forward package-get-pgp-signature-end-line nil t)
       (setq package-get-continue-update-base t)
       (if package-get-require-signed-base-updates 
 	  (if package-entries-are-signed
@@ -477,8 +519,8 @@
 	    (if (yes-or-no-p
 		 "Package Index is not PGP signed.  Continue anyway? ")
 		(setq package-get-continue-update-base t)
-	      (error "Package database not updated")
-	      (setq package-get-continue-update-base nil))))
+	      (setq package-get-continue-update-base nil)
+	      (error "Package database not updated"))))
       ;; ToDo: We should call package-get-maybe-save-index on the region
       (if package-get-continue-update-base
 	  (progn
@@ -563,12 +605,10 @@
 		   'version))
 	    (while (string=
 		    (setq version (read-string "Version: " default-version))
-		    "")
-	      )
+		    ""))
 	    (if package-symbol
 		(list package-symbol version)
-	      (list package version))
-	    )
+	      (list package version)))
 	(if package-symbol
 	    (list package-symbol)
 	  (list package))))))
@@ -590,8 +630,7 @@
   (catch 'exit
     (mapcar (lambda (pkg)
 	      (if (not (package-get (car pkg) nil 'never))
-		  (throw 'exit nil)		;; Bail out if error detected
-		  ))
+		  (throw 'exit nil)))		;; Bail out if error detected
 	    packages-package-list))
   (package-net-update-installed-db))
 
@@ -611,8 +650,7 @@
 						     package))
 	 (this-package (package-get-info-version
 			the-package version))
-	 (this-requires (package-get-info-prop this-package 'requires))
-	 )
+	 (this-requires (package-get-info-prop this-package 'requires)))
     (catch 'exit
       (setq version (package-get-info-prop this-package 'version))
       (unless (package-get-installedp package version)
@@ -641,12 +679,9 @@
 			     (package-get-all reqd-name reqd-version
 					      fetched-packages
                                               install-dir)))
-		  (throw 'exit nil)))
-	  )
-	(setq this-requires (cdr this-requires)))
-      )
-    fetched-packages
-    ))
+		  (throw 'exit nil))))
+	(setq this-requires (cdr this-requires))))
+    fetched-packages))
 
 ;;;###autoload
 (defun package-get-dependencies (packages)
@@ -705,20 +740,78 @@
 	(progn
 	  ;; Add lispdir to load-path if it doesn't already exist.
 	  ;; NOTE: this does not take symlinks, etc., into account.
-	  (if (let ( (dirs load-path) )
+	  (if (let ((dirs load-path))
 		(catch 'done
 		  (while dirs
 		    (if (string-equal (car dirs) lispdir)
 			(throw 'done nil))
-		    (setq dirs (cdr dirs))
-		    )
+		    (setq dirs (cdr dirs))) 
 		  t))
 	      (setq load-path (cons lispdir load-path)))
 	  (if (not (package-get-load-package-file lispdir "auto-autoloads"))
 	      (package-get-load-package-file lispdir "_pkg"))
 	  t)
-      nil)
-    ))
+      nil)))
+
+;;;###autoload
+(defun package-get-info (package information &optional arg remote)
+  "Get information about a package.
+
+Quite similar to `package-get-info-prop', but can retrieve a lot more
+information.
+
+Argument PACKAGE is the name of an XEmacs package (a symbol).  It must
+be a valid package, ie, a member of `package-get-base'.
+
+Argument INFORMATION is a symbol that can be any one of:
+
+   standards-version     Package system version (not used).
+   version               Version of the XEmacs package.
+   author-version        The upstream version of the package.
+   date                  The date the package was last modified.
+   build-date            The date the package was last built.
+   maintainer            The maintainer of the package.
+   distribution          Will always be \"xemacs\" (not used).
+   priority              \"low\", \"medium\", or \"high\" (not used).
+   category              Either \"standard\", \"mule\", or \"unsupported\"..
+   dump                  Is the package dumped (not used).
+   description           A description of the package.
+   filename              The filename of the binary tarball of the package.
+   md5sum                The md5sum of filename.
+   size                  The size in bytes of filename.
+   provides              A list of symbols that this package provides.
+   requires              A list of packages that this package requires.
+   type                  Can be either \"regular\" or \"single-file\".
+
+If optional argument ARG is non-nil insert INFORMATION into current
+buffer at point.  This is very useful for doing things like inserting
+a maintainer's email address into a mail buffer.
+
+If optional argument REMOTE is non-nil use a package list from a
+remote site.  For this to work `package-get-remote' must be non-nil.
+
+If this function is called interactively it will display INFORMATION
+in the minibuffer."
+  (interactive "SPackage: \nSInfo: \nP")
+    (if remote
+	(package-get-require-base t)
+      (package-get-require-base nil))
+    (let ((all-pkgs package-get-base)
+	  info)
+      (loop until (equal package (caar all-pkgs))
+	do (setq all-pkgs (cdr all-pkgs))
+	do (if (not all-pkgs)
+	       (error (format "%s is not a valid package" package))))
+      (setq info (plist-get (cadar all-pkgs) information))
+      (if (interactive-p)
+	  (if arg
+	      (insert (format "%s" info))
+	    (if (package-get-key package :version)
+		(message "%s" info)
+	      (message "%s (Package: %s is not installed)" info package)))
+	(if arg
+	    (insert (format "%s" info))
+	  info))))
 
 ;;;###autoload
 (defun package-get (package &optional version conflict install-dir)
@@ -733,8 +826,7 @@
 
 The value of `package-get-base' is used to determine what files should
 be retrieved.  The value of `package-get-remote' is used to determine
-where a package should be retrieved from.  The sites are tried in
-order so one is better off listing easily reached sites first.
+where a package should be retrieved from.
 
 Once the package is retrieved, its md5 checksum is computed.  If that
 sum does not match that stored in `package-get-base' for this version
@@ -751,23 +843,27 @@
 					  package) version))
          (latest (package-get-info-prop this-package 'version))
          (installed (package-get-key package :version))
-	 (this-requires (package-get-info-prop this-package 'requires))
 	 (found nil)
-	 (search-dirs package-get-remote)
+	 (search-dir package-get-remote)
 	 (base-filename (package-get-info-prop this-package 'filename))
 	 (package-status t)
 	 filenames full-package-filename)
+    (if (and (equal (package-get-info package 'category) "mule")
+	     (not (featurep 'mule)))
+	(error "Mule package %s can't be installed with a non-Mule XEmacs"
+	       package))
     (if (null this-package)
 	(if package-get-remote
 	    (error "Couldn't find package %s with version %s"
 		   package version)
-	  (error "No download sites or local package locations specified.")))
+	  (error "No download site or local package location specified.")))
     (if (null base-filename)
 	(error "No filename associated with package %s, version %s"
 	       package version))
     (setq install-dir
-	  (package-admin-get-install-dir package install-dir
-		(or (eq package 'mule-base) (memq 'mule-base this-requires))))
+	  (package-admin-get-install-dir 
+	   package install-dir
+	   (equal (package-get-info package 'category) "mule")))
 
     ;; If they asked for the latest using version=nil, don't get an older
     ;; version than we already have.
@@ -800,15 +896,12 @@
       ;; and copy it into the staging directory.  Then validate
       ;; the checksum.  Finally, install the package.
       (catch 'done
-	(let (search-filenames current-dir-entry host dir current-filename
-			       dest-filename)
+	(let (search-filenames host dir current-filename dest-filename)
 	  ;; In each search directory ...
-	  (while search-dirs
-	    (setq current-dir-entry (car search-dirs)
-		  host (car current-dir-entry)
-		  dir (car (cdr current-dir-entry))
-		  search-filenames filenames
-		  )
+	  (when search-dir
+	    (setq host (car search-dir)
+		  dir (car (cdr search-dir))
+		  search-filenames filenames)
 
 	    ;; Look for one of the possible package filenames ...
 	    (while search-filenames
@@ -816,49 +909,37 @@
 		    dest-filename (package-get-staging-dir current-filename))
 	      (cond
 	       ;; No host means look on the current system.
-	       ( (null host)
-		 (setq full-package-filename
-		       (substitute-in-file-name
-			(expand-file-name current-filename
-					  (file-name-as-directory dir))))
-		 )
+	       ((null host)
+		(setq full-package-filename
+		      (substitute-in-file-name
+		       (expand-file-name current-filename
+					 (file-name-as-directory dir)))))
 
 	       ;; If it's already on the disk locally, and the size is
-	       ;; greater than zero ...
-	       ( (and (file-exists-p dest-filename)
-		      (let (attrs)
-			;; file-attributes could return -1 for LARGE files,
-			;; but, hopefully, packages won't be that large.
-			(and (setq attrs (file-attributes dest-filename))
-			     (> (nth 7 attrs) 0))))
-		 (setq full-package-filename dest-filename)
-		 )
+	       ;; correct
+	       ((and (file-exists-p dest-filename)
+		     (eq (nth 7 (file-attributes dest-filename))
+			 (package-get-info package 'size)))
+		 (setq full-package-filename dest-filename))
 
 	       ;; If the file exists on the remote system ...
-	       ( (file-exists-p (package-get-remote-filename
-				 current-dir-entry current-filename))
-		 ;; Get it
-		 (setq full-package-filename dest-filename)
-		 (message "Retrieving package `%s' ..."
-			  current-filename)
-		 (sit-for 0)
-		 (copy-file (package-get-remote-filename current-dir-entry
-							 current-filename)
-			    full-package-filename t)
-		 )
-	       )
+	       ((file-exists-p (package-get-remote-filename
+				search-dir current-filename))
+		;; Get it
+		(setq full-package-filename dest-filename)
+		(message "Retrieving package `%s' ..."
+			 current-filename)
+		(sit-for 0)
+		(copy-file (package-get-remote-filename search-dir
+							current-filename)
+			   full-package-filename t)))
 
 	      ;; If we found it, we're done.
 	      (if (and full-package-filename
 		       (file-exists-p full-package-filename))
 		  (throw 'done nil))
 	      ;; Didn't find it.  Try the next possible filename.
-	      (setq search-filenames (cdr search-filenames))
-	      )
-	    ;; Try looking in the next possible directory ...
-	    (setq search-dirs (cdr search-dirs))
-	    )
-	  ))
+	      (setq search-filenames (cdr search-filenames))))))
 
       (if (or (not full-package-filename)
 	      (not (file-exists-p full-package-filename)))
@@ -874,7 +955,10 @@
 	(if (not (string= (md5 (current-buffer))
 			  (package-get-info-prop this-package
 						 'md5sum)))
-	    (error "Package %s does not match md5 checksum" base-filename)))
+	    (progn
+	      (delete-file full-package-filename)
+	      (error "Package %s does not match md5 checksum %s has been deleted" 
+		     base-filename full-package-filename))))
 
       (package-admin-delete-binary-package package install-dir)
 
@@ -892,30 +976,25 @@
 		  (progn
 		    (run-hook-with-args 'package-install-hook package install-dir)
 		    (message "Added package `%s'" package)
-		    (sit-for 0)
-		    )
+		    (sit-for 0))
 		(progn
 		  ;; display message only if there isn't already one.
 		  (if (not (current-message))
 		      (progn
 			(message "Added package `%s' (errors occurred)"
 				 package)
-			(sit-for 0)
-			))
+			(sit-for 0)))
 		  (if package-status
-		      (setq package-status 'errors))
-		  ))
-	      )
+		      (setq package-status 'errors)))))
 	  (message "Installation of package %s failed." base-filename)
 	  (sit-for 0)
 	  (switch-to-buffer package-admin-temp-buffer)
-	  (setq package-status nil)
-	  ))
+	  (delete-file full-package-filename)
+	  (setq package-status nil)))
       (setq found t))
     (if (and found package-get-remove-copy)
 	(delete-file full-package-filename))
-    package-status
-    )))
+    package-status)))
 
 (defun package-get-info-find-package (which name)
   "Look in WHICH for the package called NAME and return all the info
@@ -966,13 +1045,6 @@
    (package-get-info-version
     (package-get-info-find-package package-list package) version) property))
 
-(defun package-get-set-version-prop (package-list package version
-						  property value)
-  "A utility to make it easier to add a VALUE for a specific PROPERTY
-  in this VERSION of a specific PACKAGE kept in the PACKAGE-LIST.
-Returns the modified PACKAGE-LIST.  Any missing fields are created."
-  )
-
 (defun package-get-staging-dir (filename)
   "Return a good place to stash FILENAME when it is retrieved.
 Use `package-get-dir' for directory to store stuff.
@@ -1010,7 +1082,6 @@
 		(concat dir "/"))
 	      filename))))
 
-
 (defun package-get-installedp (package version)
   "Determine if PACKAGE with VERSION has already been installed.
 I'm not sure if I want to do this by searching directories or checking
@@ -1019,7 +1090,9 @@
   (equal (plist-get
 	  (package-get-info-find-package packages-package-list
 					 package) ':version)
-	 (if (floatp version) version (string-to-number version))))
+	 (if (floatp version) 
+	     version 
+	   (string-to-number version))))
 
 ;;;###autoload
 (defun package-get-package-provider (sym &optional force-current)
@@ -1066,6 +1139,5 @@
 	(intern (substring (symbol-name pkg) 0 (match-beginning 0))))
        t)))
 
-
 (provide 'package-get)
 ;;; package-get.el ends here
--- a/lisp/package-ui.el	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/package-ui.el	Thu Mar 20 13:19:59 2003 +0000
@@ -80,11 +80,10 @@
    :group 'pui
    :type 'face)
    
-
-
-
-(defvar pui-info-buffer "*Packages*"
-  "Buffer to use for displaying package information.")
+(defcustom pui-info-buffer "*Packages*"
+  "*Buffer to use for displaying package information."
+  :group 'pui
+  :type 'string)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; End of user-changeable variables.
@@ -137,46 +136,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Configuration routines
 
-(defun pui-directory-exists (dir)
-  "Check to see if DIR exists in `package-get-remote'."
-  (let (found)
-    (mapcar #'(lambda (item)
-		(if (and (null (car item))
-			 (string-equal (file-name-as-directory (car (cdr item)))
-				       (file-name-as-directory dir)))
-		    (setq found t)))
-	    package-get-remote)
-    found
-    ))
-
-(defun pui-package-dir-list (buffer)
-  "In BUFFER, format the list of package binary paths."
-  (let ( (count 1) paths sys dir)
-    (set-buffer buffer)
-    (buffer-disable-undo buffer)
-    (erase-buffer buffer)
-    (insert "Existing package binary paths:\n\n")
-    (setq paths package-get-remote)
-    (while paths
-      (setq sys (car (car paths))
-	    dir (car (cdr (car paths))))
-      (insert (format "%2s. " count))
-      (if (null sys)
-	  (insert dir)
-	(insert sys ":" dir))
-      (insert "\n")
-      (setq count (1+ count))
-      (setq paths (cdr paths))
-      )
-    (insert "\nThese are the places that will be searched for package binaries.\n")
-    (goto-char (point-min))
-    ))
-
 ;;;###autoload
 (defun package-ui-add-site (site)
   "Add site to package-get-remote and possibly offer to update package list."
   (let ((had-none (null package-get-remote)))
-    (push site package-get-remote)    
+    (setq package-get-remote site)    
     (when (and had-none package-get-was-current
 	       (y-or-n-p "Update Package list?"))
       (setq package-get-was-current nil)
@@ -185,39 +149,49 @@
 	  (save-window-excursion
 	    (pui-list-packages))))
     (set-menubar-dirty-flag)))
-    
+
+;;;###autoload
+(defun package-ui-download-menu ()
+  "Build the `Add Download Site' menu."
+  (mapcar (lambda (site)
+  	    (vector (car site)
+  		    `(if (equal package-get-remote (quote ,(cdr site)))
+ 		      (setq package-get-remote nil)
+ 		      (package-ui-add-site (quote ,(cdr site))))
+		    ;; I've used radio buttons so that only a single
+		    ;; site can be selected, but they are in fact
+		    ;; toggles.  SY.
+  		    :style 'radio
+  		    :selected `(equal package-get-remote (quote ,(cdr site)))))
+  	  package-get-download-sites))
 
 ;;;###autoload
-(defun pui-add-install-directory (dir)
-  "Add a new package binary directory to the head of `package-get-remote'.
+(defun package-ui-pre-release-download-menu ()
+  "Build the 'Pre-Release Download Sites' menu."
+  (mapcar (lambda (site)
+  	    (vector (car site)
+  		    `(if (equal package-get-remote (quote ,(cdr site)))
+ 		      (setq package-get-remote nil)
+ 		      (package-ui-add-site (quote ,(cdr site))))
+		    ;; I've used radio buttons so that only a single
+		    ;; site can be selected, but they are in fact
+		    ;; toggles.  SY.
+  		    :style 'radio
+  		    :selected `(equal package-get-remote (quote ,(cdr site)))))
+  	  package-get-pre-release-download-sites))
+
+;;;###autoload
+(defun pui-set-local-package-get-directory (dir)
+  "Set a new package binary directory in `package-get-remote'.
 Note that no provision is made for saving any changes made by this function.
 It exists mainly as a convenience for one-time package installations from
 disk."
-  (interactive (let ( (tmpbuf (get-buffer-create
-			       "*Existing Package Binary Paths*"))
-		      dir)
-		 (save-window-excursion
-		   (save-excursion
-		     (unwind-protect
-			 (progn
-			   (pui-package-dir-list tmpbuf)
-			   (display-buffer tmpbuf)
-			   (setq dir (read-directory-name
-				      "New package binary directory to add? "
-				      nil nil t))
-			   )
-		       (kill-buffer tmpbuf)
-		       )))
-		 (list dir)
-		 ))
-  (progn
-    (if (not (pui-directory-exists dir))
-	(progn
-	  (setq package-get-remote (cons (list nil dir) package-get-remote))
-	  (message "Package directory \"%s\" added." dir)
-	  )
-      (message "Directory \"%s\" already exists in `package-get-remote'." dir))
-    ))
+  (interactive) 
+  (let ((dir (read-directory-name
+	      "New package binary directory to add? "
+	      nil nil t)))
+    (setq package-get-remote (list nil dir))
+    (message "Package directory \"%s\" added." dir)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Package list/installer routines
@@ -238,8 +212,7 @@
                     version))
               (list " " pui-up-to-date-package-face)
             (list "*" pui-outdated-package-face)))
-      (list "-" pui-uninstalled-package-face))
-    ))
+      (list "-" pui-uninstalled-package-face))))
 
 (defun pui-update-package-display (extent &optional pkg-sym version)
   "Update the package status for EXTENT.
@@ -272,9 +245,7 @@
       (goto-char (extent-start-position extent))
       (delete-char 1)
       (insert sym-char)
-      (set-buffer-modified-p nil)
-      )
-    ))
+      (set-buffer-modified-p nil))))
 
 (defun pui-toggle-package (extent)
   (let (pkg-sym)
@@ -286,8 +257,7 @@
 	    (cons pkg-sym pui-selected-packages))
       (setq pui-deleted-packages
 	    (delete pkg-sym pui-deleted-packages)))
-    (pui-update-package-display extent pkg-sym)
-    ))
+    (pui-update-package-display extent pkg-sym)))
 
 (defun pui-toggle-package-key ()
   "Select/unselect package for installation, using the keyboard."
@@ -296,10 +266,8 @@
     (if (setq extent (extent-at (point) (current-buffer) 'pui))
 	(progn
 	  (pui-toggle-package extent)
-	  (forward-line 1)
-	  )
-      (error "No package under cursor!"))
-    ))
+	  (forward-line 1))
+      (error "No package under cursor!"))))
 
 (defun pui-toggle-package-delete (extent)
   (let (pkg-sym)
@@ -311,8 +279,7 @@
 	    (cons pkg-sym pui-deleted-packages))
       (setq pui-selected-packages
 	    (delete pkg-sym pui-selected-packages)))
-    (pui-update-package-display extent pkg-sym)
-    ))
+    (pui-update-package-display extent pkg-sym)))
   
 
 (defun pui-toggle-package-delete-key ()
@@ -322,10 +289,8 @@
     (if (setq extent (extent-at (point) (current-buffer) 'pui))
 	(progn
 	  (pui-toggle-package-delete extent)
-	  (forward-line 1)
-	  )
-      (error "No package under cursor!"))
-    ))
+	  (forward-line 1))
+      (error "No package under cursor!"))))
 
 (defun pui-current-package ()
   (let ((extent (extent-at (point) (current-buffer) 'pui)))
@@ -335,25 +300,23 @@
 (defun pui-toggle-package-event (event)
   "Select/unselect package for installation, using the mouse."
   (interactive "e")
-  (let* ( (ep (event-point event))
-          (buffer (window-buffer (event-window event)))
-          (extent (extent-at ep buffer 'pui-package))
-          )
-    (pui-toggle-package extent)
-    ))
+  (let* ((ep (event-point event))
+	 (buffer (window-buffer (event-window event)))
+	 (extent (extent-at ep buffer 'pui-package)))
+    (pui-toggle-package extent)))
 
 (defun pui-toggle-verbosity-redisplay ()
   "Toggle verbose package info."
   (interactive)
   (progn
     (setq pui-list-verbose (not pui-list-verbose))
-    (pui-list-packages)
-    ))
+    (pui-list-packages)))
 
 (defun pui-install-selected-packages ()
   "Install selected packages."
   (interactive)
-  (let ( (tmpbuf "*Packages-To-Remove*") do-delete)
+  (let ((tmpbuf "*Packages-To-Remove*") 
+	do-delete)
     (when pui-deleted-packages
       (save-window-excursion
 	(with-output-to-temp-buffer tmpbuf
@@ -362,8 +325,7 @@
 				    #'string<)
 				   :activate-callback nil
 				   :help-string "Packages selected for removal:\n"
-				   :completion-string t
-				   ))
+				   :completion-string t))
 	(setq tmpbuf (get-buffer-create tmpbuf))
 	(display-buffer tmpbuf)
 	(setq do-delete (yes-or-no-p "Remove these packages? "))
@@ -376,7 +338,8 @@
 		(nreverse pui-deleted-packages))
 	(message "Packages deleted"))))
 	 
-  (let ( (tmpbuf "*Packages-To-Install*") do-install)
+  (let ((tmpbuf "*Packages-To-Install*") 
+	do-install)
     (if pui-selected-packages
 	(progn
 	  ;; Don't change window config when asking the user if he really
@@ -390,21 +353,18 @@
 	       (sort (mapcar #'symbol-name pui-selected-packages) #'string<)
 	       :activate-callback nil
 	       :help-string "Packages selected for installation:\n"
-	       :completion-string t
-	       ))
+	       :completion-string t))
 	    (setq tmpbuf (get-buffer-create tmpbuf))
 	    (display-buffer tmpbuf)
 	    (setq do-install (y-or-n-p "Install these packages? "))
-	    (kill-buffer tmpbuf)
-	    )
+	    (kill-buffer tmpbuf))
 	  (if do-install
 	      (progn
 		(save-excursion
 		  ;; Clear old temp buffer history
 		  (set-buffer (get-buffer-create package-admin-temp-buffer))
 		  (buffer-disable-undo package-admin-temp-buffer)
-		  (erase-buffer package-admin-temp-buffer)
-		  )
+		  (erase-buffer package-admin-temp-buffer))
 		(message "Installing selected packages ...") (sit-for 0)
 		(if (catch 'done
 		      (mapcar (lambda (pkg)
@@ -415,18 +375,13 @@
 		      t)
 		    (progn
 		      (pui-list-packages)
-		      (message "Packages installed")
-		      ))
-		)
-	    (clear-message)
-	    )
-	  )
+		      (message "Packages installed"))))
+	    (clear-message)))
       (if pui-deleted-packages
 	  (pui-list-packages)
 	(error "No packages have been selected!")))
     ;; sync with windows type systems
-    (package-net-update-installed-db)
-    ))
+    (package-net-update-installed-db)))
 
 (defun pui-add-required-packages ()
   "Select packages required by those already selected for installation."
@@ -490,8 +445,7 @@
 attached to the extent as properties)."
   (let (pkg-sym info inst-ver auth-ver date maintainer balloon req)
     (if (or force-update (not (current-message))
-	    (string-match ".*: .*: " (current-message))
-	    )
+	    (string-match ".*: .*: " (current-message)))
 	(progn
 	  (setq pkg-sym (extent-property extent 'pui-package)
 		info (extent-property extent 'pui-info)
@@ -520,9 +474,7 @@
 	       "Inst V: %.2f Auth V: %s Maint: %s" 
 	       inst-ver auth-ver maintainer)
 	    (format "%.2f : %s : %s"
-		    inst-ver auth-ver maintainer))
-	  ))
-    ))
+		    inst-ver auth-ver maintainer))))))
 
 (defun pui-display-info (&optional no-error event)
   "Display additional package info in the modeline.
@@ -535,8 +487,7 @@
 	  (message (pui-help-echo extent t))
 	(if no-error
 	    (clear-message nil)
-	  (error "No package under cursor!")))
-      )))
+	  (error "No package under cursor!"))))))
 
 (defvar pui-menu
   '("Packages"
@@ -597,9 +548,9 @@
 select packages for installation via the keyboard or mouse."
   (interactive)
   (package-get-require-base t)
-  (let ( (outbuf (get-buffer-create pui-info-buffer))
-	 (sep-string "===============================================================================\n")
-	 start )
+  (let ((outbuf (get-buffer-create pui-info-buffer))
+	(sep-string "===============================================================================\n")
+	start)
     (message "Creating package list ...") (sit-for 0)
     (set-buffer outbuf)
     (setq buffer-read-only nil)
@@ -643,27 +594,21 @@
 	       (progn
 		 (setq current-vers (package-get-key pkg-sym :version))
 		 (cond
-		  ( (not current-vers)
-		    (setq current-vers "-----") )
-		  ( (stringp current-vers)
-		    (setq current-vers
-			  (format "%.2f"
-				  (string-to-number current-vers))) )
-		  ( (numberp current-vers)
-		    (setq current-vers (format "%.2f" current-vers)) )
-		  )
+		  ((not current-vers)
+		   (setq current-vers "-----"))
+		  ((stringp current-vers)
+		   (setq current-vers
+			 (format "%.2f"
+				 (string-to-number current-vers))))
+		  ((numberp current-vers)
+		   (setq current-vers (format "%.2f" current-vers))))
 		 (insert
 		  (format "%s %-15s %-5.2f  %-5s  %s\n"
 			  (car disp) pkg-sym 
 			  (if (stringp version)
 			      (string-to-number version)
 			    version)
-			  current-vers desc))
-		 ;; (insert
-		 ;;  (format "\t\t  %-12s  %s\n"
-		 ;;    (package-get-info-prop info 'author-version)
-		 ;;    (package-get-info-prop info 'date)))
-		 )
+			  current-vers desc)))
 	     (insert (format "%s %-15s %-5s %s\n"
 			     (car disp)
 			     pkg-sym version desc)))
@@ -681,8 +626,7 @@
 	   (set-extent-property extent 'pui-package pkg-sym)
 	   (set-extent-property extent 'pui-info info)
 	   (set-extent-property extent 'help-echo 'pui-help-echo)
-	   (set-extent-property extent 'keymap pui-package-keymap)
-	   ))
+	   (set-extent-property extent 'keymap pui-package-keymap)))
      (sort (copy-sequence package-get-base)
 	   #'(lambda (a b)
 	       (string< (symbol-name (car a))
@@ -700,9 +644,7 @@
       (set-buffer-menubar current-menubar)
       (add-submenu '() pui-menu)
       (setq mode-popup-menu pui-menu))
-    (clear-message)
-    ;;    (message (substitute-command-keys "Press `\\[pui-help]' for help."))
-    ))
+    (clear-message)))
 
 ;;;###autoload
 (defalias 'list-packages 'pui-list-packages)
--- a/lisp/packages.el	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/packages.el	Thu Mar 20 13:19:59 2003 +0000
@@ -149,9 +149,7 @@
     ;; one.
     (while (setq pkg (assq name packages-package-list))
       (setq packages-package-list (delete pkg (copy-alist
-					       packages-package-list)))
-      )
-    ))
+					       packages-package-list))))))
 
 ;;; Build time stuff