emacs: lisp/arc-mode.el comparison

comparison lisp/arc-mode.el @ 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	ad6c6f1bd674
children	029145c16497

comparison

equal deleted inserted replaced

-:c1f86e273a38
+:e21c343b0c6e
 (defgroup archive-zoo nil
 "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"))
 (or (getenv "TMPDIR") (getenv "TMP") "/tmp"))
 "*Directory for temporary files made by arc-mode.el"
 Only set to true for msdog systems!"
 :type 'boolean
 :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
 expected to extract to a file junking the directory part of the name."
 :type '(list (string :tag "Program")
 (put 'archive-superior-buffer 'permanent-local t)
 (defvar archive-subfile-mode nil "*Non-nil in archive member buffers.")
 (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
 [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
 	;; Real file contents is binary
 	(make-local-variable 'require-final-newline)
 	(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))))
 	;; Should we use a local copy when accessing from outside Emacs?
 (define-key archive-mode-map [menu-bar operate expunge]
 '("Expunge Marked Files" . archive-expunge))
 ))
 (let* ((item1 '(archive-subfile-mode " Archive"))
-(item2 '(archive-subfile-dos " Dos"))
+(items (list item1)))
-(items (if (memq system-type '(ms-dos windows-nt))
-		  (list item1) ; msdog has its own indicator
-		(list item1 item2))))
 (or (member item1 minor-mode-alist)
 (setq minor-mode-alist (append items minor-mode-alist))))
 ;; -------------------------------------------------------------------------
 (defun archive-find-type ()
 (widen)
 (make-local-variable 'archive-superior-buffer)
 (setq archive-superior-buffer archive-buffer)
 (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)
-	  (if (boundp 'default-buffer-file-type)
+;	      (setq buffer-file-type t))
-	      (setq buffer-file-type t))
+	  (if (and
-	  (if (fboundp extractor)
+	       (null
-	      (funcall extractor archive ename)
+		(if (fboundp extractor)
-	    (archive-*-extract archive ename (symbol-value extractor)))
+		    (funcall extractor archive ename)
-(if archive-dos-members (archive-check-dos))
+		  (archive-*-extract archive ename (symbol-value extractor))))
-(goto-char (point-min))
+	       just-created)
-(rename-buffer bufname)
+	      (progn
-(setq buffer-read-only read-only-p)
+		(set-buffer-modified-p nil)
-	  (setq buffer-undo-list nil)
+		(kill-buffer buffer))
-(set-buffer-modified-p nil)
+	    (goto-char (point-min))
-	  (setq buffer-saved-size (buffer-size))
+	    (rename-buffer bufname)
-(normal-mode)
+	    (setq buffer-read-only read-only-p)
-	  ;; Just in case an archive occurs inside another archive.
+	    (setq buffer-undo-list nil)
-	  (if (eq major-mode 'archive-mode)
+	    (set-buffer-modified-p nil)
-	      (setq archive-remote t))
+	    (setq buffer-saved-size (buffer-size))
-	  (run-hooks 'archive-extract-hooks))
+	    (normal-mode)
-	(archive-maybe-update t))
+	    ;; Just in case an archive occurs inside another archive.
-(if view-p
+	    (if (eq major-mode 'archive-mode)
-	  (view-buffer buffer (and just-created 'kill-buffer))
+		(setq archive-remote t))
-(if (eq other-window-p 'display)
+	    (run-hooks 'archive-extract-hooks))
-(display-buffer buffer)
+	  (archive-maybe-update t)))
-(if other-window-p
+(or (not (buffer-name buffer))
-(switch-to-buffer-other-window buffer)
+	  (progn
-(switch-to-buffer buffer))))))
+	    (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
+(setq exit-status
-	   (car command)
+	  (apply 'call-process
-	   nil
+		 (car command)
-	   nil
+		 nil
-	   nil
+		 nil
-	   (append (cdr command) (list archive name)))
+		 nil
-(insert-file-contents tmpfile)
+		 (append (cdr command) (list archive name))))
-(archive-delete-local tmpfile)))
+(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
 	   t
 	   nil
 	  (funcall func buffer-file-name membuf name))
 (error "Adding a new member is not supported for this archive type"))))
 ;; -------------------------------------------------------------------------
 ;; 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-excursion
 (save-restriction
-	(widen)
+(message "Updating archive...")
-(save-excursion
+(widen)
-(goto-char (point-min))
+(let ((writer  (save-excursion (set-buffer archive-superior-buffer)
-;; We don't want our ^M^J <--> ^J changes to show in the undo list
+				     (archive-name "write-file-member")))
-(let ((undo-list buffer-undo-list))
+	    (archive (save-excursion (set-buffer archive-superior-buffer)
-(unwind-protect
+				     (buffer-file-name))))
-(progn
+	(if (fboundp writer)
-(setq buffer-undo-list t)
+	    (funcall writer archive archive-subfile-mode)
-(while (search-forward "\n" nil t)
+	  (archive-*-write-file-member archive
-(replace-match "\r\n"))
+				       archive-subfile-mode
-(setq archive-subfile-dos nil)
+				       (symbol-value writer))))
-		  (if (boundp 'default-buffer-file-type)
+(set-buffer-modified-p nil)
-		      (setq buffer-file-type t))
+(message "Updating archive...done")
-;; OK, we're now have explicit ^M^Js -- save and re-unixfy
+(set-buffer archive-superior-buffer)
-(archive-write-file-member))
+(revert-buffer)
-(progn
+t)))
-(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))))
 (defun archive-*-write-file-member (archive descr command)
 (let* ((ename (aref descr 0))
 (tmpfile (expand-file-name ename archive-tmpdir))
 (top (directory-file-name (file-name-as-directory archive-tmpdir)))

Mercurial > emacs

comparison lisp/arc-mode.el @ 21570:e21c343b0c6e