1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Renamed: 1994/08/31 from tm-body.el
8 ;; Renamed: 1997/02/19 from tm-view.el
9 ;; Keywords: MIME, multimedia, mail, news
11 ;; This file is part of WEMI (Widget based Emacs MIME Interfaces).
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
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 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 ;;; @ 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 or click here by mouse button-2."
485 This is message/partial style split message.
486 Please press `v' key in this buffer."
489 (defun mime-view-insert-message/partial-button (&optional situation)
491 (goto-char (point-max))
492 (if (not (search-backward "\n\n" nil t))
495 (goto-char (point-max))
496 ;;(narrow-to-region (point-max)(point-max))
497 ;;(insert mime-view-announcement-for-message/partial)
498 ;; (mime-add-button (point-min)(point-max)
499 ;; #'mime-preview-play-current-entity)
500 (mime-insert-button mime-view-announcement-for-message/partial
501 #'mime-preview-play-current-entity)
505 ;;; @ acting-condition
508 (defvar mime-acting-condition nil
509 "Condition-tree about how to process entity.")
511 (ctree-set-calist-strictly
512 'mime-acting-condition
513 '((type . t)(subtype . t)(mode . "play")
514 (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
516 (ctree-set-calist-strictly
517 'mime-acting-condition
518 '((type . t)(subtype . t)(mode . "extract")
519 (method . mime-method-to-save)))
521 (ctree-set-calist-strictly
522 'mime-acting-condition
523 '((type . text)(subtype . plain)(mode . "play")
524 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
526 (ctree-set-calist-strictly
527 'mime-acting-condition
528 '((type . text)(subtype . plain)(mode . "print")
529 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
531 (ctree-set-calist-strictly
532 'mime-acting-condition
533 '((type . text)(subtype . html)(mode . "play")
534 (method "tm-html" nil 'file "" 'encoding 'mode 'name)
536 (ctree-set-calist-strictly
537 'mime-acting-condition
538 '((type . text)(subtype . x-rot13-47)(mode . "play")
539 (method . mime-method-to-display-caesar)
541 (ctree-set-calist-strictly
542 'mime-acting-condition
543 '((type . text)(subtype . x-rot13-47-48)(mode . "play")
544 (method . mime-method-to-display-caesar)
547 (ctree-set-calist-strictly
548 'mime-acting-condition
549 '((type . audio)(subtype . basic)(mode . "play")
550 (method "tm-au" nil 'file "" 'encoding 'mode 'name)
553 (ctree-set-calist-strictly
554 'mime-acting-condition
555 '((type . image)(mode . "play")
556 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
558 (ctree-set-calist-strictly
559 'mime-acting-condition
560 '((type . image)(mode . "print")
561 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
564 (ctree-set-calist-strictly
565 'mime-acting-condition
566 '((type . video)(subtype . mpeg)(mode . "play")
567 (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
570 (ctree-set-calist-strictly
571 'mime-acting-condition
572 '((type . application)(subtype . postscript)(mode . "play")
573 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
575 (ctree-set-calist-strictly
576 'mime-acting-condition
577 '((type . application)(subtype . postscript)(mode . "print")
578 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
581 (ctree-set-calist-strictly
582 'mime-acting-condition
583 '((type . message)(subtype . rfc822)(mode . "play")
584 (method . mime-method-to-display-message/rfc822)
586 (ctree-set-calist-strictly
587 'mime-acting-condition
588 '((type . message)(subtype . partial)(mode . "play")
589 (method . mime-method-to-store-message/partial)
592 (ctree-set-calist-strictly
593 'mime-acting-condition
594 '((type . message)(subtype . external-body)
595 ("access-type" . "anon-ftp")
596 (method . mime-method-to-display-message/external-ftp)
599 (ctree-set-calist-strictly
600 'mime-acting-condition
601 '((type . application)(subtype . octet-stream)
602 (method . mime-method-to-save)
606 ;;; @ quitting method
609 (defvar mime-preview-quitting-method-alist
610 '((mime-show-message-mode
611 . mime-preview-quitting-method-for-mime-show-message-mode))
612 "Alist of major-mode vs. quitting-method of mime-view.")
614 (defvar mime-view-over-to-previous-method-alist nil)
615 (defvar mime-view-over-to-next-method-alist nil)
617 (defvar mime-view-show-summary-method nil
618 "Alist of major-mode vs. show-summary-method.")
621 ;;; @ following method
624 (defvar mime-view-following-method-alist nil
625 "Alist of major-mode vs. following-method of mime-view.")
627 (defvar mime-view-following-required-fields-list
634 ;; hack from Gnus 5.0.4.
636 (defvar mime-view-x-face-to-pbm-command
637 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
639 (defvar mime-view-x-face-command
640 (concat mime-view-x-face-to-pbm-command
642 "String to be executed to display an X-Face field.
643 The command will be executed in a sub-shell asynchronously.
644 The compressed face will be piped to this command.")
646 (defun mime-view-x-face-function ()
647 "Function to display X-Face field. You can redefine to customize."
648 ;; 1995/10/12 (c.f. tm-eng:130)
649 ;; fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
651 (narrow-to-region (point-min) (re-search-forward "^$" nil t))
653 (goto-char (point-min))
654 (if (re-search-forward "^X-Face:[ \t]*" nil t)
655 (let ((beg (match-end 0))
656 (end (std11-field-end))
658 (call-process-region beg end "sh" nil 0 nil
659 "-c" mime-view-x-face-command)
666 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
668 (defvar mime-raw-buffer-coding-system-alist
669 `((t . ,(mime-charset-to-coding-system default-mime-charset)))
670 "Alist of major-mode vs. corresponding coding-system of `mime-raw-buffer'.")
676 (defvar mime-view-redisplay nil)
678 (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
684 (or mime-view-redisplay
685 (setq mime-raw-message-info (mime-parse-message ctl encoding))
687 (let ((message-info mime-raw-message-info)
688 (the-buf (current-buffer))
691 (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
692 (set-buffer (get-buffer-create obuf))
693 (let ((inhibit-read-only t))
694 ;;(setq buffer-read-only nil)
697 (setq mime-raw-buffer the-buf)
698 (setq mime-preview-original-major-mode mode)
699 (setq major-mode 'mime-view-mode)
700 (setq mode-name "MIME-View")
701 (mime-view-display-message message-info the-buf obuf)
702 (set-buffer-modified-p nil)
704 (setq buffer-read-only t)
707 (setq mime-preview-buffer obuf)
710 (defun mime-view-display-message (message-info ibuf obuf)
711 (let* ((start (mime-entity-point-min message-info))
712 (end (mime-entity-point-max message-info))
713 (media-type (mime-entity-media-type message-info))
714 (media-subtype (mime-entity-media-subtype message-info))
715 (params (mime-entity-parameters message-info))
716 (encoding (mime-entity-encoding message-info))
717 end-of-header e nb ne subj)
720 (setq end-of-header (if (re-search-forward "^$" nil t)
723 (if (> end-of-header end)
724 (setq end-of-header end)
727 (narrow-to-region start end)
730 (mime-raw-get-subject params encoding)))
734 (narrow-to-region nb nb)
735 ;; Insert message-header
737 (narrow-to-region (point)(point))
738 (insert-buffer-substring mime-raw-buffer start end-of-header)
739 (let ((f (cdr (assq mime-preview-original-major-mode
740 mime-view-content-header-filter-alist))))
743 (mime-view-default-content-header-filter)
745 (run-hooks 'mime-view-content-header-filter-hook)
748 (ctree-match-calist mime-preview-condition
749 (list* (cons 'type media-type)
750 (cons 'subtype media-subtype)
751 (cons 'encoding encoding)
752 (cons 'major-mode major-mode)
755 (cdr (assq 'message-button situation)))
756 (body-presentation-method
757 (cdr (assq 'body-presentation-method situation))))
758 (when (eq message-button 'visible)
759 (goto-char (point-max))
760 (mime-view-insert-entity-button message-info message-info subj)
762 (cond ((eq body-presentation-method 'with-filter)
763 (let ((body-filter (cdr (assq 'body-filter situation))))
765 (narrow-to-region (point-max)(point-max))
766 (insert-buffer-substring mime-raw-buffer end-of-header end)
767 (funcall body-filter situation)
769 ((functionp body-presentation-method)
770 (funcall body-presentation-method situation)
772 ((null (mime-entity-children message-info))
773 (goto-char (point-max))
774 (mime-view-insert-entity-button message-info message-info subj)
776 (setq ne (point-max))
778 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
779 (put-text-property nb ne 'mime-view-entity message-info)
781 (let ((children (mime-entity-children message-info))
783 (cdr (assq 'childrens-situation situation))))
785 (mime-view-display-entity (car children) message-info ibuf obuf
787 (setq children (cdr children))
790 (defun mime-view-display-entity (entity message-info ibuf obuf
792 (let* ((start (mime-entity-point-min entity))
793 (end (mime-entity-point-max entity))
794 (media-type (mime-entity-media-type entity))
795 (media-subtype (mime-entity-media-subtype entity))
796 (params (mime-entity-parameters entity))
797 (encoding (mime-entity-encoding entity))
798 end-of-header e nb ne subj)
801 (setq end-of-header (if (re-search-forward "^$" nil t)
804 (if (> end-of-header end)
805 (setq end-of-header end)
808 (narrow-to-region start end)
811 (mime-raw-get-subject params encoding)))
814 (ctree-match-calist mime-preview-condition
815 (list* (cons 'type media-type)
816 (cons 'subtype media-subtype)
817 (cons 'encoding encoding)
818 (cons 'major-mode major-mode)
820 default-situation))))
822 (eq (cdr (assq 'entity-button situation)) 'invisible))
824 (eq (cdr (assq 'header situation)) 'visible))
825 (body-presentation-method
826 (cdr (assq 'body-presentation-method situation))))
829 (narrow-to-region nb nb)
830 (or button-is-invisible
831 (if (mime-view-entity-button-visible-p entity message-info)
832 (mime-view-insert-entity-button entity message-info subj)
834 (if header-is-visible
836 (narrow-to-region (point)(point))
837 (insert-buffer-substring mime-raw-buffer start end-of-header)
838 (let ((f (cdr (assq mime-preview-original-major-mode
839 mime-view-content-header-filter-alist))))
842 (mime-view-default-content-header-filter)
844 (run-hooks 'mime-view-content-header-filter-hook)
846 (cond ((eq body-presentation-method 'with-filter)
847 (let ((body-filter (cdr (assq 'body-filter situation))))
849 (narrow-to-region (point-max)(point-max))
850 (insert-buffer-substring mime-raw-buffer end-of-header end)
851 (funcall body-filter situation)
853 ((functionp body-presentation-method)
854 (funcall body-presentation-method situation)
856 (or header-is-visible
857 body-presentation-method
859 (goto-char (point-max))
862 (setq ne (point-max))
864 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
865 (put-text-property nb ne 'mime-view-entity entity)
867 (let ((children (mime-entity-children entity))
869 (cdr (assq 'childrens-situation situation))))
871 (mime-view-display-entity (car children) message-info ibuf obuf
873 (setq children (cdr children))
876 (defun mime-raw-get-uu-filename (param &optional encoding)
877 (if (member (or encoding
878 (cdr (assq 'encoding param))
880 mime-view-uuencode-encoding-name-list)
882 (or (if (re-search-forward "^begin [0-9]+ " nil t)
883 (if (looking-at ".+$")
884 (buffer-substring (match-beginning 0)(match-end 0))
889 (defun mime-raw-get-subject (param &optional encoding)
890 (or (std11-find-field-body '("Content-Description" "Subject"))
892 (if (or (and (setq ret (mime/Content-Disposition))
893 (setq ret (assoc "filename" (cdr ret)))
895 (setq ret (assoc "name" param))
896 (setq ret (assoc "x-name" param))
898 (std11-strip-quoted-string (cdr ret))
900 (mime-raw-get-uu-filename param encoding)
904 ;;; @ MIME viewer mode
907 (defconst mime-view-menu-title "MIME-View")
908 (defconst mime-view-menu-list
909 '((up "Move to upper entity" mime-preview-move-to-upper)
910 (previous "Move to previous entity" mime-preview-move-to-previous)
911 (next "Move to next entity" mime-preview-move-to-next)
912 (scroll-down "Scroll-down" mime-preview-scroll-down-entity)
913 (scroll-up "Scroll-up" mime-preview-scroll-up-entity)
914 (play "Play current entity" mime-preview-play-current-entity)
915 (extract "Extract current entity" mime-preview-extract-current-entity)
916 (print "Print current entity" mime-preview-print-current-entity)
917 (x-face "Show X Face" mime-preview-display-x-face)
919 "Menu for MIME Viewer")
921 (cond (running-xemacs
922 (defvar mime-view-xemacs-popup-menu
923 (cons mime-view-menu-title
926 (vector (nth 1 item)(nth 2 item) t)
928 mime-view-menu-list)))
929 (defun mime-view-xemacs-popup-menu (event)
930 "Popup the menu in the MIME Viewer buffer"
932 (select-window (event-window event))
933 (set-buffer (event-buffer event))
934 (popup-menu 'mime-view-xemacs-popup-menu))
935 (defvar mouse-button-2 'button2)
938 (defvar mouse-button-2 [mouse-2])
941 (defun mime-view-define-keymap (&optional default)
942 (let ((mime-view-mode-map (if (keymapp default)
943 (copy-keymap default)
946 (define-key mime-view-mode-map
947 "u" (function mime-preview-move-to-upper))
948 (define-key mime-view-mode-map
949 "p" (function mime-preview-move-to-previous))
950 (define-key mime-view-mode-map
951 "n" (function mime-preview-move-to-next))
952 (define-key mime-view-mode-map
953 "\e\t" (function mime-preview-move-to-previous))
954 (define-key mime-view-mode-map
955 "\t" (function mime-preview-move-to-next))
956 (define-key mime-view-mode-map
957 " " (function mime-preview-scroll-up-entity))
958 (define-key mime-view-mode-map
959 "\M- " (function mime-preview-scroll-down-entity))
960 (define-key mime-view-mode-map
961 "\177" (function mime-preview-scroll-down-entity))
962 (define-key mime-view-mode-map
963 "\C-m" (function mime-preview-next-line-entity))
964 (define-key mime-view-mode-map
965 "\C-\M-m" (function mime-preview-previous-line-entity))
966 (define-key mime-view-mode-map
967 "v" (function mime-preview-play-current-entity))
968 (define-key mime-view-mode-map
969 "e" (function mime-preview-extract-current-entity))
970 (define-key mime-view-mode-map
971 "\C-c\C-p" (function mime-preview-print-current-entity))
972 (define-key mime-view-mode-map
973 "a" (function mime-preview-follow-current-entity))
974 (define-key mime-view-mode-map
975 "q" (function mime-preview-quit))
976 (define-key mime-view-mode-map
977 "h" (function mime-preview-show-summary))
978 (define-key mime-view-mode-map
979 "\C-c\C-x" (function mime-preview-kill-buffer))
980 ;; (define-key mime-view-mode-map
981 ;; "<" (function beginning-of-buffer))
982 ;; (define-key mime-view-mode-map
983 ;; ">" (function end-of-buffer))
984 (define-key mime-view-mode-map
985 "?" (function describe-mode))
986 (define-key mime-view-mode-map
987 [tab] (function mime-preview-move-to-next))
988 (define-key mime-view-mode-map
989 [delete] (function mime-preview-scroll-down-entity))
990 (define-key mime-view-mode-map
991 [backspace] (function mime-preview-scroll-down-entity))
992 (if (functionp default)
993 (cond (running-xemacs
994 (set-keymap-default-binding mime-view-mode-map default)
997 (setq mime-view-mode-map
998 (append mime-view-mode-map (list (cons t default))))
1001 (define-key mime-view-mode-map
1002 mouse-button-2 (function mime-button-dispatcher))
1004 (cond (running-xemacs
1005 (define-key mime-view-mode-map
1006 mouse-button-3 (function mime-view-xemacs-popup-menu))
1008 ((>= emacs-major-version 19)
1009 (define-key mime-view-mode-map [menu-bar mime-view]
1010 (cons mime-view-menu-title
1011 (make-sparse-keymap mime-view-menu-title)))
1014 (define-key mime-view-mode-map
1015 (vector 'menu-bar 'mime-view (car item))
1016 (cons (nth 1 item)(nth 2 item))
1019 (reverse mime-view-menu-list)
1022 (use-local-map mime-view-mode-map)
1023 (run-hooks 'mime-view-define-keymap-hook)
1026 (defsubst mime-maybe-hide-echo-buffer ()
1027 "Clear mime-echo buffer and delete window for it."
1028 (let ((buf (get-buffer mime-echo-buffer-name)))
1033 (let ((win (get-buffer-window buf)))
1040 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
1041 default-keymap-or-function)
1042 "Major mode for viewing MIME message.
1044 Here is a list of the standard keys for mime-view-mode.
1049 u Move to upper content
1050 p or M-TAB Move to previous content
1051 n or TAB Move to next content
1052 SPC Scroll up or move to next content
1053 M-SPC or DEL Scroll down or move to previous content
1054 RET Move to next line
1055 M-RET Move to previous line
1056 v Decode current content as `play mode'
1057 e Decode current content as `extract mode'
1058 C-c C-p Decode current content as `print mode'
1059 a Followup to current content.
1062 button-2 Move to point under the mouse cursor
1063 and decode current content as `play mode'
1066 (mime-maybe-hide-echo-buffer)
1067 (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
1068 (win-conf (current-window-configuration))
1071 (switch-to-buffer ret)
1072 (setq mime-preview-original-window-configuration win-conf)
1075 (setq mime-mother-buffer mother)
1077 (mime-view-define-keymap default-keymap-or-function)
1079 (next-single-property-change (point-min) 'mime-view-entity)))
1082 (goto-char (point-min))
1083 (search-forward "\n\n" nil t)
1085 (run-hooks 'mime-view-mode-hook)
1092 (autoload 'mime-preview-play-current-entity "mime-play"
1093 "Play current entity." t)
1095 (defun mime-preview-extract-current-entity ()
1096 "Extract current entity into file (maybe).
1097 It decodes current entity to call internal or external method as
1098 \"extract\" mode. The method is selected from variable
1099 `mime-acting-condition'."
1101 (mime-preview-play-current-entity "extract")
1104 (defun mime-preview-print-current-entity ()
1105 "Print current entity (maybe).
1106 It decodes current entity to call internal or external method as
1107 \"print\" mode. The method is selected from variable
1108 `mime-acting-condition'."
1110 (mime-preview-play-current-entity "print")
1117 (defun mime-preview-original-major-mode ()
1118 "Return major-mode of original buffer.
1119 If a current buffer has mime-mother-buffer, return original major-mode
1120 of the mother-buffer."
1121 (if mime-mother-buffer
1123 (set-buffer mime-mother-buffer)
1124 (mime-preview-original-major-mode)
1126 mime-preview-original-major-mode))
1128 (defun mime-preview-follow-current-entity ()
1129 "Write follow message to current entity.
1130 It calls following-method selected from variable
1131 `mime-view-following-method-alist'."
1134 (while (null (setq entity
1135 (get-text-property (point) 'mime-view-entity)))
1139 (previous-single-property-change (point) 'mime-view-entity))
1141 (entity-node-id (mime-entity-node-id entity))
1142 (len (length entity-node-id))
1146 (if (eq (next-single-property-change (point-min)
1152 ((eq (next-single-property-change p-beg 'mime-view-entity)
1154 (setq p-beg (point))
1156 (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1158 (setq p-end (point-max))
1160 ((null entity-node-id)
1161 (setq p-end (point-max))
1169 (next-single-property-change
1170 (point) 'mime-view-entity))
1172 (let ((rc (mime-entity-node-id
1173 (get-text-property (point)
1174 'mime-view-entity))))
1175 (or (equal entity-node-id
1176 (nthcdr (- (length rc) len) rc))
1181 (setq p-end (point-max))
1184 (let* ((mode (mime-preview-original-major-mode))
1186 (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1188 (the-buf (current-buffer))
1189 (a-buf mime-raw-buffer)
1192 (set-buffer (setq new-buf (get-buffer-create new-name)))
1194 (insert-buffer-substring the-buf p-beg p-end)
1195 (goto-char (point-min))
1196 (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1204 (mime-raw-find-entity-from-node-id entity-node-id))
1207 (mime-entity-point-min ci)
1208 (mime-entity-point-max ci)
1210 (std11-header-string-except
1212 (apply (function regexp-or) fields)
1215 (eq (mime-entity-media-type ci) 'message)
1216 (eq (mime-entity-media-subtype ci) 'rfc822))
1222 (setq fields (std11-collect-field-names)
1223 entity-node-id (cdr entity-node-id))
1226 (let ((rest mime-view-following-required-fields-list))
1228 (let ((field-name (car rest)))
1229 (or (std11-field-body field-name)
1235 (set-buffer the-buf)
1236 (set-buffer mime-mother-buffer)
1237 (set-buffer mime-raw-buffer)
1238 (std11-field-body field-name)
1242 (setq rest (cdr rest))
1244 (eword-decode-header)
1246 (let ((f (cdr (assq mode mime-view-following-method-alist))))
1251 "Sorry, following method for %s is not implemented yet."
1260 (defun mime-preview-display-x-face ()
1262 (save-window-excursion
1263 (set-buffer mime-raw-buffer)
1264 (mime-view-x-face-function)
1271 (defun mime-preview-move-to-upper ()
1272 "Move to upper entity.
1273 If there is no upper entity, call function `mime-preview-quit'."
1276 (while (null (setq cinfo
1277 (get-text-property (point) 'mime-view-entity)))
1280 (let ((r (mime-raw-find-entity-from-node-id
1281 (cdr (mime-entity-node-id cinfo))
1282 (get-text-property 1 'mime-view-entity)))
1285 (while (setq point (previous-single-property-change
1286 (point) 'mime-view-entity))
1288 (if (eq r (get-text-property (point) 'mime-view-entity))
1295 (defun mime-preview-move-to-previous ()
1296 "Move to previous entity.
1297 If there is no previous entity, it calls function registered in
1298 variable `mime-view-over-to-previous-method-alist'."
1300 (while (null (get-text-property (point) 'mime-view-entity))
1304 (previous-single-property-change (point) 'mime-view-entity)))
1307 (let ((f (assq mime-preview-original-major-mode
1308 mime-view-over-to-previous-method-alist)))
1314 (defun mime-preview-move-to-next ()
1315 "Move to next entity.
1316 If there is no previous entity, it calls function registered in
1317 variable `mime-view-over-to-next-method-alist'."
1319 (let ((point (next-single-property-change (point) 'mime-view-entity)))
1322 (let ((f (assq mime-preview-original-major-mode
1323 mime-view-over-to-next-method-alist)))
1329 (defun mime-preview-scroll-up-entity (&optional h)
1330 "Scroll up current entity.
1331 If reached to (point-max), it calls function registered in variable
1332 `mime-view-over-to-next-method-alist'."
1335 (setq h (1- (window-height)))
1337 (if (= (point) (point-max))
1338 (let ((f (assq mime-preview-original-major-mode
1339 mime-view-over-to-next-method-alist)))
1344 (or (next-single-property-change (point) 'mime-view-entity)
1347 (if (> (point) point)
1352 (defun mime-preview-scroll-down-entity (&optional h)
1353 "Scroll down current entity.
1354 If reached to (point-min), it calls function registered in variable
1355 `mime-view-over-to-previous-method-alist'."
1358 (setq h (1- (window-height)))
1360 (if (= (point) (point-min))
1361 (let ((f (assq mime-preview-original-major-mode
1362 mime-view-over-to-previous-method-alist)))
1369 (while (> (point) 1)
1371 (previous-single-property-change (point)
1377 (setq point (point-min))
1379 (forward-line (- h))
1380 (if (< (point) point)
1384 (defun mime-preview-next-line-entity ()
1386 (mime-preview-scroll-up-entity 1)
1389 (defun mime-preview-previous-line-entity ()
1391 (mime-preview-scroll-down-entity 1)
1398 (defun mime-preview-quit ()
1399 "Quit from MIME-preview buffer.
1400 It calls function registered in variable
1401 `mime-preview-quitting-method-alist'."
1403 (let ((r (assq mime-preview-original-major-mode
1404 mime-preview-quitting-method-alist)))
1409 (defun mime-preview-show-summary ()
1411 It calls function registered in variable
1412 `mime-view-show-summary-method'."
1414 (let ((r (assq mime-preview-original-major-mode
1415 mime-view-show-summary-method)))
1420 (defun mime-preview-kill-buffer ()
1422 (kill-buffer (current-buffer))
1429 (provide 'mime-view)
1431 (run-hooks 'mime-view-load-hook)
1433 ;;; mime-view.el ends here