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."
60 ;;; @ buffer local variables
66 (defvar mime-raw-message-info
67 "Information about structure of message.
68 Please use reference function `mime-entity-SLOT' to get value of SLOT.
70 Following is a list of slots of the structure:
72 node-id reversed entity-number (list of integers)
73 point-min beginning point of region in raw-buffer
74 point-max end point of region in raw-buffer
75 type media-type (symbol)
76 subtype media-subtype (symbol)
77 type/subtype media-type/subtype (string or nil)
78 parameters parameter of Content-Type field (association list)
79 encoding Content-Transfer-Encoding (string or nil)
80 children entities included in this entity (list of content-infos)
82 If an entity includes other entities in its body, such as multipart or
83 message/rfc822, `mime-entity' structures of them are included in
84 `children', so the `mime-entity' structure become a tree.")
85 (make-variable-buffer-local 'mime-raw-message-info)
87 (defvar mime-preview-buffer nil
88 "MIME-preview buffer corresponding with the (raw) buffer.")
89 (make-variable-buffer-local 'mime-preview-buffer)
92 ;;; @@ in preview-buffer
95 (defvar mime-mother-buffer nil
96 "Mother buffer corresponding with the (MIME-preview) buffer.
97 If current MIME-preview buffer is generated by other buffer, such as
98 message/partial, it is called `mother-buffer'.")
99 (make-variable-buffer-local 'mime-mother-buffer)
101 (defvar mime-raw-buffer nil
102 "Raw buffer corresponding with the (MIME-preview) buffer.")
103 (make-variable-buffer-local 'mime-raw-buffer)
105 (defvar mime-preview-original-major-mode nil
106 "Major-mode of mime-raw-buffer.")
107 (make-variable-buffer-local 'mime-preview-original-major-mode)
109 (defvar mime-preview-original-window-configuration nil
110 "Window-configuration before mime-view-mode is called.")
111 (make-variable-buffer-local 'mime-preview-original-window-configuration)
114 ;;; @ entity information
117 (defsubst mime-raw-find-entity-from-node-id (entity-node-id
118 &optional message-info)
119 "Return entity from ENTITY-NODE-ID in mime-raw-buffer.
120 If optional argument MESSAGE-INFO is not specified,
121 `mime-raw-message-info' is used."
122 (mime-raw-find-entity-from-number (reverse entity-node-id) message-info))
124 (defun mime-raw-find-entity-from-number (entity-number &optional message-info)
125 "Return entity from ENTITY-NUMBER in mime-raw-buffer.
126 If optional argument MESSAGE-INFO is not specified,
127 `mime-raw-message-info' is used."
129 (setq message-info mime-raw-message-info))
130 (if (eq entity-number t)
132 (let ((sn (car entity-number)))
135 (let ((rc (nth sn (mime-entity-children message-info))))
137 (mime-raw-find-entity-from-number (cdr entity-number) rc)
141 (defun mime-raw-find-entity-from-point (point &optional message-info)
142 "Return entity from POINT in mime-raw-buffer.
143 If optional argument MESSAGE-INFO is not specified,
144 `mime-raw-message-info' is used."
146 (setq message-info mime-raw-message-info))
147 (if (and (<= (mime-entity-point-min message-info) point)
148 (<= point (mime-entity-point-max message-info)))
149 (let ((children (mime-entity-children message-info)))
153 (mime-raw-find-entity-from-point point (car children))))
157 (setq children (cdr children)))
160 (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
161 "Return entity-node-id from POINT in mime-raw-buffer.
162 If optional argument MESSAGE-INFO is not specified,
163 `mime-raw-message-info' is used."
164 (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
166 (defsubst mime-raw-point-to-entity-number (point &optional message-info)
167 "Return entity-number from POINT in mime-raw-buffer.
168 If optional argument MESSAGE-INFO is not specified,
169 `mime-raw-message-info' is used."
170 (reverse (mime-raw-point-to-entity-node-id point message-info)))
172 (defsubst mime-raw-entity-parent (entity &optional message-info)
173 "Return mother entity of ENTITY.
174 If optional argument MESSAGE-INFO is not specified,
175 `mime-raw-message-info' is used."
176 (mime-raw-find-entity-from-node-id (cdr (mime-entity-node-id entity))
179 (defun mime-raw-flatten-message-info (&optional message-info)
180 "Return list of entity in mime-raw-buffer.
181 If optional argument MESSAGE-INFO is not specified,
182 `mime-raw-message-info' is used."
184 (setq message-info mime-raw-message-info))
185 (let ((dest (list message-info))
186 (rcl (mime-entity-children message-info)))
188 (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
189 (setq rcl (cdr rcl)))
193 ;;; @ presentation of preview
199 ;;; @@@ predicate function
202 (defun mime-view-entity-button-visible-p (entity message-info)
203 "Return non-nil if header of ENTITY is visible.
204 Please redefine this function if you want to change default setting."
205 (let ((media-type (mime-entity-media-type entity))
206 (media-subtype (mime-entity-media-subtype entity)))
207 (or (not (eq media-type 'application))
208 (and (not (eq media-subtype 'x-selection))
209 (or (not (eq media-subtype 'octet-stream))
211 (mime-raw-entity-parent entity message-info)))
212 (or (not (eq (mime-entity-media-type mother-entity)
214 (not (eq (mime-entity-media-subtype mother-entity)
219 ;;; @@@ entity button generator
222 (defun mime-view-insert-entity-button (entity message-info subj)
223 "Insert entity-button of ENTITY."
224 (let ((entity-node-id (mime-entity-node-id entity))
225 (params (mime-entity-parameters entity)))
227 (let ((access-type (assoc "access-type" params))
228 (num (or (cdr (assoc "x-part-number" params))
229 (if (consp entity-node-id)
232 (format "%s" (1+ num))
234 (reverse entity-node-id) ".")
238 (let ((server (assoc "server" params)))
239 (setq access-type (cdr access-type))
241 (format "%s %s ([%s] %s)"
242 num subj access-type (cdr server))
243 (let ((site (cdr (assoc "site" params)))
244 (dir (cdr (assoc "directory" params)))
246 (format "%s %s ([%s] %s:%s)"
247 num subj access-type site dir)
251 (let ((media-type (mime-entity-media-type entity))
252 (media-subtype (mime-entity-media-subtype entity))
253 (charset (cdr (assoc "charset" params)))
254 (encoding (mime-entity-encoding entity)))
258 (format " <%s/%s%s%s>"
259 media-type media-subtype
261 (concat "; " charset)
264 (concat " (" encoding ")")
266 (if (>= (+ (current-column)(length rest))(window-width))
270 (function mime-preview-play-current-entity))
277 ;;; @@@ predicate function
280 ;; (defvar mime-view-childrens-header-showing-Content-Type-list
281 ;; '("message/rfc822" "message/news"))
283 ;; (defun mime-view-header-visible-p (entity message-info)
284 ;; "Return non-nil if header of ENTITY is visible."
285 ;; (let ((entity-node-id (mime-entity-node-id entity)))
286 ;; (member (mime-entity-type/subtype
287 ;; (mime-raw-find-entity-from-node-id
288 ;; (cdr entity-node-id) message-info))
289 ;; mime-view-childrens-header-showing-Content-Type-list)
292 ;;; @@@ entity header filter
295 (defvar mime-view-content-header-filter-alist nil)
297 (defun mime-view-default-content-header-filter ()
298 (mime-view-cut-header)
299 (eword-decode-header)
302 ;;; @@@ entity field cutter
305 (defvar mime-view-ignored-field-list
306 '(".*Received" ".*Path" ".*Id" "References"
307 "Replied" "Errors-To"
308 "Lines" "Sender" ".*Host" "Xref"
309 "Content-Type" "Precedence"
311 "All fields that match this list will be hidden in MIME preview buffer.
312 Each elements are regexp of field-name.")
314 (defvar mime-view-ignored-field-regexp
316 (apply (function regexp-or) mime-view-ignored-field-list)
319 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
320 "All fields that match this list will be displayed in MIME preview buffer.
321 Each elements are regexp of field-name.")
323 (defun mime-view-cut-header ()
324 (goto-char (point-min))
325 (while (re-search-forward mime-view-ignored-field-regexp nil t)
326 (let* ((beg (match-beginning 0))
328 (name (buffer-substring beg end))
331 (let ((rest mime-view-visible-field-list))
333 (if (string-match (car rest) name)
336 (setq rest (cdr rest))))
339 (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
348 ;;; @@@ predicate function
351 (defun mime-calist::field-match-method-as-default-rule (calist
352 field-type field-value)
353 (let ((s-field (assq field-type calist)))
354 (cond ((null s-field)
355 (cons (cons field-type field-value) calist)
359 (define-calist-field-match-method
360 'header #'mime-calist::field-match-method-as-default-rule)
362 (define-calist-field-match-method
363 'body #'mime-calist::field-match-method-as-default-rule)
366 (defvar mime-preview-condition nil
367 "Condition-tree about how to display entity.")
369 (ctree-set-calist-strictly
370 'mime-preview-condition '((type . application)(subtype . octet-stream)
373 (ctree-set-calist-strictly
374 'mime-preview-condition '((type . application)(subtype . octet-stream)
377 (ctree-set-calist-strictly
378 'mime-preview-condition '((type . application)(subtype . octet-stream)
382 (ctree-set-calist-strictly
383 'mime-preview-condition '((type . application)(subtype . pgp)
386 (ctree-set-calist-strictly
387 'mime-preview-condition '((type . application)(subtype . x-latex)
390 (ctree-set-calist-strictly
391 'mime-preview-condition '((type . application)(subtype . x-selection)
394 (ctree-set-calist-strictly
395 'mime-preview-condition '((type . application)(subtype . x-comment)
398 (ctree-set-calist-strictly
399 'mime-preview-condition '((type . message)(subtype . delivery-status)
402 (ctree-set-calist-strictly
403 'mime-preview-condition '((body . visible)
404 (body-presentation-method . with-filter)
405 (body-filter . mime-preview-filter-for-text/plain)))
407 (ctree-set-calist-strictly
408 'mime-preview-condition '((type . nil)
410 (body-presentation-method . with-filter)
411 (body-filter . mime-preview-filter-for-text/plain)))
413 (ctree-set-calist-strictly
414 'mime-preview-condition '((type . text)(subtype . enriched)
416 (body-presentation-method . with-filter)
418 . mime-preview-filter-for-text/enriched)))
420 (ctree-set-calist-strictly
421 'mime-preview-condition '((type . text)(subtype . richtext)
423 (body-presentation-method . with-filter)
425 . mime-preview-filter-for-text/richtext)))
427 (ctree-set-calist-strictly
428 'mime-preview-condition '((type . text)(subtype . t)
430 (body-presentation-method . with-filter)
431 (body-filter . mime-preview-filter-for-text/plain)))
433 (ctree-set-calist-strictly
434 'mime-preview-condition '((type . message)(subtype . partial)
435 (body-presentation-method
436 . mime-view-insert-message/partial-button)))
438 (ctree-set-calist-strictly
439 'mime-preview-condition '((type . message)(subtype . rfc822)
440 (body-presentation-method . nil)
441 (childrens-situation (header . visible)
442 (entity-button . invisible))))
444 (ctree-set-calist-strictly
445 'mime-preview-condition '((type . message)(subtype . news)
446 (body-presentation-method . nil)
447 (childrens-situation (header . visible)
448 (entity-button . invisible))))
451 ;;; @@@ entity filter
454 (autoload 'mime-preview-filter-for-text/plain "mime-text")
455 (autoload 'mime-preview-filter-for-text/enriched "mime-text")
456 (autoload 'mime-preview-filter-for-text/richtext "mime-text")
458 (defvar mime-text-decoder-alist
459 '((mime-show-message-mode . mime-text-decode-buffer)
460 (mime-temp-message-mode . mime-text-decode-buffer)
461 (t . mime-text-decode-buffer-maybe)
463 "Alist of major-mode vs. mime-text-decoder.
464 Each element looks like (SYMBOL . FUNCTION). SYMBOL is major-mode or
467 Specification of FUNCTION is described in DOC-string of variable
470 This value is overridden by buffer local variable `mime-text-decoder'
474 (defvar mime-view-announcement-for-message/partial
475 (if (and (>= emacs-major-version 19) window-system)
477 \[[ This is message/partial style split message. ]]
478 \[[ Please press `v' key in this buffer ]]
479 \[[ or click here by mouse button-2. ]]"
481 \[[ This is message/partial style split message. ]]
482 \[[ Please press `v' key in this buffer. ]]"
485 (defun mime-view-insert-message/partial-button (&optional situation)
487 (goto-char (point-max))
488 (if (not (search-backward "\n\n" nil t))
491 (goto-char (point-max))
492 (narrow-to-region (point-max)(point-max))
493 (insert mime-view-announcement-for-message/partial)
494 (mime-add-button (point-min)(point-max)
495 #'mime-preview-play-current-entity)
499 ;;; @ acting-condition
502 (defvar mime-acting-condition nil
503 "Condition-tree about how to process entity.")
505 (ctree-set-calist-strictly
506 'mime-acting-condition
507 '((type . t)(subtype . t)(mode . "play")
508 (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
510 (ctree-set-calist-strictly
511 'mime-acting-condition
512 '((type . t)(subtype . t)(mode . "extract")
513 (method . mime-method-to-save)))
515 (ctree-set-calist-strictly
516 'mime-acting-condition
517 '((type . text)(subtype . plain)(mode . "play")
518 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
520 (ctree-set-calist-strictly
521 'mime-acting-condition
522 '((type . text)(subtype . plain)(mode . "print")
523 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
525 (ctree-set-calist-strictly
526 'mime-acting-condition
527 '((type . text)(subtype . html)(mode . "play")
528 (method "tm-html" nil 'file "" 'encoding 'mode 'name)
530 (ctree-set-calist-strictly
531 'mime-acting-condition
532 '((type . text)(subtype . x-rot13-47)(mode . "play")
533 (method . mime-method-to-display-caesar)
535 (ctree-set-calist-strictly
536 'mime-acting-condition
537 '((type . text)(subtype . x-rot13-47-48)(mode . "play")
538 (method . mime-method-to-display-caesar)
541 (ctree-set-calist-strictly
542 'mime-acting-condition
543 '((type . audio)(subtype . basic)(mode . "play")
544 (method "tm-au" nil 'file "" 'encoding 'mode 'name)
547 (ctree-set-calist-strictly
548 'mime-acting-condition
549 '((type . image)(mode . "play")
550 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
552 (ctree-set-calist-strictly
553 'mime-acting-condition
554 '((type . image)(mode . "print")
555 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
558 (ctree-set-calist-strictly
559 'mime-acting-condition
560 '((type . video)(subtype . mpeg)(mode . "play")
561 (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
564 (ctree-set-calist-strictly
565 'mime-acting-condition
566 '((type . application)(subtype . postscript)(mode . "play")
567 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
569 (ctree-set-calist-strictly
570 'mime-acting-condition
571 '((type . application)(subtype . postscript)(mode . "print")
572 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
575 (ctree-set-calist-strictly
576 'mime-acting-condition
577 '((type . message)(subtype . rfc822)(mode . "play")
578 (method . mime-method-to-display-message/rfc822)
580 (ctree-set-calist-strictly
581 'mime-acting-condition
582 '((type . message)(subtype . partial)(mode . "play")
583 (method . mime-method-to-store-message/partial)
586 (ctree-set-calist-strictly
587 'mime-acting-condition
588 '((type . message)(subtype . external-body)
589 ("access-type" . "anon-ftp")
590 (method . mime-method-to-display-message/external-ftp)
593 (ctree-set-calist-strictly
594 'mime-acting-condition
595 '((type . application)(subtype . octet-stream)
596 (method . mime-method-to-save)
600 ;;; @ quitting method
603 (defvar mime-preview-quitting-method-alist
604 '((mime-show-message-mode
605 . mime-preview-quitting-method-for-mime-show-message-mode))
606 "Alist of major-mode vs. quitting-method of mime-view.")
608 (defvar mime-view-over-to-previous-method-alist nil)
609 (defvar mime-view-over-to-next-method-alist nil)
611 (defvar mime-view-show-summary-method nil
612 "Alist of major-mode vs. show-summary-method.")
615 ;;; @ following method
618 (defvar mime-view-following-method-alist nil
619 "Alist of major-mode vs. following-method of mime-view.")
621 (defvar mime-view-following-required-fields-list
628 ;; hack from Gnus 5.0.4.
630 (defvar mime-view-x-face-to-pbm-command
631 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
633 (defvar mime-view-x-face-command
634 (concat mime-view-x-face-to-pbm-command
636 "String to be executed to display an X-Face field.
637 The command will be executed in a sub-shell asynchronously.
638 The compressed face will be piped to this command.")
640 (defun mime-view-x-face-function ()
641 "Function to display X-Face field. You can redefine to customize."
642 ;; 1995/10/12 (c.f. tm-eng:130)
643 ;; fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
645 (narrow-to-region (point-min) (re-search-forward "^$" nil t))
647 (goto-char (point-min))
648 (if (re-search-forward "^X-Face:[ \t]*" nil t)
649 (let ((beg (match-end 0))
650 (end (std11-field-end))
652 (call-process-region beg end "sh" nil 0 nil
653 "-c" mime-view-x-face-command)
660 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
662 (defvar mime-raw-buffer-coding-system-alist
663 `((t . ,(mime-charset-to-coding-system default-mime-charset)))
664 "Alist of major-mode vs. corresponding coding-system of `mime-raw-buffer'.")
670 (defvar mime-view-redisplay nil)
672 (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
678 (or mime-view-redisplay
679 (setq mime-raw-message-info (mime-parse-message ctl encoding))
681 (let ((message-info mime-raw-message-info)
682 (the-buf (current-buffer))
685 (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
686 (set-buffer (get-buffer-create obuf))
687 (let ((inhibit-read-only t))
688 ;;(setq buffer-read-only nil)
691 (setq mime-raw-buffer the-buf)
692 (setq mime-preview-original-major-mode mode)
693 (setq major-mode 'mime-view-mode)
694 (setq mode-name "MIME-View")
695 (mime-view-display-message message-info the-buf obuf)
696 (set-buffer-modified-p nil)
698 (setq buffer-read-only t)
701 (setq mime-preview-buffer obuf)
704 (defun mime-view-display-message (message-info ibuf obuf)
705 (let* ((start (mime-entity-point-min message-info))
706 (end (mime-entity-point-max message-info))
707 (media-type (mime-entity-media-type message-info))
708 (media-subtype (mime-entity-media-subtype message-info))
709 (params (mime-entity-parameters message-info))
710 (encoding (mime-entity-encoding message-info))
711 end-of-header e nb ne subj)
714 (setq end-of-header (if (re-search-forward "^$" nil t)
717 (if (> end-of-header end)
718 (setq end-of-header end)
721 (narrow-to-region start end)
724 (mime-raw-get-subject params encoding)))
728 (narrow-to-region nb nb)
729 ;; Insert message-header
731 (narrow-to-region (point)(point))
732 (insert-buffer-substring mime-raw-buffer start end-of-header)
733 (let ((f (cdr (assq mime-preview-original-major-mode
734 mime-view-content-header-filter-alist))))
737 (mime-view-default-content-header-filter)
739 (run-hooks 'mime-view-content-header-filter-hook)
742 (ctree-match-calist mime-preview-condition
743 (list* (cons 'type media-type)
744 (cons 'subtype media-subtype)
745 (cons 'encoding encoding)
746 (cons 'major-mode major-mode)
749 (cdr (assq 'message-button situation)))
750 (body-presentation-method
751 (cdr (assq 'body-presentation-method situation))))
752 (when (eq message-button 'visible)
753 (goto-char (point-max))
754 (mime-view-insert-entity-button message-info message-info subj)
756 (cond ((eq body-presentation-method 'with-filter)
757 (let ((body-filter (cdr (assq 'body-filter situation))))
759 (narrow-to-region (point-max)(point-max))
760 (insert-buffer-substring mime-raw-buffer end-of-header end)
761 (funcall body-filter situation)
763 ((functionp body-presentation-method)
764 (funcall body-presentation-method situation)
766 ((null (mime-entity-children message-info))
767 (goto-char (point-max))
768 (mime-view-insert-entity-button message-info message-info subj)
770 (setq ne (point-max))
772 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
773 (put-text-property nb ne 'mime-view-entity message-info)
775 (let ((children (mime-entity-children message-info))
777 (cdr (assq 'childrens-situation situation))))
779 (mime-view-display-entity (car children) message-info ibuf obuf
781 (setq children (cdr children))
784 (defun mime-view-display-entity (entity message-info ibuf obuf
786 (let* ((start (mime-entity-point-min entity))
787 (end (mime-entity-point-max entity))
788 (media-type (mime-entity-media-type entity))
789 (media-subtype (mime-entity-media-subtype entity))
790 (params (mime-entity-parameters entity))
791 (encoding (mime-entity-encoding entity))
792 end-of-header e nb ne subj)
795 (setq end-of-header (if (re-search-forward "^$" nil t)
798 (if (> end-of-header end)
799 (setq end-of-header end)
802 (narrow-to-region start end)
805 (mime-raw-get-subject params encoding)))
808 (ctree-match-calist mime-preview-condition
809 (list* (cons 'type media-type)
810 (cons 'subtype media-subtype)
811 (cons 'encoding encoding)
812 (cons 'major-mode major-mode)
814 default-situation))))
816 (eq (cdr (assq 'entity-button situation)) 'invisible))
818 (eq (cdr (assq 'header situation)) 'visible))
819 (body-presentation-method
820 (cdr (assq 'body-presentation-method situation))))
823 (narrow-to-region nb nb)
824 (or button-is-invisible
825 (if (mime-view-entity-button-visible-p entity message-info)
826 (mime-view-insert-entity-button entity message-info subj)
828 (if header-is-visible
830 (narrow-to-region (point)(point))
831 (insert-buffer-substring mime-raw-buffer start end-of-header)
832 (let ((f (cdr (assq mime-preview-original-major-mode
833 mime-view-content-header-filter-alist))))
836 (mime-view-default-content-header-filter)
838 (run-hooks 'mime-view-content-header-filter-hook)
840 (cond ((eq body-presentation-method 'with-filter)
841 (let ((body-filter (cdr (assq 'body-filter situation))))
843 (narrow-to-region (point-max)(point-max))
844 (insert-buffer-substring mime-raw-buffer end-of-header end)
845 (funcall body-filter situation)
847 ((functionp body-presentation-method)
848 (funcall body-presentation-method situation)
850 (or header-is-visible
851 body-presentation-method
853 (goto-char (point-max))
856 (setq ne (point-max))
858 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
859 (put-text-property nb ne 'mime-view-entity entity)
861 (let ((children (mime-entity-children entity))
863 (cdr (assq 'childrens-situation situation))))
865 (mime-view-display-entity (car children) message-info ibuf obuf
867 (setq children (cdr children))
870 (defun mime-raw-get-uu-filename (param &optional encoding)
871 (if (member (or encoding
872 (cdr (assq 'encoding param))
874 mime-view-uuencode-encoding-name-list)
876 (or (if (re-search-forward "^begin [0-9]+ " nil t)
877 (if (looking-at ".+$")
878 (buffer-substring (match-beginning 0)(match-end 0))
883 (defun mime-raw-get-subject (param &optional encoding)
884 (or (std11-find-field-body '("Content-Description" "Subject"))
886 (if (or (and (setq ret (mime/Content-Disposition))
887 (setq ret (assoc "filename" (cdr ret)))
889 (setq ret (assoc "name" param))
890 (setq ret (assoc "x-name" param))
892 (std11-strip-quoted-string (cdr ret))
894 (mime-raw-get-uu-filename param encoding)
898 ;;; @ MIME viewer mode
901 (defconst mime-view-menu-title "MIME-View")
902 (defconst mime-view-menu-list
903 '((up "Move to upper entity" mime-preview-move-to-upper)
904 (previous "Move to previous entity" mime-preview-move-to-previous)
905 (next "Move to next entity" mime-preview-move-to-next)
906 (scroll-down "Scroll-down" mime-preview-scroll-down-entity)
907 (scroll-up "Scroll-up" mime-preview-scroll-up-entity)
908 (play "Play current entity" mime-preview-play-current-entity)
909 (extract "Extract current entity" mime-preview-extract-current-entity)
910 (print "Print current entity" mime-preview-print-current-entity)
911 (x-face "Show X Face" mime-preview-display-x-face)
913 "Menu for MIME Viewer")
915 (cond (running-xemacs
916 (defvar mime-view-xemacs-popup-menu
917 (cons mime-view-menu-title
920 (vector (nth 1 item)(nth 2 item) t)
922 mime-view-menu-list)))
923 (defun mime-view-xemacs-popup-menu (event)
924 "Popup the menu in the MIME Viewer buffer"
926 (select-window (event-window event))
927 (set-buffer (event-buffer event))
928 (popup-menu 'mime-view-xemacs-popup-menu))
929 (defvar mouse-button-2 'button2)
932 (defvar mouse-button-2 [mouse-2])
935 (defun mime-view-define-keymap (&optional default)
936 (let ((mime-view-mode-map (if (keymapp default)
937 (copy-keymap default)
940 (define-key mime-view-mode-map
941 "u" (function mime-preview-move-to-upper))
942 (define-key mime-view-mode-map
943 "p" (function mime-preview-move-to-previous))
944 (define-key mime-view-mode-map
945 "n" (function mime-preview-move-to-next))
946 (define-key mime-view-mode-map
947 "\e\t" (function mime-preview-move-to-previous))
948 (define-key mime-view-mode-map
949 "\t" (function mime-preview-move-to-next))
950 (define-key mime-view-mode-map
951 " " (function mime-preview-scroll-up-entity))
952 (define-key mime-view-mode-map
953 "\M- " (function mime-preview-scroll-down-entity))
954 (define-key mime-view-mode-map
955 "\177" (function mime-preview-scroll-down-entity))
956 (define-key mime-view-mode-map
957 "\C-m" (function mime-preview-next-line-entity))
958 (define-key mime-view-mode-map
959 "\C-\M-m" (function mime-preview-previous-line-entity))
960 (define-key mime-view-mode-map
961 "v" (function mime-preview-play-current-entity))
962 (define-key mime-view-mode-map
963 "e" (function mime-preview-extract-current-entity))
964 (define-key mime-view-mode-map
965 "\C-c\C-p" (function mime-preview-print-current-entity))
966 (define-key mime-view-mode-map
967 "a" (function mime-preview-follow-current-entity))
968 (define-key mime-view-mode-map
969 "q" (function mime-preview-quit))
970 (define-key mime-view-mode-map
971 "h" (function mime-preview-show-summary))
972 (define-key mime-view-mode-map
973 "\C-c\C-x" (function mime-preview-kill-buffer))
974 ;; (define-key mime-view-mode-map
975 ;; "<" (function beginning-of-buffer))
976 ;; (define-key mime-view-mode-map
977 ;; ">" (function end-of-buffer))
978 (define-key mime-view-mode-map
979 "?" (function describe-mode))
980 (define-key mime-view-mode-map
981 [tab] (function mime-preview-move-to-next))
982 (define-key mime-view-mode-map
983 [delete] (function mime-preview-scroll-down-entity))
984 (define-key mime-view-mode-map
985 [backspace] (function mime-preview-scroll-down-entity))
986 (if (functionp default)
987 (cond (running-xemacs
988 (set-keymap-default-binding mime-view-mode-map default)
991 (setq mime-view-mode-map
992 (append mime-view-mode-map (list (cons t default))))
995 (define-key mime-view-mode-map
996 mouse-button-2 (function mime-button-dispatcher))
998 (cond (running-xemacs
999 (define-key mime-view-mode-map
1000 mouse-button-3 (function mime-view-xemacs-popup-menu))
1002 ((>= emacs-major-version 19)
1003 (define-key mime-view-mode-map [menu-bar mime-view]
1004 (cons mime-view-menu-title
1005 (make-sparse-keymap mime-view-menu-title)))
1008 (define-key mime-view-mode-map
1009 (vector 'menu-bar 'mime-view (car item))
1010 (cons (nth 1 item)(nth 2 item))
1013 (reverse mime-view-menu-list)
1016 (use-local-map mime-view-mode-map)
1017 (run-hooks 'mime-view-define-keymap-hook)
1020 (defsubst mime-maybe-hide-echo-buffer ()
1021 "Clear mime-echo buffer and delete window for it."
1022 (let ((buf (get-buffer mime-echo-buffer-name)))
1027 (let ((win (get-buffer-window buf)))
1034 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
1035 default-keymap-or-function)
1036 "Major mode for viewing MIME message.
1038 Here is a list of the standard keys for mime-view-mode.
1043 u Move to upper content
1044 p or M-TAB Move to previous content
1045 n or TAB Move to next content
1046 SPC Scroll up or move to next content
1047 M-SPC or DEL Scroll down or move to previous content
1048 RET Move to next line
1049 M-RET Move to previous line
1050 v Decode current content as `play mode'
1051 e Decode current content as `extract mode'
1052 C-c C-p Decode current content as `print mode'
1053 a Followup to current content.
1056 button-2 Move to point under the mouse cursor
1057 and decode current content as `play mode'
1060 (mime-maybe-hide-echo-buffer)
1061 (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
1062 (win-conf (current-window-configuration))
1065 (switch-to-buffer ret)
1066 (setq mime-preview-original-window-configuration win-conf)
1069 (setq mime-mother-buffer mother)
1071 (mime-view-define-keymap default-keymap-or-function)
1073 (next-single-property-change (point-min) 'mime-view-entity)))
1076 (goto-char (point-min))
1077 (search-forward "\n\n" nil t)
1079 (run-hooks 'mime-view-mode-hook)
1086 (autoload 'mime-preview-play-current-entity "mime-play"
1087 "Play current entity." t)
1089 (defun mime-preview-extract-current-entity ()
1090 "Extract current entity into file (maybe).
1091 It decodes current entity to call internal or external method as
1092 \"extract\" mode. The method is selected from variable
1093 `mime-acting-condition'."
1095 (mime-preview-play-current-entity "extract")
1098 (defun mime-preview-print-current-entity ()
1099 "Print current entity (maybe).
1100 It decodes current entity to call internal or external method as
1101 \"print\" mode. The method is selected from variable
1102 `mime-acting-condition'."
1104 (mime-preview-play-current-entity "print")
1111 (defun mime-preview-original-major-mode ()
1112 "Return major-mode of original buffer.
1113 If a current buffer has mime-mother-buffer, return original major-mode
1114 of the mother-buffer."
1115 (if mime-mother-buffer
1117 (set-buffer mime-mother-buffer)
1118 (mime-preview-original-major-mode)
1120 mime-preview-original-major-mode))
1122 (defun mime-preview-follow-current-entity ()
1123 "Write follow message to current entity.
1124 It calls following-method selected from variable
1125 `mime-view-following-method-alist'."
1128 (while (null (setq entity
1129 (get-text-property (point) 'mime-view-entity)))
1133 (previous-single-property-change (point) 'mime-view-entity))
1135 (entity-node-id (mime-entity-node-id entity))
1136 (len (length entity-node-id))
1140 (if (eq (next-single-property-change (point-min)
1146 ((eq (next-single-property-change p-beg 'mime-view-entity)
1148 (setq p-beg (point))
1150 (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1152 (setq p-end (point-max))
1154 ((null entity-node-id)
1155 (setq p-end (point-max))
1163 (next-single-property-change
1164 (point) 'mime-view-entity))
1166 (let ((rc (mime-entity-node-id
1167 (get-text-property (point)
1168 'mime-view-entity))))
1169 (or (equal entity-node-id
1170 (nthcdr (- (length rc) len) rc))
1175 (setq p-end (point-max))
1178 (let* ((mode (mime-preview-original-major-mode))
1180 (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1182 (the-buf (current-buffer))
1183 (a-buf mime-raw-buffer)
1186 (set-buffer (setq new-buf (get-buffer-create new-name)))
1188 (insert-buffer-substring the-buf p-beg p-end)
1189 (goto-char (point-min))
1190 (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1198 (mime-raw-find-entity-from-node-id entity-node-id))
1201 (mime-entity-point-min ci)
1202 (mime-entity-point-max ci)
1204 (std11-header-string-except
1206 (apply (function regexp-or) fields)
1209 (eq (mime-entity-media-type ci) 'message)
1210 (eq (mime-entity-media-subtype ci) 'rfc822))
1216 (setq fields (std11-collect-field-names)
1217 entity-node-id (cdr entity-node-id))
1220 (let ((rest mime-view-following-required-fields-list))
1222 (let ((field-name (car rest)))
1223 (or (std11-field-body field-name)
1229 (set-buffer the-buf)
1230 (set-buffer mime-mother-buffer)
1231 (set-buffer mime-raw-buffer)
1232 (std11-field-body field-name)
1236 (setq rest (cdr rest))
1238 (eword-decode-header)
1240 (let ((f (cdr (assq mode mime-view-following-method-alist))))
1245 "Sorry, following method for %s is not implemented yet."
1254 (defun mime-preview-display-x-face ()
1256 (save-window-excursion
1257 (set-buffer mime-raw-buffer)
1258 (mime-view-x-face-function)
1265 (defun mime-preview-move-to-upper ()
1266 "Move to upper entity.
1267 If there is no upper entity, call function `mime-preview-quit'."
1270 (while (null (setq cinfo
1271 (get-text-property (point) 'mime-view-entity)))
1274 (let ((r (mime-raw-find-entity-from-node-id
1275 (cdr (mime-entity-node-id cinfo))
1276 (get-text-property 1 'mime-view-entity)))
1279 (while (setq point (previous-single-property-change
1280 (point) 'mime-view-entity))
1282 (if (eq r (get-text-property (point) 'mime-view-entity))
1289 (defun mime-preview-move-to-previous ()
1290 "Move to previous entity.
1291 If there is no previous entity, it calls function registered in
1292 variable `mime-view-over-to-previous-method-alist'."
1294 (while (null (get-text-property (point) 'mime-view-entity))
1298 (previous-single-property-change (point) 'mime-view-entity)))
1301 (let ((f (assq mime-preview-original-major-mode
1302 mime-view-over-to-previous-method-alist)))
1308 (defun mime-preview-move-to-next ()
1309 "Move to next entity.
1310 If there is no previous entity, it calls function registered in
1311 variable `mime-view-over-to-next-method-alist'."
1313 (let ((point (next-single-property-change (point) 'mime-view-entity)))
1316 (let ((f (assq mime-preview-original-major-mode
1317 mime-view-over-to-next-method-alist)))
1323 (defun mime-preview-scroll-up-entity (&optional h)
1324 "Scroll up current entity.
1325 If reached to (point-max), it calls function registered in variable
1326 `mime-view-over-to-next-method-alist'."
1329 (setq h (1- (window-height)))
1331 (if (= (point) (point-max))
1332 (let ((f (assq mime-preview-original-major-mode
1333 mime-view-over-to-next-method-alist)))
1338 (or (next-single-property-change (point) 'mime-view-entity)
1341 (if (> (point) point)
1346 (defun mime-preview-scroll-down-entity (&optional h)
1347 "Scroll down current entity.
1348 If reached to (point-min), it calls function registered in variable
1349 `mime-view-over-to-previous-method-alist'."
1352 (setq h (1- (window-height)))
1354 (if (= (point) (point-min))
1355 (let ((f (assq mime-preview-original-major-mode
1356 mime-view-over-to-previous-method-alist)))
1363 (while (> (point) 1)
1365 (previous-single-property-change (point)
1371 (setq point (point-min))
1373 (forward-line (- h))
1374 (if (< (point) point)
1378 (defun mime-preview-next-line-entity ()
1380 (mime-preview-scroll-up-entity 1)
1383 (defun mime-preview-previous-line-entity ()
1385 (mime-preview-scroll-down-entity 1)
1392 (defun mime-preview-quit ()
1393 "Quit from MIME-preview buffer.
1394 It calls function registered in variable
1395 `mime-preview-quitting-method-alist'."
1397 (let ((r (assq mime-preview-original-major-mode
1398 mime-preview-quitting-method-alist)))
1403 (defun mime-preview-show-summary ()
1405 It calls function registered in variable
1406 `mime-view-show-summary-method'."
1408 (let ((r (assq mime-preview-original-major-mode
1409 mime-view-show-summary-method)))
1414 (defun mime-preview-kill-buffer ()
1416 (kill-buffer (current-buffer))
1423 (provide 'mime-view)
1425 (run-hooks 'mime-view-load-hook)
1427 ;;; mime-view.el ends here