Commits

Anonymous committed d981c27

[xemacs-21-4-hg @ 2004-01-27 02:58:07 by vins]
Nearly final set of patches for 21.4.15. pui updates.

  • Participants
  • Parent commits 184f1ff

Comments (0)

Files changed (22)

+2004-01-25  Steve Youngs  <youngs@xemacs.org>
+
+	* etc/package-index.LATEST.gpg: New, replaces
+	`package-index.LATEST.pgp'. 
+
+	* etc/package-index.LATEST.pgp: Removed, replaced with
+	`package-index.LATEST.gpg'. 
+
 2004-01-20  Jerry James  <james@xemacs.org>
 
 	* configure.in: The icc compiler pretends to be gcc.  It isn't.

File lib-src/Makefile.in.in

 ## mmencode binary is used by tm - but is really part of the metamail package
 ## mmencode.c was merged copy of mmencode.c and codes.c of metamail
 mmencode : ${srcdir}/mmencode.c
-	$(CC) $(cflags) ${srcdir}/mmencode.c -o $@
+	$(CC) $(cflags) ${srcdir}/mmencode.c $(ldflags) -o $@
 
 
 ## The timer utility (timer.c, getdate.y) is not used in XEmacs
 ## because XEmacs provides built-in timer facilities.
 
 make-path: ${srcdir}/make-path.c ../src/config.h
-	$(CC) -Demacs $(cflags) ${srcdir}/make-path.c -o $@
+	$(CC) -Demacs $(cflags) ${srcdir}/make-path.c $(ldflags) -o $@

File lisp/ChangeLog

