Mercurial > hg > xemacs-beta

diff lisp/package-get.el @ 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 184461bc8de4
children 1aba3abebad6
line wrap: on
line diff
--- 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