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.
32 (require 'eword-decode)
41 (defconst mime-view-version-string
42 `,(concat (car mime-module-version) " MIME-View "
43 (mapconcat #'number-to-string (cddr mime-module-version) ".")
44 " (" (cadr mime-module-version) ")"))
50 (defgroup mime-view nil
54 (defcustom mime-view-find-every-acting-situation nil
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 ;;; @ buffer local variables
71 (defvar mime-raw-message-info
72 "Information about structure of message.
73 Please use reference function `mime-entity-SLOT' to get value of SLOT.
75 Following is a list of slots of the structure:
77 node-id reversed entity-number (list of integers)
78 point-min beginning point of region in raw-buffer
79 point-max end point of region in raw-buffer
80 type media-type (symbol)
81 subtype media-subtype (symbol)
82 type/subtype media-type/subtype (string or nil)
83 parameters parameter of Content-Type field (association list)
84 encoding Content-Transfer-Encoding (string or nil)
85 children entities included in this entity (list of content-infos)
87 If an entity includes other entities in its body, such as multipart or
88 message/rfc822, `mime-entity' structures of them are included in
89 `children', so the `mime-entity' structure become a tree.")
90 (make-variable-buffer-local 'mime-raw-message-info)
92 (defvar mime-preview-buffer nil
93 "MIME-preview buffer corresponding with the (raw) buffer.")
94 (make-variable-buffer-local 'mime-preview-buffer)
97 ;;; @@ in preview-buffer
100 (defvar mime-mother-buffer nil
101 "Mother buffer corresponding with the (MIME-preview) buffer.
102 If current MIME-preview buffer is generated by other buffer, such as
103 message/partial, it is called `mother-buffer'.")
104 (make-variable-buffer-local 'mime-mother-buffer)
106 (defvar mime-raw-buffer nil
107 "Raw buffer corresponding with the (MIME-preview) buffer.")
108 (make-variable-buffer-local 'mime-raw-buffer)
110 (defvar mime-preview-original-major-mode nil
111 "Major-mode of mime-raw-buffer.")
112 (make-variable-buffer-local 'mime-preview-original-major-mode)
114 (defvar mime-preview-original-window-configuration nil
115 "Window-configuration before mime-view-mode is called.")
116 (make-variable-buffer-local 'mime-preview-original-window-configuration)
119 ;;; @ entity information
122 (defsubst mime-raw-find-entity-from-node-id (entity-node-id
123 &optional message-info)
124 "Return entity from ENTITY-NODE-ID in mime-raw-buffer.
125 If optional argument MESSAGE-INFO is not specified,
126 `mime-raw-message-info' is used."
127 (mime-raw-find-entity-from-number (reverse entity-node-id) message-info))
129 (defun mime-raw-find-entity-from-number (entity-number &optional message-info)
130 "Return entity from ENTITY-NUMBER in mime-raw-buffer.
131 If optional argument MESSAGE-INFO is not specified,
132 `mime-raw-message-info' is used."
134 (setq message-info mime-raw-message-info))
135 (if (eq entity-number t)
137 (let ((sn (car entity-number)))
140 (let ((rc (nth sn (mime-entity-children message-info))))
142 (mime-raw-find-entity-from-number (cdr entity-number) rc)
146 (defun mime-raw-find-entity-from-point (point &optional message-info)
147 "Return entity from POINT in mime-raw-buffer.
148 If optional argument MESSAGE-INFO is not specified,
149 `mime-raw-message-info' is used."
151 (setq message-info mime-raw-message-info))
152 (if (and (<= (mime-entity-point-min message-info) point)
153 (<= point (mime-entity-point-max message-info)))
154 (let ((children (mime-entity-children message-info)))
158 (mime-raw-find-entity-from-point point (car children))))
162 (setq children (cdr children)))
165 (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
166 "Return entity-node-id from POINT in mime-raw-buffer.
167 If optional argument MESSAGE-INFO is not specified,
168 `mime-raw-message-info' is used."
169 (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
171 (defsubst mime-raw-point-to-entity-number (point &optional message-info)
172 "Return entity-number from POINT in mime-raw-buffer.
173 If optional argument MESSAGE-INFO is not specified,
174 `mime-raw-message-info' is used."
175 (reverse (mime-raw-point-to-entity-node-id point message-info)))
177 (defsubst mime-raw-entity-parent (entity &optional message-info)
178 "Return mother entity of ENTITY.
179 If optional argument MESSAGE-INFO is not specified,
180 `mime-raw-message-info' is used."
181 (mime-raw-find-entity-from-node-id (cdr (mime-entity-node-id entity))
184 (defun mime-raw-flatten-message-info (&optional message-info)
185 "Return list of entity in mime-raw-buffer.
186 If optional argument MESSAGE-INFO is not specified,
187 `mime-raw-message-info' is used."
189 (setq message-info mime-raw-message-info))
190 (let ((dest (list message-info))
191 (rcl (mime-entity-children message-info)))
193 (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
194 (setq rcl (cdr rcl)))
198 ;;; @ presentation of preview
204 ;;; @@@ predicate function
207 (defun mime-view-entity-button-visible-p (entity message-info)
208 "Return non-nil if header of ENTITY is visible.
209 Please redefine this function if you want to change default setting."
210 (let ((media-type (mime-entity-media-type entity))
211 (media-subtype (mime-entity-media-subtype entity)))
212 (or (not (eq media-type 'application))
213 (and (not (eq media-subtype 'x-selection))
214 (or (not (eq media-subtype 'octet-stream))
216 (mime-raw-entity-parent entity message-info)))
217 (or (not (eq (mime-entity-media-type mother-entity)
219 (not (eq (mime-entity-media-subtype mother-entity)
224 ;;; @@@ entity button generator
227 (defun mime-view-insert-entity-button (entity message-info subj)
228 "Insert entity-button of ENTITY."
229 (let ((entity-node-id (mime-entity-node-id entity))
230 (params (mime-entity-parameters entity)))
232 (let ((access-type (assoc "access-type" params))
233 (num (or (cdr (assoc "x-part-number" params))
234 (if (consp entity-node-id)
237 (format "%s" (1+ num))
239 (reverse entity-node-id) ".")
243 (let ((server (assoc "server" params)))
244 (setq access-type (cdr access-type))
246 (format "%s %s ([%s] %s)"
247 num subj access-type (cdr server))
248 (let ((site (cdr (assoc "site" params)))
249 (dir (cdr (assoc "directory" params)))
251 (format "%s %s ([%s] %s:%s)"
252 num subj access-type site dir)
256 (let ((media-type (mime-entity-media-type entity))
257 (media-subtype (mime-entity-media-subtype entity))
258 (charset (cdr (assoc "charset" params)))
259 (encoding (mime-entity-encoding entity)))
263 (format " <%s/%s%s%s>"
264 media-type media-subtype
266 (concat "; " charset)
269 (concat " (" encoding ")")
271 (if (>= (+ (current-column)(length rest))(window-width))
275 (function mime-preview-play-current-entity))
282 ;;; @@@ predicate function
285 ;; (defvar mime-view-childrens-header-showing-Content-Type-list
286 ;; '("message/rfc822" "message/news"))
288 ;; (defun mime-view-header-visible-p (entity message-info)
289 ;; "Return non-nil if header of ENTITY is visible."
290 ;; (let ((entity-node-id (mime-entity-node-id entity)))
291 ;; (member (mime-entity-type/subtype
292 ;; (mime-raw-find-entity-from-node-id
293 ;; (cdr entity-node-id) message-info))
294 ;; mime-view-childrens-header-showing-Content-Type-list)
297 ;;; @@@ entity header filter
300 (defvar mime-view-content-header-filter-alist nil)
302 (defun mime-view-default-content-header-filter ()
303 (mime-view-cut-header)
304 (eword-decode-header)
307 ;;; @@@ entity field cutter
310 (defvar mime-view-ignored-field-list
311 '(".*Received" ".*Path" ".*Id" "References"
312 "Replied" "Errors-To"
313 "Lines" "Sender" ".*Host" "Xref"
314 "Content-Type" "Precedence"
316 "All fields that match this list will be hidden in MIME preview buffer.
317 Each elements are regexp of field-name.")
319 (defvar mime-view-ignored-field-regexp
321 (apply (function regexp-or) mime-view-ignored-field-list)
324 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
325 "All fields that match this list will be displayed in MIME preview buffer.
326 Each elements are regexp of field-name.")
328 (defun mime-view-cut-header ()
329 (goto-char (point-min))
330 (while (re-search-forward mime-view-ignored-field-regexp nil t)
331 (let* ((beg (match-beginning 0))
333 (name (buffer-substring beg end))
336 (let ((rest mime-view-visible-field-list))
338 (if (string-match (car rest) name)
341 (setq rest (cdr rest))))
344 (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
353 ;;; @@@ predicate function
356 (defun mime-calist::field-match-method-as-default-rule (calist
357 field-type field-value)
358 (let ((s-field (assq field-type calist)))
359 (cond ((null s-field)
360 (cons (cons field-type field-value) calist)
364 (define-calist-field-match-method
365 'header #'mime-calist::field-match-method-as-default-rule)
367 (define-calist-field-match-method
368 'body #'mime-calist::field-match-method-as-default-rule)
371 (defvar mime-preview-condition nil
372 "Condition-tree about how to display entity.")
374 (ctree-set-calist-strictly
375 'mime-preview-condition '((type . application)(subtype . octet-stream)
378 (ctree-set-calist-strictly
379 'mime-preview-condition '((type . application)(subtype . octet-stream)
382 (ctree-set-calist-strictly
383 'mime-preview-condition '((type . application)(subtype . octet-stream)
387 (ctree-set-calist-strictly
388 'mime-preview-condition '((type . application)(subtype . pgp)
391 (ctree-set-calist-strictly
392 'mime-preview-condition '((type . application)(subtype . x-latex)
395 (ctree-set-calist-strictly
396 'mime-preview-condition '((type . application)(subtype . x-selection)
399 (ctree-set-calist-strictly
400 'mime-preview-condition '((type . application)(subtype . x-comment)
403 (ctree-set-calist-strictly
404 'mime-preview-condition '((type . message)(subtype . delivery-status)
407 (ctree-set-calist-strictly
408 'mime-preview-condition '((body . visible)
409 (body-presentation-method . with-filter)
410 (body-filter . mime-preview-filter-for-text/plain)))
412 (ctree-set-calist-strictly
413 'mime-preview-condition '((type . nil)
415 (body-presentation-method . with-filter)
416 (body-filter . mime-preview-filter-for-text/plain)))
418 (ctree-set-calist-strictly
419 'mime-preview-condition '((type . text)(subtype . enriched)
421 (body-presentation-method . with-filter)
423 . mime-preview-filter-for-text/enriched)))
425 (ctree-set-calist-strictly
426 'mime-preview-condition '((type . text)(subtype . richtext)
428 (body-presentation-method . with-filter)
430 . mime-preview-filter-for-text/richtext)))
432 (ctree-set-calist-strictly
433 'mime-preview-condition '((type . text)(subtype . t)
435 (body-presentation-method . with-filter)
436 (body-filter . mime-preview-filter-for-text/plain)))
438 (ctree-set-calist-strictly
439 'mime-preview-condition '((type . message)(subtype . partial)
440 (body-presentation-method
441 . mime-view-insert-message/partial-button)))
443 (ctree-set-calist-strictly
444 'mime-preview-condition '((type . message)(subtype . rfc822)
445 (body-presentation-method . nil)
446 (childrens-situation (header . visible)
447 (entity-button . invisible))))
449 (ctree-set-calist-strictly
450 'mime-preview-condition '((type . message)(subtype . news)
451 (body-presentation-method . nil)
452 (childrens-situation (header . visible)
453 (entity-button . invisible))))
456 ;;; @@@ entity filter
459 (autoload 'mime-preview-filter-for-text/plain "mime-text")
460 (autoload 'mime-preview-filter-for-text/enriched "mime-text")
461 (autoload 'mime-preview-filter-for-text/richtext "mime-text")
463 (defvar mime-text-decoder-alist
464 '((mime-show-message-mode . mime-text-decode-buffer)
465 (mime-temp-message-mode . mime-text-decode-buffer)
466 (t . mime-text-decode-buffer-maybe)
468 "Alist of major-mode vs. mime-text-decoder.
469 Each element looks like (SYMBOL . FUNCTION). SYMBOL is major-mode or
472 Specification of FUNCTION is described in DOC-string of variable
475 This value is overridden by buffer local variable `mime-text-decoder'
479 (defvar mime-view-announcement-for-message/partial
480 (if (and (>= emacs-major-version 19) window-system)
482 \[[ This is message/partial style split message. ]]
483 \[[ Please press `v' key in this buffer ]]
484 \[[ or click here by mouse button-2. ]]"
486 \[[ This is message/partial style split message. ]]
487 \[[ Please press `v' key in this buffer. ]]"
490 (defun mime-view-insert-message/partial-button (&optional situation)
492 (goto-char (point-max))
493 (if (not (search-backward "\n\n" nil t))
496 (goto-char (point-max))
497 (narrow-to-region (point-max)(point-max))
498 (insert mime-view-announcement-for-message/partial)
499 (mime-add-button (point-min)(point-max)
500 #'mime-preview-play-current-entity)
504 ;;; @ acting-condition
507 (defvar mime-acting-condition nil
508 "Condition-tree about how to process entity.")
510 (ctree-set-calist-strictly
511 'mime-acting-condition
512 '((type . t)(subtype . t)(mode . "play")
513 (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
515 (ctree-set-calist-strictly
516 'mime-acting-condition
517 '((type . t)(subtype . t)(mode . "extract")
518 (method . mime-method-to-save)))
520 (ctree-set-calist-strictly
521 'mime-acting-condition
522 '((type . text)(subtype . plain)(mode . "play")
523 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
525 (ctree-set-calist-strictly
526 'mime-acting-condition
527 '((type . text)(subtype . plain)(mode . "print")
528 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
530 (ctree-set-calist-strictly
531 'mime-acting-condition
532 '((type . text)(subtype . html)(mode . "play")
533 (method "tm-html" nil 'file "" 'encoding 'mode 'name)
535 (ctree-set-calist-strictly
536 'mime-acting-condition
537 '((type . text)(subtype . x-rot13-47)(mode . "play")
538 (method . mime-method-to-display-caesar)
540 (ctree-set-calist-strictly
541 'mime-acting-condition
542 '((type . text)(subtype . x-rot13-47-48)(mode . "play")
543 (method . mime-method-to-display-caesar)
546 (ctree-set-calist-strictly
547 'mime-acting-condition
548 '((type . audio)(subtype . basic)(mode . "play")
549 (method "tm-au" nil 'file "" 'encoding 'mode 'name)
552 (ctree-set-calist-strictly
553 'mime-acting-condition
554 '((type . image)(mode . "play")
555 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
557 (ctree-set-calist-strictly
558 'mime-acting-condition
559 '((type . image)(mode . "print")
560 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
563 (ctree-set-calist-strictly
564 'mime-acting-condition
565 '((type . video)(subtype . mpeg)(mode . "play")
566 (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
569 (ctree-set-calist-strictly
570 'mime-acting-condition
571 '((type . application)(subtype . postscript)(mode . "play")
572 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
574 (ctree-set-calist-strictly
575 'mime-acting-condition
576 '((type . application)(subtype . postscript)(mode . "print")
577 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
580 (ctree-set-calist-strictly
581 'mime-acting-condition
582 '((type . message)(subtype . rfc822)(mode . "play")
583 (method . mime-method-to-display-message/rfc822)
585 (ctree-set-calist-strictly
586 'mime-acting-condition
587 '((type . message)(subtype . partial)(mode . "play")
588 (method . mime-method-to-store-message/partial)
591 (ctree-set-calist-strictly
592 'mime-acting-condition
593 '((type . message)(subtype . external-body)
594 ("access-type" . "anon-ftp")
595 (method . mime-method-to-display-message/external-ftp)
598 (ctree-set-calist-strictly
599 'mime-acting-condition
600 '((type . application)(subtype . octet-stream)
601 (method . mime-method-to-save)
605 ;;; @ quitting method
608 (defvar mime-preview-quitting-method-alist
609 '((mime-show-message-mode
610 . mime-preview-quitting-method-for-mime-show-message-mode))
611 "Alist of major-mode vs. quitting-method of mime-view.")
613 (defvar mime-view-over-to-previous-method-alist nil)
614 (defvar mime-view-over-to-next-method-alist nil)
616 (defvar mime-view-show-summary-method nil
617 "Alist of major-mode vs. show-summary-method.")
620 ;;; @ following method
623 (defvar mime-view-following-method-alist nil
624 "Alist of major-mode vs. following-method of mime-view.")
626 (defvar mime-view-following-required-fields-list
633 ;; hack from Gnus 5.0.4.
635 (defvar mime-view-x-face-to-pbm-command
636 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
638 (defvar mime-view-x-face-command
639 (concat mime-view-x-face-to-pbm-command
641 "String to be executed to display an X-Face field.
642 The command will be executed in a sub-shell asynchronously.
643 The compressed face will be piped to this command.")
645 (defun mime-view-x-face-function ()
646 "Function to display X-Face field. You can redefine to customize."
647 ;; 1995/10/12 (c.f. tm-eng:130)
648 ;; fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
650 (narrow-to-region (point-min) (re-search-forward "^$" nil t))
652 (goto-char (point-min))
653 (if (re-search-forward "^X-Face:[ \t]*" nil t)
654 (let ((beg (match-end 0))
655 (end (std11-field-end))
657 (call-process-region beg end "sh" nil 0 nil
658 "-c" mime-view-x-face-command)
665 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
667 (defvar mime-raw-buffer-coding-system-alist
668 `((t . ,(mime-charset-to-coding-system default-mime-charset)))
669 "Alist of major-mode vs. corresponding coding-system of `mime-raw-buffer'.")
675 (defvar mime-view-redisplay nil)
677 (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
683 (or mime-view-redisplay
684 (setq mime-raw-message-info (mime-parse-message ctl encoding))
686 (let ((message-info mime-raw-message-info)
687 (the-buf (current-buffer))
690 (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
691 (set-buffer (get-buffer-create obuf))
692 (let ((inhibit-read-only t))
693 ;;(setq buffer-read-only nil)
696 (setq mime-raw-buffer the-buf)
697 (setq mime-preview-original-major-mode mode)
698 (setq major-mode 'mime-view-mode)
699 (setq mode-name "MIME-View")
700 (mime-view-display-message message-info the-buf obuf)
701 (set-buffer-modified-p nil)
703 (setq buffer-read-only t)
706 (setq mime-preview-buffer obuf)
709 (defun mime-view-display-message (message-info ibuf obuf)
710 (let* ((start (mime-entity-point-min message-info))
711 (end (mime-entity-point-max message-info))
712 (media-type (mime-entity-media-type message-info))
713 (media-subtype (mime-entity-media-subtype message-info))
714 (params (mime-entity-parameters message-info))
715 (encoding (mime-entity-encoding message-info))
716 end-of-header e nb ne subj)
719 (setq end-of-header (if (re-search-forward "^$" nil t)
722 (if (> end-of-header end)
723 (setq end-of-header end)
726 (narrow-to-region start end)
729 (mime-raw-get-subject params encoding)))
733 (narrow-to-region nb nb)
734 ;; Insert message-header
736 (narrow-to-region (point)(point))
737 (insert-buffer-substring mime-raw-buffer start end-of-header)
738 (let ((f (cdr (assq mime-preview-original-major-mode
739 mime-view-content-header-filter-alist))))
742 (mime-view-default-content-header-filter)
744 (run-hooks 'mime-view-content-header-filter-hook)
747 (ctree-match-calist mime-preview-condition
748 (list* (cons 'type media-type)
749 (cons 'subtype media-subtype)
750 (cons 'encoding encoding)
751 (cons 'major-mode major-mode)
754 (cdr (assq 'message-button situation)))
755 (body-presentation-method
756 (cdr (assq 'body-presentation-method situation))))
757 (when (eq message-button 'visible)
758 (goto-char (point-max))
759 (mime-view-insert-entity-button message-info message-info subj)
761 (cond ((eq body-presentation-method 'with-filter)
762 (let ((body-filter (cdr (assq 'body-filter situation))))
764 (narrow-to-region (point-max)(point-max))
765 (insert-buffer-substring mime-raw-buffer end-of-header end)
766 (funcall body-filter situation)
768 ((functionp body-presentation-method)
769 (funcall body-presentation-method situation)
771 ((null (mime-entity-children message-info))
772 (goto-char (point-max))
773 (mime-view-insert-entity-button message-info message-info subj)
775 (setq ne (point-max))
777 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
778 (put-text-property nb ne 'mime-view-entity message-info)
780 (let ((children (mime-entity-children message-info))
782 (cdr (assq 'childrens-situation situation))))
784 (mime-view-display-entity (car children) message-info ibuf obuf
786 (setq children (cdr children))
789 (defun mime-view-display-entity (entity message-info ibuf obuf
791 (let* ((start (mime-entity-point-min entity))
792 (end (mime-entity-point-max entity))
793 (media-type (mime-entity-media-type entity))
794 (media-subtype (mime-entity-media-subtype entity))
795 (params (mime-entity-parameters entity))
796 (encoding (mime-entity-encoding entity))
797 end-of-header e nb ne subj)
800 (setq end-of-header (if (re-search-forward "^$" nil t)
803 (if (> end-of-header end)
804 (setq end-of-header end)
807 (narrow-to-region start end)
810 (mime-raw-get-subject params encoding)))
813 (ctree-match-calist mime-preview-condition
814 (list* (cons 'type media-type)
815 (cons 'subtype media-subtype)
816 (cons 'encoding encoding)
817 (cons 'major-mode major-mode)
819 default-situation))))
821 (eq (cdr (assq 'entity-button situation)) 'invisible))
823 (eq (cdr (assq 'header situation)) 'visible))
824 (body-presentation-method
825 (cdr (assq 'body-presentation-method situation))))
828 (narrow-to-region nb nb)
829 (or button-is-invisible
830 (if (mime-view-entity-button-visible-p entity message-info)
831 (mime-view-insert-entity-button entity message-info subj)
833 (if header-is-visible
835 (narrow-to-region (point)(point))
836 (insert-buffer-substring mime-raw-buffer start end-of-header)
837 (let ((f (cdr (assq mime-preview-original-major-mode
838 mime-view-content-header-filter-alist))))
841 (mime-view-default-content-header-filter)
843 (run-hooks 'mime-view-content-header-filter-hook)
845 (cond ((eq body-presentation-method 'with-filter)
846 (let ((body-filter (cdr (assq 'body-filter situation))))
848 (narrow-to-region (point-max)(point-max))
849 (insert-buffer-substring mime-raw-buffer end-of-header end)
850 (funcall body-filter situation)
852 ((functionp body-presentation-method)
853 (funcall body-presentation-method situation)
855 (or header-is-visible
856 body-presentation-method
858 (goto-char (point-max))
861 (setq ne (point-max))
863 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
864 (put-text-property nb ne 'mime-view-entity entity)
866 (let ((children (mime-entity-children entity))
868 (cdr (assq 'childrens-situation situation))))
870 (mime-view-display-entity (car children) message-info ibuf obuf
872 (setq children (cdr children))
875 (defun mime-raw-get-uu-filename (param &optional encoding)
876 (if (member (or encoding
877 (cdr (assq 'encoding param))
879 mime-view-uuencode-encoding-name-list)
881 (or (if (re-search-forward "^begin [0-9]+ " nil t)
882 (if (looking-at ".+$")
883 (buffer-substring (match-beginning 0)(match-end 0))
888 (defun mime-raw-get-subject (param &optional encoding)
889 (or (std11-find-field-body '("Content-Description" "Subject"))
891 (if (or (and (setq ret (mime/Content-Disposition))
892 (setq ret (assoc "filename" (cdr ret)))
894 (setq ret (assoc "name" param))
895 (setq ret (assoc "x-name" param))
897 (std11-strip-quoted-string (cdr ret))
899 (mime-raw-get-uu-filename param encoding)
903 ;;; @ MIME viewer mode
906 (defconst mime-view-menu-title "MIME-View")
907 (defconst mime-view-menu-list
908 '((up "Move to upper entity" mime-preview-move-to-upper)
909 (previous "Move to previous entity" mime-preview-move-to-previous)
910 (next "Move to next entity" mime-preview-move-to-next)
911 (scroll-down "Scroll-down" mime-preview-scroll-down-entity)
912 (scroll-up "Scroll-up" mime-preview-scroll-up-entity)
913 (play "Play current entity" mime-preview-play-current-entity)
914 (extract "Extract current entity" mime-preview-extract-current-entity)
915 (print "Print current entity" mime-preview-print-current-entity)
916 (x-face "Show X Face" mime-preview-display-x-face)
918 "Menu for MIME Viewer")
920 (cond (running-xemacs
921 (defvar mime-view-xemacs-popup-menu
922 (cons mime-view-menu-title
925 (vector (nth 1 item)(nth 2 item) t)
927 mime-view-menu-list)))
928 (defun mime-view-xemacs-popup-menu (event)
929 "Popup the menu in the MIME Viewer buffer"
931 (select-window (event-window event))
932 (set-buffer (event-buffer event))
933 (popup-menu 'mime-view-xemacs-popup-menu))
934 (defvar mouse-button-2 'button2)
937 (defvar mouse-button-2 [mouse-2])
940 (defun mime-view-define-keymap (&optional default)
941 (let ((mime-view-mode-map (if (keymapp default)
942 (copy-keymap default)
945 (define-key mime-view-mode-map
946 "u" (function mime-preview-move-to-upper))
947 (define-key mime-view-mode-map
948 "p" (function mime-preview-move-to-previous))
949 (define-key mime-view-mode-map
950 "n" (function mime-preview-move-to-next))
951 (define-key mime-view-mode-map
952 "\e\t" (function mime-preview-move-to-previous))
953 (define-key mime-view-mode-map
954 "\t" (function mime-preview-move-to-next))
955 (define-key mime-view-mode-map
956 " " (function mime-preview-scroll-up-entity))
957 (define-key mime-view-mode-map
958 "\M- " (function mime-preview-scroll-down-entity))
959 (define-key mime-view-mode-map
960 "\177" (function mime-preview-scroll-down-entity))
961 (define-key mime-view-mode-map
962 "\C-m" (function mime-preview-next-line-entity))
963 (define-key mime-view-mode-map
964 "\C-\M-m" (function mime-preview-previous-line-entity))
965 (define-key mime-view-mode-map
966 "v" (function mime-preview-play-current-entity))
967 (define-key mime-view-mode-map
968 "e" (function mime-preview-extract-current-entity))
969 (define-key mime-view-mode-map
970 "\C-c\C-p" (function mime-preview-print-current-entity))
971 (define-key mime-view-mode-map
972 "a" (function mime-preview-follow-current-entity))
973 (define-key mime-view-mode-map
974 "q" (function mime-preview-quit))
975 (define-key mime-view-mode-map
976 "h" (function mime-preview-show-summary))
977 (define-key mime-view-mode-map
978 "\C-c\C-x" (function mime-preview-kill-buffer))
979 ;; (define-key mime-view-mode-map
980 ;; "<" (function beginning-of-buffer))
981 ;; (define-key mime-view-mode-map
982 ;; ">" (function end-of-buffer))
983 (define-key mime-view-mode-map
984 "?" (function describe-mode))
985 (define-key mime-view-mode-map
986 [tab] (function mime-preview-move-to-next))
987 (define-key mime-view-mode-map
988 [delete] (function mime-preview-scroll-down-entity))
989 (define-key mime-view-mode-map
990 [backspace] (function mime-preview-scroll-down-entity))
991 (if (functionp default)
992 (cond (running-xemacs
993 (set-keymap-default-binding mime-view-mode-map default)
996 (setq mime-view-mode-map
997 (append mime-view-mode-map (list (cons t default))))
1000 (define-key mime-view-mode-map
1001 mouse-button-2 (function mime-button-dispatcher))
1003 (cond (running-xemacs
1004 (define-key mime-view-mode-map
1005 mouse-button-3 (function mime-view-xemacs-popup-menu))
1007 ((>= emacs-major-version 19)
1008 (define-key mime-view-mode-map [menu-bar mime-view]
1009 (cons mime-view-menu-title
1010 (make-sparse-keymap mime-view-menu-title)))
1013 (define-key mime-view-mode-map
1014 (vector 'menu-bar 'mime-view (car item))
1015 (cons (nth 1 item)(nth 2 item))
1018 (reverse mime-view-menu-list)
1021 (use-local-map mime-view-mode-map)
1022 (run-hooks 'mime-view-define-keymap-hook)
1025 (defsubst mime-maybe-hide-echo-buffer ()
1026 "Clear mime-echo buffer and delete window for it."
1027 (let ((buf (get-buffer mime-echo-buffer-name)))
1032 (let ((win (get-buffer-window buf)))
1039 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
1040 default-keymap-or-function)
1041 "Major mode for viewing MIME message.
1043 Here is a list of the standard keys for mime-view-mode.
1048 u Move to upper content
1049 p or M-TAB Move to previous content
1050 n or TAB Move to next content
1051 SPC Scroll up or move to next content
1052 M-SPC or DEL Scroll down or move to previous content
1053 RET Move to next line
1054 M-RET Move to previous line
1055 v Decode current content as `play mode'
1056 e Decode current content as `extract mode'
1057 C-c C-p Decode current content as `print mode'
1058 a Followup to current content.
1061 button-2 Move to point under the mouse cursor
1062 and decode current content as `play mode'
1065 (mime-maybe-hide-echo-buffer)
1066 (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
1067 (win-conf (current-window-configuration))
1070 (switch-to-buffer ret)
1071 (setq mime-preview-original-window-configuration win-conf)
1074 (setq mime-mother-buffer mother)
1076 (mime-view-define-keymap default-keymap-or-function)
1078 (next-single-property-change (point-min) 'mime-view-entity)))
1081 (goto-char (point-min))
1082 (search-forward "\n\n" nil t)
1084 (run-hooks 'mime-view-mode-hook)
1091 (autoload 'mime-preview-play-current-entity "mime-play"
1092 "Play current entity." t)
1094 (defun mime-preview-extract-current-entity ()
1095 "Extract current entity into file (maybe).
1096 It decodes current entity to call internal or external method as
1097 \"extract\" mode. The method is selected from variable
1098 `mime-acting-condition'."
1100 (mime-preview-play-current-entity "extract")
1103 (defun mime-preview-print-current-entity ()
1104 "Print current entity (maybe).
1105 It decodes current entity to call internal or external method as
1106 \"print\" mode. The method is selected from variable
1107 `mime-acting-condition'."
1109 (mime-preview-play-current-entity "print")
1116 (defun mime-preview-original-major-mode ()
1117 "Return major-mode of original buffer.
1118 If a current buffer has mime-mother-buffer, return original major-mode
1119 of the mother-buffer."
1120 (if mime-mother-buffer
1122 (set-buffer mime-mother-buffer)
1123 (mime-preview-original-major-mode)
1125 mime-preview-original-major-mode))
1127 (defun mime-preview-follow-current-entity ()
1128 "Write follow message to current entity.
1129 It calls following-method selected from variable
1130 `mime-view-following-method-alist'."
1133 (while (null (setq entity
1134 (get-text-property (point) 'mime-view-entity)))
1138 (previous-single-property-change (point) 'mime-view-entity))
1140 (entity-node-id (mime-entity-node-id entity))
1141 (len (length entity-node-id))
1145 (if (eq (next-single-property-change (point-min)
1151 ((eq (next-single-property-change p-beg 'mime-view-entity)
1153 (setq p-beg (point))
1155 (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1157 (setq p-end (point-max))
1159 ((null entity-node-id)
1160 (setq p-end (point-max))
1168 (next-single-property-change
1169 (point) 'mime-view-entity))
1171 (let ((rc (mime-entity-node-id
1172 (get-text-property (point)
1173 'mime-view-entity))))
1174 (or (equal entity-node-id
1175 (nthcdr (- (length rc) len) rc))
1180 (setq p-end (point-max))
1183 (let* ((mode (mime-preview-original-major-mode))
1185 (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1187 (the-buf (current-buffer))
1188 (a-buf mime-raw-buffer)
1191 (set-buffer (setq new-buf (get-buffer-create new-name)))
1193 (insert-buffer-substring the-buf p-beg p-end)
1194 (goto-char (point-min))
1195 (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1203 (mime-raw-find-entity-from-node-id entity-node-id))
1206 (mime-entity-point-min ci)
1207 (mime-entity-point-max ci)
1209 (std11-header-string-except
1211 (apply (function regexp-or) fields)
1214 (eq (mime-entity-media-type ci) 'message)
1215 (eq (mime-entity-media-subtype ci) 'rfc822))
1221 (setq fields (std11-collect-field-names)
1222 entity-node-id (cdr entity-node-id))
1225 (let ((rest mime-view-following-required-fields-list))
1227 (let ((field-name (car rest)))
1228 (or (std11-field-body field-name)
1234 (set-buffer the-buf)
1235 (set-buffer mime-mother-buffer)
1236 (set-buffer mime-raw-buffer)
1237 (std11-field-body field-name)
1241 (setq rest (cdr rest))
1243 (eword-decode-header)
1245 (let ((f (cdr (assq mode mime-view-following-method-alist))))
1250 "Sorry, following method for %s is not implemented yet."
1259 (defun mime-preview-display-x-face ()
1261 (save-window-excursion
1262 (set-buffer mime-raw-buffer)
1263 (mime-view-x-face-function)
1270 (defun mime-preview-move-to-upper ()
1271 "Move to upper entity.
1272 If there is no upper entity, call function `mime-preview-quit'."
1275 (while (null (setq cinfo
1276 (get-text-property (point) 'mime-view-entity)))
1279 (let ((r (mime-raw-find-entity-from-node-id
1280 (cdr (mime-entity-node-id cinfo))
1281 (get-text-property 1 'mime-view-entity)))
1284 (while (setq point (previous-single-property-change
1285 (point) 'mime-view-entity))
1287 (if (eq r (get-text-property (point) 'mime-view-entity))
1294 (defun mime-preview-move-to-previous ()
1295 "Move to previous entity.
1296 If there is no previous entity, it calls function registered in
1297 variable `mime-view-over-to-previous-method-alist'."
1299 (while (null (get-text-property (point) 'mime-view-entity))
1303 (previous-single-property-change (point) 'mime-view-entity)))
1306 (let ((f (assq mime-preview-original-major-mode
1307 mime-view-over-to-previous-method-alist)))
1313 (defun mime-preview-move-to-next ()
1314 "Move to next entity.
1315 If there is no previous entity, it calls function registered in
1316 variable `mime-view-over-to-next-method-alist'."
1318 (let ((point (next-single-property-change (point) 'mime-view-entity)))
1321 (let ((f (assq mime-preview-original-major-mode
1322 mime-view-over-to-next-method-alist)))
1328 (defun mime-preview-scroll-up-entity (&optional h)
1329 "Scroll up current entity.
1330 If reached to (point-max), it calls function registered in variable
1331 `mime-view-over-to-next-method-alist'."
1334 (setq h (1- (window-height)))
1336 (if (= (point) (point-max))
1337 (let ((f (assq mime-preview-original-major-mode
1338 mime-view-over-to-next-method-alist)))
1343 (or (next-single-property-change (point) 'mime-view-entity)
1346 (if (> (point) point)
1351 (defun mime-preview-scroll-down-entity (&optional h)
1352 "Scroll down current entity.
1353 If reached to (point-min), it calls function registered in variable
1354 `mime-view-over-to-previous-method-alist'."
1357 (setq h (1- (window-height)))
1359 (if (= (point) (point-min))
1360 (let ((f (assq mime-preview-original-major-mode
1361 mime-view-over-to-previous-method-alist)))
1368 (while (> (point) 1)
1370 (previous-single-property-change (point)
1376 (setq point (point-min))
1378 (forward-line (- h))
1379 (if (< (point) point)
1383 (defun mime-preview-next-line-entity ()
1385 (mime-preview-scroll-up-entity 1)
1388 (defun mime-preview-previous-line-entity ()
1390 (mime-preview-scroll-down-entity 1)
1397 (defun mime-preview-quit ()
1398 "Quit from MIME-preview buffer.
1399 It calls function registered in variable
1400 `mime-preview-quitting-method-alist'."
1402 (let ((r (assq mime-preview-original-major-mode
1403 mime-preview-quitting-method-alist)))
1408 (defun mime-preview-show-summary ()
1410 It calls function registered in variable
1411 `mime-view-show-summary-method'."
1413 (let ((r (assq mime-preview-original-major-mode
1414 mime-view-show-summary-method)))
1419 (defun mime-preview-kill-buffer ()
1421 (kill-buffer (current-buffer))
1428 (provide 'mime-view)
1430 (run-hooks 'mime-view-load-hook)
1432 ;;; mime-view.el ends here