X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac89b32c15b8962fd388b1f568f0945885a017c7..bfc58a84b276919f675b0c65e84ea97238833033:/lisp/arc-mode.el

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index e0a587c760..4fc04b706b 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,10 +1,11 @@
 ;;; arc-mode.el --- simple editing of archives
 
-;; Copyright (C) 1995, 1997-1998, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997-1998, 2001-2013 Free Software Foundation,
+;; Inc.
 
 ;; Author: Morten Welinder <terra@gnu.org>
 ;; Keywords: files archives msdog editing major-mode
-;; Favourite-brand-of-beer: None, I hate beer.
+;; Favorite-brand-of-beer: None, I hate beer.
 
 ;; This file is part of GNU Emacs.
 
@@ -75,7 +76,7 @@
 ;;
 ;; LZH         A series of (header,file).  Headers are checksummed.  No
 ;;             interaction among members.
-;;             Headers come in three flavours called level 0, 1 and 2 headers.
+;;             Headers come in three flavors called level 0, 1 and 2 headers.
 ;;             Level 2 header is free of DOS specific restrictions and most
 ;;             prevalently used.  Also level 1 and 2 headers consist of base
 ;;             and extension headers.  For more details see
@@ -96,7 +97,7 @@
 ;;
 ;; archive-mode-hook
 ;; archive-foo-mode-hook
-;; archive-extract-hooks
+;; archive-extract-hook
 
 ;;; Code:
 
@@ -140,8 +141,10 @@ A local copy of the archive will be used when updating."
   :type 'regexp
   :group 'archive)
 
