--- a/lisp/package-admin.el	Wed Mar 19 22:52:25 2003 +0000
+++ b/lisp/package-admin.el	Thu Mar 20 13:19:59 2003 +0000
@@ -114,25 +114,6 @@
 hook is called *before* the package is deleted. The hook function is passed
 two arguments: the package name, and the install directory.")
 
-;;;###autoload
-(defun package-admin-add-single-file-package (file destdir &optional pkg-dir)
-  "Install a single file Lisp package into XEmacs package hierarchy.
-`file' should be the full path to the lisp file to install.
-`destdir' should be a simple directory name.
-The optional `pkg-dir' can be used to override the default package hierarchy
-\(car \(last late-packages))."
-  (interactive "fLisp File: \nsDestination: ")
-  (when (null pkg-dir)
-    (setq pkg-dir (car (last late-packages))))
-  (let ((destination (concat pkg-dir "/lisp/" destdir))
-	(buf (get-buffer-create package-admin-temp-buffer)))
-    (call-process "add-little-package.sh"
-		  nil
-		  buf
-		  t
-		  ;; rest of command line follows
-		  package-admin-xemacs file destination)))
-
 (defun package-admin-install-function-mswindows (file pkg-dir buffer)
   "Install function for mswindows."
   (let ((default-directory (file-name-as-directory pkg-dir)))
@@ -152,15 +133,7 @@
     ;; Don't assume GNU tar.
     (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer)
 	0
-      1)
-    ))
-
-;  (call-process "add-big-package.sh"
-;		nil
-;		buffer
-;		t
-;		;; rest of command line follows
-;		package-admin-xemacs file pkg-dir))
+      1)))
 
 (defun package-admin-get-install-dir (package pkg-dir &optional mule-related)
   "If PKG-DIR is non-nil return that,
@@ -187,45 +160,35 @@
 	;; Ok we need to guess
 	(if mule-related
 	    (package-admin-get-install-dir 'mule-base nil nil)
-	  (if (eq package 'xemacs-base)
-	      (car (last late-packages))
-	    (package-admin-get-install-dir 'xemacs-base nil nil)))))))
-
-
+	  (car (last late-packages)))))))
 
 (defun package-admin-get-manifest-file (pkg-topdir package)
   "Return the name of the MANIFEST file for package PACKAGE.
 Note that PACKAGE is a symbol, and not a string."
-  (let (dir)
-    (setq dir (expand-file-name "pkginfo" pkg-topdir))
-    (expand-file-name (concat "MANIFEST." (symbol-name package)) dir)
-    ))
+  (let ((dir (file-name-as-directory
+	      (expand-file-name "pkginfo" pkg-topdir))))
+    (expand-file-name (concat "MANIFEST." (symbol-name package)) dir)))
 
 (defun package-admin-check-manifest (pkg-outbuf pkg-topdir)
   "Check for a MANIFEST.<package> file in the package distribution.
 If it doesn't exist, create and write one.
 PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR
 is the top-level directory under which the package was installed."
-  (let ( (manifest-buf " *pkg-manifest*")
-	 old-case-fold-search regexp package-name pathname regexps)
-    ;; Save and restore the case-fold-search status.
-    ;; We do this in case we have to screw with it (as it the case of
-    ;; case-insensitive filesystems such as MS Windows).
-    (setq old-case-fold-search case-fold-search)
+  (let ((manifest-buf " *pkg-manifest*")
+	(old-case-fold-search case-fold-search)
+	regexp package-name pathname regexps)
     (unwind-protect
 	(save-excursion				;; Probably redundant.
-	  (set-buffer (get-buffer pkg-outbuf))	;; Probably already the
-						;; current buffer.
+	  (set-buffer (get-buffer pkg-outbuf))	;; Probably already the current buffer.
 	  (goto-char (point-min))
 
 	  ;; Make filenames case-insensitive, if necessary
 	  (if (eq system-type 'windows-nt)
 	      (setq case-fold-search t))
 
-	  ;; We really should compute the regexp.
-	  ;; However, directory-sep-char is currently broken, but we need
-	  ;; functional code *NOW*.
-	  (setq regexp "\\bpkginfo[\\/]MANIFEST\\...*")
+	  (setq regexp (concat "\\bpkginfo" 
+			       (char-to-string directory-sep-char)
+			       "MANIFEST\\...*"))
 
 	  ;; Look for the manifest.
 	  (if (not (re-search-forward regexp nil t))
@@ -234,22 +197,18 @@
 
 		;; Yuk.  We weren't passed the package name, and so we have
 		;; to dig for it.  Look for it as the subdirectory name below
-		;; "lisp", "man", "info", or "etc".
+		;; "lisp", or "man".
 		;; Here, we don't use a single regexp because we want to search
 		;; the directories for a package name in a particular order.
-		;; The problem is that packages could have directories like
-		;; "etc/sounds/" or "etc/photos/" and we don't want to get
-		;; these confused with the actual package name (although, in
-		;; the case of "etc/sounds/", it's probably correct).
 		(if (catch 'done
-		      (let ( (dirs '("lisp" "info" "man" "etc")) rexp)
+		      (let ((dirs '("lisp" "man")) 
+			    rexp)
 			(while dirs
 			  (setq rexp (concat "\\b" (car dirs)
 					     "[\\/]\\([^\\/]+\\)[\//]"))
 			  (if (re-search-forward rexp nil t)
 			      (throw 'done t))
-			  (setq dirs (cdr dirs))
-			  )))
+			  (setq dirs (cdr dirs)))))
 		    (progn
 		      (setq package-name (buffer-substring (match-beginning 1)
 							   (match-end 1)))
@@ -277,22 +236,16 @@
 					    (buffer-substring
 					     (match-beginning 1)
 					     (match-end 1)))
-				      (throw 'found-path t)
-				      ))
-				(setq regexps (cdr regexps))
-				)
-			      )
+				      (throw 'found-path t)))
+				(setq regexps (cdr regexps))))
 			    (progn
 			      ;; found a pathname -- add it to the manifest
 			      ;; buffer
 			      (save-excursion
 				(set-buffer manifest-buf)
 				(goto-char (point-max))
-				(insert pathname "\n")
-				)
-			      ))
-			(forward-line 1)
-			)
+				(insert pathname "\n"))))
+			(forward-line 1))
 
 		      ;; Processed all lines.
 		      ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
@@ -312,25 +265,16 @@
 			;; Put the files in sorted order
 			(if-fboundp 'sort-lines
 			    (sort-lines nil (point-min) (point-max))
-			  (error 'unimplemented
-				 "`xemacs-base' not installed?"))
+			  (warn "`xemacs-base' not installed, MANIFEST.%s not sorted"
+				package-name))
 			;; Write the file.
 			;; Note that using `write-region' *BYPASSES* any check
 			;; to see if XEmacs is currently editing/visiting the
 			;; file.
-			(write-region (point-min) (point-max) pathname)
-			)
-		      (kill-buffer manifest-buf)
-		      )
-		  (progn
-		    ;; We can't determine the package name from an extracted
-		    ;; file in the tar output buffer.
-		    ))
-		))
-	  )
+			(write-region (point-min) (point-max) pathname))
+		      (kill-buffer manifest-buf))))))
       ;; Restore old case-fold-search status
-      (setq case-fold-search old-case-fold-search))
-    ))
+      (setq case-fold-search old-case-fold-search))))
 
 ;;;###autoload
 (defun package-admin-add-binary-package (file &optional pkg-dir)
@@ -338,8 +282,7 @@
   (interactive "fPackage tarball: ")
   (let ((buf (get-buffer-create package-admin-temp-buffer))
 	(status 1)
-	start err-list
-	)
+	start err-list)
     (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir))
     ;; Ensure that the current directory doesn't change
     (save-excursion
@@ -361,17 +304,11 @@
 		(if (re-search-forward (car err-list) nil t)
 		    (progn
 		      (setq status 1)
-		      (throw 'done nil)
-		      ))
-		(setq err-list (cdr err-list))
-		)
-	      )
+		      (throw 'done nil)))
+		(setq err-list (cdr err-list))))
 	    ;; Make sure that the MANIFEST file exists
-	    (package-admin-check-manifest buf pkg-dir)
-	    ))
-      )
-    status
-    ))
+	    (package-admin-check-manifest buf pkg-dir))))
+    status))
 
 (defun package-admin-rmtree (directory)
   "Delete a directory and all of its contents, recursively.
@@ -406,13 +343,12 @@
 	     (setq package-lispdir (expand-file-name (symbol-name package)
 						     package-lispdir))
 	     (file-accessible-directory-p package-lispdir))
-	package-lispdir)
-    ))
+	package-lispdir)))
 
 (defun package-admin-delete-binary-package (package pkg-topdir)
   "Delete a binary installation of PACKAGE below directory PKG-TOPDIR.
 PACKAGE is a symbol, not a string."
-  (let ( (tmpbuf " *pkg-manifest*") manifest-file package-lispdir dirs file)
+  (let (manifest-file package-lispdir dirs file)
     (setq pkg-topdir (package-admin-get-install-dir package pkg-topdir))
     (setq manifest-file (package-admin-get-manifest-file pkg-topdir package))
     (run-hook-with-args 'package-delete-hook package pkg-topdir)
@@ -421,8 +357,7 @@
 	  ;; The manifest file exists!  Use it to delete the old distribution.
 	  (message "Removing old files for package \"%s\" ..." package)
 	  (sit-for 0)
-	  (setq tmpbuf (get-buffer-create tmpbuf))
-	  (with-current-buffer tmpbuf
+	  (with-temp-buffer
 	    (buffer-disable-undo)
 	    (erase-buffer)
 	    (insert-file-contents manifest-file)
@@ -454,66 +389,30 @@
 
 	    ;; Delete empty directories.
 	    (if dirs
-		(let ( (orig-default-directory default-directory)
-		       ;; directory files file
-		       )
-		  ;; Make sure we preserve the existing `default-directory'.
-		  ;; JV, why does this change the default directory? Does it indeed?
-		  (unwind-protect
-		      (progn
-			;; Warning: destructive sort!
-			(setq dirs (nreverse (sort dirs 'string<)))
-;			;; For each directory ...
-;			(while dirs
-;			  (setq directory (file-name-as-directory (car dirs)))
-;			  (setq files (directory-files directory))
-;			  ;; Delete the directory if it's empty.
-;			  (if (catch 'done
-;				(while files
-;				  (setq file (car files))
-;				  (if (and (not (string= file "."))
-;					   (not (string= file "..")))
-;				      (throw 'done nil))
-;				  (setq files (cdr files))
-;				  )
-;				t)
-;			      (
-;			      (delete-directory directory))
-;			  (setq dirs (cdr dirs))
-;			  )
-			;; JV, On all OS's that I know of delete-directory fails on
-			;; on non-empty dirs anyway
-			(mapc
-			   (lambda (dir)
-			     (condition-case ()
-				 (delete-directory dir)))
-			   dirs))
-		    (setq default-directory orig-default-directory)
-		    )))
-	    )
-	  (kill-buffer tmpbuf)
+		(progn
+		  (mapc
+		   (lambda (dir)
+		     (condition-case ()
+			 (delete-directory dir)))
+		   dirs)))
 	  ;; Delete the MANIFEST file
 	  ;; (set-file-modes manifest-file 438) ;; 438 -> #o666
 	  ;; Note. Packages can have MANIFEST in MANIFEST.
 	  (condition-case ()
 	      (delete-file manifest-file)
 	    (error nil)) ;; Do warning?
-	  (message "Removing old files for package \"%s\" ... done" package))
-	;; The manifest file doesn't exist.  Fallback to just deleting the
-	;; package-specific lisp directory, if it exists.
-	;;
-	;; Delete old lisp directory, if any
-	;; Gads, this is ugly.  However, we're not supposed to use `concat'
-	;; in the name of portability.
-	(when (setq package-lispdir (package-admin-get-lispdir pkg-topdir
-							     package))
-	      (message "Removing old lisp directory \"%s\" ..."
-		       package-lispdir)
-	      (sit-for 0)
-	      (package-admin-rmtree package-lispdir)
-	      (message "Removing old lisp directory \"%s\" ... done"
-		       package-lispdir)
-	      ))
+	  (message "Removing old files for package \"%s\" ... done" package)))
+      ;; The manifest file doesn't exist.  Fallback to just deleting the
+      ;; package-specific lisp directory, if it exists.
+      ;;
+      ;; Delete old lisp directory, if any
+      ;; Gads, this is ugly.  However, we're not supposed to use `concat'
+      ;; in the name of portability.
+      (setq package-lispdir (package-admin-get-lispdir pkg-topdir package))
+      (message "Removing old lisp directory \"%s\" ..." package-lispdir)
+      (sit-for 0)
+      (package-admin-rmtree package-lispdir)
+      (message "Removing old lisp directory \"%s\" ... done" package-lispdir))
     ;; Delete the package from the database of installed packages.
     (package-delete-name package)))