Push ChangeLog entry for previous commit.

[gnu-emacs] / lisp / arc-mode.el

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index ea875b9989daf478a6c19ffa29979a76660197a5..8849fb852440d838d1d33f9a62e199a1636b0803 100644 (file)
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,10 +1,11 @@
 ;;; arc-mode.el --- simple editing of archives
 
 ;;; 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
 
 ;; 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.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -75,7 +76,7 @@
 ;;
 ;; LZH         A series of (header,file).  Headers are checksummed.  No
 ;;             interaction among members.
 ;;
 ;; 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
 ;;             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-mode-hook
 ;; archive-foo-mode-hook

-;; archive-extract-hooks
+;; archive-extract-hook

 
 ;;; Code:
 
 
 ;;; Code:
 


@@ -140,8 +141,10 @@ A local copy of the archive will be used when updating."
   :type 'regexp
   :group 'archive)
 
   :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)
 ;; ------------------------------
   :type 'hook
   :group 'archive)
 ;; ------------------------------


@@ -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."
   "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 +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."
   '("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 +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."
   "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 +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."
 
 (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."


@@ -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)
 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
     (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
          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))
          ;; 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).
       ;; under archive-tmpdir.  This is necessary for nested archives
       ;; (`archive-extract' sets `archive-remote' to t in case
       ;; an archive occurs inside another archive).


@@ -1036,7 +1044,7 @@ using `make-temp-file', and the generated name is returned."
          (setq archive-file-name-coding-system file-name-coding)
          (if (and
               (null
          (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
                      ;; external programs.
                      (coding-system-for-write
                       (and enable-multibyte-characters


@@ -1073,7 +1081,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))
               ;; 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))
            (if archive-read-only
                (message "Note: altering this archive is not implemented."))))
        (archive-maybe-update t))


@@ -1083,7 +1091,7 @@ using `make-temp-file', and the generated name is returned."
            (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
            ((eq other-window-p 'display) (display-buffer buffer))
            (other-window-p (switch-to-buffer-other-window buffer))
            (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
            ((eq other-window-p 'display) (display-buffer buffer))
            (other-window-p (switch-to-buffer-other-window buffer))

-           (t (pop-to-buffer-same-window buffer))))))
+           (t (switch-to-buffer buffer))))))

 
 (defun archive-*-extract (archive name command)
   (let* ((default-directory (file-name-as-directory archive-tmpdir))
 
 (defun archive-*-extract (archive name command)
   (let* ((default-directory (file-name-as-directory archive-tmpdir))


@@ -1113,13 +1121,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 +2051,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 +2134,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