X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-view.el;h=9afb5dce90a4057b4d7f4386804c09a873835837;hb=8e18eb1fd95180a6ea115a00ce2f045815809b49;hp=1cb26dafa03eae37b46b8fbc89760e8cee360b9e;hpb=7daeb476bdb289acaea91d4ef3041194b62f65bb;p=elisp%2Ftm.git diff --git a/tm-view.el b/tm-view.el index 1cb26da..9afb5dc 100644 --- a/tm-view.el +++ b/tm-view.el @@ -1,39 +1,36 @@ -;;; ;;; tm-view.el --- interactive MIME viewer for GNU Emacs -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; modified by Steven L. Baur -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el) -;;; Version: $Revision: 7.66 $ -;;; Keywords: mail, news, MIME, multimedia -;;; -;;; This file is part of tm (Tools for MIME). -;;; -;;; This program 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 2, or -;;; (at your option) any later version. -;;; -;;; This program 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el) +;; Version: $Revision: 7.79 $ +;; Keywords: mail, news, MIME, multimedia + +;; This file is part of tm (Tools for MIME). + +;; This program 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 2, or (at +;; your option) any later version. + +;; This program 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + ;;; Code: (require 'tl-str) (require 'tl-list) (require 'tl-atype) (require 'tl-misc) -(require 'tl-822) +(require 'std11) (require 'mel) (require 'tm-ew-d) (require 'tm-def) @@ -45,7 +42,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.66 1996/07/01 23:42:12 morioka Exp $") + "$Id: tm-view.el,v 7.79 1996/12/16 15:06:08 morioka Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -56,50 +53,84 @@ (defvar mime/content-decoding-condition '(((type . "text/plain") - (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-plain" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "text/html") (method "tm-html" nil 'file 'type 'encoding 'mode 'name) - (mode . "play")) + (mode . "play") + ) ((type . "text/x-rot13-47") - (method . mime-article/decode-caesar)) - + (method . mime-article/decode-caesar) + (mode . "play") + ) ((type . "audio/basic") - (method "tm-au" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-au" nil 'file 'type 'encoding 'mode 'name) + (mode . "play") + ) ((type . "image/jpeg") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-image" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "image/gif") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-image" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "image/tiff") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-image" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "image/x-tiff") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-image" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "image/x-xbm") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-image" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "image/x-pic") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-image" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "image/x-mag") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-image" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "video/mpeg") - (method "tm-mpeg" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-mpeg" nil 'file 'type 'encoding 'mode 'name) + (mode . "play") + ) + ((type . "application/postscript") + (method "tm-ps" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ((type . "application/octet-stream") - (method "tm-file" nil 'file 'type 'encoding 'mode 'name)) + (method "tm-file" nil 'file 'type 'encoding 'mode 'name) + (mode "play" "print") + ) ;;((type . "message/external-body") ;; (method "xterm" nil ;; "-e" "showexternal" ;; 'file '"access-type" '"name" '"site" '"directory")) ((type . "message/rfc822") - (method . mime-article/view-message/rfc822)) + (method . mime-article/view-message/rfc822) + (mode . "play") + ) ((type . "message/partial") - (method . mime-article/decode-message/partial)) + (method . mime-article/decode-message/partial) + (mode . "play") + ) - ((method "metamail" t - "-m" "tm" "-x" "-d" "-z" "-e" 'file)(mode . "play")) + ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file) + (mode . "play") + ) ((method "tm-file" nil 'file 'type 'encoding 'mode 'name) - (mode . "extract")) + (mode . "extract") + ) )) (defvar mime-viewer/childrens-header-showing-Content-Type-list @@ -349,6 +380,9 @@ Each elements are regexp of field-name. [tm-view.el]") (defvar mime-viewer/following-method-alist nil) +(defvar mime-viewer/following-required-fields-list + '("From")) + ;;; @@ X-Face ;;; @@ -375,7 +409,7 @@ The compressed face will be piped to this command.") (goto-char (point-min)) (if (re-search-forward "^X-Face:[ \t]*" nil t) (let ((beg (match-end 0)) - (end (rfc822/field-end)) + (end (std11-field-end)) ) (call-process-region beg end "sh" nil 0 nil "-c" mime-viewer/x-face-command) @@ -564,8 +598,7 @@ The compressed face will be piped to this command.") )) (defun mime-article/get-subject (param &optional encoding) - (or (rfc822/get-field-body "Content-Description") - (rfc822/get-field-body "Subject") + (or (std11-find-field-body '("Content-Description" "Subject")) (let (ret) (if (or (and (setq ret (mime/Content-Disposition)) (setq ret (assoc "filename" (cdr ret))) @@ -573,7 +606,7 @@ The compressed face will be piped to this command.") (setq ret (assoc "name" param)) (setq ret (assoc "x-name" param)) ) - (rfc822/strip-quoted-string (cdr ret)) + (std11-strip-quoted-string (cdr ret)) )) (mime-article/get-uu-filename param encoding) "")) @@ -608,13 +641,12 @@ The compressed face will be piped to this command.") (or cinfo (setq cinfo mime::article/content-info) ) - (some-element - (function - (lambda (ci) - (equal (mime::content-info/rcnum ci) rcnum) - )) - (mime/flatten-content-info cinfo) - )) + (find-if (function + (lambda (ci) + (equal (mime::content-info/rcnum ci) rcnum) + )) + (mime/flatten-content-info cinfo) + )) (defun mime-article/cnum-to-cinfo (cn &optional cinfo) (or cinfo @@ -937,7 +969,7 @@ button-2 Move to point under the mouse cursor (mime::content-info/point-min ci) (mime::content-info/point-max ci) ) - (rfc822/get-header-string-except + (std11-header-string-except (concat "^" (apply (function regexp-or) fields) ":") "")))) @@ -948,10 +980,28 @@ button-2 Move to point under the mouse cursor (insert str) ) rcnum)) - (setq fields (rfc822/get-field-names) + (setq fields (std11-collect-field-names) rcnum (cdr rcnum)) ) ) + (let ((rest mime-viewer/following-required-fields-list)) + (while rest + (let ((field-name (car rest))) + (or (std11-field-body field-name) + (insert + (format + (concat field-name + ": " + (save-excursion + (set-buffer the-buf) + (set-buffer mime::preview/mother-buffer) + (set-buffer mime::preview/article-buffer) + (std11-field-body field-name) + ) + "\n"))) + )) + (setq rest (cdr rest)) + )) (mime/decode-message-header) ) (funcall (cdr (assq mode mime-viewer/following-method-alist)) @@ -996,7 +1046,7 @@ button-2 Move to point under the mouse cursor (i (- (length pcl) 1)) beg) (catch 'tag - (while (>= i 0) + (while (> i 0) (setq beg (mime::preview-content-info/point-min (nth i pcl))) (if (> p beg) (throw 'tag (goto-char beg))