X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-view.el;h=9afb5dce90a4057b4d7f4386804c09a873835837;hb=8e18eb1fd95180a6ea115a00ce2f045815809b49;hp=ce0f48376f36a9b1660fd94e4f09d9d5c4dc422e;hpb=ad70c7508648f96247524e2074e285be9275bb62;p=elisp%2Ftm.git diff --git a/tm-view.el b/tm-view.el index ce0f483..9afb5dc 100644 --- a/tm-view.el +++ b/tm-view.el @@ -1,50 +1,48 @@ -;;; ;;; 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.52 $ -;;; 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) (require 'tm-parse) +(require 'tm-text) ;;; @ version ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 7.52 1996/04/23 22:52:55 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) @@ -55,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 @@ -112,10 +144,10 @@ "application/octet-stream" "application/x-selection" "application/x-comment")) -(defvar mime-viewer/content-subject-omitting-Content-Type-list +(defvar mime-viewer/content-button-ignored-ctype-list '("application/x-selection")) -(defvar mime-viewer/content-subject-showing-Content-Type-list +(defvar mime-viewer/content-button-visible-ctype-list '("application/pgp")) (defvar mime-viewer/uuencode-encoding-name-list '("x-uue" "x-uuencode")) @@ -135,7 +167,7 @@ Each elements are regexp of field-name. [tm-view.el]") ":")) (defvar mime-viewer/visible-field-list - '("Dnas.*") + '("Dnas.*" "Message-Id") "All fields that match this list will be displayed in MIME preview buffer. Each elements are regexp of field-name. [tm-view.el]") @@ -192,54 +224,69 @@ Each elements are regexp of field-name. [tm-view.el]") )) -;;; @@ content subject +;;; @@ content button ;;; -(defun mime-viewer/insert-content-subject - (rcnum cinfo ctype params subj) +(defun mime-preview/insert-content-button + (rcnum cinfo ctype params subj encoding) (save-restriction (narrow-to-region (point)(point)) - (insert - (let ((access-type (assoc "access-type" params)) - (num (or (assoc-value "x-part-number" params) - (if (consp rcnum) - (mapconcat (function - (lambda (num) - (format "%s" (1+ num)) - )) - (reverse rcnum) ".") - "0")) - )) - (if access-type - (let ((server (assoc "server" params))) - (setq access-type (cdr access-type)) - (if server - (format "[%s %s ([%s] %s)]\n" num subj - access-type (cdr server)) - (let ((site (assoc-value "site" params)) - (dir (assoc-value "directory" params)) - ) - (format "[%s %s ([%s] %s:%s)]\n" num subj - access-type site dir) - ))) - (format "[%s %s (%s)]\n" num subj ctype) - ))) + (let ((access-type (assoc "access-type" params)) + (charset (assoc "charset" params)) + (num (or (assoc-value "x-part-number" params) + (if (consp rcnum) + (mapconcat (function + (lambda (num) + (format "%s" (1+ num)) + )) + (reverse rcnum) ".") + "0")) + )) + (cond (access-type + (let ((server (assoc "server" params))) + (setq access-type (cdr access-type)) + (if server + (insert (format "[%s %s ([%s] %s)]\n" num subj + access-type (cdr server))) + (let ((site (assoc-value "site" params)) + (dir (assoc-value "directory" params)) + ) + (insert (format "[%s %s ([%s] %s:%s)]\n" num subj + access-type site dir)) + ))) + ) + (t + (insert (concat "[" num " " subj)) + (let ((rest + (if (setq charset (cdr charset)) + (if encoding + (format " <%s; %s (%s)>]\n" + ctype charset encoding) + (format " <%s; %s>]\n" ctype charset) + ) + (format " <%s>]\n" ctype) + ))) + (if (>= (+ (current-column)(length rest))(window-width)) + (setq rest (concat "\n\t" rest)) + ) + (insert rest) + )))) (tm:add-button (point-min)(1- (point-max)) (function mime-viewer/play-content)) )) -(defun mime-viewer/default-content-subject-function - (rcnum cinfo ctype params subj) +(defun mime-preview/default-content-button-function + (rcnum cinfo ctype params subj encoding) (if (and (consp rcnum) (not (member ctype - mime-viewer/content-subject-omitting-Content-Type-list))) - (mime-viewer/insert-content-subject - rcnum cinfo ctype params subj) + mime-viewer/content-button-ignored-ctype-list))) + (mime-preview/insert-content-button + rcnum cinfo ctype params subj encoding) )) -(defvar mime-viewer/content-subject-function - (function mime-viewer/default-content-subject-function)) +(defvar mime-preview/content-button-function + (function mime-preview/default-content-button-function)) ;;; @@ content header filter @@ -276,17 +323,17 @@ Each elements are regexp of field-name. [tm-view.el]") ;;; @@ content filter ;;; -(defvar mime-viewer/content-filter-alist nil) - -(defun mime-viewer/default-content-filter (rcnum cinfo ctype params subj) - (mime-viewer/filter-text/plain ctype params encoding) - ) +(defvar mime-viewer/content-filter-alist + '(("text/enriched" . mime-preview/filter-for-text/enriched) + ("text/richtext" . mime-preview/filter-for-text/richtext) + (t . mime-preview/filter-for-text/plain) + )) ;;; @@ content separator ;;; -(defun mime-viewer/default-content-separator (rcnum cinfo ctype params subj) +(defun mime-preview/default-content-separator (rcnum cinfo ctype params subj) (if (and (not (mime-viewer/header-visible-p rcnum cinfo ctype)) (not (mime-viewer/body-visible-p rcnum cinfo ctype)) ) @@ -333,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 ;;; @@ -359,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) @@ -405,41 +455,36 @@ The compressed face will be piped to this command.") ret)) (defun mime-viewer/make-preview-buffer (&optional obuf) - (let ((cinfo mime::article/content-info) - (the-buf (current-buffer)) - (mode major-mode) - pcl dest) + (let* ((cinfo mime::article/content-info) + (pcl (mime/flatten-content-info cinfo)) + (dest (make-list (length pcl) nil)) + (the-buf (current-buffer)) + (mode major-mode) + ) (or obuf - (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")) - ) - (setq pcl (mime/flatten-content-info cinfo)) - (let ((bf (get-buffer obuf))) - (if bf - (progn - (set-buffer obuf) - (setq buffer-read-only nil) - (erase-buffer) - ) - (setq bf (get-buffer-create obuf)) - (set-buffer obuf) - )) + (setq obuf (concat "*Preview-" (buffer-name the-buf) "*"))) + (set-buffer (get-buffer-create obuf)) + (setq buffer-read-only nil) + (widen) + (erase-buffer) (setq mime::preview/article-buffer the-buf) (setq mime::preview/original-major-mode mode) (setq major-mode 'mime/viewer-mode) (setq mode-name "MIME-View") - (while pcl - (setq dest - (cons (mime-viewer/display-content (car pcl) cinfo the-buf obuf) - dest) - pcl (cdr pcl)) - ) + (let ((drest dest)) + (while pcl + (setcar drest + (mime-preview/display-content (car pcl) cinfo the-buf obuf)) + (setq pcl (cdr pcl) + drest (cdr drest)) + )) (set-buffer-modified-p nil) (setq buffer-read-only t) (set-buffer the-buf) - (list obuf (nreverse dest)) + (list obuf dest) )) -(defun mime-viewer/display-content (content cinfo ibuf obuf) +(defun mime-preview/display-content (content cinfo ibuf obuf) (let* ((beg (mime::content-info/point-min content)) (end (mime::content-info/point-max content)) (ctype (mime::content-info/type content)) @@ -464,37 +509,34 @@ The compressed face will be piped to this command.") (set-buffer obuf) (setq nb (point)) (narrow-to-region nb nb) - (funcall mime-viewer/content-subject-function - rcnum cinfo ctype params subj) - (set-buffer ibuf) + (funcall mime-preview/content-button-function + rcnum cinfo ctype params subj encoding) (if (mime-viewer/header-visible-p rcnum cinfo ctype) - (mime-viewer/display-header beg he obuf) + (mime-preview/display-header beg he) ) (if (and (null rcnum) (member - ctype mime-viewer/content-subject-showing-Content-Type-list)) + ctype mime-viewer/content-button-visible-ctype-list)) (save-excursion - (set-buffer obuf) (goto-char (point-max)) - (mime-viewer/insert-content-subject rcnum cinfo ctype params subj) + (mime-preview/insert-content-button + rcnum cinfo ctype params subj encoding) )) (cond ((mime-viewer/body-visible-p rcnum cinfo ctype) - (mime-viewer/display-body he end obuf - rcnum cinfo ctype params subj encoding) + (mime-preview/display-body he end + rcnum cinfo ctype params subj encoding) ) ((equal ctype "message/partial") - (mime-viewer/display-message/partial obuf) + (mime-preview/display-message/partial) ) ((and (null rcnum) (null (mime::content-info/children cinfo)) ) - (set-buffer obuf) (goto-char (point-max)) - (mime-viewer/insert-content-subject rcnum cinfo ctype params subj) - ) - (t (set-buffer obuf)) - ) - (mime-viewer/default-content-separator rcnum cinfo ctype params subj) + (mime-preview/insert-content-button + rcnum cinfo ctype params subj encoding) + )) + (mime-preview/default-content-separator rcnum cinfo ctype params subj) (prog1 (progn (setq ne (point-max)) @@ -504,40 +546,32 @@ The compressed face will be piped to this command.") (goto-char ne) ))) -(defun mime-viewer/display-header (beg end obuf) - (let ((str (buffer-substring beg end)) - (f (assq major-mode mime-viewer/content-header-filter-alist)) - ) - (save-excursion - (set-buffer obuf) - (save-restriction - (narrow-to-region (point)(point)) - (insert str) - (if (and f (setq f (cdr f))) - (funcall f) - (mime-viewer/default-content-header-filter) - ) - (run-hooks 'mime-viewer/content-header-filter-hook) - )))) +(defun mime-preview/display-header (beg end) + (save-restriction + (narrow-to-region (point)(point)) + (insert-buffer-substring mime::preview/article-buffer beg end) + (let ((f (cdr (assq mime::preview/original-major-mode + mime-viewer/content-header-filter-alist)))) + (if (functionp f) + (funcall f) + (mime-viewer/default-content-header-filter) + )) + (run-hooks 'mime-viewer/content-header-filter-hook) + )) -(defun mime-viewer/display-body (beg end obuf - rcnum cinfo ctype params subj encoding) - (let ((str (buffer-substring beg end)) - be) - (set-buffer obuf) - (save-restriction - (setq be (point-max)) - (narrow-to-region be be) - (insert str) - (let ((f (assoc-value ctype mime-viewer/content-filter-alist))) - (if (and f (fboundp f)) - (funcall f ctype params encoding) - (mime-viewer/default-content-filter rcnum cinfo ctype params subj) - )) +(defun mime-preview/display-body (beg end + rcnum cinfo ctype params subj encoding) + (save-restriction + (narrow-to-region (point-max)(point-max)) + (insert-buffer-substring mime::preview/article-buffer beg end) + (let ((f (cdr (or (assoc ctype mime-viewer/content-filter-alist) + (assq t mime-viewer/content-filter-alist))))) + (and (functionp f) + (funcall f ctype params encoding) + ) ))) -(defun mime-viewer/display-message/partial (obuf) - (set-buffer obuf) +(defun mime-preview/display-message/partial () (save-restriction (goto-char (point-max)) (if (not (search-backward "\n\n" nil t)) @@ -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 @@ -663,59 +695,6 @@ The compressed face will be piped to this command.") )) -;;; @ content filter -;;; - -(defvar mime-viewer/code-converter-alist - '((mime/show-message-mode . mime/code-convert-region-to-emacs) - (mime/temporary-message-mode . mime/code-convert-region-to-emacs) - )) - -(defun mime-viewer/default-code-convert-region - (beg end charset &optional encoding) - (if (member encoding '("quoted-printable" "base64")) - (mime/code-convert-region-to-emacs beg (point-max) charset) - )) - -(defun mime-preview/decode-text-region (beg end charset encoding) - (mime/decode-region encoding beg end) - (let* ((mode mime::preview/original-major-mode) - (m (or (save-excursion - (set-buffer mime::preview/article-buffer) - mime::article/code-converter) - (cdr (assq mode mime-viewer/code-converter-alist)) - )) - ) - (if (and m (fboundp m)) - (funcall m beg (point-max) charset encoding) - (mime-viewer/default-code-convert-region - beg (point-max) charset encoding) - ))) - -(defun mime-viewer/filter-text/plain (ctype params encoding) - (let ((charset (cdr (assoc "charset" params))) - (beg (point-min)) (end (point-max)) - ) - (mime-preview/decode-text-region beg end charset encoding) - ) - (goto-char (point-max)) - (if (not (eq (char-after (1- (point))) ?\n)) - (insert "\n") - ) - (if browse-url-browser-function - (progn - (goto-char (point-min)) - (while (re-search-forward tm:URL-regexp nil t) - (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) - ) - - ;;; @ MIME viewer mode ;;; @@ -733,85 +712,94 @@ The compressed face will be piped to this command.") ) "Menu for MIME Viewer") -(defvar mime/viewer-mode-map nil) -(if (null mime/viewer-mode-map) +(if running-xemacs (progn - (setq mime/viewer-mode-map (make-keymap)) - (suppress-keymap mime/viewer-mode-map) - (define-key mime/viewer-mode-map - "u" (function mime-viewer/up-content)) - (define-key mime/viewer-mode-map - "p" (function mime-viewer/previous-content)) - (define-key mime/viewer-mode-map - "n" (function mime-viewer/next-content)) - (define-key mime/viewer-mode-map - " " (function mime-viewer/scroll-up-content)) - (define-key mime/viewer-mode-map - "\M- " (function mime-viewer/scroll-down-content)) - (define-key mime/viewer-mode-map - "\177" (function mime-viewer/scroll-down-content)) - (define-key mime/viewer-mode-map - "\C-m" (function mime-viewer/next-line-content)) - (define-key mime/viewer-mode-map - "\C-\M-m" (function mime-viewer/previous-line-content)) - (define-key mime/viewer-mode-map - "v" (function mime-viewer/play-content)) - (define-key mime/viewer-mode-map - "e" (function mime-viewer/extract-content)) - (define-key mime/viewer-mode-map - "\C-c\C-p" (function mime-viewer/print-content)) - (define-key mime/viewer-mode-map - "x" (function mime-viewer/display-x-face)) - (define-key mime/viewer-mode-map - "a" (function mime-viewer/follow-content)) - (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)) - (define-key mime/viewer-mode-map - ">" (function end-of-buffer)) - (if mouse-button-2 - (define-key mime/viewer-mode-map - mouse-button-2 (function tm:button-dispatcher)) - ) - (cond (running-xemacs - (defvar mime-viewer/xemacs-popup-menu - (cons mime-viewer/menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) t) - )) - mime-viewer/menu-list))) - (defun mime-viewer/xemacs-popup-menu (event) - "Popup the menu in the MIME Viewer buffer" - (interactive "e") - (select-window (event-window event)) - (set-buffer (event-buffer event)) - (popup-menu 'mime-viewer/xemacs-popup-menu)) - (define-key mime/viewer-mode-map - mouse-button-3 (function mime-viewer/xemacs-popup-menu)) - ) - ((>= emacs-major-version 19) - (define-key mime/viewer-mode-map [menu-bar mime-view] - (cons mime-viewer/menu-title - (make-sparse-keymap mime-viewer/menu-title))) - (mapcar (function - (lambda (item) - (define-key mime/viewer-mode-map - (vector 'menu-bar 'mime-view (car item)) - (cons (nth 1 item)(nth 2 item)) - ) - )) - (reverse mime-viewer/menu-list) - ) - )) + (defvar mime-viewer/xemacs-popup-menu + (cons mime-viewer/menu-title + (mapcar (function + (lambda (item) + (vector (nth 1 item)(nth 2 item) t) + )) + mime-viewer/menu-list))) + (defun mime-viewer/xemacs-popup-menu (event) + "Popup the menu in the MIME Viewer buffer" + (interactive "e") + (select-window (event-window event)) + (set-buffer (event-buffer event)) + (popup-menu 'mime-viewer/xemacs-popup-menu)) )) -(defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf) +(defun mime-viewer/define-keymap (&optional mother) + (let ((mime/viewer-mode-map (if mother + (copy-keymap mother) + (make-keymap)))) + (suppress-keymap mime/viewer-mode-map) + (define-key mime/viewer-mode-map + "u" (function mime-viewer/up-content)) + (define-key mime/viewer-mode-map + "p" (function mime-viewer/previous-content)) + (define-key mime/viewer-mode-map + "n" (function mime-viewer/next-content)) + (define-key mime/viewer-mode-map + " " (function mime-viewer/scroll-up-content)) + (define-key mime/viewer-mode-map + "\M- " (function mime-viewer/scroll-down-content)) + (define-key mime/viewer-mode-map + "\177" (function mime-viewer/scroll-down-content)) + (define-key mime/viewer-mode-map + "\C-m" (function mime-viewer/next-line-content)) + (define-key mime/viewer-mode-map + "\C-\M-m" (function mime-viewer/previous-line-content)) + (define-key mime/viewer-mode-map + "v" (function mime-viewer/play-content)) + (define-key mime/viewer-mode-map + "e" (function mime-viewer/extract-content)) + (define-key mime/viewer-mode-map + "\C-c\C-p" (function mime-viewer/print-content)) + (define-key mime/viewer-mode-map + "x" (function mime-viewer/display-x-face)) + (define-key mime/viewer-mode-map + "a" (function mime-viewer/follow-content)) + (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)) + (define-key mime/viewer-mode-map + ">" (function end-of-buffer)) + (define-key mime/viewer-mode-map + "?" (function describe-mode)) + (if mouse-button-2 + (define-key mime/viewer-mode-map + mouse-button-2 (function tm:button-dispatcher)) + ) + (cond (running-xemacs + (define-key mime/viewer-mode-map + mouse-button-3 (function mime-viewer/xemacs-popup-menu)) + ) + ((>= emacs-major-version 19) + (define-key mime/viewer-mode-map [menu-bar mime-view] + (cons mime-viewer/menu-title + (make-sparse-keymap mime-viewer/menu-title))) + (mapcar (function + (lambda (item) + (define-key mime/viewer-mode-map + (vector 'menu-bar 'mime-view (car item)) + (cons (nth 1 item)(nth 2 item)) + ) + )) + (reverse mime-viewer/menu-list) + ) + )) + (use-local-map mime/viewer-mode-map) + (run-hooks 'mime-viewer/define-keymap-hook) + )) + +(defun mime/viewer-mode (&optional mother ctl encoding ibuf obuf + mother-keymap) "Major mode for viewing MIME message. Here is a list of the standard keys for mime/viewer-mode. @@ -830,16 +818,11 @@ M-RET Move to previous line v Decode current content as `play mode' e Decode current content as `extract mode' C-c C-p Decode current content as `print mode' -f Display X-Face +a Followup to current content. +x Display X-Face q Quit button-2 Move to point under the mouse cursor and decode current content as `play mode' - - -Here are all the commands with their current binding, -listed in key order: - -\\{mime/viewer-mode-map} " (interactive) (let ((buf (get-buffer mime/output-buffer-name))) @@ -858,7 +841,7 @@ listed in key order: (progn (setq mime::preview/mother-buffer mother) )) - (use-local-map mime/viewer-mode-map) + (mime-viewer/define-keymap mother-keymap) (setq mime::preview/content-list (nth 1 ret)) (goto-char (let ((ce (mime::preview-content-info/point-max @@ -957,77 +940,73 @@ listed in key order: (new-name (format "%s-%s" (buffer-name) (reverse rcnum))) new-buf (the-buf (current-buffer)) - from to cc reply-to subj mid f) - (save-excursion - (set-buffer mime::preview/article-buffer) - (setq from (rfc822/get-field-body "From") - to (rfc822/get-field-body "To") - cc (rfc822/get-field-body "cc") - reply-to (rfc822/get-field-body "Reply-To") - subj (rfc822/get-field-body "Subject") - mid (rfc822/get-field-body "Message-Id") - )) + (a-buf mime::preview/article-buffer) + (hb (mime::content-info/point-min cinfo)) + (he (mime::content-info/point-max cinfo)) + fields from to cc reply-to subj mid f) (save-excursion (set-buffer (setq new-buf (get-buffer-create new-name))) (erase-buffer) (insert-buffer-substring the-buf p-beg p-end) (goto-char (point-min)) (if (mime-viewer/header-visible-p rcnum root-cinfo) - (setq mid nil) - (insert "\n") + (delete-region (goto-char (point-min)) + (if (re-search-forward "^$" nil t) + (match-end 0) + (point-min))) ) (goto-char (point-min)) - (if (setq f (rfc822/get-field-body "From")) - (setq from f) - (and from - (insert (format "From: %s\n" - (mime-eword/decode-string from))) - )) - (if (setq f (rfc822/get-field-body "To")) - (setq to f) - (and to - (insert (format "To: %s\n" - (mime-eword/decode-string to))) - )) - (if (setq f (rfc822/get-field-body "cc")) - (setq cc f) - (and cc - (insert (format "cc: %s\n" - (mime-eword/decode-string cc))) - )) - (if (setq f (rfc822/get-field-body "Reply-To")) - (setq reply-to f) - (and reply-to - (insert (format "Reply-To: %s\n" - (mime-eword/decode-string reply-to))) - )) - (if (setq f (or (rfc822/get-field-body "Subject") - (rfc822/get-field-body "Content-Description"))) - (setq subj f) - (and subj - (insert (format "Subject: %s\n" - (mime-eword/decode-string subj))) - )) - (if (setq f (rfc822/get-field-body "Message-Id")) - (setq mid f) - (and mid - (insert (format "Message-Id: %s\n" - (mime-eword/decode-string mid))) - )) - (goto-char (point-max)) - (funcall (cdr (assq mode mime-viewer/following-method-alist)) - (or reply-to - (if (string-equal - (nth 1 (rfc822/extract-address-components from)) - user-mail-address) - to - from)) - cc (and subj - (if (string-match "^Re:" subj) - subj - (concat "Re: " subj)) - )) - ))))) + (insert "\n") + (goto-char (point-min)) + (let ((rcnum (mime::content-info/rcnum cinfo)) ci str) + (while (progn + (setq str + (save-excursion + (set-buffer a-buf) + (setq ci (mime-article/rcnum-to-cinfo rcnum)) + (save-restriction + (narrow-to-region + (mime::content-info/point-min ci) + (mime::content-info/point-max ci) + ) + (std11-header-string-except + (concat "^" + (apply (function regexp-or) fields) + ":") "")))) + (if (string-equal (mime::content-info/type ci) + "message/rfc822") + nil + (if str + (insert str) + ) + rcnum)) + (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)) + new-buf) + )))) (defun mime-viewer/display-x-face () (interactive) @@ -1067,7 +1046,7 @@ listed in key order: (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))