1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Renamed: 1994/08/31 from tm-body.el
8 ;; Renamed: 1997/02/19 from tm-view.el
9 ;; Keywords: MIME, multimedia, mail, news
11 ;; This file is part of WEMI (Widget based Emacs MIME Interfaces).
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
40 (defconst mime-view-version-string
41 `,(concat (car mime-user-interface-version) " MIME-View "
42 (mapconcat #'number-to-string
43 (cddr mime-user-interface-version) ".")
44 " (" (cadr mime-user-interface-version) ")"))
50 (defgroup mime-view nil
54 (defcustom mime-view-find-every-acting-situation t
55 "*Find every available acting-situation if non-nil."
59 (defcustom mime-acting-situation-examples-file "~/.mime-example"
60 "*File name of example about acting-situation demonstrated by user."
65 ;;; @ in raw-buffer (representation space)
68 (defvar mime-preview-buffer nil
69 "MIME-preview buffer corresponding with the (raw) buffer.")
70 (make-variable-buffer-local 'mime-preview-buffer)
73 (defvar mime-raw-representation-type nil
74 "Representation-type of mime-raw-buffer.
75 It must be nil, `binary' or `cooked'.
76 If it is nil, `mime-raw-representation-type-alist' is used as default
78 Notice that this variable is usually used as buffer local variable in
81 (make-variable-buffer-local 'mime-raw-representation-type)
83 (defvar mime-raw-representation-type-alist
84 '((mime-show-message-mode . binary)
85 (mime-temp-message-mode . binary)
88 "Alist of major-mode vs. representation-type of mime-raw-buffer.
89 Each element looks like (SYMBOL . REPRESENTATION-TYPE). SYMBOL is
90 major-mode or t. t means default. REPRESENTATION-TYPE must be
92 This value is overridden by buffer local variable
93 `mime-raw-representation-type' if it is not nil.")
96 (defun mime-raw-find-entity-from-point (point &optional message-info)
97 "Return entity from POINT in mime-raw-buffer.
98 If optional argument MESSAGE-INFO is not specified,
99 `mime-message-structure' is used."
101 (setq message-info mime-message-structure))
102 (if (and (<= (mime-entity-point-min message-info) point)
103 (<= point (mime-entity-point-max message-info)))
104 (let ((children (mime-entity-children message-info)))
108 (mime-raw-find-entity-from-point point (car children))))
112 (setq children (cdr children)))
116 ;;; @ in preview-buffer (presentation space)
119 (defvar mime-mother-buffer nil
120 "Mother buffer corresponding with the (MIME-preview) buffer.
121 If current MIME-preview buffer is generated by other buffer, such as
122 message/partial, it is called `mother-buffer'.")
123 (make-variable-buffer-local 'mime-mother-buffer)
125 (defvar mime-raw-buffer nil
126 "Raw buffer corresponding with the (MIME-preview) buffer.")
127 (make-variable-buffer-local 'mime-raw-buffer)
129 (defvar mime-preview-original-window-configuration nil
130 "Window-configuration before mime-view-mode is called.")
131 (make-variable-buffer-local 'mime-preview-original-window-configuration)
133 (defun mime-preview-original-major-mode (&optional recursive)
134 "Return major-mode of original buffer.
135 If optional argument RECURSIVE is non-nil and current buffer has
136 mime-mother-buffer, it returns original major-mode of the
138 (if (and recursive mime-mother-buffer)
140 (set-buffer mime-mother-buffer)
141 (mime-preview-original-major-mode recursive)
146 (get-text-property (point-min) 'mime-view-entity)))
150 ;;; @ entity information
153 (defsubst mime-entity-representation-type (entity)
154 (with-current-buffer (mime-entity-buffer entity)
155 (or mime-raw-representation-type
156 (cdr (or (assq major-mode mime-raw-representation-type-alist)
157 (assq t mime-raw-representation-type-alist))))))
159 (defsubst mime-entity-cooked-p (entity)
160 (eq (mime-entity-representation-type entity) 'cooked))
162 (defun mime-entity-situation (entity)
163 "Return situation of ENTITY."
164 (append (or (mime-entity-content-type entity)
165 (make-mime-content-type 'text 'plain))
166 (let ((d (mime-entity-content-disposition entity)))
167 (cons (cons 'disposition-type
168 (mime-content-disposition-type d))
171 (let ((name (car param)))
172 (cons (cond ((string= name "filename")
174 ((string= name "creation-date")
176 ((string= name "modification-date")
178 ((string= name "read-date")
180 ((string= name "size")
182 (t (cons 'disposition (car param))))
184 (mime-content-disposition-parameters d))
186 (list (cons 'encoding (mime-entity-encoding entity))
189 (set-buffer (mime-entity-buffer entity))
194 (defun mime-view-entity-title (entity)
195 (or (mime-read-field 'Content-Description entity)
196 (mime-read-field 'Subject entity)
197 (mime-entity-filename entity)
201 (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
202 "Return entity-node-id from POINT in mime-raw-buffer.
203 If optional argument MESSAGE-INFO is not specified,
204 `mime-message-structure' is used."
205 (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
207 (defsubst mime-raw-point-to-entity-number (point &optional message-info)
208 "Return entity-number from POINT in mime-raw-buffer.
209 If optional argument MESSAGE-INFO is not specified,
210 `mime-message-structure' is used."
211 (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
213 (defun mime-raw-flatten-message-info (&optional message-info)
214 "Return list of entity in mime-raw-buffer.
215 If optional argument MESSAGE-INFO is not specified,
216 `mime-message-structure' is used."
218 (setq message-info mime-message-structure))
219 (let ((dest (list message-info))
220 (rcl (mime-entity-children message-info)))
222 (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
223 (setq rcl (cdr rcl)))
227 ;;; @ presentation of preview
233 ;;; @@@ predicate function
236 (defun mime-view-entity-button-visible-p (entity)
237 "Return non-nil if header of ENTITY is visible.
238 Please redefine this function if you want to change default setting."
239 (let ((media-type (mime-entity-media-type entity))
240 (media-subtype (mime-entity-media-subtype entity)))
241 (or (not (eq media-type 'application))
242 (and (not (eq media-subtype 'x-selection))
243 (or (not (eq media-subtype 'octet-stream))
244 (let ((mother-entity (mime-entity-parent entity)))
245 (or (not (eq (mime-entity-media-type mother-entity)
247 (not (eq (mime-entity-media-subtype mother-entity)
252 ;;; @@@ entity button generator
255 (defun mime-view-insert-entity-button (entity)
256 "Insert entity-button of ENTITY."
257 (let ((entity-node-id (mime-entity-node-id entity))
258 (params (mime-entity-parameters entity))
259 (subject (mime-view-entity-title entity)))
261 (let ((access-type (assoc "access-type" params))
262 (num (or (cdr (assoc "x-part-number" params))
263 (if (consp entity-node-id)
266 (format "%s" (1+ num))
268 (reverse entity-node-id) ".")
272 (let ((server (assoc "server" params)))
273 (setq access-type (cdr access-type))
275 (format "%s %s ([%s] %s)"
276 num subject access-type (cdr server))
277 (let ((site (cdr (assoc "site" params)))
278 (dir (cdr (assoc "directory" params)))
280 (format "%s %s ([%s] %s:%s)"
281 num subject access-type site dir)
285 (let ((media-type (mime-entity-media-type entity))
286 (media-subtype (mime-entity-media-subtype entity))
287 (charset (cdr (assoc "charset" params)))
288 (encoding (mime-entity-encoding entity)))
292 (format " <%s/%s%s%s>"
293 media-type media-subtype
295 (concat "; " charset)
298 (concat " (" encoding ")")
300 (if (>= (+ (current-column)(length rest))(window-width))
304 (function mime-preview-play-current-entity))
311 (defvar mime-header-presentation-method-alist nil
312 "Alist of major mode vs. corresponding header-presentation-method functions.
313 Each element looks like (SYMBOL . FUNCTION).
314 SYMBOL must be major mode in raw-buffer or t. t means default.
315 Interface of FUNCTION must be (ENTITY SITUATION).")
317 (defvar mime-view-ignored-field-list
318 '(".*Received" ".*Path" ".*Id" "References"
319 "Replied" "Errors-To"
320 "Lines" "Sender" ".*Host" "Xref"
321 "Content-Type" "Precedence"
323 "All fields that match this list will be hidden in MIME preview buffer.
324 Each elements are regexp of field-name.")
326 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
327 "All fields that match this list will be displayed in MIME preview buffer.
328 Each elements are regexp of field-name.")
334 ;;; @@@ predicate function
337 (defun mime-calist::field-match-method-as-default-rule (calist
338 field-type field-value)
339 (let ((s-field (assq field-type calist)))
340 (cond ((null s-field)
341 (cons (cons field-type field-value) calist)
345 (define-calist-field-match-method
346 'header #'mime-calist::field-match-method-as-default-rule)
348 (define-calist-field-match-method
349 'body #'mime-calist::field-match-method-as-default-rule)
352 (defvar mime-preview-condition nil
353 "Condition-tree about how to display entity.")
355 (ctree-set-calist-strictly
356 'mime-preview-condition '((type . application)(subtype . octet-stream)
359 (ctree-set-calist-strictly
360 'mime-preview-condition '((type . application)(subtype . octet-stream)
363 (ctree-set-calist-strictly
364 'mime-preview-condition '((type . application)(subtype . octet-stream)
368 (ctree-set-calist-strictly
369 'mime-preview-condition '((type . application)(subtype . pgp)
372 (ctree-set-calist-strictly
373 'mime-preview-condition '((type . application)(subtype . x-latex)
376 (ctree-set-calist-strictly
377 'mime-preview-condition '((type . application)(subtype . x-selection)
380 (ctree-set-calist-strictly
381 'mime-preview-condition '((type . application)(subtype . x-comment)
384 (ctree-set-calist-strictly
385 'mime-preview-condition '((type . message)(subtype . delivery-status)
388 (ctree-set-calist-strictly
389 'mime-preview-condition
391 (body-presentation-method . mime-display-text/plain)))
393 (ctree-set-calist-strictly
394 'mime-preview-condition
397 (body-presentation-method . mime-display-text/plain)))
399 (ctree-set-calist-strictly
400 'mime-preview-condition
401 '((type . text)(subtype . enriched)
403 (body-presentation-method . mime-display-text/enriched)))
405 (ctree-set-calist-strictly
406 'mime-preview-condition
407 '((type . text)(subtype . richtext)
409 (body-presentation-method . mime-display-text/richtext)))
411 (ctree-set-calist-strictly
412 'mime-preview-condition
413 '((type . text)(subtype . t)
415 (body-presentation-method . mime-display-text/plain)))
417 (ctree-set-calist-strictly
418 'mime-preview-condition
419 '((type . multipart)(subtype . alternative)
421 (body-presentation-method . mime-display-multipart/alternative)))
423 (ctree-set-calist-strictly
424 'mime-preview-condition '((type . message)(subtype . partial)
425 (body-presentation-method
426 . mime-display-message/partial-button)))
428 (ctree-set-calist-strictly
429 'mime-preview-condition '((type . message)(subtype . rfc822)
430 (body-presentation-method . nil)
431 (childrens-situation (header . visible)
432 (entity-button . invisible))))
434 (ctree-set-calist-strictly
435 'mime-preview-condition '((type . message)(subtype . news)
436 (body-presentation-method . nil)
437 (childrens-situation (header . visible)
438 (entity-button . invisible))))
441 ;;; @@@ entity presentation
444 (autoload 'mime-display-text/plain "mime-text")
445 (autoload 'mime-display-text/enriched "mime-text")
446 (autoload 'mime-display-text/richtext "mime-text")
448 (defvar mime-view-announcement-for-message/partial
449 (if (and (>= emacs-major-version 19) window-system)
451 This is message/partial style split message.
452 Please press `v' key in this buffer or click here by mouse button-2."
454 This is message/partial style split message.
455 Please press `v' key in this buffer."
458 (defun mime-display-message/partial-button (&optional entity situation)
460 (goto-char (point-max))
461 (if (not (search-backward "\n\n" nil t))
464 (goto-char (point-max))
465 ;;(narrow-to-region (point-max)(point-max))
466 ;;(insert mime-view-announcement-for-message/partial)
467 ;; (mime-add-button (point-min)(point-max)
468 ;; #'mime-preview-play-current-entity)
469 (mime-insert-button mime-view-announcement-for-message/partial
470 #'mime-preview-play-current-entity)
473 (defun mime-display-multipart/mixed (entity situation)
474 (let ((children (mime-entity-children entity))
476 (cdr (assq 'childrens-situation situation))))
478 (mime-display-entity (car children) nil default-situation)
479 (setq children (cdr children))
482 (defcustom mime-view-type-subtype-score-alist
483 '(((text . enriched) . 3)
484 ((text . richtext) . 2)
487 "Alist MEDIA-TYPE vs corresponding score.
488 MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default."
490 :type '(repeat (cons (choice :tag "Media-Type"
491 (item :tag "Type/Subtype"
492 (cons symbol symbol))
493 (item :tag "Type" symbol)
494 (item :tag "Default" t))
497 (defun mime-display-multipart/alternative (entity situation)
498 (let* ((children (mime-entity-children entity))
500 (cdr (assq 'childrens-situation situation)))
508 (or (ctree-match-calist
509 mime-preview-condition
510 (append (mime-entity-situation child)
513 (if (cdr (assq 'body-presentation-method situation))
518 (cdr (assq 'type situation))
519 (cdr (assq 'subtype situation)))
520 mime-view-type-subtype-score-alist)
522 (cdr (assq 'type situation))
523 mime-view-type-subtype-score-alist)
526 mime-view-type-subtype-score-alist)
528 (if (> score max-score)
538 (let ((child (car children))
539 (situation (car situations)))
540 (mime-display-entity child (if (= i p)
542 (del-alist 'body-presentation-method
543 (copy-alist situation))))
545 (setq children (cdr children)
546 situations (cdr situations)
551 ;;; @ acting-condition
554 (defvar mime-acting-condition nil
555 "Condition-tree about how to process entity.")
557 (if (file-readable-p mailcap-file)
558 (let ((entries (mailcap-parse-file)))
560 (let ((entry (car entries))
563 (let* ((field (car entry))
564 (field-type (car field)))
565 (cond ((eq field-type 'view) (setq view field))
566 ((eq field-type 'print) (setq print field))
567 ((memq field-type '(compose composetyped edit)))
568 (t (setq shared (cons field shared))))
570 (setq entry (cdr entry))
572 (setq shared (nreverse shared))
573 (ctree-set-calist-with-default
574 'mime-acting-condition
575 (append shared (list '(mode . "play")(cons 'method (cdr view)))))
577 (ctree-set-calist-with-default
578 'mime-acting-condition
580 (list '(mode . "print")(cons 'method (cdr view))))
583 (setq entries (cdr entries))
586 (ctree-set-calist-strictly
587 'mime-acting-condition
588 '((type . application)(subtype . octet-stream)
590 (method . mime-detect-content)
593 (ctree-set-calist-with-default
594 'mime-acting-condition
596 (method . mime-save-content)))
598 (ctree-set-calist-strictly
599 'mime-acting-condition
600 '((type . text)(subtype . x-rot13-47)(mode . "play")
601 (method . mime-view-caesar)
603 (ctree-set-calist-strictly
604 'mime-acting-condition
605 '((type . text)(subtype . x-rot13-47-48)(mode . "play")
606 (method . mime-view-caesar)
609 (ctree-set-calist-strictly
610 'mime-acting-condition
611 '((type . message)(subtype . rfc822)(mode . "play")
612 (method . mime-view-message/rfc822)
614 (ctree-set-calist-strictly
615 'mime-acting-condition
616 '((type . message)(subtype . partial)(mode . "play")
617 (method . mime-store-message/partial-piece)
620 (ctree-set-calist-strictly
621 'mime-acting-condition
622 '((type . message)(subtype . external-body)
623 ("access-type" . "anon-ftp")
624 (method . mime-view-message/external-ftp)
627 (ctree-set-calist-strictly
628 'mime-acting-condition
629 '((type . application)(subtype . octet-stream)
630 (method . mime-save-content)
634 ;;; @ quitting method
637 (defvar mime-preview-quitting-method-alist
638 '((mime-show-message-mode
639 . mime-preview-quitting-method-for-mime-show-message-mode))
640 "Alist of major-mode vs. quitting-method of mime-view.")
642 (defvar mime-preview-over-to-previous-method-alist nil
643 "Alist of major-mode vs. over-to-previous-method of mime-view.")
645 (defvar mime-preview-over-to-next-method-alist nil
646 "Alist of major-mode vs. over-to-next-method of mime-view.")
649 ;;; @ following method
652 (defvar mime-preview-following-method-alist nil
653 "Alist of major-mode vs. following-method of mime-view.")
655 (defvar mime-view-following-required-fields-list
662 (defun mime-display-entity (entity &optional situation
663 default-situation preview-buffer)
665 (setq preview-buffer (current-buffer)))
666 (let* ((raw-buffer (mime-entity-buffer entity))
667 (start (mime-entity-point-min entity))
669 (set-buffer raw-buffer)
673 (or (ctree-match-calist mime-preview-condition
674 (append (mime-entity-situation entity)
677 (let ((button-is-invisible
678 (eq (cdr (assq 'entity-button situation)) 'invisible))
680 (eq (cdr (assq 'header situation)) 'visible))
681 (header-presentation-method
682 (or (cdr (assq 'header-presentation-method situation))
683 (cdr (assq major-mode mime-header-presentation-method-alist))))
684 (body-presentation-method
685 (cdr (assq 'body-presentation-method situation)))
686 (children (mime-entity-children entity)))
687 (set-buffer preview-buffer)
689 (narrow-to-region nb nb)
690 (or button-is-invisible
691 (if (mime-view-entity-button-visible-p entity)
692 (mime-view-insert-entity-button entity)
694 (when header-is-visible
695 (if header-presentation-method
696 (funcall header-presentation-method entity situation)
697 (mime-insert-decoded-header entity
698 mime-view-ignored-field-list
699 mime-view-visible-field-list
700 (if (mime-entity-cooked-p entity)
702 default-mime-charset))
704 (goto-char (point-max))
706 (run-hooks 'mime-display-header-hook)
709 ((functionp body-presentation-method)
710 (funcall body-presentation-method entity situation)
713 (when button-is-invisible
714 (goto-char (point-max))
715 (mime-view-insert-entity-button entity)
717 (or header-is-visible
719 (goto-char (point-max))
723 (setq ne (point-max))
725 (put-text-property nb ne 'mime-view-entity entity)
728 (if (functionp body-presentation-method)
729 (funcall body-presentation-method entity situation)
730 (mime-display-multipart/mixed entity situation)
735 ;;; @ MIME viewer mode
738 (defconst mime-view-menu-title "MIME-View")
739 (defconst mime-view-menu-list
740 '((up "Move to upper entity" mime-preview-move-to-upper)
741 (previous "Move to previous entity" mime-preview-move-to-previous)
742 (next "Move to next entity" mime-preview-move-to-next)
743 (scroll-down "Scroll-down" mime-preview-scroll-down-entity)
744 (scroll-up "Scroll-up" mime-preview-scroll-up-entity)
745 (play "Play current entity" mime-preview-play-current-entity)
746 (extract "Extract current entity" mime-preview-extract-current-entity)
747 (print "Print current entity" mime-preview-print-current-entity)
749 "Menu for MIME Viewer")
751 (cond (running-xemacs
752 (defvar mime-view-xemacs-popup-menu
753 (cons mime-view-menu-title
756 (vector (nth 1 item)(nth 2 item) t)
758 mime-view-menu-list)))
759 (defun mime-view-xemacs-popup-menu (event)
760 "Popup the menu in the MIME Viewer buffer"
762 (select-window (event-window event))
763 (set-buffer (event-buffer event))
764 (popup-menu 'mime-view-xemacs-popup-menu))
765 (defvar mouse-button-2 'button2)
768 (defvar mouse-button-2 [mouse-2])
771 (defun mime-view-define-keymap (&optional default)
772 (let ((mime-view-mode-map (if (keymapp default)
773 (copy-keymap default)
776 (define-key mime-view-mode-map
777 "u" (function mime-preview-move-to-upper))
778 (define-key mime-view-mode-map
779 "p" (function mime-preview-move-to-previous))
780 (define-key mime-view-mode-map
781 "n" (function mime-preview-move-to-next))
782 (define-key mime-view-mode-map
783 "\e\t" (function mime-preview-move-to-previous))
784 (define-key mime-view-mode-map
785 "\t" (function mime-preview-move-to-next))
786 (define-key mime-view-mode-map
787 " " (function mime-preview-scroll-up-entity))
788 (define-key mime-view-mode-map
789 "\M- " (function mime-preview-scroll-down-entity))
790 (define-key mime-view-mode-map
791 "\177" (function mime-preview-scroll-down-entity))
792 (define-key mime-view-mode-map
793 "\C-m" (function mime-preview-next-line-entity))
794 (define-key mime-view-mode-map
795 "\C-\M-m" (function mime-preview-previous-line-entity))
796 (define-key mime-view-mode-map
797 "v" (function mime-preview-play-current-entity))
798 (define-key mime-view-mode-map
799 "e" (function mime-preview-extract-current-entity))
800 (define-key mime-view-mode-map
801 "\C-c\C-p" (function mime-preview-print-current-entity))
802 (define-key mime-view-mode-map
803 "a" (function mime-preview-follow-current-entity))
804 (define-key mime-view-mode-map
805 "q" (function mime-preview-quit))
806 (define-key mime-view-mode-map
807 "\C-c\C-x" (function mime-preview-kill-buffer))
808 ;; (define-key mime-view-mode-map
809 ;; "<" (function beginning-of-buffer))
810 ;; (define-key mime-view-mode-map
811 ;; ">" (function end-of-buffer))
812 (define-key mime-view-mode-map
813 "?" (function describe-mode))
814 (define-key mime-view-mode-map
815 [tab] (function mime-preview-move-to-next))
816 (define-key mime-view-mode-map
817 [delete] (function mime-preview-scroll-down-entity))
818 (define-key mime-view-mode-map
819 [backspace] (function mime-preview-scroll-down-entity))
820 (if (functionp default)
821 (cond (running-xemacs
822 (set-keymap-default-binding mime-view-mode-map default)
825 (setq mime-view-mode-map
826 (append mime-view-mode-map (list (cons t default))))
829 (define-key mime-view-mode-map
830 mouse-button-2 (function mime-button-dispatcher))
832 (cond (running-xemacs
833 (define-key mime-view-mode-map
834 mouse-button-3 (function mime-view-xemacs-popup-menu))
836 ((>= emacs-major-version 19)
837 (define-key mime-view-mode-map [menu-bar mime-view]
838 (cons mime-view-menu-title
839 (make-sparse-keymap mime-view-menu-title)))
842 (define-key mime-view-mode-map
843 (vector 'menu-bar 'mime-view (car item))
844 (cons (nth 1 item)(nth 2 item))
847 (reverse mime-view-menu-list)
850 (use-local-map mime-view-mode-map)
851 (run-hooks 'mime-view-define-keymap-hook)
854 (defsubst mime-maybe-hide-echo-buffer ()
855 "Clear mime-echo buffer and delete window for it."
856 (let ((buf (get-buffer mime-echo-buffer-name)))
861 (let ((win (get-buffer-window buf)))
868 (defvar mime-view-redisplay nil)
870 (defun mime-display-message (message &optional preview-buffer
871 mother default-keymap-or-function)
872 (mime-maybe-hide-echo-buffer)
873 (let ((win-conf (current-window-configuration))
874 (raw-buffer (mime-entity-buffer message)))
877 (concat "*Preview-" (buffer-name raw-buffer) "*")))
878 (set-buffer raw-buffer)
879 (setq mime-preview-buffer preview-buffer)
880 (let ((inhibit-read-only t))
881 (set-buffer (get-buffer-create preview-buffer))
884 (setq mime-raw-buffer raw-buffer)
886 (setq mime-mother-buffer mother)
888 (setq mime-preview-original-window-configuration win-conf)
889 (setq major-mode 'mime-view-mode)
890 (setq mode-name "MIME-View")
891 (mime-display-entity message nil
892 '((entity-button . invisible)
895 (mime-view-define-keymap default-keymap-or-function)
897 (next-single-property-change (point-min) 'mime-view-entity)))
900 (goto-char (point-min))
901 (search-forward "\n\n" nil t)
903 (run-hooks 'mime-view-mode-hook)
904 (set-buffer-modified-p nil)
905 (setq buffer-read-only t)
906 (or (get-buffer-window preview-buffer)
907 (let ((r-win (get-buffer-window raw-buffer)))
909 (set-window-buffer r-win preview-buffer)
910 (switch-to-buffer preview-buffer)
914 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
915 default-keymap-or-function)
917 (mime-display-message
918 (mime-parse-buffer raw-buffer)
919 preview-buffer mother default-keymap-or-function))
921 (defun mime-view-mode (&optional mother ctl encoding
922 raw-buffer preview-buffer
923 default-keymap-or-function)
924 "Major mode for viewing MIME message.
926 Here is a list of the standard keys for mime-view-mode.
931 u Move to upper content
932 p or M-TAB Move to previous content
933 n or TAB Move to next content
934 SPC Scroll up or move to next content
935 M-SPC or DEL Scroll down or move to previous content
936 RET Move to next line
937 M-RET Move to previous line
938 v Decode current content as `play mode'
939 e Decode current content as `extract mode'
940 C-c C-p Decode current content as `print mode'
941 a Followup to current content.
943 button-2 Move to point under the mouse cursor
944 and decode current content as `play mode'
947 (mime-display-message
949 (if raw-buffer (set-buffer raw-buffer))
950 (or mime-view-redisplay
951 (setq mime-message-structure (mime-parse-message ctl encoding)))
953 preview-buffer mother default-keymap-or-function))
959 (autoload 'mime-preview-play-current-entity "mime-play"
960 "Play current entity." t)
962 (defun mime-preview-extract-current-entity ()
963 "Extract current entity into file (maybe).
964 It decodes current entity to call internal or external method as
965 \"extract\" mode. The method is selected from variable
966 `mime-acting-condition'."
968 (mime-preview-play-current-entity "extract")
971 (defun mime-preview-print-current-entity ()
972 "Print current entity (maybe).
973 It decodes current entity to call internal or external method as
974 \"print\" mode. The method is selected from variable
975 `mime-acting-condition'."
977 (mime-preview-play-current-entity "print")
984 (defun mime-preview-follow-current-entity ()
985 "Write follow message to current entity.
986 It calls following-method selected from variable
987 `mime-preview-following-method-alist'."
990 (while (null (setq entity
991 (get-text-property (point) 'mime-view-entity)))
995 (previous-single-property-change (point) 'mime-view-entity))
997 (entity-node-id (mime-entity-node-id entity))
998 (len (length entity-node-id))
1002 (if (eq (next-single-property-change (point-min)
1008 ((eq (next-single-property-change p-beg 'mime-view-entity)
1010 (setq p-beg (point))
1012 (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1014 (setq p-end (point-max))
1016 ((null entity-node-id)
1017 (setq p-end (point-max))
1025 (next-single-property-change
1026 (point) 'mime-view-entity))
1028 (let ((rc (mime-entity-node-id
1029 (get-text-property (point)
1030 'mime-view-entity))))
1031 (or (equal entity-node-id
1032 (nthcdr (- (length rc) len) rc))
1037 (setq p-end (point-max))
1040 (let* ((mode (mime-preview-original-major-mode 'recursive))
1042 (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1044 (the-buf (current-buffer))
1045 (a-buf mime-raw-buffer)
1048 (set-buffer (setq new-buf (get-buffer-create new-name)))
1050 (insert-buffer-substring the-buf p-beg p-end)
1051 (goto-char (point-min))
1052 (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1059 (mime-find-entity-from-node-id entity-node-id))
1062 (mime-entity-point-min ci)
1063 (mime-entity-point-max ci)
1065 (std11-header-string-except
1067 (apply (function regexp-or) fields)
1070 (eq (mime-entity-media-type ci) 'message)
1071 (eq (mime-entity-media-subtype ci) 'rfc822))
1077 (setq fields (std11-collect-field-names)
1078 entity-node-id (cdr entity-node-id))
1081 (let ((rest mime-view-following-required-fields-list))
1083 (let ((field-name (car rest)))
1084 (or (std11-field-body field-name)
1090 (set-buffer the-buf)
1091 (set-buffer mime-mother-buffer)
1092 (set-buffer mime-raw-buffer)
1093 (std11-field-body field-name)
1097 (setq rest (cdr rest))
1099 (eword-decode-header)
1101 (let ((f (cdr (assq mode mime-preview-following-method-alist))))
1106 "Sorry, following method for %s is not implemented yet."
1115 (defun mime-preview-move-to-upper ()
1116 "Move to upper entity.
1117 If there is no upper entity, call function `mime-preview-quit'."
1120 (while (null (setq cinfo
1121 (get-text-property (point) 'mime-view-entity)))
1124 (let ((r (mime-entity-parent cinfo))
1127 (while (setq point (previous-single-property-change
1128 (point) 'mime-view-entity))
1130 (if (eq r (get-text-property (point) 'mime-view-entity))
1137 (defun mime-preview-move-to-previous ()
1138 "Move to previous entity.
1139 If there is no previous entity, it calls function registered in
1140 variable `mime-preview-over-to-previous-method-alist'."
1142 (while (null (get-text-property (point) 'mime-view-entity))
1145 (let ((point (previous-single-property-change (point) 'mime-view-entity)))
1147 (if (get-text-property (1- point) 'mime-view-entity)
1149 (goto-char (1- point))
1150 (mime-preview-move-to-previous)
1152 (let ((f (assq (mime-preview-original-major-mode)
1153 mime-preview-over-to-previous-method-alist)))
1159 (defun mime-preview-move-to-next ()
1160 "Move to next entity.
1161 If there is no previous entity, it calls function registered in
1162 variable `mime-preview-over-to-next-method-alist'."
1164 (while (null (get-text-property (point) 'mime-view-entity))
1167 (let ((point (next-single-property-change (point) 'mime-view-entity)))
1171 (if (null (get-text-property point 'mime-view-entity))
1172 (mime-preview-move-to-next)
1174 (let ((f (assq (mime-preview-original-major-mode)
1175 mime-preview-over-to-next-method-alist)))
1181 (defun mime-preview-scroll-up-entity (&optional h)
1182 "Scroll up current entity.
1183 If reached to (point-max), it calls function registered in variable
1184 `mime-preview-over-to-next-method-alist'."
1187 (setq h (1- (window-height)))
1189 (if (= (point) (point-max))
1190 (let ((f (assq (mime-preview-original-major-mode)
1191 mime-preview-over-to-next-method-alist)))
1196 (or (next-single-property-change (point) 'mime-view-entity)
1199 (if (> (point) point)
1204 (defun mime-preview-scroll-down-entity (&optional h)
1205 "Scroll down current entity.
1206 If reached to (point-min), it calls function registered in variable
1207 `mime-preview-over-to-previous-method-alist'."
1210 (setq h (1- (window-height)))
1212 (if (= (point) (point-min))
1213 (let ((f (assq (mime-preview-original-major-mode)
1214 mime-preview-over-to-previous-method-alist)))
1219 (or (previous-single-property-change (point) 'mime-view-entity)
1221 (forward-line (- h))
1222 (if (< (point) point)
1226 (defun mime-preview-next-line-entity ()
1228 (mime-preview-scroll-up-entity 1)
1231 (defun mime-preview-previous-line-entity ()
1233 (mime-preview-scroll-down-entity 1)
1240 (defun mime-preview-quit ()
1241 "Quit from MIME-preview buffer.
1242 It calls function registered in variable
1243 `mime-preview-quitting-method-alist'."
1245 (let ((r (assq (mime-preview-original-major-mode)
1246 mime-preview-quitting-method-alist)))
1251 (defun mime-preview-kill-buffer ()
1253 (kill-buffer (current-buffer))
1260 (provide 'mime-view)
1262 (run-hooks 'mime-view-load-hook)
1264 ;;; mime-view.el ends here