Mercurial > emacs
changeset 21570:e21c343b0c6e
(archive-extract-by-stdout): Don't use
binary-process-output. Bind coding-system-for-read to 'undecided,
so coding system is determined on the fly. Bind inherit-process-coding-system
to t.
(archive-dos-members): Remove.
(archive-extract): Don't call archive-check-dos. Handle pkunzip errors.
(archive-*-extract): Handle pkzip errors.
(archive-check-dos): Remove.
(archive-subfile-dos): Remove.
(archive-extract): Don't bind archive-subfile-dos.
(archive-write-file-member): Don't DOSify DOS-style archive members.
(archive-zip-extract): Make pkzip use -o- flag, to make it more silent.
| author | Eli Zaretskii <eliz@gnu.org> |
|---|---|
| date | Wed, 15 Apr 1998 15:31:30 +0000 |
| parents | c1f86e273a38 |
| children | add6627452a5 |
| files | lisp/arc-mode.el |
| diffstat | 1 files changed, 80 insertions(+), 112 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/arc-mode.el Wed Apr 15 15:17:02 1998 +0000 +++ b/lisp/arc-mode.el Wed Apr 15 15:31:30 1998 +0000 @@ -119,12 +119,6 @@ "ZOO-specific options to archive." :group 'archive) - -(defcustom archive-dos-members t - "*If non-nil then recognize member files using ^M^J as line terminator." - :type 'boolean - :group 'archive) - (defcustom archive-tmpdir (expand-file-name (make-temp-name (if (eq system-type 'ms-dos) "ar" "archive.tmp")) @@ -222,7 +216,7 @@ :group 'archive-zip) (defcustom archive-zip-extract - (if archive-zip-use-pkzip '("pkunzip" "-e") '("unzip" "-qq" "-c")) + (if archive-zip-use-pkzip '("pkunzip" "-e" "-o-") '("unzip" "-qq" "-c")) "*Program and its options to run in order to extract a zip file member. Extraction should happen to standard output. Archive and member name will be added. If `archive-zip-use-pkzip' is non-nil then this program is @@ -334,11 +328,6 @@ (make-variable-buffer-local 'archive-subfile-mode) (put 'archive-subfile-mode 'permanent-local t) -(defvar archive-subfile-dos nil - "Negation of `buffer-file-type', which see.") -(make-variable-buffer-local 'archive-subfile-dos) -(put 'archive-subfile-dos 'permanent-local t) - (defvar archive-files nil "Vector of file descriptors. Each descriptor is a vector of the form @@ -528,8 +517,6 @@ (setq require-final-newline nil) (make-local-variable 'enable-local-variables) (setq enable-local-variables nil) - (if (boundp 'default-buffer-file-type) - (setq buffer-file-type t)) (make-local-variable 'archive-read-only) (setq archive-read-only (not (file-writable-p (buffer-file-name)))) @@ -657,10 +644,7 @@ )) (let* ((item1 '(archive-subfile-mode " Archive")) - (item2 '(archive-subfile-dos " Dos")) - (items (if (memq system-type '(ms-dos windows-nt)) - (list item1) ; msdog has its own indicator - (list item1 item2)))) + (items (list item1))) (or (member item1 minor-mode-alist) (setq minor-mode-alist (append items minor-mode-alist)))) ;; ------------------------------------------------------------------------- @@ -830,49 +814,73 @@ (make-local-variable 'local-write-file-hooks) (add-hook 'local-write-file-hooks 'archive-write-file-member) (setq archive-subfile-mode descr) - (setq archive-subfile-dos nil) - (if (boundp 'default-buffer-file-type) - (setq buffer-file-type t)) - (if (fboundp extractor) - (funcall extractor archive ename) - (archive-*-extract archive ename (symbol-value extractor))) - (if archive-dos-members (archive-check-dos)) - (goto-char (point-min)) - (rename-buffer bufname) - (setq buffer-read-only read-only-p) - (setq buffer-undo-list nil) - (set-buffer-modified-p nil) - (setq buffer-saved-size (buffer-size)) - (normal-mode) - ;; Just in case an archive occurs inside another archive. - (if (eq major-mode 'archive-mode) - (setq archive-remote t)) - (run-hooks 'archive-extract-hooks)) - (archive-maybe-update t)) - (if view-p - (view-buffer buffer (and just-created 'kill-buffer)) - (if (eq other-window-p 'display) - (display-buffer buffer) - (if other-window-p - (switch-to-buffer-other-window buffer) - (switch-to-buffer buffer)))))) +; (if (boundp 'default-buffer-file-type) +; (setq buffer-file-type t)) + (if (and + (null + (if (fboundp extractor) + (funcall extractor archive ename) + (archive-*-extract archive ename (symbol-value extractor)))) + just-created) + (progn + (set-buffer-modified-p nil) + (kill-buffer buffer)) + (goto-char (point-min)) + (rename-buffer bufname) + (setq buffer-read-only read-only-p) + (setq buffer-undo-list nil) + (set-buffer-modified-p nil) + (setq buffer-saved-size (buffer-size)) + (normal-mode) + ;; Just in case an archive occurs inside another archive. + (if (eq major-mode 'archive-mode) + (setq archive-remote t)) + (run-hooks 'archive-extract-hooks)) + (archive-maybe-update t))) + (or (not (buffer-name buffer)) + (progn + (if view-p + (view-buffer buffer (and just-created 'kill-buffer))) + (if (eq other-window-p 'display) + (display-buffer buffer) + (if other-window-p + (switch-to-buffer-other-window buffer) + (switch-to-buffer buffer))))))) (defun archive-*-extract (archive name command) (let* ((default-directory (file-name-as-directory archive-tmpdir)) (tmpfile (expand-file-name (file-name-nondirectory name) - default-directory))) + default-directory)) + exit-status success) (make-directory (directory-file-name default-directory) t) - (apply 'call-process - (car command) - nil - nil - nil - (append (cdr command) (list archive name))) - (insert-file-contents tmpfile) - (archive-delete-local tmpfile))) + (setq exit-status + (apply 'call-process + (car command) + nil + nil + nil + (append (cdr command) (list archive name)))) + (cond ((and (numberp exit-status) (= exit-status 0)) + (if (not (file-exists-p tmpfile)) + (ding (message "`%s': no such file or directory" tmpfile)) + (insert-file-contents tmpfile) + (setq success t))) + ((numberp exit-status) + (ding + (message "`%s' exited with status %d" (car command) exit-status))) + ((stringp exit-status) + (ding (message "`%s' aborted: %s" (car command) exit-status))) + (t + (ding (message "`%s' failed" (car command))))) + (archive-delete-local tmpfile) + success)) (defun archive-extract-by-stdout (archive name command) - (let ((binary-process-output t)) ; for Ms-Dos + ;; We need the coding system of the output of the extract program, + ;; including the EOL encoding, be decoded dynamically, since what + ;; the extract program outputs is the contents of some file. + (let ((coding-system-for-read (or coding-system-for-read 'undecided)) + (inherit-process-coding-system t)) (apply 'call-process (car command) nil @@ -936,65 +944,25 @@ ;; ------------------------------------------------------------------------- ;; Section: IO stuff -(defun archive-check-dos (&optional force) - "*Possibly handle a buffer with ^M^J terminated lines." - (save-restriction - (widen) - (save-excursion - (goto-char (point-min)) - (setq archive-subfile-dos - (or force (not (search-forward-regexp "[^\r]\n" nil t)))) - (if (boundp 'default-buffer-file-type) - (setq buffer-file-type (not archive-subfile-dos))) - (if archive-subfile-dos - (let ((modified (buffer-modified-p))) - (buffer-disable-undo (current-buffer)) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - (buffer-enable-undo) - (set-buffer-modified-p modified)))))) - (defun archive-write-file-member () - (if archive-subfile-dos - (save-restriction - (widen) - (save-excursion - (goto-char (point-min)) - ;; We don't want our ^M^J <--> ^J changes to show in the undo list - (let ((undo-list buffer-undo-list)) - (unwind-protect - (progn - (setq buffer-undo-list t) - (while (search-forward "\n" nil t) - (replace-match "\r\n")) - (setq archive-subfile-dos nil) - (if (boundp 'default-buffer-file-type) - (setq buffer-file-type t)) - ;; OK, we're now have explicit ^M^Js -- save and re-unixfy - (archive-write-file-member)) - (progn - (archive-check-dos t) - (setq buffer-undo-list undo-list)))) - t)) - (save-excursion - (save-restriction - (message "Updating archive...") - (widen) - (let ((writer (save-excursion (set-buffer archive-superior-buffer) - (archive-name "write-file-member"))) - (archive (save-excursion (set-buffer archive-superior-buffer) - (buffer-file-name)))) - (if (fboundp writer) - (funcall writer archive archive-subfile-mode) - (archive-*-write-file-member archive - archive-subfile-mode - (symbol-value writer)))) - (set-buffer-modified-p nil) - (message "Updating archive...done") - (set-buffer archive-superior-buffer) - (revert-buffer) - t)))) + (save-excursion + (save-restriction + (message "Updating archive...") + (widen) + (let ((writer (save-excursion (set-buffer archive-superior-buffer) + (archive-name "write-file-member"))) + (archive (save-excursion (set-buffer archive-superior-buffer) + (buffer-file-name)))) + (if (fboundp writer) + (funcall writer archive archive-subfile-mode) + (archive-*-write-file-member archive + archive-subfile-mode + (symbol-value writer)))) + (set-buffer-modified-p nil) + (message "Updating archive...done") + (set-buffer archive-superior-buffer) + (revert-buffer) + t))) (defun archive-*-write-file-member (archive descr command) (let* ((ename (aref descr 0))