Mercurial > emacs

changeset 108052:ac3787d5aa1f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Sun, 18 Apr 2010 23:17:16 +0000
parents 741b32aae521 (current diff) f9390ec51de5 (diff)
children 0f1b71b92989
files
diffstat 5 files changed, 126 insertions(+), 27 deletions(-) [+]
line wrap: on
line diff
--- a/etc/NEWS	Sun Apr 18 22:46:37 2010 +0000
+++ b/etc/NEWS	Sun Apr 18 23:17:16 2010 +0000
@@ -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 22:46:37 2010 +0000
+++ b/lisp/ChangeLog	Sun Apr 18 23:17:16 2010 +0000
@@ -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 22:46:37 2010 +0000
+++ b/lisp/arc-mode.el	Sun Apr 18 23:17:16 2010 +0000
@@ -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 22:46:37 2010 +0000
+++ b/lisp/files.el	Sun Apr 18 23:17:16 2010 +0000
@@ -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 22:46:37 2010 +0000
+++ b/lisp/international/mule.el	Sun Apr 18 23:17:16 2010 +0000
@@ -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)