+2004-01-25  Steve Youngs  <sryoungs@bigpond.net.au>
+
+	* package-get.el (package-get-list-packages-where): New.  A
+	function that allows searching for groups of packages.  For
+	example, find all packages that require the fsf-compat package.
+
+2004-01-25  Steve Youngs  <youngs@xemacs.org>
+
+	The Great PUI Sync.
+
+	* auto-autoloads.el: Regenerated.
+
+	* custom-load.el: Regenerated.
+
+	* dumped-lisp.el (packages-hardcoded-lisp): New.
+
+	* menubar-items.el (menu-max-items): New.
+	(menu-submenu-max-items): New.
+	(menu-submenu-name-format): New.
+	(menu-split-long-menu): New.
+	(menu-sort-menu): New.
+	(default-menubar): Sync to 21.5 in regard to the PUI menus.
+
+	* obsolete.el (pui-add-install-directory): Renamed to the more
+	logical `pui-set-local-package-get-directory'.
+	(package-get-download-menu): Moved to `package-ui.el' and renamed
+	to `package-ui-add-download-menu'.
+
+	* package-admin.el (package-admin-install-function-mswindows):
+	Whitespace clean up.
+	(package-admin-add-single-file-package): Removed.
+	(package-admin-default-install-function): Whitespace clean up.
+	(package-admin-find-top-directory): New.
+	(package-admin-get-install-dir): Use it.
+	(package-admin-get-manifest-file): 
+	(package-admin-check-manifest): 
+	(package-admin-add-binary-package):
+	(package-admin-get-lispdir):
+	(package-admin-delete-binary-package):
+	(package-admin):
+
+	* package-get.el (package-get-package-index-file-location): New.
+	(package-get-install-to-user-init-directory): New.
+	(package-get-remote):
+	(package-get-download-sites):
+	(package-get-pre-release-download-sites): New.
+	(package-get-site-release-download-sites): New.
+	(package-get-base-filename):
+	(package-get-always-update):
+	(package-get-user-index-filename): Removed.
+	(package-get-pgp-available-p): New.
+	(package-get-require-signed-base-updates):
+	(package-get-was-current):
+	(package-entries-are-signed): New.
+	(package-get-continue-update-base): New.
+	(package-get-download-menu): Removed.
+	(package-get-require-base):
+	(package-get-update-base-entry):
+	(package-get-locate-file):
+	(package-get-locate-index-file):
+	(package-get-maybe-save-index):
+	(package-get-update-base):
+	(package-get-update-base-from-buffer):
+	(package-get-update-base-entries):
+	(package-get-interactive-package-query):
+	(package-get-update-all):
+	(package-get-all):
+	(package-get-dependencies):
+	(package-get-init-package):
+	(package-get-info): New.
+	(package-get):
+	(package-get-staging-dir):
+	(package-get-set-version-prop): Removed.
+	(package-get-installedp):
+	(package-get-ever-installed-p):
+	(packages): Removed.
+	(package-get-custom-groups): Removed.
+	(package-get-custom): Removed.
+	(package-get-custom-add-entry): Removed.
+
+	* package-info.el (batch-update-package-info):
+
+	* package-net.el (package-net-batch-generate-bin-ini):
+	(package-net-update-installed-db):
+
+	* package-ui.el (pui-info-buffer):
+	(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.
+	(package-ui-site-release-download-menu): New.
+	(pui-set-local-package-get-directory): New.
+	(pui-package-symbol-char):
+	(pui-update-package-display):
+	(pui-toggle-package):
+	(pui-toggle-package-key):
+	(pui-toggle-package-delete):
+	(pui-toggle-package-delete-key):
+	(pui-toggle-package-event):
+	(pui-toggle-verbosity-redisplay):
+	(pui-install-selected-packages):
+	(pui-add-required-packages):
+	(pui-help-echo):
+	(pui-display-info):
+	(list-packages-mode):
+	(pui-list-packages):
+
+	* packages.el (packages-compute-package-locations):
+	(package-require):
+	(package-delete-name):
+	(packages-hardcoded-lisp): Removed.
+	(packages-useful-lisp): Removed.
+	(packages-unbytecompiled-lisp): Removed.
+	(packages-find-package-directories):
+
+	Summary:
+
+	Major code clean up of all things PUI.
+
+	Much improved code to determine where packages should be
+	installed.  PUI no longer depends on any packages being
+	pre-installed to compute where packages are to be installed to.
+
+	The user can specify the location of their package-index file.  It
+	isn't necessary to set this because it has sane defaults.  People
+	who "run-in-place" won't accidently overwrite the CVS
+	package-index file.  See
+	`package-get-package-index-file-location'. 
+
+	PUI will now properly clean up after itself in the event of an
+	unsuccessful package install.  This drastically reduces the number
+	of "wrong md5sum" FAQs.
+
+	non-Mule XEmacsen can no longer install Mule packages.
+
+	Package management via the custom interface has been removed.
+
+	The PUI related menubar items have been reorganised.
+
+	The PGP verification code has been fixed and the default for
+	whether or not it is used is automatically computed.
+
+	* update-elc.el ((preloaded-file-list site-load-packages
+	need-to-dump dumped-exe)):
+	Just a couple of small changes to allow for
+	`packages-(hardcoded|useful|unbytecompiled)-lisp' not really
+	existing anymore.
+
 2003-12-10  Hrvoje Niksic  <hniksic@xemacs.org>
 
 	* bytecomp.el (byte-compile-warn-about-unused-variables): Don't

File lisp/dumped-lisp.el

+(defvar packages-hardcoded-lisp
+  '(
+    ;; Nothing at this time
+    )
+  "Lisp packages that are always dumped with XEmacs.
+This includes every package that is loaded directly by a package listed
+in dumped-lisp.el and is not itself listed.")
+
 (setq preloaded-file-list
       (assemble-list
         "backquote" 		; needed for defsubst etc.

File lisp/info.el

 			   (format (cdr (car suff)) file)
 			 (concat (cdr (car suff)) " < " file))))
 	  (message "%s..." command)
-	  (call-process shell-file-name nil t nil "-c" command)
+	  (call-process shell-file-name nil t nil shell-command-switch command)
 	  (message "")
 	  (when visit
 	    (setq buffer-file-name file)

File lisp/menubar-items.el

 	     "")))
 	(t "")))
 
+(defcustom menu-max-items 25
+  "*Maximum number of items in generated menus.
+If number of entries in such a menu is larger than this value, split menu
+into submenus of nearly equal length (see `menu-submenu-max-items').  If
+nil, never split menu into submenus."
+  :group 'menu
+  :type '(choice (const :tag "no submenus" nil)
+		 (integer)))
+
+(defcustom menu-submenu-max-items 20
+  "*Maximum number of items in submenus when splitting menus.
+We split large menus into submenus of this many items, and then balance
+them out as much as possible (otherwise the last submenu may have very few
+items)."
+  :group 'menu
+  :type 'integer)
+
+(defcustom menu-submenu-name-format "%-12.12s ... %.12s"
+  "*Format specification of the submenu name when splitting menus.
+Used by `menu-split-long-menu' if the number of entries in a menu is
+larger than `menu-menu-max-items'.
+This string should contain one %s for the name of the first entry and
+one %s for the name of the last entry in the submenu.
+If the value is a function, it should return the submenu name.  The
+function is be called with two arguments, the names of the first and
+the last entry in the menu."
+  :group 'menu
+  :type '(choice (string :tag "Format string")
+		 (function)))
+
+(defun menu-split-long-menu (menu)
+  "Split MENU according to `menu-max-items' and add accelerator specs.
+
+You should normally use the idiom
+
+\(menu-split-long-menu (menu-sort-menu menu))
+
+See also `menu-sort-menu'."
+  (let ((len (length menu)))
+    (if (or (null menu-max-items)
+	    (<= len menu-max-items))
+	(submenu-generate-accelerator-spec menu)
+      (let* ((outer (/ (+ len (1- menu-submenu-max-items))
+		       menu-submenu-max-items))
+	     (inner (/ (+ len (1- outer)) outer))
+	     (result nil))
+	(while menu
+	  (let ((sub nil)
+		(from (car menu)))
+	    (dotimes (foo (min inner len))
+	      (setq sub  (cons (car menu) sub)
+		    menu (cdr menu)))
+	    (setq len (- len inner))
+	    (let ((to (car sub)))
+	      (setq sub (nreverse sub))
+	      (setq result
+		    (cons (cons (if (stringp menu-submenu-name-format)
+				    (format menu-submenu-name-format
+					    (menu-item-strip-accelerator-spec
+					     (aref from 0))
+					    (menu-item-strip-accelerator-spec
+					     (aref to 0)))
+				  (funcall menu-submenu-name-format
+					   (menu-item-strip-accelerator-spec
+					    (aref from 0))
+					   (menu-item-strip-accelerator-spec
+					    (aref to 0))))
+				(submenu-generate-accelerator-spec sub))
+			  result)))))
+	(submenu-generate-accelerator-spec (nreverse result))))))
+
+(defun menu-sort-menu (menu)
+  "Sort MENU alphabetically.
+
+You should normally use the idiom
+
+\(menu-split-long-menu (menu-sort-menu menu))
+
+See also `menu-split-long-menu'."
+  (sort menu
+	#'(lambda (a b) (string-lessp (aref a 0) (aref b 0)))))
+
 (defun menu-item-search ()
   "Bring up a search dialog if possible and desired, else do interactive search"
   (interactive)
 
      ("%_Tools"
       ("%_Packages"
-       ("%_Add Download Site"
-        :filter (lambda (&rest junk)
-                  (submenu-generate-accelerator-spec
-		   (package-get-download-menu))))
+       ("%_Set Download Site"
+	("%_Official Releases"
+	 :filter (lambda (&rest junk)
+		   (menu-split-long-menu
+		    (submenu-generate-accelerator-spec
+		     (package-ui-download-menu)))))
+	("%_Pre-Releases"
+	 :filter (lambda (&rest junk)
+		   (menu-split-long-menu
+		    (submenu-generate-accelerator-spec
+		     (package-ui-pre-release-download-menu)))))
+	("%_Site Releases"
+	 :filter (lambda (&rest junk)
+		   (menu-split-long-menu
+		    (submenu-generate-accelerator-spec
+		     (package-ui-site-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]
-       ;; hack-o-matic, we can't force a load of package-base here
-       ;; since it triggers dialog box interactions which we can't
-       ;; deal with while using a menu
-       ("Using %_Custom"
-	:filter (lambda (&rest junk)
-		  (if package-get-base
-		      (submenu-generate-accelerator-spec
-		       (cdr (custom-menu-create 'packages)))
-		    '("Please load Package Index"))))
-
        ["%_Help" (Info-goto-node "(xemacs)Packages")])
       ("%_Internet"
        ["Read Mail %_1 (VM)..." vm

File lisp/obsolete.el

   "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)
 ;; 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

File lisp/package-admin.el

 ;;; package-admin.el --- Installation and Maintenance of XEmacs packages
 
 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
+;; Copyright (C) 2003, Steve Youngs.
 
 ;; Author: SL Baur <steve@xemacs.org>
 ;; Keywords: internal
 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)))
     ;; Don't assume GNU tar.
     (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer)
 	0
-      1)
-    ))
+      1)))
 
-;  (call-process "add-big-package.sh"
-;		nil
-;		buffer
-;		t
-;		;; rest of command line follows
-;		package-admin-xemacs file pkg-dir))
+;; A few things needed by the following 2 functions.
+(eval-when-compile
+  (require 'packages)
+  (autoload 'package-get-info "package-get")
+  (autoload 'paths-decode-directory-path "find-paths")
+  (defvar package-get-install-to-user-init-directory))
 
-(defun package-admin-get-install-dir (package pkg-dir &optional mule-related)
-  "If PKG-DIR is non-nil return that,
-else return the current location of the package if it is already installed
-or return a location appropriate for the package otherwise."
-  (if pkg-dir
+(defun package-admin-find-top-directory (type &optional user-dir)
+  "Return the top level directory for a package.
+
+Argument TYPE is a symbol that determines the type of package we're
+trying to find a directory for.
+
+Optional Argument USER-DIR if non-nil use directories off
+`user-init-directory'.  This overrides everything except
+\"EMACSPACKAGEPATH\".
+
+This function honours the environment variable \"EMACSPACKAGEPATH\"
+and returns directories found there as a priority.  If that variable
+doesn't exist and USER-DIR is nil, check in the normal places.
+
+If we still can't find a suitable directory, return nil.
+
+Possible values for TYPE are:
+
+    std  == For \"standard\" packages that go in '/xemacs-packages/'
+    mule == For \"mule\" packages that go in '/mule-packages/'
+    site == For \"unsupported\" packages that go in '/site-packages/'
+
+Note:  Type \"site\" is not yet fully supported."
+  (let* ((env-value (getenv "EMACSPACKAGEPATH"))
+	 top-dir)
+    ;; First, check the environment var.
+    (if env-value
+	(let ((path-list (paths-decode-directory-path env-value 'drop-empties)))
+	  (cond ((eq type 'std)
+		 (while path-list
+		   (if (equal (substring (car path-list) -16) 
+			      (concat "xemacs-packages" (char-to-string directory-sep-char)))
+		       (setq top-dir (car path-list)))
+		   (setq path-list (cdr path-list))))
+		((eq type 'mule)
+		 (while path-list
+		   (if (equal (substring (car path-list) -14) 
+			      (concat "mule-packages" (char-to-string directory-sep-char)))
+		       (setq top-dir (car path-list)))
+		   (setq path-list (cdr path-list)))))))
+    ;; Wasn't in the environment, try `user-init-directory' if
+    ;; USER-DIR is non-nil.
+    (if (and user-dir
+	     (not top-dir))
+	(cond ((eq type 'std)
+	       (setq top-dir (file-name-as-directory
+			      (expand-file-name "xemacs-packages" user-init-directory))))
+	      ((eq type 'mule)
+	       (setq top-dir (file-name-as-directory
+			      (expand-file-name "mule-packages" user-init-directory))))))
+    ;; Finally check the normal places
+    (if (not top-dir)
+	(let ((path-list (nth 1 (packages-find-packages
+				 emacs-roots
+				 (packages-compute-package-locations user-init-directory)))))
+	  (cond ((eq type 'std)
+		 (while path-list
+		   (if (equal (substring (car path-list) -16) 
+			      (concat "xemacs-packages" (char-to-string directory-sep-char)))
+		       (setq top-dir (car path-list)))
+		   (setq path-list (cdr path-list))))
+		((eq type 'mule)
+		 (while path-list
+		   (if (equal (substring (car path-list) -14) 
+			      (concat "mule-packages" (char-to-string directory-sep-char)))
+		       (setq top-dir (car path-list)))
+		   (setq path-list (cdr path-list)))))))
+    ;; Now return either the directory or nil.
+    top-dir))
+
+(defun package-admin-get-install-dir (package &optional pkg-dir)
+  "Find a suitable installation directory for a package.
+
+Argument PACKAGE is the package to find a installation directory for.
+Optional Argument PKG-DIR, if non-nil is a directory to use for
+installation.
+
+If PKG-DIR is non-nil and writable, return that.  Otherwise check to
+see if the PACKAGE is already installed and return that location, if
+it is writable.  Finally, fall back to the `user-init-directory' if
+all else fails.  As a side effect of installing packages under
+`user-init-directory' these packages become part of `early-packages'."
+  ;; If pkg-dir specified, return that if writable.
+  (if (and pkg-dir
+	   (file-writable-p (directory-file-name pkg-dir)))
       pkg-dir
-    (let ((package-feature (intern-soft (concat
-					 (symbol-name package) "-autoloads")))
-	  autoload-dir)
-      (when (and (not (eq package 'unknown))
-	         (featurep package-feature)
-		 (setq autoload-dir (feature-file package-feature))
-		 (setq autoload-dir (file-name-directory autoload-dir))
-		 (member autoload-dir (append early-package-load-path late-package-load-path)))
-	;; Find the corresponding entry in late-package
-	(setq pkg-dir
-	      (car-safe (member-if (lambda (h)
-			   (string-match (concat "^" (regexp-quote h))
-					 autoload-dir))
-			 (append (cdr early-packages) late-packages)))))
-      (if pkg-dir
-	  pkg-dir
-	;; 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)))))))
-
-
+    ;; If the user want her packages under ~/.xemacs/, do so.
+    (let ((type (package-get-info package 'category)))
+      (if package-get-install-to-user-init-directory
+	  (progn
+	    (cond ((equal type "standard")
+		   (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir)))
+		  ((equal type "mule")
+		   (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir))))
+	    pkg-dir)
+	;; Maybe the package has been installed before, if so, return
+	;; that directory.
+	(let ((package-feature (intern-soft (concat
+					     (symbol-name package) "-autoloads")))
+	      autoload-dir)
+	  (when (and (not (eq package 'unknown))
+		     (featurep package-feature)
+		     (setq autoload-dir (feature-file package-feature))
+		     (setq autoload-dir (file-name-directory autoload-dir))
+		     (member autoload-dir (append early-package-load-path late-package-load-path)))
+	    ;; Find the corresponding entry in late-package
+	    (setq pkg-dir
+		  (car-safe (member-if (lambda (h)
+					 (string-match (concat "^" (regexp-quote h))
+						       autoload-dir))
+				       (append (cdr early-packages) late-packages)))))
+	  (if (and pkg-dir
+		   (file-writable-p (directory-file-name pkg-dir)))
+	      pkg-dir
+	    ;; OK, the package hasn't been previously installed so we need
+	    ;; to guess where it should go.
+	    (cond ((equal type "standard")
+		   (setq pkg-dir (package-admin-find-top-directory 'std)))
+		  ((equal type "mule")
+		   (setq pkg-dir (package-admin-find-top-directory 'mule)))
+		  (t
+		   (error 'invalid-operation
+			  "Invalid package type")))
+	    (if (and pkg-dir
+		     (file-writable-p (directory-file-name pkg-dir)))
+		pkg-dir
+	      ;; Oh no!  Either we still haven't found a suitable
+	      ;; directory, or we can't write to the one we did find.
+	      ;; Drop back to the `user-init-directory'.
+	      (if (y-or-n-p (format "Directory isn't writable, use %s instead? "
+				    user-init-directory))
+		  (progn
+		    (cond ((equal type "standard")
+			   (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir)))
+			  ((equal type "mule")
+			   (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir)))
+			  (t
+			   (error 'invalid-operation
+				  "Invalid package type")))
+		    ;; Turn on `package-get-install-to-user-init-directory'
+		    ;; so we don't get asked for each package we try to
+		    ;; install in this session.
+		    (setq package-get-install-to-user-init-directory t)
+		    pkg-dir)
+		;; If we get to here XEmacs can't make up its mind and
+		;; neither can the user, nothing left to do except barf. :-(
+		(error 'search-failed
+		       (format
+			"Can't find suitable installation directory for package: %s" 
+			package))))))))))
 
 (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))
 
 		;; 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)))
 					    (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>
 		      (save-excursion
 			(set-buffer manifest-buf)
 			;; Put the files in sorted order
-			(sort-lines nil (point-min) (point-max))
+			(if (fboundp 'sort-lines)
+			    (sort-lines nil (point-min) (point-max))
+			  (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)
   (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
 		(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.
 	     (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)
 	  ;; 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)
 
 	    ;; 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))
+      (when package-lispdir
+	(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)))
 

File lisp/package-get.el

 ;;; package-get.el --- Retrieve XEmacs package
 
 ;; Copyright (C) 1998 by Pete Ware
+;; Copyright (C) 2002 Ben Wing.
+;; Copyright (C) 2003, Steve Youngs
 
 ;; Author: Pete Ware <ware@cis.ohio-state.edu>
 ;; Heavy-Modifications: Greg Klanderman <greg@alphatech.com>
 ;;                      Jan Vroonhof    <vroonhof@math.ethz.ch>
+;;                      Steve Youngs    <youngs@xemacs.org>
 ;; Keywords: internal
 
 ;; This file is part of XEmacs.
   :type 'directory
   :group 'package-get)
 
+;;;###autoload
+(defcustom package-get-package-index-file-location 
+  (or (getenv "EMACSPACKAGEPATH")
+      user-init-directory)
+  "*The directory where the package-index file can be found."
+  :type 'directory
+  :group 'package-get)
+
+;;;###autoload
+(defcustom package-get-install-to-user-init-directory nil
+  "*If non-nil install packages under `user-init-directory'."
+  :type 'boolean
+  :group 'package-get)
+
 (define-widget 'host-name 'string
   "A Host name."
   :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")
+    ("Canada (ualberta.ca)" "sunsite.ualberta.ca" "pub/Mirror/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 (mirror.cict.fr)" "mirror.cict.fr" "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")
+    ("New Zealand (nz.xemacs.org)" "ftp.nz.xemacs.org" "mirror/ftp.xemacs.org/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 (unc.edu)" "metalab.unc.edu" "pub/packages/editors/xemacs/packages")
+    ("US (us.xemacs.org)" "ftp.us.xemacs.org" "pub/xemacs/packages")
+    ("US (utk.edu)" "ftp.sunsite.utk.edu" "pub/xemacs/packages")
     )
   "*List of remote sites available for downloading packages.
 List format is '(site-description site-name directory-on-site).
   :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")
+    ("Canada Pre-Releases (ualberta.ca)" "sunsite.ualberta.ca"
+     "pub/Mirror/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 (mirror.cict.fr)" "mirror.cict.fr"
+     "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")
+    ("New Zealand Pre-Releases (nz.xemacs.org)" "ftp.nz.xemacs.org" "mirror/ftp.xemacs.org/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 (unc.edu)" "metalab.unc.edu"
+     "pub/packages/editors/xemacs/beta/experimental/packages")
+    ("US Pre-Releases (us.xemacs.org)" "ftp.us.xemacs.org"
+     "pub/xemacs/beta/experimental/packages")
+    ("US Pre-Releases (utk.edu)" "ftp.sunsite.utk.edu"
+     "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)
+
+;;;###autoload
+(defcustom package-get-site-release-download-sites
+  nil
+  "*List of remote sites available for downloading \"Site 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 "Site 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."
 ;; #### it may make sense for this to be a list of names.
 ;; #### also, should we rename "*base*" to "*index*" or "*db*"?
 ;;      "base" is a pretty poor name.
-(defcustom package-get-base-filename "package-index.LATEST.pgp"
+(defcustom package-get-base-filename "package-index.LATEST.gpg"
   "*Name of the default package-get database file.
 This may either be a relative path, in which case it is interpreted
 with respect to `package-get-remote', or an absolute path."
   :type 'file
   :group 'package-get)
 
-(defvar package-get-user-index-filename
-  (paths-construct-path (list user-init-directory package-get-base-filename))
-  "Name for the user-specific location of the package-get database file.")
-
 (defcustom package-get-always-update nil
   "*If Non-nil always make sure we are using the latest package index (base).
 Otherwise respect the `force-current' argument of `package-get-require-base'."
   :type 'boolean
   :group 'package-get)
 
-(defcustom package-get-require-signed-base-updates nil
-  "*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, updates which are not PGP signed are allowed without confirmation."
+(defun package-get-pgp-available-p ()
+  "Checks the availability of Mailcrypt and PGP executable.
+
+Returns t if both are found, nil otherwise.  As a side effect, set
+`mc-default-scheme' dependent on the PGP executable found."
+  (let (result)
+    (when (featurep 'mailcrypt-autoloads)
+      (autoload 'mc-setversion "mc-setversion"))
+    (when (fboundp 'mc-setversion)
+      (cond ((locate-file "gpg" exec-path
+			  '("" ".btm" ".bat" ".cmd" ".exe" ".com")
+			  'executable)
+	     (mc-setversion "gpg")
+	     (setq result t))
+	    ((locate-file "pgpe" exec-path
+			  '("" ".btm" ".bat" ".cmd" ".exe" ".com")
+			  'executable)
+	     (mc-setversion "5.0")
+	     (setq result t))
+	    ((locate-file "pgp" exec-path
+			  '("" ".btm" ".bat" ".cmd" ".exe" ".com")
+			  'executable)
+	     (mc-setversion "2.6")
+	     (setq result t))))
+    (if result
+	result
+      nil)))
+
+(defcustom package-get-require-signed-base-updates (package-get-pgp-available-p)
+  "*If non-nil, try to verify the package index database via PGP.
+
+If nil, no PGP verification is done.  If the package index database
+entries are not PGP signed and this variable is non-nil, require user
+confirmation to continue with the package-get procedure.
+
+The default for this variable is the return value of
+`package-get-pgp-available-p', non-nil if both the \"Mailcrypt\"
+package and a suitable PGP executable are available, nil otherwise."
   :type 'boolean
   :group 'package-get)
 
+(defvar package-entries-are-signed nil
+  "Non-nil when the package index file has been PGP signed.")
+
+(defvar package-get-continue-update-base nil
+  "Non-nil update the index even if it hasn't been signed.")
+
 (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.
     (package-get-update-base nil force-current))
   (if (or (not (boundp 'package-get-base))
 	  (not package-get-base))
-      (error "Package-get database not loaded")
+      (error 'void-variable
+	     "Package-get database not loaded")
     (setq package-get-was-current force-current)))
 
 (defconst package-get-pgp-signed-begin-line "^-----BEGIN PGP SIGNED MESSAGE-----"
   (let ((existing (assq (car entry) package-get-base)))
     (if existing
         (setcdr existing (cdr entry))
-      (setq package-get-base (cons entry package-get-base))
-      (package-get-custom-add-entry (car entry) (car (cdr entry))))))
+      (setq package-get-base (cons entry package-get-base)))))
 
 (defun package-get-locate-file (file &optional nil-if-not-found no-remote)
   "Locate an existing FILE with respect to `package-get-remote'.
 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)))))
 
 (defun package-get-locate-index-file (no-remote)
-  "Locate the package-get index file.  Do not return remote paths if NO-REMOTE
-is non-nil."
+  "Locate the package-get index file.  
+
+Do not return remote paths if NO-REMOTE is non-nil.  If the index
+file doesn't exist in `package-get-package-index-file-location', ask
+the user if one should be created using the index file in core as a
+template."
   (or (package-get-locate-file package-get-base-filename t no-remote)
-      (if (file-exists-p package-get-user-index-filename)
-	  package-get-user-index-filename)
-      (locate-data-file package-get-base-filename)
-      (error "Can't locate a package index file.")))
+      (if (file-exists-p (expand-file-name package-get-base-filename
+					   package-get-package-index-file-location))
+	  (expand-file-name package-get-base-filename
+			    package-get-package-index-file-location)
+	(if (y-or-n-p (format "No index file, shall I create one in %s? "
+			      package-get-package-index-file-location))
+	    (progn
+	      (save-excursion
+		(set-buffer 
+		 (find-file-noselect (expand-file-name
+				      package-get-base-filename
+				      package-get-package-index-file-location)))
+		(let ((coding-system-for-write 'binary))
+		  (erase-buffer)
+		  (insert-file-contents-literally
+		   (locate-data-file package-get-base-filename))
+		  (save-buffer (current-buffer))
+		  (kill-buffer (current-buffer))))
+	      (expand-file-name package-get-base-filename
+				package-get-package-index-file-location))
+	  (error 'search-failed
+		 "Can't locate a package index file.")))))
 
 (defun package-get-maybe-save-index (filename)
   "Offer to save the current buffer as the local package index file,
 			  (with-temp-buffer
 			    (insert-file-contents-literally location)
 			    (md5 (current-buffer)))))
-	(unless (and location (file-writable-p location))
-	  (setq location package-get-user-index-filename))
+	(when (not (file-writable-p location))
+	  (if (y-or-n-p (format "Sorry, %s is read-only, can I use %s? "
+				location user-init-directory))
+	      (setq location (expand-file-name
+			      package-get-base-filename
+			      package-get-package-index-file-location))
+	    (error 'file-error
+		   (format "%s is read-only" location))))
 	(when (y-or-n-p (concat "Update package index in " location "? "))
 	  (let ((coding-system-for-write 'binary))
 	    (write-file location)))))))
 
-
 ;;;###autoload
 (defun package-get-update-base (&optional db-file force-current)
   "Update the package-get database file with entries from DB-FILE.
                                       (package-get-locate-index-file
 				         (not force-current)))))
   (if (not (file-exists-p db-file))
-      (error "Package-get database file `%s' does not exist" db-file))
+      (error 'file-error
+	     (format "Package-get database file `%s' does not exist" db-file)))
   (if (not (file-readable-p db-file))
-      (error "Package-get database file `%s' not readable" db-file))
+      (error 'file-error
+	     (format "Package-get database file `%s' not readable" db-file)))
   (let ((buf (get-buffer-create "*package database*")))
     (unwind-protect
         (save-excursion
 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)))
-      (when (re-search-forward package-get-pgp-signature-end-line nil t)
-        (setq end (point)))
-      (if (not (and content-beg content-end beg end))
-          (or (not package-get-require-signed-base-updates)
-              (yes-or-no-p "Package-get entries not PGP signed, continue? ")
-              (error "Package-get database not updated")))
-      (if (and content-beg content-end beg end)
-          (if (not (condition-case nil
-                       (or (fboundp 'mc-pgp-verify-region)
-                           (load-library "mc-pgp")
-                           (fboundp 'mc-pgp-verify-region))
-                     (error nil)))
-              (or (not package-get-require-signed-base-updates)
-                  (yes-or-no-p
-                   "No mailcrypt; can't verify package-get DB signature, continue? ")
-                  (error "Package-get database not updated"))))
-      (if (and beg end
-               (fboundp 'mc-pgp-verify-region)
-               (or (not
-                    (condition-case err
-                        (mc-pgp-verify-region beg end)
-                      (file-error
-                       (and (string-match "No such file" (nth 2 err))
-                            (or (not package-get-require-signed-base-updates)
-                                (yes-or-no-p
-                                 (concat "Can't find PGP, continue without "
-                                         "package-get DB verification? ")))))
-                      (t nil)))))
-          (error "Package-get PGP signature failed to verify"))
+        (setq content-end (match-beginning 0))
+	(setq package-entries-are-signed t))
+      (re-search-forward package-get-pgp-signature-end-line nil t)
+      (setq package-get-continue-update-base t)
+      ;; This is a little overkill because the default value of
+      ;; `package-get-require-signed-base-updates' is the return of
+      ;; `package-get-pgp-available-p', but we have to allow for
+      ;; someone explicitly setting
+      ;; `package-get-require-signed-base-updates' to t. --SY
+      (when (and package-get-require-signed-base-updates
+		 (package-get-pgp-available-p))
+	(if package-entries-are-signed
+	    (let (good-sig)
+	      (setq package-get-continue-update-base nil)
+	      (autoload 'mc-verify "mc-toplev")
+	      (when (mc-verify)
+		(setq good-sig t))
+	      (if good-sig
+		  (setq package-get-continue-update-base t)
+		(error 'process-error 
+		       "GnuPG error.  Package database not updated")))
+	  (if (yes-or-no-p
+	       "Package Index is not PGP signed.  Continue anyway? ")
+	      (setq package-get-continue-update-base t)
+	    (setq package-get-continue-update-base nil)
+	    (warn "Package database not updated"))))
       ;; ToDo: We should call package-get-maybe-save-index on the region
-      (package-get-update-base-entries content-beg content-end)
-      (message "Updated package-get database"))))
+      (when package-get-continue-update-base
+	(package-get-update-base-entries content-beg content-end)
+	(message "Updated package database")))))
 
 (defun package-get-update-base-entries (start end)
   "Update the package-get database with the entries found between
   (save-excursion
     (goto-char start)
     (if (not (re-search-forward "^(package-get-update-base-entry" nil t))
-        (error "Buffer does not contain package-get database entries"))
+        (error 'search-failed
+	       "Buffer does not contain package-get database entries"))
     (beginning-of-line)
     (let ((count 0))
       (while (and (< (point) end)
         (let ((entry (read (current-buffer))))
           (if (or (not (consp entry))
                   (not (eq (car entry) 'package-get-update-base-entry)))
-              (error "Invalid package-get database entry found"))
+              (error 'syntax-error
+		     "Invalid package-get database entry found"))
           (package-get-update-base-entry
            (car (cdr (car (cdr entry)))))
           (setq count (1+ count))))
 		   '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))))))
   (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))
 
 						     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)
 		   (reqd-version (cadr reqd-package))
 		   (reqd-name (car reqd-package)))
 	      (if (null reqd-name)
-		  (error "Unable to find a provider for %s"
-			 (car this-requires)))
+		  (error 'search-failed
+			 (format "Unable to find a provider for %s"
+				 (car this-requires))))
 	      (if (not (setq fetched-packages
 			     (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)
                                   (let* ((reqd-package (package-get-package-provider reqd))
                                          (reqd-name    (car reqd-package)))
                                     (if (null reqd-name)
-                                        (error "Unable to find a provider for %s" reqd))
+                                        (error 'search-failed
+					       (format "Unable to find a provider for %s" reqd)))
                                     reqd-name))
                               this-requires)
                              dependencies))
 	(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 'invalid-argument
+		      (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-list-packages-where (item field &optional arg)
+  "Return a list of packages that fulfill certain criteria.
+
+Argument ITEM, a symbol, is what you want to check for.  ITEM must be a
+symbol even when it doesn't make sense to be a symbol \(think, searching
+maintainers, descriptions, etc\).  The function will convert the symbol
+to a string if a string is what is needed.  The downside to this is that
+ITEM can only ever be a single word.
+
+Argument FIELD, a symbol, is the field to check in.  You can specify
+any one of:
+
+      Field            Sane or Allowable Content
+    description          any single word
+    category             `standard' or `mule'
+    maintainer           any single word
+    build-date           yyyy-mm-dd
+    date                 yyyy-mm-dd
+    type                 `regular' or `single'
+    requires             any package name
+    provides             any symbol
+    priority             `low', `medium', or `high'
+
+Optional Argument ARG, a prefix arg, insert output at point in the
+current buffer."
+  (interactive "SList packages that have (item): \nSin their (field): \nP")
+  (package-get-require-base nil)
+  (let ((pkgs package-get-base)
+	(strings '(description category maintainer build-date date))
+	(symbols '(type requires provides priority))
+	results)
+    (cond ((memq field strings)
+	   (setq item (symbol-name item))
+	   (while pkgs
+	     (when (string-match item (package-get-info (caar pkgs) field))
+	       (setq results (push (caar pkgs) results)))
+	     (setq pkgs (cdr pkgs))))
+	  ((memq field symbols)
+	   (if (or (eq field 'type)
+		   (eq field 'priority))
+	       (while pkgs
+		 (when (eq item (package-get-info (caar pkgs) field))
+		   (setq results (push (caar pkgs) results)))
+		 (setq pkgs (cdr pkgs)))
+	     (while pkgs
+	       (when (memq item (package-get-info (caar pkgs) field))
+		 (setq results (push (caar pkgs) results)))
+	       (setq pkgs (cdr pkgs)))))
+	  (t 
+	   (error 'wrong-type-argument field)))
+    (if (interactive-p)
+	(if arg
+	    (insert (format "%s" results))
+	  (message "%s" results)))
+    results))
 
 ;;;###autoload
 (defun package-get (package &optional version conflict install-dir)
 
 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
 					  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 'invalid-state 
+	       "Mule packages can't be installed with a non-Mule XEmacs"))
     (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 'search-failed
+		   (format "Couldn't find package %s with version %s"
+			   package version))
+	  (error 'syntax-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))))
+	(error 'syntax-error
+	       (format "No filename associated with package %s, version %s"
+		       package version)))
+    (setq install-dir (package-admin-get-install-dir package install-dir))
 
     ;; If they asked for the latest using version=nil, don't get an older
     ;; version than we already have.
                  latest))
             (if (not (null version))
                 (warn "Installing %s package version %s, you had a newer version %s"
-                      package latest installed)
+		  package latest installed)
               (warn "Skipping %s package, you have a newer version %s"
-                    package installed)
+		package installed)
               (throw 'skip-update t))))
 
     ;; Contrive a list of possible package filenames.
       ;; 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
 		    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)))
 	  (if package-get-remote
-	      (error "Unable to find file %s" base-filename)
-	    (error
-	     "No download sites or local package locations specified.")))
+	      (error 'search-failed
+		     (format "Unable to find file %s" base-filename))
+	    (error 'syntax-error
+		   "No download sites or local package locations specified.")))
       ;; Validate the md5 checksum
       ;; Doing it with XEmacs removes the need for an external md5 program
       (message "Validating checksum for `%s'..." package) (sit-for 0)
 	(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 'process-error
+		     (format "Package %s does not match md5 checksum %s has been deleted"
+			     base-filename full-package-filename)))))
 
       (package-admin-delete-binary-package package install-dir)
 
 		  (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
    (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.
 		(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
   (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)
         (message "No appropriate package found")))
     found))
 
-;;
-;; customize interfaces.
-;; The group is in this file so that custom loads includes this file.
-;;
-(defgroup packages nil
-  "Configure XEmacs packages."
-  :group 'emacs)
-
-;;;###autoload
-(defun package-get-custom ()
-  "Fetch and install the latest versions of all customized packages."
-  (interactive)
-  (package-get-require-base t)
-  (mapcar (lambda (pkg)
-	    (if (eval (intern (concat (symbol-name (car pkg)) "-package")))
-		(package-get (car pkg) nil))
-	    t)
-	  package-get-base)
-  (package-net-update-installed-db))
-
 (defun package-get-ever-installed-p (pkg &optional notused)
   (string-match "-package$" (symbol-name pkg))
   (custom-initialize-set
 	(intern (substring (symbol-name pkg) 0 (match-beginning 0))))
        t)))
 
-(defvar package-get-custom-groups nil
-  "List of package-get-custom groups")
-
-(defun package-get-custom-add-entry (package props)
-  (let* ((category (plist-get props 'category))
-         (group (intern (concat category "-packages")))
-         (custom-var (intern (concat (symbol-name package) "-package")))
-         (description (plist-get props 'description)))
-    (when (not (memq group package-get-custom-groups))
-      (setq package-get-custom-groups (cons group
-                                            package-get-custom-groups))
-      (eval `(defgroup ,group nil
-               ,(concat category " package group")
-               :group 'packages)))
-    (eval `(defcustom ,custom-var nil
-             ,description
-             :group ',group
-             :initialize 'package-get-ever-installed-p
-             :type 'boolean))))
-
-
 (provide 'package-get)
 ;;; package-get.el ends here

File lisp/package-info.el

 maintainer -- The package maintainer.
 category -- The build category."
   (unless noninteractive
-    (error "`batch-update-package-info' is to be used only with -batch"))
+    (error 'invalid-operation
+	   "`batch-update-package-info' is to be used only with -batch"))
   (let ((version (nth 0 command-line-args-left))
 	(filename (nth 1 command-line-args-left))
 	(requires (nth 2 command-line-args-left))

File lisp/package-net.el

 (defun package-net-batch-generate-bin-ini ()
   "Convert the package index to ini file format."
   (unless noninteractive
-    (error "`package-net-batch-generate-bin-ini' is to be used only with -batch"))
+    (error 'invalid-operation
+	   "`package-net-batch-generate-bin-ini' is to be used only with -batch"))
   (package-net-generate-bin-ini package-net-setup-version))
 
 ;;;###autoload

File lisp/package-ui.el

    :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.
     (define-key m "q" 'pui-quit)
     (define-key m "g" 'pui-list-packages)
     (define-key m "i" 'pui-display-info)
+    (define-key m "m" 'pui-display-maintainer)
     (define-key m "?" 'describe-mode)
     (define-key m "v" 'pui-toggle-verbosity-redisplay)
     (define-key m "d" 'pui-toggle-package-delete-key)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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)
 	  (save-window-excursion
 	    (pui-list-packages))))
     (set-menubar-dirty-flag)))
-    
 
 ;;;###autoload
-(defun pui-add-install-directory (dir)
-  "Add a new package binary directory to the head of `package-get-remote'.
+(defun package-ui-download-menu ()
+  "Build the `Add Download Site' menu."
+