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
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)
501 (mime-insert-button mime-view-announcement-for-message/partial
502 #'mime-preview-play-current-entity)
506 ;;; @ acting-condition
509 (defvar mime-acting-condition nil
510 "Condition-tree about how to process entity.")
512 (ctree-set-calist-strictly
513 'mime-acting-condition
514 '((type . t)(subtype . t)(mode . "play")
515 (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
517 (ctree-set-calist-strictly
518 'mime-acting-condition
519 '((type . t)(subtype . t)(mode . "extract")
520 (method . mime-method-to-save)))
522 (ctree-set-calist-strictly
523 'mime-acting-condition
524 '((type . text)(subtype . plain)(mode . "play")
525 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
527 (ctree-set-calist-strictly
528 'mime-acting-condition
529 '((type . text)(subtype . plain)(mode . "print")
530 (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
532 (ctree-set-calist-strictly
533 'mime-acting-condition
534 '((type . text)(subtype . html)(mode . "play")
535 (method "tm-html" nil 'file "" 'encoding 'mode 'name)
537 (ctree-set-calist-strictly
538 'mime-acting-condition
539 '((type . text)(subtype . x-rot13-47)(mode . "play")
540 (method . mime-method-to-display-caesar)
542 (ctree-set-calist-strictly
543 'mime-acting-condition
544 '((type . text)(subtype . x-rot13-47-48)(mode . "play")
545 (method . mime-method-to-display-caesar)
548 (ctree-set-calist-strictly
549 'mime-acting-condition
550 '((type . audio)(subtype . basic)(mode . "play")
551 (method "tm-au" nil 'file "" 'encoding 'mode 'name)
554 (ctree-set-calist-strictly
555 'mime-acting-condition
556 '((type . image)(mode . "play")
557 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
559 (ctree-set-calist-strictly
560 'mime-acting-condition
561 '((type . image)(mode . "print")
562 (method "tm-image" nil 'file "" 'encoding 'mode 'name)
565 (ctree-set-calist-strictly
566 'mime-acting-condition
567 '((type . video)(subtype . mpeg)(mode . "play")
568 (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
571 (ctree-set-calist-strictly
572 'mime-acting-condition
573 '((type . application)(subtype . postscript)(mode . "play")
574 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
576 (ctree-set-calist-strictly
577 'mime-acting-condition
578 '((type . application)(subtype . postscript)(mode . "print")
579 (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
582 (ctree-set-calist-strictly
583 'mime-acting-condition
584 '((type . message)(subtype . rfc822)(mode . "play")
585 (method . mime-method-to-display-message/rfc822)
587 (ctree-set-calist-strictly
588 'mime-acting-condition
589 '((type . message)(subtype . partial)(mode . "play")
590 (method . mime-method-to-store-message/partial)
593 (ctree-set-calist-strictly
594 'mime-acting-condition
595 '((type . message)(subtype . external-body)
596 ("access-type" . "anon-ftp")
597 (method . mime-method-to-display-message/external-ftp)
600 (ctree-set-calist-strictly
601 'mime-acting-condition
602 '((type . application)(subtype . octet-stream)
603 (method . mime-method-to-save)
607 ;;; @ quitting method
610 (defvar mime-preview-quitting-method-alist
611 '((mime-show-message-mode
612 . mime-preview-quitting-method-for-mime-show-message-mode))
613 "Alist of major-mode vs. quitting-method of mime-view.")
615 (defvar mime-view-over-to-previous-method-alist nil)
616 (defvar mime-view-over-to-next-method-alist nil)
618 (defvar mime-view-show-summary-method nil
619 "Alist of major-mode vs. show-summary-method.")
622 ;;; @ following method
625 (defvar mime-view-following-method-alist nil
626 "Alist of major-mode vs. following-method of mime-view.")
628 (defvar mime-view-following-required-fields-list
635 ;; hack from Gnus 5.0.4.
637 (defvar mime-view-x-face-to-pbm-command
638 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
640 (defvar mime-view-x-face-command
641 (concat mime-view-x-face-to-pbm-command
643 "String to be executed to display an X-Face field.
644 The command will be executed in a sub-shell asynchronously.
645 The compressed face will be piped to this command.")
647 (defun mime-view-x-face-function ()
648 "Function to display X-Face field. You can redefine to customize."
649 ;; 1995/10/12 (c.f. tm-eng:130)
650 ;; fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
652 (narrow-to-region (point-min) (re-search-forward "^$" nil t))
654 (goto-char (point-min))
655 (if (re-search-forward "^X-Face:[ \t]*" nil t)
656 (let ((beg (match-end 0))
657 (end (std11-field-end))
659 (call-process-region beg end "sh" nil 0 nil
660 "-c" mime-view-x-face-command)
667 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
669 (defvar mime-raw-buffer-coding-system-alist
670 `((t . ,(mime-charset-to-coding-system default-mime-charset)))
671 "Alist of major-mode vs. corresponding coding-system of `mime-raw-buffer'.")
677 (defvar mime-view-redisplay nil)
679 (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
685 (or mime-view-redisplay
686 (setq mime-raw-message-info (mime-parse-message ctl encoding))
688 (let ((message-info mime-raw-message-info)
689 (the-buf (current-buffer))
692 (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
693 (set-buffer (get-buffer-create obuf))
694 (let ((inhibit-read-only t))
695 ;;(setq buffer-read-only nil)
698 (setq mime-raw-buffer the-buf)
699 (setq mime-preview-original-major-mode mode)
700 (setq major-mode 'mime-view-mode)
701 (setq mode-name "MIME-View")
702 (mime-view-display-message message-info the-buf obuf)
703 (set-buffer-modified-p nil)
705 (setq buffer-read-only t)
708 (setq mime-preview-buffer obuf)
711 (defun mime-view-display-message (message-info ibuf obuf)
712 (let* ((start (mime-entity-point-min message-info))
713 (end (mime-entity-point-max message-info))
714 (media-type (mime-entity-media-type message-info))
715 (media-subtype (mime-entity-media-subtype message-info))
716 (params (mime-entity-parameters message-info))
717 (encoding (mime-entity-encoding message-info))
718 end-of-header e nb ne subj)
721 (setq end-of-header (if (re-search-forward "^$" nil t)
724 (if (> end-of-header end)
725 (setq end-of-header end)
728 (narrow-to-region start end)
731 (mime-raw-get-subject params encoding)))
735 (narrow-to-region nb nb)
736 ;; Insert message-header
738 (narrow-to-region (point)(point))
739 (insert-buffer-substring mime-raw-buffer start end-of-header)
740 (let ((f (cdr (assq mime-preview-original-major-mode
741 mime-view-content-header-filter-alist))))
744 (mime-view-default-content-header-filter)
746 (run-hooks 'mime-view-content-header-filter-hook)
749 (ctree-match-calist mime-preview-condition
750 (list* (cons 'type media-type)
751 (cons 'subtype media-subtype)
752 (cons 'encoding encoding)
753 (cons 'major-mode major-mode)
756 (cdr (assq 'message-button situation)))
757 (body-presentation-method
758 (cdr (assq 'body-presentation-method situation))))
759 (when (eq message-button 'visible)
760 (goto-char (point-max))
761 (mime-view-insert-entity-button message-info message-info subj)
763 (cond ((eq body-presentation-method 'with-filter)
764 (let ((body-filter (cdr (assq 'body-filter situation))))
766 (narrow-to-region (point-max)(point-max))
767 (insert-buffer-substring mime-raw-buffer end-of-header end)
768 (funcall body-filter situation)
770 ((functionp body-presentation-method)
771 (funcall body-presentation-method situation)
773 ((null (mime-entity-children message-info))
774 (goto-char (point-max))
775 (mime-view-insert-entity-button message-info message-info subj)
777 (setq ne (point-max))
779 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
780 (put-text-property nb ne 'mime-view-entity message-info)
782 (let ((children (mime-entity-children message-info))
784 (cdr (assq 'childrens-situation situation))))
786 (mime-view-display-entity (car children) message-info ibuf obuf
788 (setq children (cdr children))
791 (defun mime-view-display-entity (entity message-info ibuf obuf
793 (let* ((start (mime-entity-point-min entity))
794 (end (mime-entity-point-max entity))
795 (media-type (mime-entity-media-type entity))
796 (media-subtype (mime-entity-media-subtype entity))
797 (params (mime-entity-parameters entity))
798 (encoding (mime-entity-encoding entity))
799 end-of-header e nb ne subj)
802 (setq end-of-header (if (re-search-forward "^$" nil t)
805 (if (> end-of-header end)
806 (setq end-of-header end)
809 (narrow-to-region start end)
812 (mime-raw-get-subject params encoding)))
815 (ctree-match-calist mime-preview-condition
816 (list* (cons 'type media-type)
817 (cons 'subtype media-subtype)
818 (cons 'encoding encoding)
819 (cons 'major-mode major-mode)
821 default-situation))))
823 (eq (cdr (assq 'entity-button situation)) 'invisible))
825 (eq (cdr (assq 'header situation)) 'visible))
826 (body-presentation-method
827 (cdr (assq 'body-presentation-method situation))))
830 (narrow-to-region nb nb)
831 (or button-is-invisible
832 (if (mime-view-entity-button-visible-p entity message-info)
833 (mime-view-insert-entity-button entity message-info subj)
835 (if header-is-visible
837 (narrow-to-region (point)(point))
838 (insert-buffer-substring mime-raw-buffer start end-of-header)
839 (let ((f (cdr (assq mime-preview-original-major-mode
840 mime-view-content-header-filter-alist))))
843 (mime-view-default-content-header-filter)
845 (run-hooks 'mime-view-content-header-filter-hook)
847 (cond ((eq body-presentation-method 'with-filter)
848 (let ((body-filter (cdr (assq 'body-filter situation))))
850 (narrow-to-region (point-max)(point-max))
851 (insert-buffer-substring mime-raw-buffer end-of-header end)
852 (funcall body-filter situation)
854 ((functionp body-presentation-method)
855 (funcall body-presentation-method situation)
857 (or header-is-visible
858 body-presentation-method
860 (goto-char (point-max))
863 (setq ne (point-max))
865 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
866 (put-text-property nb ne 'mime-view-entity entity)
868 (let ((children (mime-entity-children entity))
870 (cdr (assq 'childrens-situation situation))))
872 (mime-view-display-entity (car children) message-info ibuf obuf
874 (setq children (cdr children))
877 (defun mime-raw-get-uu-filename (param &optional encoding)
878 (if (member (or encoding
879 (cdr (assq 'encoding param))
881 mime-view-uuencode-encoding-name-list)
883 (or (if (re-search-forward "^begin [0-9]+ " nil t)
884 (if (looking-at ".+$")
885 (buffer-substring (match-beginning 0)(match-end 0))
890 (defun mime-raw-get-subject (param &optional encoding)
891 (or (std11-find-field-body '("Content-Description" "Subject"))
893 (if (or (and (setq ret (mime/Content-Disposition))
894 (setq ret (assoc "filename" (cdr ret)))
896 (setq ret (assoc "name" param))
897 (setq ret (assoc "x-name" param))
899 (std11-strip-quoted-string (cdr ret))
901 (mime-raw-get-uu-filename param encoding)
905 ;;; @ MIME viewer mode
908 (defconst mime-view-menu-title "MIME-View")
909 (defconst mime-view-menu-list
910 '((up "Move to upper entity" mime-preview-move-to-upper)
911 (previous "Move to previous entity" mime-preview-move-to-previous)
912 (next "Move to next entity" mime-preview-move-to-next)
913 (scroll-down "Scroll-down" mime-preview-scroll-down-entity)
914 (scroll-up "Scroll-up" mime-preview-scroll-up-entity)
915 (play "Play current entity" mime-preview-play-current-entity)
916 (extract "Extract current entity" mime-preview-extract-current-entity)
917 (print "Print current entity" mime-preview-print-current-entity)
918 (x-face "Show X Face" mime-preview-display-x-face)
920 "Menu for MIME Viewer")
922 (cond (running-xemacs
923 (defvar mime-view-xemacs-popup-menu
924 (cons mime-view-menu-title
927 (vector (nth 1 item)(nth 2 item) t)
929 mime-view-menu-list)))
930 (defun mime-view-xemacs-popup-menu (event)
931 "Popup the menu in the MIME Viewer buffer"
933 (select-window (event-window event))
934 (set-buffer (event-buffer event))
935 (popup-menu 'mime-view-xemacs-popup-menu))
936 (defvar mouse-button-2 'button2)
939 (defvar mouse-button-2 [mouse-2])
942 (defun mime-view-define-keymap (&optional default)
943 (let ((mime-view-mode-map (if (keymapp default)
944 (copy-keymap default)
947 (define-key mime-view-mode-map
948 "u" (function mime-preview-move-to-upper))
949 (define-key mime-view-mode-map
950 "p" (function mime-preview-move-to-previous))
951 (define-key mime-view-mode-map
952 "n" (function mime-preview-move-to-next))
953 (define-key mime-view-mode-map
954 "\e\t" (function mime-preview-move-to-previous))
955 (define-key mime-view-mode-map
956 "\t" (function mime-preview-move-to-next))
957 (define-key mime-view-mode-map
958 " " (function mime-preview-scroll-up-entity))
959 (define-key mime-view-mode-map
960 "\M- " (function mime-preview-scroll-down-entity))
961 (define-key mime-view-mode-map
962 "\177" (function mime-preview-scroll-down-entity))
963 (define-key mime-view-mode-map
964 "\C-m" (function mime-preview-next-line-entity))
965 (define-key mime-view-mode-map
966 "\C-\M-m" (function mime-preview-previous-line-entity))
967 (define-key mime-view-mode-map
968 "v" (function mime-preview-play-current-entity))
969 (define-key mime-view-mode-map
970 "e" (function mime-preview-extract-current-entity))
971 (define-key mime-view-mode-map
972 "\C-c\C-p" (function mime-preview-print-current-entity))
973 (define-key mime-view-mode-map
974 "a" (function mime-preview-follow-current-entity))
975 (define-key mime-view-mode-map
976 "q" (function mime-preview-quit))
977 (define-key mime-view-mode-map
978 "h" (function mime-preview-show-summary))
979 (define-key mime-view-mode-map
980 "\C-c\C-x" (function mime-preview-kill-buffer))
981 ;; (define-key mime-view-mode-map
982 ;; "<" (function beginning-of-buffer))
983 ;; (define-key mime-view-mode-map
984 ;; ">" (function end-of-buffer))
985 (define-key mime-view-mode-map
986 "?" (function describe-mode))
987 (define-key mime-view-mode-map
988 [tab] (function mime-preview-move-to-next))
989 (define-key mime-view-mode-map
990 [delete] (function mime-preview-scroll-down-entity))
991 (define-key mime-view-mode-map
992 [backspace] (function mime-preview-scroll-down-entity))
993 (if (functionp default)
994 (cond (running-xemacs
995 (set-keymap-default-binding mime-view-mode-map default)
998 (setq mime-view-mode-map
999 (append mime-view-mode-map (list (cons t default))))
1002 (define-key mime-view-mode-map
1003 mouse-button-2 (function mime-button-dispatcher))
1005 (cond (running-xemacs
1006 (define-key mime-view-mode-map
1007 mouse-button-3 (function mime-view-xemacs-popup-menu))
1009 ((>= emacs-major-version 19)
1010 (define-key mime-view-mode-map [menu-bar mime-view]
1011 (cons mime-view-menu-title
1012 (make-sparse-keymap mime-view-menu-title)))
1015 (define-key mime-view-mode-map
1016 (vector 'menu-bar 'mime-view (car item))
1017 (cons (nth 1 item)(nth 2 item))
1020 (reverse mime-view-menu-list)
1023 (use-local-map mime-view-mode-map)
1024 (run-hooks 'mime-view-define-keymap-hook)
1027 (defsubst mime-maybe-hide-echo-buffer ()
1028 "Clear mime-echo buffer and delete window for it."
1029 (let ((buf (get-buffer mime-echo-buffer-name)))
1034 (let ((win (get-buffer-window buf)))
1041 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
1042 default-keymap-or-function)
1043 "Major mode for viewing MIME message.
1045 Here is a list of the standard keys for mime-view-mode.
1050 u Move to upper content
1051 p or M-TAB Move to previous content
1052 n or TAB Move to next content
1053 SPC Scroll up or move to next content
1054 M-SPC or DEL Scroll down or move to previous content
1055 RET Move to next line
1056 M-RET Move to previous line
1057 v Decode current content as `play mode'
1058 e Decode current content as `extract mode'
1059 C-c C-p Decode current content as `print mode'
1060 a Followup to current content.
1063 button-2 Move to point under the mouse cursor
1064 and decode current content as `play mode'
1067 (mime-maybe-hide-echo-buffer)
1068 (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
1069 (win-conf (current-window-configuration))
1072 (switch-to-buffer ret)
1073 (setq mime-preview-original-window-configuration win-conf)
1076 (setq mime-mother-buffer mother)
1078 (mime-view-define-keymap default-keymap-or-function)
1080 (next-single-property-change (point-min) 'mime-view-entity)))
1083 (goto-char (point-min))
1084 (search-forward "\n\n" nil t)
1086 (run-hooks 'mime-view-mode-hook)
1093 (autoload 'mime-preview-play-current-entity "mime-play"
1094 "Play current entity." t)
1096 (defun mime-preview-extract-current-entity ()
1097 "Extract current entity into file (maybe).
1098 It decodes current entity to call internal or external method as
1099 \"extract\" mode. The method is selected from variable
1100 `mime-acting-condition'."
1102 (mime-preview-play-current-entity "extract")
1105 (defun mime-preview-print-current-entity ()
1106 "Print current entity (maybe).
1107 It decodes current entity to call internal or external method as
1108 \"print\" mode. The method is selected from variable
1109 `mime-acting-condition'."
1111 (mime-preview-play-current-entity "print")
1118 (defun mime-preview-original-major-mode ()
1119 "Return major-mode of original buffer.
1120 If a current buffer has mime-mother-buffer, return original major-mode
1121 of the mother-buffer."
1122 (if mime-mother-buffer
1124 (set-buffer mime-mother-buffer)
1125 (mime-preview-original-major-mode)
1127 mime-preview-original-major-mode))
1129 (defun mime-preview-follow-current-entity ()
1130 "Write follow message to current entity.
1131 It calls following-method selected from variable
1132 `mime-view-following-method-alist'."
1135 (while (null (setq entity
1136 (get-text-property (point) 'mime-view-entity)))
1140 (previous-single-property-change (point) 'mime-view-entity))
1142 (entity-node-id (mime-entity-node-id entity))
1143 (len (length entity-node-id))
1147 (if (eq (next-single-property-change (point-min)
1153 ((eq (next-single-property-change p-beg 'mime-view-entity)
1155 (setq p-beg (point))
1157 (setq p-end (next-single-property-change p-beg 'mime-view-entity))
1159 (setq p-end (point-max))
1161 ((null entity-node-id)
1162 (setq p-end (point-max))
1170 (next-single-property-change
1171 (point) 'mime-view-entity))
1173 (let ((rc (mime-entity-node-id
1174 (get-text-property (point)
1175 'mime-view-entity))))
1176 (or (equal entity-node-id
1177 (nthcdr (- (length rc) len) rc))
1182 (setq p-end (point-max))
1185 (let* ((mode (mime-preview-original-major-mode))
1187 (format "%s-%s" (buffer-name) (reverse entity-node-id)))
1189 (the-buf (current-buffer))
1190 (a-buf mime-raw-buffer)
1193 (set-buffer (setq new-buf (get-buffer-create new-name)))
1195 (insert-buffer-substring the-buf p-beg p-end)
1196 (goto-char (point-min))
1197 (let ((entity-node-id (mime-entity-node-id entity)) ci str)
1205 (mime-raw-find-entity-from-node-id entity-node-id))
1208 (mime-entity-point-min ci)
1209 (mime-entity-point-max ci)
1211 (std11-header-string-except
1213 (apply (function regexp-or) fields)
1216 (eq (mime-entity-media-type ci) 'message)
1217 (eq (mime-entity-media-subtype ci) 'rfc822))
1223 (setq fields (std11-collect-field-names)
1224 entity-node-id (cdr entity-node-id))
1227 (let ((rest mime-view-following-required-fields-list))
1229 (let ((field-name (car rest)))
1230 (or (std11-field-body field-name)
1236 (set-buffer the-buf)
1237 (set-buffer mime-mother-buffer)
1238 (set-buffer mime-raw-buffer)
1239 (std11-field-body field-name)
1243 (setq rest (cdr rest))
1245 (eword-decode-header)
1247 (let ((f (cdr (assq mode mime-view-following-method-alist))))
1252 "Sorry, following method for %s is not implemented yet."
1261 (defun mime-preview-display-x-face ()
1263 (save-window-excursion
1264 (set-buffer mime-raw-buffer)
1265 (mime-view-x-face-function)
1272 (defun mime-preview-move-to-upper ()
1273 "Move to upper entity.
1274 If there is no upper entity, call function `mime-preview-quit'."
1277 (while (null (setq cinfo
1278 (get-text-property (point) 'mime-view-entity)))
1281 (let ((r (mime-raw-find-entity-from-node-id
1282 (cdr (mime-entity-node-id cinfo))
1283 (get-text-property 1 'mime-view-entity)))
1286 (while (setq point (previous-single-property-change
1287 (point) 'mime-view-entity))
1289 (if (eq r (get-text-property (point) 'mime-view-entity))
1296 (defun mime-preview-move-to-previous ()
1297 "Move to previous entity.
1298 If there is no previous entity, it calls function registered in
1299 variable `mime-view-over-to-previous-method-alist'."
1301 (while (null (get-text-property (point) 'mime-view-entity))
1305 (previous-single-property-change (point) 'mime-view-entity)))
1308 (let ((f (assq mime-preview-original-major-mode
1309 mime-view-over-to-previous-method-alist)))
1315 (defun mime-preview-move-to-next ()
1316 "Move to next entity.
1317 If there is no previous entity, it calls function registered in
1318 variable `mime-view-over-to-next-method-alist'."
1320 (let ((point (next-single-property-change (point) 'mime-view-entity)))
1323 (let ((f (assq mime-preview-original-major-mode
1324 mime-view-over-to-next-method-alist)))
1330 (defun mime-preview-scroll-up-entity (&optional h)
1331 "Scroll up current entity.
1332 If reached to (point-max), it calls function registered in variable
1333 `mime-view-over-to-next-method-alist'."
1336 (setq h (1- (window-height)))
1338 (if (= (point) (point-max))
1339 (let ((f (assq mime-preview-original-major-mode
1340 mime-view-over-to-next-method-alist)))
1345 (or (next-single-property-change (point) 'mime-view-entity)
1348 (if (> (point) point)
1353 (defun mime-preview-scroll-down-entity (&optional h)
1354 "Scroll down current entity.
1355 If reached to (point-min), it calls function registered in variable
1356 `mime-view-over-to-previous-method-alist'."
1359 (setq h (1- (window-height)))
1361 (if (= (point) (point-min))
1362 (let ((f (assq mime-preview-original-major-mode
1363 mime-view-over-to-previous-method-alist)))
1370 (while (> (point) 1)
1372 (previous-single-property-change (point)
1378 (setq point (point-min))
1380 (forward-line (- h))
1381 (if (< (point) point)
1385 (defun mime-preview-next-line-entity ()
1387 (mime-preview-scroll-up-entity 1)
1390 (defun mime-preview-previous-line-entity ()
1392 (mime-preview-scroll-down-entity 1)
1399 (defun mime-preview-quit ()
1400 "Quit from MIME-preview buffer.
1401 It calls function registered in variable
1402 `mime-preview-quitting-method-alist'."
1404 (let ((r (assq mime-preview-original-major-mode
1405 mime-preview-quitting-method-alist)))
1410 (defun mime-preview-show-summary ()
1412 It calls function registered in variable
1413 `mime-view-show-summary-method'."
1415 (let ((r (assq mime-preview-original-major-mode
1416 mime-view-show-summary-method)))
1421 (defun mime-preview-kill-buffer ()
1423 (kill-buffer (current-buffer))
1430 (provide 'mime-view)
1432 (run-hooks 'mime-view-load-hook)
1434 ;;; mime-view.el ends here