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 SEMI (Sophisticated 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-alist
74 '((mime-show-message-mode . binary)
75 (mime-temp-message-mode . binary)
78 "Alist of major-mode vs. representation-type of mime-raw-buffer.
79 Each element looks like (SYMBOL . REPRESENTATION-TYPE). SYMBOL is
80 major-mode or t. t means default. REPRESENTATION-TYPE must be
81 `binary' or `cooked'.")
84 (defun mime-raw-find-entity-from-point (point &optional message-info)
85 "Return entity from POINT in mime-raw-buffer.
86 If optional argument MESSAGE-INFO is not specified,
87 `mime-message-structure' is used."
89 (setq message-info mime-message-structure))
90 (if (and (<= (mime-entity-point-min message-info) point)
91 (<= point (mime-entity-point-max message-info)))
92 (let ((children (mime-entity-children message-info)))
96 (mime-raw-find-entity-from-point point (car children))))
100 (setq children (cdr children)))
104 ;;; @ in preview-buffer (presentation space)
107 (defvar mime-mother-buffer nil
108 "Mother buffer corresponding with the (MIME-preview) buffer.
109 If current MIME-preview buffer is generated by other buffer, such as
110 message/partial, it is called `mother-buffer'.")
111 (make-variable-buffer-local 'mime-mother-buffer)
113 (defvar mime-raw-buffer nil
114 "Raw buffer corresponding with the (MIME-preview) buffer.")
115 (make-variable-buffer-local 'mime-raw-buffer)
117 (defvar mime-preview-original-window-configuration nil
118 "Window-configuration before mime-view-mode is called.")
119 (make-variable-buffer-local 'mime-preview-original-window-configuration)
121 (defun mime-preview-original-major-mode (&optional recursive)
122 "Return major-mode of original buffer.
123 If optional argument RECURSIVE is non-nil and current buffer has
124 mime-mother-buffer, it returns original major-mode of the
126 (if (and recursive mime-mother-buffer)
128 (set-buffer mime-mother-buffer)
129 (mime-preview-original-major-mode recursive)
134 (get-text-property (point-min) 'mime-view-entity)))
138 ;;; @ entity information
141 (defun mime-entity-situation (entity)
142 "Return situation of ENTITY."
143 (append (or (mime-entity-content-type entity)
144 (make-mime-content-type 'text 'plain))
145 (let ((d (mime-entity-content-disposition entity)))
146 (cons (cons 'disposition-type
147 (mime-content-disposition-type d))
150 (let ((name (car param)))
151 (cons (cond ((string= name "filename")
153 ((string= name "creation-date")
155 ((string= name "modification-date")
157 ((string= name "read-date")
159 ((string= name "size")
161 (t (cons 'disposition (car param))))
163 (mime-content-disposition-parameters d))
165 (list (cons 'encoding (mime-entity-encoding entity))
168 (set-buffer (mime-entity-buffer entity))
173 (defun mime-view-entity-title (entity)
174 (or (mime-read-field 'Content-Description entity)
175 (mime-read-field 'Subject entity)
176 (mime-entity-filename entity)
180 (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
181 "Return entity-node-id from POINT in mime-raw-buffer.
182 If optional argument MESSAGE-INFO is not specified,
183 `mime-message-structure' is used."
184 (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
186 (defsubst mime-raw-point-to-entity-number (point &optional message-info)
187 "Return entity-number from POINT in mime-raw-buffer.
188 If optional argument MESSAGE-INFO is not specified,
189 `mime-message-structure' is used."
190 (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
192 (defun mime-raw-flatten-message-info (&optional message-info)
193 "Return list of entity in mime-raw-buffer.
194 If optional argument MESSAGE-INFO is not specified,
195 `mime-message-structure' is used."
197 (setq message-info mime-message-structure))
198 (let ((dest (list message-info))
199 (rcl (mime-entity-children message-info)))
201 (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
202 (setq rcl (cdr rcl)))
206 ;;; @ presentation of preview
212 ;;; @@@ predicate function
215 (defun mime-view-entity-button-visible-p (entity)
216 "Return non-nil if header of ENTITY is visible.
217 Please redefine this function if you want to change default setting."
218 (let ((media-type (mime-entity-media-type entity))
219 (media-subtype (mime-entity-media-subtype entity)))
220 (or (not (eq media-type 'application))
221 (and (not (eq media-subtype 'x-selection))
222 (or (not (eq media-subtype 'octet-stream))
223 (let ((mother-entity (mime-entity-parent entity)))
224 (or (not (eq (mime-entity-media-type mother-entity)
226 (not (eq (mime-entity-media-subtype mother-entity)
231 ;;; @@@ entity button generator
234 (defun mime-view-insert-entity-button (entity)
235 "Insert entity-button of ENTITY."
236 (let ((entity-node-id (mime-entity-node-id entity))
237 (params (mime-entity-parameters entity))
238 (subject (mime-view-entity-title entity)))
240 (let ((access-type (assoc "access-type" params))
241 (num (or (cdr (assoc "x-part-number" params))
242 (if (consp entity-node-id)
245 (format "%s" (1+ num))
247 (reverse entity-node-id) ".")
251 (let ((server (assoc "server" params)))
252 (setq access-type (cdr access-type))
254 (format "%s %s ([%s] %s)"
255 num subject access-type (cdr server))
256 (let ((site (cdr (assoc "site" params)))
257 (dir (cdr (assoc "directory" params)))
259 (format "%s %s ([%s] %s:%s)"
260 num subject access-type site dir)
264 (let ((media-type (mime-entity-media-type entity))
265 (media-subtype (mime-entity-media-subtype entity))
266 (charset (cdr (assoc "charset" params)))
267 (encoding (mime-entity-encoding entity)))
271 (format " <%s/%s%s%s>"
272 media-type media-subtype
274 (concat "; " charset)
277 (concat " (" encoding ")")
279 (if (>= (+ (current-column)(length rest))(window-width))
283 (function mime-preview-play-current-entity))
290 (defvar mime-header-presentation-method-alist nil
291 "Alist of major mode vs. corresponding header-presentation-method functions.
292 Each element looks like (SYMBOL . FUNCTION).
293 SYMBOL must be major mode in raw-buffer or t. t means default.
294 Interface of FUNCTION must be (ENTITY SITUATION).")
296 (defvar mime-view-ignored-field-list
297 '(".*Received" ".*Path" ".*Id" "References"
298 "Replied" "Errors-To"
299 "Lines" "Sender" ".*Host" "Xref"
300 "Content-Type" "Precedence"
302 "All fields that match this list will be hidden in MIME preview buffer.
303 Each elements are regexp of field-name.")
305 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
306 "All fields that match this list will be displayed in MIME preview buffer.
307 Each elements are regexp of field-name.")
313 ;;; @@@ predicate function
316 (defun mime-calist::field-match-method-as-default-rule (calist
317 field-type field-value)
318 (let ((s-field (assq field-type calist)))
319 (cond ((null s-field)
320 (cons (cons field-type field-value) calist)
324 (define-calist-field-match-method
325 'header #'mime-calist::field-match-method-as-default-rule)
327 (define-calist-field-match-method
328 'body #'mime-calist::field-match-method-as-default-rule)
331 (defvar mime-preview-condition nil
332 "Condition-tree about how to display entity.")
334 (ctree-set-calist-strictly
335 'mime-preview-condition '((type . application)(subtype . octet-stream)
338 (ctree-set-calist-strictly
339 'mime-preview-condition '((type . application)(subtype . octet-stream)
342 (ctree-set-calist-strictly
343 'mime-preview-condition '((type . application)(subtype . octet-stream)
347 (ctree-set-calist-strictly
348 'mime-preview-condition '((type . application)(subtype . pgp)
351 (ctree-set-calist-strictly
352 'mime-preview-condition '((type . application)(subtype . x-latex)
355 (ctree-set-calist-strictly
356 'mime-preview-condition '((type . application)(subtype . x-selection)
359 (ctree-set-calist-strictly
360 'mime-preview-condition '((type . application)(subtype . x-comment)
363 (ctree-set-calist-strictly
364 'mime-preview-condition '((type . message)(subtype . delivery-status)
367 (ctree-set-calist-strictly
368 'mime-preview-condition
370 (body-presentation-method . mime-display-text/plain)))
372 (ctree-set-calist-strictly
373 'mime-preview-condition
376 (body-presentation-method . mime-display-text/plain)))
378 (ctree-set-calist-strictly
379 'mime-preview-condition
380 '((type . text)(subtype . enriched)
382 (body-presentation-method . mime-display-text/enriched)))
384 (ctree-set-calist-strictly
385 'mime-preview-condition
386 '((type . text)(subtype . richtext)
388 (body-presentation-method . mime-display-text/richtext)))
390 (ctree-set-calist-strictly
391 'mime-preview-condition
392 '((type . text)(subtype . t)
394 (body-presentation-method . mime-display-text/plain)))
396 (ctree-set-calist-strictly
397 'mime-preview-condition
398 '((type . multipart)(subtype . alternative)
400 (body-presentation-method . mime-display-multipart/alternative)))
402 (ctree-set-calist-strictly
403 'mime-preview-condition '((type . message)(subtype . partial)
404 (body-presentation-method
405 . mime-display-message/partial-button)))
407 (ctree-set-calist-strictly
408 'mime-preview-condition '((type . message)(subtype . rfc822)
409 (body-presentation-method . nil)
410 (childrens-situation (header . visible)
411 (entity-button . invisible))))
413 (ctree-set-calist-strictly
414 'mime-preview-condition '((type . message)(subtype . news)
415 (body-presentation-method . nil)
416 (childrens-situation (header . visible)
417 (entity-button . invisible))))
420 ;;; @@@ entity presentation
423 (autoload 'mime-display-text/plain "mime-text")
424 (autoload 'mime-display-text/enriched "mime-text")
425 (autoload 'mime-display-text/richtext "mime-text")
427 (defvar mime-view-announcement-for-message/partial
428 (if (and (>= emacs-major-version 19) window-system)
430 \[[ This is message/partial style split message. ]]
431 \[[ Please press `v' key in this buffer ]]
432 \[[ or click here by mouse button-2. ]]"
434 \[[ This is message/partial style split message. ]]
435 \[[ Please press `v' key in this buffer. ]]"
438 (defun mime-display-message/partial-button (&optional entity situation)
440 (goto-char (point-max))
441 (if (not (search-backward "\n\n" nil t))
444 (goto-char (point-max))
445 (narrow-to-region (point-max)(point-max))
446 (insert mime-view-announcement-for-message/partial)
447 (mime-add-button (point-min)(point-max)
448 #'mime-preview-play-current-entity)
451 (defun mime-display-multipart/mixed (entity situation)
452 (let ((children (mime-entity-children entity))
454 (cdr (assq 'childrens-situation situation))))
456 (mime-display-entity (car children) nil default-situation)
457 (setq children (cdr children))
460 (defcustom mime-view-type-subtype-score-alist
461 '(((text . enriched) . 3)
462 ((text . richtext) . 2)
465 "Alist MEDIA-TYPE vs corresponding score.
466 MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default."
468 :type '(repeat (cons (choice :tag "Media-Type"
469 (cons :tag "Type/Subtype"
470 (symbol :tag "Primary-type")
471 (symbol :tag "Subtype"))
473 (const :tag "Default" t))
476 (defun mime-display-multipart/alternative (entity situation)
477 (let* ((children (mime-entity-children entity))
479 (cdr (assq 'childrens-situation situation)))
487 (or (ctree-match-calist
488 mime-preview-condition
489 (append (mime-entity-situation child)
492 (if (cdr (assq 'body-presentation-method situation))
497 (cdr (assq 'type situation))
498 (cdr (assq 'subtype situation)))
499 mime-view-type-subtype-score-alist)
501 (cdr (assq 'type situation))
502 mime-view-type-subtype-score-alist)
505 mime-view-type-subtype-score-alist)
507 (if (> score max-score)
517 (let ((child (car children))
518 (situation (car situations)))
519 (mime-display-entity child (if (= i p)
521 (del-alist 'body-presentation-method
522 (copy-alist situation))))
524 (setq children (cdr children)
525 situations (cdr situations)
530 ;;; @ acting-condition
533 (defvar mime-acting-condition nil
534 "Condition-tree about how to process entity.")
536 (if (file-readable-p mailcap-file)
537 (let ((entries (mailcap-parse-file)))
539 (let ((entry (car entries))
542 (let* ((field (car entry))
543 (field-type (car field)))
544 (cond ((eq field-type 'view) (setq view field))
545 ((eq field-type 'print) (setq print field))
546 ((memq field-type '(compose composetyped edit)))
547 (t (setq shared (cons field shared))))
549 (setq entry (cdr entry))
551 (setq shared (nreverse shared))
552 (ctree-set-calist-with-default
553 'mime-acting-condition
554 (append shared (list '(mode . "play")(cons 'method (cdr view)))))
556 (ctree-set-calist-with-default
557 'mime-acting-condition
559 (list '(mode . "print")(cons 'method (cdr view))))
562 (setq entries (cdr entries))
565 (ctree-set-calist-strictly
566 'mime-acting-condition
567 '((type . application)(subtype . octet-stream)
569 (method . mime-detect-content)
572 (ctree-set-calist-with-default
573 'mime-acting-condition
575 (method . mime-save-content)))
577 (ctree-set-calist-strictly
578 'mime-acting-condition
579 '((type . text)(subtype . x-rot13-47)(mode . "play")
580 (method . mime-view-caesar)
582 (ctree-set-calist-strictly
583 'mime-acting-condition
584 '((type . text)(subtype . x-rot13-47-48)(mode . "play")
585 (method . mime-view-caesar)
588 (ctree-set-calist-strictly
589 'mime-acting-condition
590 '((type . message)(subtype . rfc822)(mode . "play")
591 (method . mime-view-message/rfc822)
593 (ctree-set-calist-strictly
594 'mime-acting-condition
595 '((type . message)(subtype . partial)(mode . "play")
596 (method . mime-store-message/partial-piece)
599 (ctree-set-calist-strictly
600 'mime-acting-condition
601 '((type . message)(subtype . external-body)
602 ("access-type" . "anon-ftp")
603 (method . mime-view-message/external-anon-ftp)
606 (ctree-set-calist-strictly
607 'mime-acting-condition
608 '((type . message)(subtype . external-body)
609 ("access-type" . "url")
610 (method . mime-view-message/external-url)
613 (ctree-set-calist-strictly
614 'mime-acting-condition
615 '((type . application)(subtype . octet-stream)
616 (method . mime-save-content)
620 ;;; @ quitting method
623 (defvar mime-preview-quitting-method-alist
624 '((mime-show-message-mode
625 . mime-preview-quitting-method-for-mime-show-message-mode))
626 "Alist of major-mode vs. quitting-method of mime-view.")
628 (defvar mime-preview-over-to-previous-method-alist nil
629 "Alist of major-mode vs. over-to-previous-method of mime-view.")
631 (defvar mime-preview-over-to-next-method-alist nil
632 "Alist of major-mode vs. over-to-next-method of mime-view.")
635 ;;; @ following method
638 (defvar mime-preview-following-method-alist nil
639 "Alist of major-mode vs. following-method of mime-view.")
641 (defvar mime-view-following-required-fields-list
648 (defun mime-display-entity (entity &optional situation
649 default-situation preview-buffer)
651 (setq preview-buffer (current-buffer)))
652 (let* ((raw-buffer (mime-entity-buffer entity))
653 (start (mime-entity-point-min entity))
655 (set-buffer raw-buffer)
659 (or (ctree-match-calist mime-preview-condition
660 (append (mime-entity-situation entity)
663 (let ((button-is-invisible
664 (eq (cdr (assq 'entity-button situation)) 'invisible))
666 (eq (cdr (assq 'header situation)) 'visible))
667 (header-presentation-method
668 (or (cdr (assq 'header-presentation-method situation))
669 (cdr (assq major-mode mime-header-presentation-method-alist))))
670 (body-presentation-method
671 (cdr (assq 'body-presentation-method situation)))
672 (children (mime-entity-children entity)))
673 (set-buffer preview-buffer)
675 (narrow-to-region nb nb)
676 (or button-is-invisible
677 (if (mime-view-entity-button-visible-p entity)
678 (mime-view-insert-entity-button entity)
680 (when header-is-visible
681 (if header-presentation-method
682 (funcall header-presentation-method entity situation)
683 (mime-insert-decoded-header entity
684 mime-view-ignored-field-list
685 mime-view-visible-field-list))
686 (goto-char (point-max))
688 (run-hooks 'mime-display-header-hook)
691 ((functionp body-presentation-method)
692 (funcall body-presentation-method entity situation)
695 (when button-is-invisible
696 (goto-char (point-max))
697 (mime-view-insert-entity-button entity)
699 (or header-is-visible
701 (goto-char (point-max))
705 (setq ne (point-max))
707 (put-text-property nb ne 'mime-view-entity entity)
710 (if (functionp body-presentation-method)
711 (funcall body-presentation-method entity situation)
712 (mime-display-multipart/mixed entity situation)
717 ;;; @ MIME viewer mode
720 (defconst mime-view-menu-title "MIME-View")
721 (defconst mime-view-menu-list
722 '((up "Move to upper entity" mime-preview-move-to-upper)
723 (previous "Move to previous entity" mime-preview-move-to-previous)
724 (next "Move to next entity" mime-preview-move-to-next)
725 (scroll-down "Scroll-down" mime-preview-scroll-down-entity)
726 (scroll-up "Scroll-up" mime-preview-scroll-up-entity)
727 (play "Play current entity" mime-preview-play-current-entity)
728 (extract "Extract current entity" mime-preview-extract-current-entity)
729 (print "Print current entity" mime-preview-print-current-entity)
731 "Menu for MIME Viewer")
733 (cond (running-xemacs
734 (defvar mime-view-xemacs-popup-menu
735 (cons mime-view-menu-title
738 (vector (nth 1 item)(nth 2 item) t)
740 mime-view-menu-list)))
741 (defun mime-view-xemacs-popup-menu (event)
742 "Popup the menu in the MIME Viewer buffer"
744 (select-window (event-window event))
745 (set-buffer (event-buffer event))
746 (popup-menu 'mime-view-xemacs-popup-menu))
747 (defvar mouse-button-2 'button2)
750 (defvar mouse-button-2 [mouse-2])
753 (defun mime-view-define-keymap (&optional default)
754 (let ((mime-view-mode-map (if (keymapp default)
755 (copy-keymap default)
758 (define-key mime-view-mode-map
759 "u" (function mime-preview-move-to-upper))
760 (define-key mime-view-mode-map
761 "p" (function mime-preview-move-to-previous))
762 (define-key mime-view-mode-map
763 "n" (function mime-preview-move-to-next))
764 (define-key mime-view-mode-map
765 "\e\t" (function mime-preview-move-to-previous))
766 (define-key mime-view-mode-map
767 "\t" (function mime-preview-move-to-next))
768 (define-key mime-view-mode-map
769 " " (function mime-preview-scroll-up-entity))
770 (define-key mime-view-mode-map
771 "\M- " (function mime-preview-scroll-down-entity))
772 (define-key mime-view-mode-map
773 "\177" (function mime-preview-scroll-down-entity))
774 (define-key mime-view-mode-map
775 "\C-m" (function mime-preview-next-line-entity))
776 (define-key mime-view-mode-map
777 "\C-\M-m" (function mime-preview-previous-line-entity))
778 (define-key mime-view-mode-map
779 "v" (function mime-preview-play-current-entity))
780 (define-key mime-view-mode-map
781 "e" (function mime-preview-extract-current-entity))
782 (define-key mime-view-mode-map
783 "\C-c\C-p" (function mime-preview-print-current-entity))
784 (define-key mime-view-mode-map
785 "a" (function mime-preview-follow-current-entity))
786 (define-key mime-view-mode-map
787 "q" (function mime-preview-quit))
788 (define-key mime-view-mode-map
789 "\C-c\C-x" (function mime-preview-kill-buffer))
790 ;; (define-key mime-view-mode-map
791 ;; "<" (function beginning-of-buffer))
792 ;; (define-key mime-view-mode-map
793 ;; ">" (function end-of-buffer))
794 (define-key mime-view-mode-map
795 "?" (function describe-mode))
796 (define-key mime-view-mode-map
797 [tab] (function mime-preview-move-to-next))
798 (define-key mime-view-mode-map
799 [delete] (function mime-preview-scroll-down-entity))
800 (define-key mime-view-mode-map
801 [backspace] (function mime-preview-scroll-down-entity))
802 (if (functionp default)
803 (cond (running-xemacs
804 (set-keymap-default-binding mime-view-mode-map default)
807 (setq mime-view-mode-map
808 (append mime-view-mode-map (list (cons t default))))
811 (define-key mime-view-mode-map
812 mouse-button-2 (function mime-button-dispatcher))
814 (cond (running-xemacs
815 (define-key mime-view-mode-map
816 mouse-button-3 (function mime-view-xemacs-popup-menu))
818 ((>= emacs-major-version 19)
819 (define-key mime-view-mode-map [menu-bar mime-view]
820 (cons mime-view-menu-title
821 (make-sparse-keymap mime-view-menu-title)))
824 (define-key mime-view-mode-map
825 (vector 'menu-bar 'mime-view (car item))
826 (cons (nth 1 item)(nth 2 item))
829 (reverse mime-view-menu-list)
832 (use-local-map mime-view-mode-map)
833 (run-hooks 'mime-view-define-keymap-hook)
836 (defsubst mime-maybe-hide-echo-buffer ()
837 "Clear mime-echo buffer and delete window for it."
838 (let ((buf (get-buffer mime-echo-buffer-name)))
843 (let ((win (get-buffer-window buf)))
850 (defvar mime-view-redisplay nil)
852 (defun mime-display-message (message &optional preview-buffer
853 mother default-keymap-or-function)
854 (mime-maybe-hide-echo-buffer)
855 (let ((win-conf (current-window-configuration))
856 (raw-buffer (mime-entity-buffer message)))
859 (concat "*Preview-" (buffer-name raw-buffer) "*")))
860 (set-buffer raw-buffer)
861 (setq mime-preview-buffer preview-buffer)
862 (let ((inhibit-read-only t))
863 (set-buffer (get-buffer-create preview-buffer))
866 (setq mime-raw-buffer raw-buffer)
868 (setq mime-mother-buffer mother)
870 (setq mime-preview-original-window-configuration win-conf)
871 (setq major-mode 'mime-view-mode)
872 (setq mode-name "MIME-View")
873 (mime-display-entity message nil
874 '((entity-button . invisible)
877 (mime-view-define-keymap default-keymap-or-function)
879 (next-single-property-change (point-min) 'mime-view-entity)))
882 (goto-char (point-min))
883 (search-forward "\n\n" nil t)
885 (run-hooks 'mime-view-mode-hook)
886 (set-buffer-modified-p nil)
887 (setq buffer-read-only t)
888 (or (get-buffer-window preview-buffer)
889 (let ((r-win (get-buffer-window raw-buffer)))
891 (set-window-buffer r-win preview-buffer)
892 (let ((m-win (and mother (get-buffer-window mother))))
894 (set-window-buffer m-win preview-buffer)
895 (switch-to-buffer preview-buffer)
899 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
900 default-keymap-or-function
902 "View RAW-BUFFER in MIME-View mode.
903 Optional argument PREVIEW-BUFFER is either nil or a name of preview
905 Optional argument DEFAULT-KEYMAP-OR-FUNCTION is nil, keymap or
906 function. If it is a keymap, keymap of MIME-View mode will be added
907 to it. If it is a function, it will be bound as default binding of
908 keymap of MIME-View mode.
909 Optional argument REPRESENTATION-TYPE is representation-type of
910 message. It must be nil, `binary' or `cooked'. If it is nil,
911 `binary' is used as default."
914 (setq raw-buffer (current-buffer)))
915 (or representation-type
916 (setq representation-type
918 (set-buffer raw-buffer)
919 (cdr (or (assq major-mode mime-raw-representation-type-alist)
920 (assq t mime-raw-representation-type-alist)))
922 (if (eq representation-type 'binary)
923 (setq representation-type 'buffer)
925 (mime-display-message
926 (mime-open-entity representation-type raw-buffer)
927 preview-buffer mother default-keymap-or-function))
929 (defun mime-view-mode (&optional mother ctl encoding
930 raw-buffer preview-buffer
931 default-keymap-or-function)
932 "Major mode for viewing MIME message.
934 Here is a list of the standard keys for mime-view-mode.
939 u Move to upper content
940 p or M-TAB Move to previous content
941 n or TAB Move to next content
942 SPC Scroll up or move to next content
943 M-SPC or DEL Scroll down or move to previous content
944 RET Move to next line
945 M-RET Move to previous line
946 v Decode current content as `play mode'
947 e Decode current content as `extract mode'
948 C-c C-p Decode current content as `print mode'
949 a Followup to current content.
951 button-2 Move to point under the mouse cursor
952 and decode current content as `play mode'
955 (unless mime-view-redisplay
957 (if raw-buffer (set-buffer raw-buffer))
960 (or (assq major-mode mime-raw-representation-type-alist)
961 (assq t mime-raw-representation-type-alist)))))
962 (if (eq type 'binary)
965 (setq mime-message-structure (mime-open-entity type raw-buffer))
966 (or (mime-entity-content-type mime-message-structure)
967 (mime-entity-set-content-type-internal
968 mime-message-structure ctl))
970 (or (mime-entity-encoding mime-message-structure)
971 (mime-entity-set-encoding-internal mime-message-structure encoding))
973 (mime-display-message mime-message-structure preview-buffer
974 mother default-keymap-or-function)
981 (autoload 'mime-preview-play-current-entity "mime-play"
982 "Play current entity." t)
984 (defun mime-preview-extract-current-entity (&optional ignore-examples)
985 "Extract current entity into file (maybe).
986 It decodes current entity to call internal or external method as
987 \"extract\" mode. The method is selected from variable
988 `mime-acting-condition'."
990 (mime-preview-play-current-entity ignore-examples "extract")
993 (defun mime-preview-print-current-entity (&optional ignore-examples)
994 "Print current entity (maybe).
995 It decodes current entity to call internal or external method as
996 \"print\" mode. The method is selected from variable
997 `mime-acting-condition'."
999 (mime-preview-play-current-entity ignore-examples "print")
1006 (defun mime-preview-follow-current-entity ()
1007 "Write follow message to current entity.
1008 It calls following-method selected from variable
1009 `mime-preview-following-method-alist'."
1012 (while (null (setq entity
1013 (get-text-property (point) 'mime-view-entity)))
1017 (previous-single-property-change (point) 'mime-view-entity))
1019 (entity-node-id (mime-entity-node-id entity))
1020 (len (length entity-node-id))
1024 (if (eq (next-single-property-change (point-min)
1030 ((eq (next-single-property-change p-beg 'mime-view-entity)
1032 (setq p-beg (point))
1034 (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1036 (setq p-end (point-max))
1038 ((null entity-node-id)
1039 (setq p-end (point-max))
1047 (next-single-property-change
1048 (point) 'mime-view-entity))
1050 (let ((rc (mime-entity-node-id
1051 (get-text-property (point)
1052 'mime-view-entity))))
1053 (or (equal entity-node-id
1054 (nthcdr (- (length rc) len) rc))
1059 (setq p-end (point-max))
1062 (let* ((mode (mime-preview-original-major-mode 'recursive))
1064 (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1066 (the-buf (current-buffer))
1067 (a-buf mime-raw-buffer)
1070 (set-buffer (setq new-buf (get-buffer-create new-name)))
1072 (insert-buffer-substring the-buf p-beg p-end)
1073 (goto-char (point-min))
1074 (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1081 (mime-find-entity-from-node-id entity-node-id))
1084 (mime-entity-point-min ci)
1085 (mime-entity-point-max ci)
1087 (std11-header-string-except
1089 (apply (function regexp-or) fields)
1092 (eq (mime-entity-media-type ci) 'message)
1093 (eq (mime-entity-media-subtype ci) 'rfc822))
1099 (setq fields (std11-collect-field-names)
1100 entity-node-id (cdr entity-node-id))
1103 (let ((rest mime-view-following-required-fields-list))
1105 (let ((field-name (car rest)))
1106 (or (std11-field-body field-name)
1112 (set-buffer the-buf)
1113 (set-buffer mime-mother-buffer)
1114 (set-buffer mime-raw-buffer)
1115 (std11-field-body field-name)
1119 (setq rest (cdr rest))
1121 (eword-decode-header)
1123 (let ((f (cdr (assq mode mime-preview-following-method-alist))))
1128 "Sorry, following method for %s is not implemented yet."
1137 (defun mime-preview-move-to-upper ()
1138 "Move to upper entity.
1139 If there is no upper entity, call function `mime-preview-quit'."
1142 (while (null (setq cinfo
1143 (get-text-property (point) 'mime-view-entity)))
1146 (let ((r (mime-entity-parent cinfo))
1149 (while (setq point (previous-single-property-change
1150 (point) 'mime-view-entity))
1152 (if (eq r (get-text-property (point) 'mime-view-entity))
1159 (defun mime-preview-move-to-previous ()
1160 "Move to previous entity.
1161 If there is no previous entity, it calls function registered in
1162 variable `mime-preview-over-to-previous-method-alist'."
1164 (while (null (get-text-property (point) 'mime-view-entity))
1167 (let ((point (previous-single-property-change (point) 'mime-view-entity)))
1169 (if (get-text-property (1- point) 'mime-view-entity)
1171 (goto-char (1- point))
1172 (mime-preview-move-to-previous)
1174 (let ((f (assq (mime-preview-original-major-mode)
1175 mime-preview-over-to-previous-method-alist)))
1181 (defun mime-preview-move-to-next ()
1182 "Move to next entity.
1183 If there is no previous entity, it calls function registered in
1184 variable `mime-preview-over-to-next-method-alist'."
1186 (while (null (get-text-property (point) 'mime-view-entity))
1189 (let ((point (next-single-property-change (point) 'mime-view-entity)))
1193 (if (null (get-text-property point 'mime-view-entity))
1194 (mime-preview-move-to-next)
1196 (let ((f (assq (mime-preview-original-major-mode)
1197 mime-preview-over-to-next-method-alist)))
1203 (defun mime-preview-scroll-up-entity (&optional h)
1204 "Scroll up current entity.
1205 If reached to (point-max), it calls function registered in variable
1206 `mime-preview-over-to-next-method-alist'."
1209 (setq h (1- (window-height)))
1211 (if (= (point) (point-max))
1212 (let ((f (assq (mime-preview-original-major-mode)
1213 mime-preview-over-to-next-method-alist)))
1218 (or (next-single-property-change (point) 'mime-view-entity)
1221 (if (> (point) point)
1226 (defun mime-preview-scroll-down-entity (&optional h)
1227 "Scroll down current entity.
1228 If reached to (point-min), it calls function registered in variable
1229 `mime-preview-over-to-previous-method-alist'."
1232 (setq h (1- (window-height)))
1234 (if (= (point) (point-min))
1235 (let ((f (assq (mime-preview-original-major-mode)
1236 mime-preview-over-to-previous-method-alist)))
1241 (or (previous-single-property-change (point) 'mime-view-entity)
1243 (forward-line (- h))
1244 (if (< (point) point)
1248 (defun mime-preview-next-line-entity ()
1250 (mime-preview-scroll-up-entity 1)
1253 (defun mime-preview-previous-line-entity ()
1255 (mime-preview-scroll-down-entity 1)
1262 (defun mime-preview-quit ()
1263 "Quit from MIME-preview buffer.
1264 It calls function registered in variable
1265 `mime-preview-quitting-method-alist'."
1267 (let ((r (assq (mime-preview-original-major-mode)
1268 mime-preview-quitting-method-alist)))
1273 (defun mime-preview-kill-buffer ()
1275 (kill-buffer (current-buffer))
1282 (provide 'mime-view)
1284 (run-hooks 'mime-view-load-hook)
1286 ;;; mime-view.el ends here