;;; arc-mode.el --- simple editing of archives
-;; Copyright (C) 1995, 1997, 1998, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@gnu.org>
-;; Keywords: archives msdog editing major-mode
+;; Keywords: files archives msdog editing major-mode
;; Favourite-brand-of-beer: None, I hate beer.
;; This file is part of GNU Emacs.
;; ARCHIVE TYPES: Currently only the archives below are handled, but the
;; structure for handling just about anything is in place.
;;
-;; Arc Lzh Zip Zoo Rar
-;; ----------------------------------------
-;; View listing Intern Intern Intern Intern Y
-;; Extract member Y Y Y Y Y
-;; Save changed member Y Y Y Y N
-;; Add new member N N N N N
-;; Delete member Y Y Y Y N
-;; Rename member Y Y N N N
-;; Chmod - Y Y - N
-;; Chown - Y - - N
-;; Chgrp - Y - - N
+;; Arc Lzh Zip Zoo Rar 7z
+;; --------------------------------------------
+;; 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
+;; Add new member N N N N N N
+;; Delete member Y Y Y Y N N
+;; Rename member Y Y N N N N
+;; Chmod - Y Y - N N
+;; Chown - Y - - N N
+;; Chgrp - Y - - N N
;;
;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips
;; on the first released version of this package.
;; Zip archive configuration
(defcustom archive-zip-extract
- (if (and (not (executable-find "unzip"))
- (executable-find "pkunzip"))
- '("pkunzip" "-e" "-o-")
- '("unzip" "-qq" "-c"))
+ (cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
+ ((executable-find "7z") '("7z" "x" "-so"))
+ ((executable-find "pkunzip") '("pkunzip" "-e" "-o-"))
+ (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."
:type '(list (string :tag "Program")
- (repeat :tag "Options"
- :inline t
- (string :format "%v")))
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
:group 'archive-zip)
;; For several reasons the latter behavior is not desirable in general.
:inline t
(string :format "%v")))
:group 'archive-zoo)
+;; ------------------------------
+;; 7z archive configuration
+
+(defcustom archive-7z-extract
+ '("7z" "x" "-so")
+ "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."
+ :type '(list (string :tag "Program")
+ (repeat :tag "Options"
+ :inline t
+ (string :format "%v")))
+ :group 'archive-7z)
+
;; -------------------------------------------------------------------------
;;; Section: Variables
;; mode on and off. You can corrupt things that way.
(if (zerop (buffer-size))
;; At present we cannot create archives from scratch
- (funcall (default-value 'major-mode))
+ (funcall (or (default-value 'major-mode) 'fundamental-mode))
(if (and (not force) archive-files) nil
(let* ((type (archive-find-type))
(typename (capitalize (symbol-name type))))
(or file-name-coding-system
default-file-name-coding-system
locale-coding-system))
- (if default-enable-multibyte-characters
+ (if (default-value 'enable-multibyte-characters)
(set-buffer-multibyte 'to))
(archive-summarize nil)
(setq buffer-read-only t))))
((and (looking-at "MZ")
(re-search-forward "Rar!" (+ (point) 100000) t))
'rar-exe)
+ ((looking-at "7z\274\257\047\034") '7z)
(t (error "Buffer format not recognized")))))
;; -------------------------------------------------------------------------
file by that name already exists in DIR, a unique new name is generated
using `make-temp-file', and the generated name is returned."
(let ((fullname (expand-file-name fname dir))
- (alien (string-match file-name-invalid-regexp fname)))
- (if (or alien (file-exists-p fullname))
- (make-temp-file
+ (alien (string-match file-name-invalid-regexp fname))
+ (tmpfile
(expand-file-name
(if (if (fboundp 'msdos-long-file-names)
(not (msdos-long-file-names)))
"am"
"arc-mode.")
- dir))
+ dir)))
+ (if (or alien (file-exists-p fullname))
+ (progn
+ ;; Maked 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
+ ;; under archive-tmpdir. This is necessary for nested archives
+ ;; (`archive-extract' sets `archive-remote' to t in case
+ ;; an archive occurs inside another archive).
+ (make-directory (file-name-directory fullname) t)
fullname)))
(defun archive-maybe-copy (archive)
archive)))
(setq archive-local-name
(archive-unique-fname archive-name archive-tmpdir))
- ;; Maked 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 archive-local-name) t)
(save-restriction
(widen)
(write-region start (point-max) archive-local-name nil 'nomessage))
(archive-maybe-update t))
(or (not (buffer-name buffer))
(cond
- (view-p (view-buffer
- buffer (and just-created 'kill-buffer-if-not-modified)))
+ (view-p
+ (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 (switch-to-buffer buffer))))))
(archive-delete-local tmpfile)
success))
-(defun archive-extract-by-stdout (archive name command)
+(defun archive-extract-by-stdout (archive name command &optional stderr-file)
(apply 'call-process
(car command)
nil
- t
+ (if stderr-file (list t stderr-file) t)
nil
(append (cdr command) (list archive name))))
(apply 'vector (nreverse files))))
(defun archive-zip-extract (archive name)
- (if (equal (car archive-zip-extract) "pkzip")
- (archive-*-extract archive name archive-zip-extract)
- (archive-extract-by-stdout archive name archive-zip-extract)))
+ (cond
+ ((member-ignore-case (car archive-zip-extract) '("pkunzip" "pkzip"))
+ (archive-*-extract archive name archive-zip-extract))
+ ((equal (car archive-zip-extract) "7z")
+ (let ((archive-7z-extract archive-zip-extract))
+ (archive-7z-extract archive name)))
+ (t
+ (archive-extract-by-stdout
+ archive
+ ;; unzip expands wildcards in NAME, so we need to quote it.
+ ;; FIXME: Does pkunzip need similar treatment?
+ ;; (7z doesn't need to quote wildcards)
+ (if (equal (car archive-zip-extract) "unzip")
+ (shell-quote-argument name)
+ name)
+ archive-zip-extract))))
(defun archive-zip-write-file-member (archive descr)
(archive-*-write-file-member
;; Ratio ; Date'
" +\\([0-9%]+\\) +\\([-0-9]+\\)"
;; Time ; Attr.
- " +\\([0-9:]+\\) +......"
+ " +\\([0-9:]+\\) +[^ \n]\\{6,10\\}"
;; CRC; Meth ; Var.
" +[0-9A-F]+ +[^ \n]+ +[0-9.]+\n"))
(goto-char (match-end 0))
(if tmpbuf (kill-buffer tmpbuf))
(delete-file tmpfile))))
+;; -------------------------------------------------------------------------
+;;; Section: 7z Archives
+
+(defun archive-7z-summarize ()
+ (let ((maxname 10)
+ (maxsize 5)
+ (file buffer-file-name)
+ (files ()))
+ (with-temp-buffer
+ (call-process "7z" nil t nil "l" "-slt" file)
+ (goto-char (point-min))
+ (re-search-forward "^-+\n")
+ (while (re-search-forward "^Path = \\(.*\\)\n" nil t)
+ (goto-char (match-end 0))
+ (let ((name (match-string 1))
+ (size (save-excursion
+ (and (re-search-forward "^Size = \\(.*\\)\n")
+ (match-string 1))))
+ (time (save-excursion
+ (and (re-search-forward "^Modified = \\(.*\\)\n")
+ (match-string 1)))))
+ (if (> (length name) maxname) (setq maxname (length name)))
+ (if (> (length size) maxsize) (setq maxsize (length size)))
+ (push (vector name name nil nil time nil nil size)
+ files))))
+ (setq files (nreverse files))
+ (goto-char (point-min))
+ (let* ((format (format " %%%ds %%s %%s" maxsize))
+ (sep (format format (make-string maxsize ?-) "-------------------" ""))
+ (column (length sep)))
+ (insert (format format "Size " "Date Time " " Filename") "\n")
+ (insert sep (make-string maxname ?-) "\n")
+ (archive-summarize-files (mapcar (lambda (desc)
+ (let ((text
+ (format format
+ (aref desc 7)
+ (aref desc 4)
+ (aref desc 1))))
+ (vector text
+ column
+ (length text))))
+ files))
+ (insert sep (make-string maxname ?-) "\n")
+ (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)))))
+;; -------------------------------------------------------------------------
;;; Section `ar' archives.
;; TODO: we currently only handle the basic format of ar archives,