greg(a)alphatech.com (Greg Klanderman) writes: 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)