tm 7.43.1.
[elisp/tm.git] / tm-view.el
index badb800..99e6f9a 100644 (file)
@@ -2,13 +2,13 @@
 ;;; tm-view.el --- interactive MIME viewer for GNU Emacs
 ;;;
 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
-;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
+;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko
 ;;;
 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; modified by Steven L. Baur <steve@miranova.com>
 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el)
-;;; Version: $Revision: 7.34 $
+;;; Version: $Revision: 7.42 $
 ;;; Keywords: mail, news, MIME, multimedia
 ;;;
 ;;; This file is part of tm (Tools for MIME).
@@ -44,7 +44,7 @@
 ;;;
 
 (defconst mime-viewer/RCS-ID
-  "$Id: tm-view.el,v 7.34 1995/12/15 15:08:28 morioka Exp $")
+  "$Id: tm-view.el,v 7.42 1996/02/13 06:28:37 morioka Exp $")
 
 (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID))
 (defconst mime/viewer-version mime-viewer/version)
     ((type . "audio/basic")
      (method "tm-au"    nil 'file 'type 'encoding 'mode 'name))
     
-    ((type . "image/gif")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
     ((type . "image/jpeg")
      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
+    ((type . "image/gif")
+     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
     ((type . "image/tiff")
      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
     ((type . "image/x-tiff")
@@ -77,6 +77,8 @@
      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
     ((type . "image/x-pic")
      (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
+    ((type . "image/x-mag")
+     (method "tm-image" nil 'file 'type 'encoding 'mode 'name))
     
     ((type . "video/mpeg")
      (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name))
   '("message/rfc822" "message/news"))
 
 (defvar mime-viewer/default-showing-Content-Type-list
-  '("text/plain" "text/richtext" "text/enriched"
+  '("text/plain" nil "text/richtext" "text/enriched"
     "text/x-latex" "application/x-latex"
-    "application/octet-stream" nil
-    "application/pgp"
+    "application/pgp" "text/x-pgp"
+    "application/octet-stream"
     "application/x-selection" "application/x-comment"))
 
 (defvar mime-viewer/content-subject-omitting-Content-Type-list
 (defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode"))
 
 (defvar mime-viewer/ignored-field-list
-  '(".*Received" ".*Path" ".*Id"
+  '(".*Received" ".*Path" ".*Id" "References"
     "Replied" "Errors-To"
-    "Lines" "Sender" "Nntp-Posting-Host"
-    "Content-Type" "Precedence" "X-Face"
+    "Lines" "Sender" ".*Host" "Xref"
+    "Content-Type" "Precedence"
     "Status" "X-VM-.*")
   "All fields that match this list will be hidden in MIME preview buffer.
 Each elements are regexp of field-name. [tm-view.el]")
@@ -132,7 +134,7 @@ Each elements are regexp of field-name. [tm-view.el]")
          ":"))
 
 (defvar mime-viewer/visible-field-list
-  '("Message-Id")
+  '("Dnas.*")
   "All fields that match this list will be displayed in MIME preview buffer.
 Each elements are regexp of field-name. [tm-view.el]")
 
@@ -141,6 +143,7 @@ Each elements are regexp of field-name. [tm-view.el]")
          (apply (function regexp-or) mime-viewer/visible-field-list)
          ":"))
 
+(defvar mime-viewer/redisplay nil)
 
 (defvar mime-viewer/announcement-for-message/partial
   (if (and (>= emacs-major-version 19) window-system)
@@ -300,6 +303,7 @@ Each elements are regexp of field-name. [tm-view.el]")
 ;; for XEmacs
 (defvar mime::article/preview-buffer nil)
 (defvar mime::article/code-converter nil)
+(defvar mime::preview/article-buffer nil)
 
 (make-variable-buffer-local 'mime::article/content-info)
 (make-variable-buffer-local 'mime::article/preview-buffer)
@@ -322,14 +326,20 @@ Each elements are regexp of field-name. [tm-view.el]")
 (defvar mime-viewer/over-to-previous-method-alist nil)
 (defvar mime-viewer/over-to-next-method-alist nil)
 
+(defvar mime-viewer/show-summary-method nil)
+
 
 ;;; @@ X-Face
 ;;;
 
 ;; hack from Gnus 5.0.4.
 
+(defvar mime-viewer/x-face-to-pbm-command
+  "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
+
 (defvar mime-viewer/x-face-command
-  "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
+  (concat mime-viewer/x-face-to-pbm-command
+         " | xv -quit -")
   "String to be executed to display an X-Face field.
 The command will be executed in a sub-shell asynchronously.
 The compressed face will be piped to this command.")
@@ -370,7 +380,9 @@ The compressed face will be piped to this command.")
        (get-buffer ibuf)
        (set-buffer ibuf)
        ))
-  (setq mime::article/content-info (mime/parse-message ctl encoding))
+  (or mime-viewer/redisplay
+      (setq mime::article/content-info (mime/parse-message ctl encoding))
+      )
   (let ((ret (mime-viewer/make-preview-buffer obuf)))
     (setq mime::article/preview-buffer (car ret))
     ret))
@@ -431,7 +443,7 @@ The compressed face will be piped to this command.")
       (narrow-to-region beg end)
       (setq subj
            (mime-eword/decode-string
-            (mime-viewer/get-subject params encoding)))
+            (mime-article/get-subject params encoding)))
       )
     (set-buffer obuf)
     (setq nb (point))
@@ -522,7 +534,7 @@ The compressed face will be piped to this command.")
                     (function mime-viewer/play-content))
       )))
 
-(defun mime-viewer/get-subject (param &optional encoding)
+(defun mime-article/get-uu-filename (param &optional encoding)
   (if (member (or encoding
                  (cdr (assq 'encoding param))
                  )
@@ -533,30 +545,24 @@ The compressed face will be piped to this command.")
                    (buffer-substring (match-beginning 0)(match-end 0))
                  ))
            ""))
-    (let (ret)
-      (or (and (setq ret (assoc "name" param))
-              (rfc822/strip-quoted-string (cdr ret))
-              )
-         (and (setq ret (assoc "x-name" param))
-              (rfc822/strip-quoted-string (cdr ret))
-              )
-         
-         (save-excursion
-           (save-restriction
-             (goto-char (point-min))
-             (narrow-to-region (point-min)
-                               (or (and (search-forward "\n\n" nil t)
-                                        (match-beginning 0)
-                                        )
-                                   (point-max)))
-             (or
-              (rfc822/get-field-body "Content-Description")
-              (rfc822/get-field-body "Subject")
-              )))
-         ""))
     ))
 
-  
+(defun mime-article/get-subject (param &optional encoding)
+  (or (rfc822/get-field-body "Content-Description")
+      (rfc822/get-field-body "Subject")
+      (let (ret)
+       (if (or (and (setq ret (mime/Content-Disposition))
+                    (setq ret (assoc "filename" (cdr ret)))
+                    )
+               (setq ret (assoc "name" param))
+               (setq ret (assoc "x-name" param))
+               )
+           (rfc822/strip-quoted-string (cdr ret))
+         ))
+      (mime-article/get-uu-filename param encoding)
+      ""))
+
+
 ;;; @ content information
 ;;;
 
@@ -683,8 +689,11 @@ The compressed face will be piped to this command.")
       (progn
        (goto-char (point-min))
        (while (re-search-forward tm:URL-regexp nil t)
-         (tm:add-button (match-beginning 0)(match-end 0)
-                        (function tm:browse-url))
+         (let ((beg (match-beginning 0))
+               (end (match-end 0)))
+           (tm:add-button beg end
+                          (function tm:browse-url)
+                          (list (buffer-substring beg end))))
          )))
   (run-hooks 'mime-viewer/plain-text-preview-hook)
   )
@@ -739,6 +748,8 @@ The compressed face will be piped to this command.")
       (define-key mime/viewer-mode-map
        "q"        (function mime-viewer/quit))
       (define-key mime/viewer-mode-map
+       "h"        (function mime-viewer/show-summary))
+      (define-key mime/viewer-mode-map
        "\C-c\C-x" (function mime-viewer/kill-buffer))
       (define-key mime/viewer-mode-map
         "<"        (function beginning-of-buffer))
@@ -1037,25 +1048,29 @@ listed in key order:
   (mime-viewer/scroll-down-content 1)
   )
 
-(defun mime-viewer/quit (&optional the-buf buf)
+(defun mime-viewer/quit ()
   (interactive)
-  (or the-buf
-      (setq the-buf (current-buffer))
-      )
-  (or buf
-      (setq buf (mime::preview-content-info/buffer
-                (mime-preview/point-pcinfo (point))))
-      )
-  (let ((r (progn
-            (switch-to-buffer buf)
+  (let ((r (save-excursion
+            (set-buffer (mime::preview-content-info/buffer
+                         (mime-preview/point-pcinfo (point))))
             (assq major-mode mime-viewer/quitting-method-alist)
             )))
     (if r
-       (progn
-         (switch-to-buffer the-buf)
-         (funcall (cdr r))
-         ))
-    ))
+       (funcall (cdr r))
+      )))
+
+(defun mime-viewer/show-summary ()
+  (interactive)
+  (let ((r (save-excursion
+            (set-buffer
+             (mime::preview-content-info/buffer
+              (mime-preview/point-pcinfo (point)))
+             )
+            (assq major-mode mime-viewer/show-summary-method)
+            )))
+    (if r
+       (funcall (cdr r))
+      )))
 
 (defun mime-viewer/kill-buffer ()
   (interactive)
@@ -1069,3 +1084,5 @@ listed in key order:
 (provide 'tm-view)
 
 (run-hooks 'tm-view-load-hook)
+
+;;; tm-view.el ends here