-(defcustom archive-extract-hooks nil
-  "Hooks to run when an archive member has been extracted."
+(define-obsolete-variable-alias 'archive-extract-hooks
+  'archive-extract-hook "24.3")
+(defcustom archive-extract-hook nil
+  "Hook run when an archive member has been extracted."
   :type 'hook
   :group 'archive)
 ;; ------------------------------
@@ -216,10 +219,10 @@ Archive and member name will be added."
 ;; Zip archive configuration
 
 (defcustom archive-zip-extract
-  (cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
-	((executable-find "7z") '("7z" "x" "-so"))
+  (cond ((executable-find "unzip")   '("unzip" "-qq" "-c"))
+	((executable-find "7z")      '("7z" "x" "-so"))
 	((executable-find "pkunzip") '("pkunzip" "-e" "-o-"))
-	(t '("unzip" "-qq" "-c")))
+	(t                           '("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."
@@ -235,44 +238,44 @@ be added."
 ;; names.
 
 (defcustom archive-zip-expunge
-  (if (and (not (executable-find "zip"))
-           (executable-find "pkzip"))
-      '("pkzip" "-d")
-    '("zip" "-d" "-q"))
+  (cond ((executable-find "zip")     '("zip" "-d" "-q"))
+	((executable-find "7z")      '("7z" "d"))
+	((executable-find "pkzip")   '("pkzip" "-d"))
+	(t                           '("zip" "-d" "-q")))
   "Program and its options to run in order to delete zip file members.
 Archive and member names will be added."
   :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
+	       (repeat :tag "Options"
+		       :inline t
+		       (string :format "%v")))
   :group 'archive-zip)
 
 (defcustom archive-zip-update
-  (if (and (not (executable-find "zip"))
-           (executable-find "pkzip"))
-      '("pkzip" "-u" "-P")
-    '("zip" "-q"))
+  (cond ((executable-find "zip")     '("zip" "-q"))
+	((executable-find "7z")      '("7z" "u"))
+	((executable-find "pkzip")   '("pkzip" "-u" "-P"))
+	(t                           '("zip" "-q")))
   "Program and its options to run in order to update a zip file member.
 Options should ensure that specified directory will be put into the zip
 file.  Archive and member name will be added."
   :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
+	       (repeat :tag "Options"
+		       :inline t
+		       (string :format "%v")))
   :group 'archive-zip)
 
 (defcustom archive-zip-update-case
-  (if (and (not (executable-find "zip"))
-           (executable-find "pkzip"))
-      '("pkzip" "-u" "-P")
-    '("zip" "-q" "-k"))
+  (cond ((executable-find "zip")     '("zip" "-q" "-k"))
+	((executable-find "7z")      '("7z" "u"))
+	((executable-find "pkzip")   '("pkzip" "-u" "-P"))
+	(t                           '("zip" "-q" "-k")))
   "Program and its options to run in order to update a case fiddled zip member.
 Options should ensure that specified directory will be put into the zip file.
 Archive and member name will be added."
   :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
+	       (repeat :tag "Options"
+		       :inline t
+		       (string :format "%v")))
   :group 'archive-zip)
 
 (defcustom archive-zip-case-fiddle t
@@ -322,6 +325,7 @@ Archive and member name will be added."
   "Program and its options to run in order to extract a 7z file member.
 Extraction should happen to standard output.  Archive and member name will
 be added."
+  :version "24.1"
   :type '(list (string :tag "Program")
 	       (repeat :tag "Options"
 		       :inline t
@@ -332,6 +336,7 @@ be added."
   '("7z" "d")
   "Program and its options to run in order to delete 7z file members.
 Archive and member names will be added."
+  :version "24.1"
   :type '(list (string :tag "Program")
 	       (repeat :tag "Options"
 		       :inline t
@@ -343,6 +348,7 @@ Archive and member names will be added."
   "Program and its options to run in order to update a 7z file member.
 Options should ensure that specified directory will be put into the 7z
 file.  Archive and member name will be added."
+  :version "24.1"
   :type '(list (string :tag "Program")
 	       (repeat :tag "Options"
 		       :inline t
@@ -619,11 +625,12 @@ the mode is invalid.  If ERROR is nil then nil will be returned."
 
 (defun archive-unixdate (low high)
   "Stringify Unix (LOW HIGH) date."
-  (let ((str (current-time-string (cons high low))))
+  (let* ((time (cons high low))
+	 (str (current-time-string time)))
     (format "%s-%s-%s"
 	    (substring str 8 10)
 	    (substring str 4 7)
-	    (substring str 20 24))))
+	    (format-time-string "%Y" time))))
 
 (defun archive-unixtime (low high)
   "Stringify Unix (LOW HIGH) time."
@@ -783,7 +790,8 @@ is visible (and the real data of the buffer is hidden).
 Optional argument SHUT-UP, if non-nil, means don't print messages
 when parsing the archive."
   (widen)
-  (let ((inhibit-read-only t))
+  (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file
+	(inhibit-read-only t))
     (setq archive-proper-file-start (copy-marker (point-min) t))
     (set (make-local-variable 'change-major-mode-hook) 'archive-desummarize)
     (or shut-up
@@ -860,13 +868,13 @@ using `make-temp-file', and the generated name is returned."
 	  dir)))
     (if (or alien (file-exists-p fullname))
 	(progn
-	  ;; Maked sure all the leading directories in
+	  ;; Make sure all the leading directories in
 	  ;; archive-local-name exist under archive-tmpdir, so that
 	  ;; the directory structure recorded in the archive is
 	  ;; reconstructed in the temporary directory.
 	  (make-directory (file-name-directory tmpfile) t)
 	  (make-temp-file tmpfile))
-      ;; Maked sure all the leading directories in `fullname' exist
+      ;; Make sure all the leading directories in `fullname' exist
       ;; under archive-tmpdir.  This is necessary for nested archives
       ;; (`archive-extract' sets `archive-remote' to t in case
       ;; an archive occurs inside another archive).
@@ -967,11 +975,6 @@ using `make-temp-file', and the generated name is returned."
 		    (save-excursion
 		      (funcall set-auto-coding-function
 			       filename (- (point-max) (point-min)))))
-	       ;; dos-w32.el defines the function
-	       ;; find-buffer-file-type-coding-system for DOS/Windows
-	       ;; systems which preserves the coding-system of existing files.
-	       ;; (That function is called via file-coding-system-alist.)
-	       ;; Here, we want it to act as if the extracted file existed.
 	       ;; The following let-binding of file-name-handler-alist forces
 	       ;; find-file-not-found-set-buffer-file-coding-system to ignore
 	       ;; the file's name (see dos-w32.el).
@@ -1036,7 +1039,7 @@ using `make-temp-file', and the generated name is returned."
 	  (setq archive-file-name-coding-system file-name-coding)
 	  (if (and
 	       (null
-		(let (;; We may have to encode file name arguement for
+		(let (;; We may have to encode the file name argument for
 		      ;; external programs.
 		      (coding-system-for-write
 		       (and enable-multibyte-characters
@@ -1073,7 +1076,7 @@ using `make-temp-file', and the generated name is returned."
               ;; We will write out the archive ourselves if it is
               ;; part of another archive.
               (remove-hook 'write-contents-functions 'archive-write-file t))
-            (run-hooks 'archive-extract-hooks)
+            (run-hooks 'archive-extract-hook)
 	    (if archive-read-only
 		(message "Note: altering this archive is not implemented."))))
 	(archive-maybe-update t))
@@ -1113,13 +1116,54 @@ using `make-temp-file', and the generated name is returned."
     (archive-delete-local tmpfile)
     success))
 
-(defun archive-extract-by-stdout (archive name command &optional stderr-file)
-  (apply 'call-process
-	 (car command)
-	 nil
-	 (if stderr-file (list t stderr-file) t)
-	 nil
-	 (append (cdr command) (list archive name))))
+(defun archive-extract-by-stdout (archive name command &optional stderr-test)
+  (let ((stderr-file (make-temp-file "arc-stderr")))
+    (unwind-protect
+	(prog1
+	    (apply 'call-process
+		   (car command)
+		   nil
+		   (if stderr-file (list t stderr-file) t)
+		   nil
+		   (append (cdr command) (list archive name)))
+	  (with-temp-buffer
+	    (insert-file-contents stderr-file)
+	    (goto-char (point-min))
+	    (when (if (stringp stderr-test)
+		      (not (re-search-forward stderr-test nil t))
+		    (> (buffer-size) 0))
+	      (message "%s" (buffer-string)))))
+      (if (file-exists-p stderr-file)
+	  (delete-file stderr-file)))))
+
+(defun archive-extract-by-file (archive name command &optional stdout-test)
+  (let ((dest (make-temp-file "arc-dir" 'dir))
+	(stdout-file (make-temp-file "arc-stdout")))
+    (unwind-protect
+	(prog1
+	    (apply 'call-process
+		   (car command)
+		   nil
+		   `(:file ,stdout-file)
+		   nil
+		   (append (cdr command) (list archive name dest)))
+	  (with-temp-buffer
+	    (insert-file-contents stdout-file)
+	    (goto-char (point-min))
+	    (when (if (stringp stdout-test)
+		      (not (re-search-forward stdout-test nil t))
+		    (> (buffer-size) 0))
+	      (message "%s" (buffer-string))))
+	  (if (file-exists-p (expand-file-name name dest))
+	      (insert-file-contents-literally (expand-file-name name dest))))
+      (if (file-exists-p stdout-file)
+	  (delete-file stdout-file))
+      (if (file-exists-p (expand-file-name name dest))
+	  (delete-file (expand-file-name name dest)))
+      (while (file-name-directory name)
+	(setq name (directory-file-name (file-name-directory name)))
+	(delete-directory (expand-file-name name dest)))
+      (delete-directory dest))))
 
 (defun archive-extract-other-window ()
   "In archive mode, find this member in another window."
@@ -2002,17 +2046,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
       ;; The code below assumes the name is relative and may do undesirable
       ;; things otherwise.
       (error "Can't extract files with non-relative names")
-    (let ((dest (make-temp-file "arc-rar" 'dir)))
-      (unwind-protect
-          (progn
-            (call-process "unrar-free" nil nil nil
-                          "--extract" archive name dest)
-            (insert-file-contents-literally (expand-file-name name dest)))
-        (delete-file (expand-file-name name dest))
-        (while (file-name-directory name)
-          (setq name (directory-file-name (file-name-directory name)))
-          (delete-directory (expand-file-name name dest)))
-        (delete-directory dest)))))
+    (archive-extract-by-file archive name '("unrar-free" "--extract") "All OK")))
 
 ;;; Section: Rar self-extracting .exe archives.
 
@@ -2095,17 +2129,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
       (apply 'vector files))))
 
 (defun archive-7z-extract (archive name)
-  (let ((tmpfile (make-temp-file "7z-stderr")))
-    ;; 7z doesn't provide a `quiet' option to suppress non-essential
-    ;; stderr messages.  So redirect stderr to a temp file and display it
-    ;; in the echo area when it contains error messages.
-    (prog1 (archive-extract-by-stdout
-	    archive name archive-7z-extract tmpfile)
-      (with-temp-buffer
-	(insert-file-contents tmpfile)
-	(unless (search-forward "Everything is Ok" nil t)
-	  (message "%s" (buffer-string)))
-	(delete-file tmpfile)))))
+  ;; 7z doesn't provide a `quiet' option to suppress non-essential
+  ;; stderr messages.  So redirect stderr to a temp file and display it
+  ;; in the echo area when it contains no message indicating success.
+  (archive-extract-by-stdout
+   archive name archive-7z-extract "Everything is Ok"))
 
 (defun archive-7z-write-file-member (archive descr)
   (archive-*-write-file-member