Display archive errors in the echo area instead of inserting to the file buffer.

[bpt/emacs.git] / lisp / arc-mode.el

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 8b17208..a97a052 100644 (file)
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -622,11 +622,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."
@@ -1116,13 +1117,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."
@@ -2005,17 +2047,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.
 
@@ -2098,17 +2130,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