]> code.delx.au - gnu-emacs/blobdiff - lisp/arc-mode.el
Merge from emacs-23; up to 2010-06-29T18:17:31Z!cyd@stupidchicken.com.
[gnu-emacs] / lisp / arc-mode.el
index 6dda7b2e40be0d85be702ec0b2037807e012cb96..83862555c804f88e491d98a6c9016e9adaf600df 100644 (file)
@@ -1,11 +1,10 @@
 ;;; arc-mode.el --- simple editing of archives
 
-;; Copyright (C) 1995, 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997-1998, 2001-2012  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.
 
@@ -56,9 +55,9 @@
 ;;                     --------------------------------------------
 ;; View listing                Intern  Intern  Intern  Intern  Y       Y
 ;; Extract member      Y       Y       Y       Y       Y       Y
-;; Save changed member Y       Y       Y       Y       N       N
+;; Save changed member Y       Y       Y       Y       N       Y
 ;; Add new member      N       N       N       N       N       N
-;; Delete member       Y       Y       Y       Y       N       N
+;; Delete member       Y       Y       Y       Y       N       Y
 ;; Rename member       Y       Y       N       N       N       N
 ;; Chmod               -       Y       Y       -       N       N
 ;; Chown               -       Y       -       -       N       N
@@ -76,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
@@ -217,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."
@@ -236,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
@@ -324,9 +323,30 @@ Archive and member name will be added."
 Extraction should happen to standard output.  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-7z)
+
+(defcustom archive-7z-expunge
+  '("7z" "d")
+  "Program and its options to run in order to delete 7z file members.
+Archive and member names will be added."
+  :type '(list (string :tag "Program")
+              (repeat :tag "Options"
+                      :inline t
+                      (string :format "%v")))
+  :group 'archive-7z)
+
+(defcustom archive-7z-update
+  '("7z" "u")
+  "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."
+  :type '(list (string :tag "Program")
+              (repeat :tag "Options"
+                      :inline t
+                      (string :format "%v")))
   :group 'archive-7z)
 
 ;; -------------------------------------------------------------------------
@@ -340,7 +360,7 @@ be added."
 (defvar archive-local-name nil "Name of local copy of remote archive.")
 (defvar archive-mode-map
   (let ((map (make-keymap)))
-    (suppress-keymap map)
+    (set-keymap-parent map special-mode-map)
     (define-key map " " 'archive-next-line)
     (define-key map "a" 'archive-alternate-display)
     ;;(define-key map "c" 'archive-copy)
@@ -349,15 +369,12 @@ be added."
     (define-key map "e" 'archive-extract)
     (define-key map "f" 'archive-extract)
     (define-key map "\C-m" 'archive-extract)
-    (define-key map "g" 'revert-buffer)
-    (define-key map "h" 'describe-mode)
     (define-key map "m" 'archive-mark)
     (define-key map "n" 'archive-next-line)
     (define-key map "\C-n" 'archive-next-line)
     (define-key map [down] 'archive-next-line)
     (define-key map "o" 'archive-extract-other-window)
     (define-key map "p" 'archive-previous-line)
-    (define-key map "q" 'quit-window)
     (define-key map "\C-p" 'archive-previous-line)
     (define-key map [up] 'archive-previous-line)
     (define-key map "r" 'archive-rename-entry)
@@ -616,7 +633,7 @@ the mode is invalid.  If ERROR is nil then nil will be returned."
 (defun archive-get-lineno ()
   (if (>= (point) archive-file-list-start)
       (count-lines archive-file-list-start
-                  (save-excursion (beginning-of-line) (point)))
+                  (line-beginning-position))
     0))
 
 (defun archive-get-descr (&optional noerror)
@@ -843,13 +860,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).
@@ -1019,7 +1036,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
@@ -1390,7 +1407,7 @@ as a relative change like \"g+rw\" as for chmod(2)."
       (error "Renaming is not supported for this archive type"))))
 
 ;; Revert the buffer and recompute the dired-like listing.
-(defun archive-mode-revert (&optional no-auto-save no-confirm)
+(defun archive-mode-revert (&optional _no-auto-save _no-confirm)
   (let ((no (archive-get-lineno)))
     (setq archive-files nil)
     (let ((revert-buffer-function nil)
@@ -1813,10 +1830,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
      archive
      ;; unzip expands wildcards in NAME, so we need to quote it.  But
      ;; not on DOS/Windows, since that fails extraction on those
-     ;; systems, and file names with wildcards in zip archives don't
-     ;; work there anyway.
+     ;; systems (unless w32-quote-process-args is nil), and file names
+     ;; with wildcards in zip archives don't work there anyway.
      ;; FIXME: Does pkunzip need similar treatment?
-     (if (and (not (memq system-type '(windows-nt ms-dos)))
+     (if (and (or (not (memq system-type '(windows-nt ms-dos)))
+                 (and (boundp 'w32-quote-process-args)
+                      (null w32-quote-process-args)))
              (equal (car archive-zip-extract) "unzip"))
         (shell-quote-argument name)
        name)
@@ -2039,7 +2058,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
     (with-temp-buffer
       (call-process "7z" nil t nil "l" "-slt" file)
       (goto-char (point-min))
-      (re-search-forward "^-+\n")
+      ;; Four dashes start the meta info section that should be skipped.
+      ;; Archive members start with more than four dashes.
+      (re-search-forward "^-----+\n")
       (while (re-search-forward "^Path = \\(.*\\)\n" nil t)
         (goto-char (match-end 0))
         (let ((name (match-string 1))
@@ -2086,6 +2107,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
          (message "%s" (buffer-string)))
        (delete-file tmpfile)))))
 
+(defun archive-7z-write-file-member (archive descr)
+  (archive-*-write-file-member
+   archive
+   descr
+   archive-7z-update))
+
 ;; -------------------------------------------------------------------------
 ;;; Section `ar' archives.
 
@@ -2213,5 +2240,4 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
 
 (provide 'arc-mode)
 
-;; arch-tag: e5966a01-35ec-4f27-8095-a043a79b457b
 ;;; arc-mode.el ends here