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 8386255..a97a052 100644 (file)
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -322,6 +322,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."
   "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
   :type '(list (string :tag "Program")
               (repeat :tag "Options"
                       :inline t


@@ -332,6 +333,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."
   '("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
   :type '(list (string :tag "Program")
               (repeat :tag "Options"
                       :inline t


@@ -343,6 +345,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."
   "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
   :type '(list (string :tag "Program")
               (repeat :tag "Options"
                       :inline t


@@ -619,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."
 
 (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)
     (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."
 
 (defun archive-unixtime (low high)
   "Stringify Unix (LOW HIGH) time."


@@ -1113,13 +1117,54 @@ using `make-temp-file', and the generated name is returned."
     (archive-delete-local tmpfile)
     success))
 
     (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."
 
 (defun archive-extract-other-window ()
   "In archive mode, find this member in another window."


@@ -2002,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")
       ;; 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.
 
 
 ;;; Section: Rar self-extracting .exe archives.
 


@@ -2095,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)
       (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
 
 (defun archive-7z-write-file-member (archive descr)
   (archive-*-write-file-member