--- a/lisp/package-admin.el	Mon Aug 13 10:43:56 2007 +0200
+++ b/lisp/package-admin.el	Mon Aug 13 10:44:22 2007 +0200
@@ -38,6 +38,45 @@
 (defvar package-admin-temp-buffer "*Package Output*"
   "Temporary buffer where output of backend commands is saved.")
 
+(defvar package-admin-install-function 'package-admin-default-install-function
+  "The function to call to install a package.
+Three args are passed: FILENAME PKG-DIR BUF
+Install package FILENAME into directory PKG-DIR, with any messages output
+to buffer BUF.")
+
+(defvar package-admin-error-messages '(
+				       "No space left on device"
+				       "No such file or directory"
+				       "Filename too long"
+				       "Read-only file system"
+				       "File too large"
+				       "Too many open files"
+				       "Not enough space"
+				       "Permission denied"
+				       "Input/output error"
+				       "Out of memory"
+				       "Unable to create directory"
+				       "Directory checksum error"
+				       "Cannot exclusively open file"
+				       "corrupted file"
+				       "incomplete .* tree"
+				       "Bad table"
+				       "corrupt input"
+				       "invalid compressed data"
+				       "too many leaves in Huffman tree"
+				       "not a valid zip file"
+				       "first entry not deflated or stored"
+				       "encrypted file --"
+				       "unexpected end of file"
+				       )
+  "Regular expressions of possible error messages.
+After each package extraction, the `package-admin-temp-buffer' buffer is
+scanned for these messages.  An error code is returned if one of these are
+found.
+
+This is awful, but it exists because error return codes aren't reliable
+under MS Windows.")
+
 ;;;###autoload
 (defun package-admin-add-single-file-package (file destdir &optional pkg-dir)
   "Install a single file Lisp package into XEmacs package hierarchy.
@@ -57,23 +96,72 @@
 		  ;; rest of command line follows
 		  package-admin-xemacs file destination)))
 
-;;;###autoload
-(defun package-admin-add-binary-package (file &optional pkg-dir)
-  "Install a pre-bytecompiled XEmacs package into package hierarchy."
-  (interactive "fPackage tarball: ")
+(defun package-admin-install-function-mswindows (file pkg-dir buf)
+  "Install function for mswindows"
+  (let ( (default-directory pkg-dir) )
+    (call-process "djtar" nil buf t "-x" file)
+    ))
+
+(defun package-admin-default-install-function (file pkg-dir buf)
+  "Default function to install a package.
+Install package FILENAME into directory PKG-DIR, with any messages output
+to buffer BUF."
+  (let (filename)
+    (setq filename (expand-file-name file pkg-dir))
+    (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf)
+	0
+      1)
+    ))
+
+;  (call-process "add-big-package.sh"
+;		nil
+;		buf
+;		t
+;		;; rest of command line follows
+;		package-admin-xemacs file pkg-dir))
+
+(defun package-admin-get-install-dir (pkg-dir)
   (when (null pkg-dir)
     (when (or (not (listp late-packages))
 	      (not late-packages))
       (error "No package path"))
     (setq pkg-dir (car (last late-packages))))
+  pkg-dir
+  )
 
-  (let ((buf (get-buffer-create package-admin-temp-buffer)))
-    (call-process "add-big-package.sh"
-		  nil
-		  buf
-		  t
-		  ;; rest of command line follows
-		  package-admin-xemacs file pkg-dir)))
+;;;###autoload
+(defun package-admin-add-binary-package (file &optional pkg-dir)
+  "Install a pre-bytecompiled XEmacs package into package hierarchy."
+  (interactive "fPackage tarball: ")
+  (setq pkg-dir (package-admin-get-install-dir pkg-dir))
+  (let ((buf (get-buffer-create package-admin-temp-buffer))
+	(status 1)
+	start err-list
+	)
+    ;; Insure that the current directory doesn't change
+    (save-excursion
+      (set-buffer buf)
+      (setq default-directory pkg-dir)
+      (setq case-fold-search t)
+      (buffer-disable-undo)
+      (goto-char (setq start (point-max)))
+      (if (= 0 (setq status (funcall package-admin-install-function
+				     file pkg-dir buf)))
+	  (catch 'done
+	    (goto-char start)
+	    (setq err-list package-admin-error-messages)
+	    (while err-list
+	      (if (re-search-forward (car err-list) nil t)
+		  (progn
+		    (setq status 1)
+		    (throw 'done nil)
+		    ))
+	      (setq err-list (cdr err-list))
+	      )
+	    ))
+      )
+    status
+    ))
 
 (provide 'package-admin)