Mercurial > emacs
changeset 107896:f9390ec51de5
Add 7z archive format support (bug#5475).
* arc-mode.el (archive-zip-extract): Try to find 7z executable.
(archive-7z-extract): New defcustom.
(archive-find-type): Add magic string for 7z.
(archive-extract-by-stdout): Add new optional arg `stderr-file'.
If `stderr-file' is non-nil, use `(t stderr-file)' for the
`buffer' arg of `call-process'.
(archive-zip-extract): Check `archive-zip-extract' for "7z" and
call the function `archive-7z-extract' with the variable
`archive-7z-extract' let-bound to `archive-zip-extract'.
(archive-7z-summarize, archive-7z-extract): New functions.
* international/mule.el (auto-coding-alist):
* files.el (auto-mode-alist): Add 7z file extension.
| author | Juri Linkov <juri@jurta.org> |
|---|---|
| date | Mon, 19 Apr 2010 02:08:52 +0300 |
| parents | 265966b778f9 |
| children | 1721e4658521 ac3787d5aa1f |
| files | etc/NEWS lisp/ChangeLog lisp/arc-mode.el lisp/files.el lisp/international/mule.el |
| diffstat | 5 files changed, 126 insertions(+), 27 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Sun Apr 18 17:49:33 2010 -0400 +++ b/etc/NEWS Mon Apr 19 02:08:52 2010 +0300 @@ -85,6 +85,8 @@ * Changes in Specialized Modes and Packages in Emacs 24.1 +** Archive Mode has basic support to browse 7z archives. + ** partial-completion-mode is now obsolete. ** mpc.el: Can use pseudo tags of the form tag1|tag2 as a union of two tags.
--- a/lisp/ChangeLog Sun Apr 18 17:49:33 2010 -0400 +++ b/lisp/ChangeLog Mon Apr 19 02:08:52 2010 +0300 @@ -1,3 +1,21 @@ +2010-04-18 Juri Linkov <juri@jurta.org> + + Add 7z archive format support (bug#5475). + + * arc-mode.el (archive-zip-extract): Try to find 7z executable. + (archive-7z-extract): New defcustom. + (archive-find-type): Add magic string for 7z. + (archive-extract-by-stdout): Add new optional arg `stderr-file'. + If `stderr-file' is non-nil, use `(t stderr-file)' for the + `buffer' arg of `call-process'. + (archive-zip-extract): Check `archive-zip-extract' for "7z" and + call the function `archive-7z-extract' with the variable + `archive-7z-extract' let-bound to `archive-zip-extract'. + (archive-7z-summarize, archive-7z-extract): New functions. + + * international/mule.el (auto-coding-alist): + * files.el (auto-mode-alist): Add 7z file extension. + 2010-04-18 Stefan Monnier <monnier@iro.umontreal.ca> * loadup.el: Setup hash-cons for pure data.
--- a/lisp/arc-mode.el Sun Apr 18 17:49:33 2010 -0400 +++ b/lisp/arc-mode.el Mon Apr 19 02:08:52 2010 +0300 @@ -52,17 +52,17 @@ ;; 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. @@ -217,17 +217,17 @@ ;; 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. @@ -315,6 +315,20 @@ :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 @@ -732,6 +746,7 @@ ((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"))))) ;; ------------------------------------------------------------------------- @@ -1081,11 +1096,11 @@ (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)))) @@ -1787,16 +1802,22 @@ (apply 'vector (nreverse files)))) (defun archive-zip-extract (archive name) - (if (member-ignore-case (car archive-zip-extract) '("pkunzip" "pkzip")) - (archive-*-extract 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))) + archive-zip-extract)))) (defun archive-zip-write-file-member (archive descr) (archive-*-write-file-member @@ -2004,7 +2025,65 @@ (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,
--- a/lisp/files.el Sun Apr 18 17:49:33 2010 -0400 +++ b/lisp/files.el Mon Apr 19 02:08:52 2010 +0300 @@ -2252,8 +2252,8 @@ ;; The list of archive file extensions should be in sync with ;; `auto-coding-alist' with `no-conversion' coding system. ("\\.\\(\ -arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode) +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.\\(sx[dmicw]\\|od[fgpst]\\|oxt\\)\\'" . archive-mode) ;OpenOffice.org ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. ;; Mailer puts message to be edited in
--- a/lisp/international/mule.el Sun Apr 18 17:49:33 2010 -0400 +++ b/lisp/international/mule.el Mon Apr 19 02:08:52 2010 +0300 @@ -1626,8 +1626,8 @@ ;; .exe and .EXE are added to support archive-mode looking at DOS ;; self-extracting exe archives. (purecopy '(("\\.\\(\ -arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . no-conversion-multibyte) ("\\.\\(exe\\|EXE\\)\\'" . no-conversion) ("\\.\\(sx[dmicw]\\|odt\\|tar\\|tgz\\)\\'" . no-conversion)