greg(a)alphatech.com (Greg Klanderman) writes:
> try this. i submitted to patches last night but haven't even gotten
> the usual (immediate) confirmation. i will resubmit.
There is something wrong with the xemacs-patches I guess. I submitted
this one (twice already)
Index: package-admin.el
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/lisp/package-admin.el,v
retrieving revision 1.6
diff -u -u -r1.6 package-admin.el
--- package-admin.el 1998/09/26 00:21:59 1.6
+++ package-admin.el 1998/10/02 22:24:19
@@ -388,89 +388,99 @@
(message "Removing old files for package \"%s\" ..." package)
(sit-for 0)
(setq tmpbuf (get-buffer-create tmpbuf))
- (save-excursion
- (set-buffer tmpbuf)
- (buffer-disable-undo tmpbuf)
- (erase-buffer tmpbuf)
+ (with-current-buffer tmpbuf
+ (buffer-disable-undo)
+ (erase-buffer)
(insert-file-contents manifest-file)
(goto-char (point-min))
+
;; For each entry in the MANIFEST ...
(while (< (point) (point-max))
(beginning-of-line)
(setq file (expand-file-name (buffer-substring
(point)
- (save-excursion (end-of-line)
- (point)))
+ (point-at-eol))
pkg-topdir))
(if (file-directory-p file)
;; Keep a record of each directory
(setq dirs (cons file dirs))
- (progn
;; Delete each file.
;; Make sure that the file is writable.
;; (This is important under MS Windows.)
- (set-file-modes file 438) ;; 438 -> #o666
- (delete-file file)
- ))
- (forward-line 1)
- )
+ ;; I do not know why it important under MS Windows but
+ ;; 1. It bombs out out when the file does not exist. This can be condition-cased
+ ;; 2. If I removed the write permissions, I do not want XEmacs to just ignore them.
+ ;; If it wants to, XEmacs may ask, but that is about all
+ ;; (set-file-modes file 438) ;; 438 -> #o666
+ ;; Note, user might have removed the file!
+ (condition-case ()
+ (delete-file file)
+ (error nil))) ;; We may want to turn the error into a Warning?
+ (forward-line 1))
+
;; 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))
- )
- )
+; ;; 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)
;; Delete the MANIFEST file
- (set-file-modes manifest-file 438) ;; 438 -> #o666
- (delete-file manifest-file)
- (message "Removing old files for package \"%s\" ... done" package)
- )
- (progn
+ ;; (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.
- (if (setq package-lispdir (package-admin-get-lispdir pkg-topdir
+ (when (setq package-lispdir (package-admin-get-lispdir pkg-topdir
package))
- (progn
(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)
- ))
+ (package-delete-name package)))
(provide 'package-admin)