X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/565c0ca57e89ab1a1b4c378c615a998eb8fc0f99..147c0425024ce9c1dbb7301300867d8563a6730a:/lisp/arc-mode.el diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 6dda7b2e40..8b17208983 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -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 ;; 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 @@ -323,10 +322,34 @@ 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 - (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." + :version "24.1" + :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." + :version "24.1" + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) :group 'archive-7z) ;; ------------------------------------------------------------------------- @@ -340,7 +363,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 +372,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 +636,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 +863,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 +1039,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 +1410,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 +1833,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 +2061,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 +2110,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 +2243,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