[gnus git] branch master updated: m0-1-5-g7614d15 =2= Add support for viewing ms-tnef files, and possibly other archives. ; * mm-util.el (mm-find-buffer-file-coding-system): Comment fix.

       via  7614d15141b55d710334ba47d9940081cd75b4b8 (commit)
       via  8580c19b5129e577fbc541112cd7f78bc70e8624 (commit)
      from  2638e160cedfa459930e4db59624285e7eb00902 (commit)


- Log -----------------------------------------------------------------
commit 7614d15141b55d710334ba47d9940081cd75b4b8
Author: Lars Ingebrigtsen <[email protected]>
Date:   Tue Jan 31 19:35:21 2012 +0100

    Add support for viewing ms-tnef files, and possibly other archives.
    
    * mm-archive.el: New file.
    
    * mm-decode.el (mm-dissect-singlepart): Use it to decode ms-tnef files.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 11bd23a..f4201a7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2012-01-31  Lars Ingebrigtsen  <[email protected]>
 
+	* mm-archive.el: New file.
+
+	* mm-decode.el (mm-dissect-singlepart): Use it to decode ms-tnef files.
+
 	* mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
 
 	* message.el (message-goto-*): Make all the `message-goto-*' commands
diff --git a/lisp/mm-archive.el b/lisp/mm-archive.el
new file mode 100644
index 0000000..dbe68af
--- /dev/null
+++ b/lisp/mm-archive.el
@@ -0,0 +1,75 @@
+;;; mm-archive.el --- Functions for parsing archive files as MIME
+
+;; Copyright (C) 2012  Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <[email protected]>
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(defvar mm-archive-decoders
+  '(("application/ms-tnef" "tnef" "-f" "-" "-C")))
+
+(defun mm-dissect-archive (handle)
+  (let ((decoder (cdr (assoc (car (mm-handle-type handle))
+			     mm-archive-decoders)))
+	(dir (mm-make-temp-file
+	      (expand-file-name "emm." mm-tmp-directory) 'dir)))
+    (set-file-modes dir #o700)
+    (unwind-protect
+	(progn
+	  (mm-with-unibyte-buffer
+	    (mm-insert-part handle)
+	    (apply 'call-process-region (point-min) (point-max) (car decoder)
+		   nil (get-buffer-create "*tnef*")
+		   nil (append (cdr decoder) (list dir))))
+	  `("multipart/mixed"
+	    ,handle
+	    ,@(mm-archive-list-files dir)))
+      (dolist (file (directory-files dir))
+	(unless (member file '("." ".."))
+	  (ignore-errors
+	    (delete-file (expand-file-name file dir)))))
+      (ignore-errors
+	(delete-directory dir)))))
+
+(defun mm-archive-list-files (dir)
+  (let ((handles nil)
+	type)
+    (dolist (file (directory-files dir))
+      (unless (member file '("." ".."))
+	(with-temp-buffer
+	  (when (string-match "\\.\\([^.]+\\)$" file)
+	    (setq type (mailcap-extension-to-mime (match-string 1 file))))
+	  (unless type
+	    (setq type "application/octet-stream"))
+	  (insert (format "Content-type: %s\n" type))
+	  (insert "Content-Transfer-Encoding: 8bit\n\n")
+	  (insert-file-contents (expand-file-name file dir))
+	  (push
+	   (mm-make-handle (mm-copy-to-buffer)
+			   (list type)
+			   '8bit nil
+			   `("attachment" (filename . ,file))
+			   nil nil nil)
+	   handles))))
+    handles))
+
+(provide 'mm-archive)
+
+;; mm-archive.el ends here
diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index dd3eb6c..a66a9c5 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -29,6 +29,7 @@
 
 (require 'mail-parse)
 (require 'mm-bodies)
+(require 'mm-archive)
 (eval-when-compile (require 'cl)
 		   (require 'term))
 
@@ -653,8 +654,12 @@ Postpone undisplaying of viewers for types in
 	    (if (equal "text/plain" (car ctl))
 		(assoc 'format ctl)
 	      t))
+    (let ((handle
     (mm-make-handle
      (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+      (if (member (car ctl) mm-archive-decoders)
+	  (mm-dissect-archive handle)
+	handle))))
 
 (defun mm-dissect-multipart (ctl from)
   (goto-char (point-min))

commit 8580c19b5129e577fbc541112cd7f78bc70e8624
Author: Lars Ingebrigtsen <[email protected]>
Date:   Tue Jan 31 18:28:10 2012 +0100

    * mm-util.el (mm-find-buffer-file-coding-system): Comment fix.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 45bfd6e..11bd23a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
 2012-01-31  Lars Ingebrigtsen  <[email protected]>
 
+	* mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
+
 	* message.el (message-goto-*): Make all the `message-goto-*' commands
 	push the mark before moving point.  This makes it easier to go back to
 	where you came from after editing whatever you jumped to.
diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index e911928..4fb5ea7 100644
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -1592,7 +1592,7 @@ gzip, bzip2, etc. are allowed."
   (unless filename
     (setq filename buffer-file-name))
   (save-excursion
-    (let ((decomp (unless ;; No worth to examine charset of tar files.
+    (let ((decomp (unless ;; Not worth it to examine charset of tar files.
 		      (and filename
 			   (string-match
 			    "\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'"

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog     |    6 ++++
 lisp/mm-archive.el |   75 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 lisp/mm-decode.el  |    9 +++++-
 lisp/mm-util.el    |    2 +-
 4 files changed, 89 insertions(+), 3 deletions(-)
 create mode 100644 lisp/mm-archive.el

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project