X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2dcdbdd97db0f414a2f11421e9d8001ea6178517..53baf48a6e99b5ff434d5177b00beda3fc9a8f71:/lisp/arc-mode.el diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 70f43aebaf..a97a052dc0 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1,10 +1,10 @@ ;;; arc-mode.el --- simple editing of archives -;; Copyright (C) 1995, 1997-1998, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1997-1998, 2001-2012 Free Software Foundation, Inc. ;; Author: Morten Welinder ;; 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 +75,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 @@ -216,10 +216,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 +235,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 +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." + :version "24.1" :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." + :version "24.1" :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." + :version "24.1" :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." - (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." @@ -860,13 +864,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). @@ -1036,7 +1040,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 @@ -1083,7 +1087,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)) - (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)) @@ -1113,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." @@ -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") - (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 +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