1 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Renamed: 1994/8/31 from tm-body.el
8 ;; Renamed: 1997/02/19 from tm-view.el
9 ;; Version: $Revision: 0.95 $
10 ;; Keywords: MIME, multimedia, mail, news
12 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
14 ;; This program is free software; you can redistribute it and/or
15 ;; modify it under the terms of the GNU General Public License as
16 ;; published by the Free Software Foundation; either version 2, or (at
17 ;; your option) any later version.
19 ;; This program is distributed in the hope that it will be useful, but
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;; General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
34 (require 'eword-decode)
42 (defconst mime-view-RCS-ID
43 "$Id: mime-view.el,v 0.95 1997-06-24 16:21:46 morioka Exp $")
45 (defconst mime-view-version (get-version-string mime-view-RCS-ID))
51 (defvar mime-acting-condition
52 '(((type . "text/plain")
53 (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)
57 (method "tm-html" nil 'file 'type 'encoding 'mode 'name)
60 ((type . "text/x-rot13-47")
61 (method . mime-display-caesar)
64 ((type . "text/x-rot13-47-48")
65 (method . mime-display-caesar)
68 ((type . "audio/basic")
69 (method "tm-au" nil 'file 'type 'encoding 'mode 'name)
73 ((type . "image/jpeg")
74 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
78 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
82 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
85 ((type . "image/tiff")
86 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
89 ((type . "image/x-tiff")
90 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
93 ((type . "image/x-xbm")
94 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
97 ((type . "image/x-pic")
98 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
101 ((type . "image/x-mag")
102 (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
103 (mode "play" "print")
106 ((type . "video/mpeg")
107 (method "tm-mpeg" nil 'file 'type 'encoding 'mode 'name)
111 ((type . "application/postscript")
112 (method "tm-ps" nil 'file 'type 'encoding 'mode 'name)
113 (mode "play" "print")
115 ((type . "application/octet-stream")
116 (method "tm-file" nil 'file 'type 'encoding 'mode 'name)
117 (mode "play" "print")
120 ;;((type . "message/external-body")
121 ;; (method "xterm" nil
122 ;; "-e" "showexternal"
123 ;; 'file '"access-type" '"name" '"site" '"directory"))
124 ((type . "message/external-body")
125 ("access-type" . "anon-ftp")
126 (method . mime-display-message/external-ftp)
128 ((type . "message/rfc822")
129 (method . mime-article/view-message/rfc822)
132 ((type . "message/partial")
133 (method . mime-display-message/partial)
137 ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
140 ((method "tm-file" nil 'file 'type 'encoding 'mode 'name)
145 (defvar mime-view-childrens-header-showing-Content-Type-list
146 '("message/rfc822" "message/news"))
148 (defvar mime-view-visible-media-type-list
149 '("text/plain" nil "text/richtext" "text/enriched"
150 "text/rfc822-headers"
151 "text/x-latex" "application/x-latex"
152 "message/delivery-status"
153 "application/pgp" "text/x-pgp"
154 "application/octet-stream"
155 "application/x-selection" "application/x-comment")
156 "*List of media-types to be able to display in MIME-View buffer.
157 Each elements are string of TYPE/SUBTYPE, e.g. \"text/plain\".")
159 (defvar mime-view-content-button-visible-ctype-list
160 '("application/pgp"))
162 (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
164 (defvar mime-view-ignored-field-list
165 '(".*Received" ".*Path" ".*Id" "References"
166 "Replied" "Errors-To"
167 "Lines" "Sender" ".*Host" "Xref"
168 "Content-Type" "Precedence"
170 "All fields that match this list will be hidden in MIME preview buffer.
171 Each elements are regexp of field-name. [mime-view.el]")
173 (defvar mime-view-ignored-field-regexp
175 (apply (function regexp-or) mime-view-ignored-field-list)
178 (defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
179 "All fields that match this list will be displayed in MIME preview buffer.
180 Each elements are regexp of field-name.")
182 (defvar mime-view-redisplay nil)
184 (defvar mime-view-announcement-for-message/partial
185 (if (and (>= emacs-major-version 19) window-system)
187 \[[ This is message/partial style split message. ]]
188 \[[ Please press `v' key in this buffer ]]
189 \[[ or click here by mouse button-2. ]]"
191 \[[ This is message/partial style split message. ]]
192 \[[ Please press `v' key in this buffer. ]]"
196 ;;; @@ predicate functions
199 (defun mime-view-header-visible-p (rcnum cinfo)
200 "Return non-nil if header of current entity is visible."
202 (member (mime::content-info/type
203 (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
204 mime-view-childrens-header-showing-Content-Type-list)
207 (defun mime-view-body-visible-p (rcnum cinfo &optional ctype)
211 (mime::content-info/type
212 (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
215 (and (member ctype mime-view-visible-media-type-list)
216 (if (string-equal ctype "application/octet-stream")
219 (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
221 (member (mime::content-info/encoding ccinfo)
222 '(nil "7bit" "8bit"))
231 (defun mime-view-insert-entity-button (rcnum cinfo ctype params subj encoding)
232 "Insert entity-button."
234 (let ((access-type (assoc "access-type" params))
235 (num (or (cdr (assoc "x-part-number" params))
239 (format "%s" (1+ num))
245 (let ((server (assoc "server" params)))
246 (setq access-type (cdr access-type))
248 (format "%s %s ([%s] %s)"
249 num subj access-type (cdr server))
250 (let ((site (cdr (assoc "site" params)))
251 (dir (cdr (assoc "directory" params)))
253 (format "%s %s ([%s] %s:%s)"
254 num subj access-type site dir)
258 (let ((charset (cdr (assoc "charset" params))))
264 (concat "; " charset)
265 (if encoding (concat " (" encoding ")"))
268 (if (>= (+ (current-column)(length rest))(window-width))
272 (function mime-view-play-current-entity))
275 (defun mime-view-entity-button-function
276 (rcnum cinfo ctype params subj encoding)
277 "Insert entity button conditionally.
278 Please redefine this function if you want to change default setting."
280 (string= ctype "application/x-selection")
281 (and (string= ctype "application/octet-stream")
282 (string= (mime::content-info/type
283 (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
284 "multipart/encrypted"))
285 (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding)
289 ;;; @@ content header filter
292 (defsubst mime-view-cut-header ()
293 (goto-char (point-min))
294 (while (re-search-forward mime-view-ignored-field-regexp nil t)
295 (let* ((beg (match-beginning 0))
297 (name (buffer-substring beg end))
299 (or (member-if (function
301 (string-match regexp name)
302 )) mime-view-visible-field-list)
305 (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
310 (defun mime-view-default-content-header-filter ()
311 (mime-view-cut-header)
312 (eword-decode-header)
315 (defvar mime-view-content-header-filter-alist nil)
318 ;;; @@ content filter
321 (defvar mime-view-content-filter-alist
322 '(("text/enriched" . mime-view-filter-for-text/enriched)
323 ("text/richtext" . mime-view-filter-for-text/richtext)
324 (t . mime-view-filter-for-text/plain)
326 "Alist of media-types vs. corresponding MIME-View filter functions.
327 Each element looks like (TYPE/SUBTYPE . FUNCTION) or (t . FUNCTION).
328 TYPE/SUBTYPE is a string of media-type and FUNCTION is a filter
329 function. t means default media-type.")
332 ;;; @@ entity separator
335 (defun mime-view-entity-separator-function (rcnum cinfo ctype params subj)
336 "Insert entity separator conditionally.
337 Please redefine this function if you want to change default setting."
338 (or (mime-view-header-visible-p rcnum cinfo)
339 (mime-view-body-visible-p rcnum cinfo ctype)
341 (goto-char (point-max))
346 ;;; @@ buffer local variables
349 ;;; @@@ in raw buffer
352 (defvar mime::article/content-info
353 "Information about structure of message.
354 Please use reference function `mime::content-info/SLOT-NAME' to
355 reference slot of content-info. Their argument is only content-info.
357 Following is a list of slots of the structure:
359 rcnum reversed content-number (list)
360 point-min beginning point of region in raw-buffer
361 point-max end point of region in raw-buffer
362 type media-type/subtype (string or nil)
363 parameters parameter of Content-Type field (association list)
364 encoding Content-Transfer-Encoding (string or nil)
365 children entities included in this entity (list of content-infos)
367 If a entity includes other entities in its body, such as multipart or
368 message/rfc822, content-infos of other entities are included in
369 `children', so content-info become a tree.")
370 (make-variable-buffer-local 'mime::article/content-info)
372 (defvar mime-view-buffer nil
373 "MIME View buffer corresponding with the (raw) buffer.")
374 (make-variable-buffer-local 'mime-view-buffer)
377 ;;; @@@ in view buffer
380 (defvar mime-mother-buffer nil
381 "Mother buffer corresponding with the (MIME-View) buffer.
382 If current MIME-View buffer is generated by other buffer, such as
383 message/partial, it is called `mother-buffer'.")
384 (make-variable-buffer-local 'mime-mother-buffer)
386 (defvar mime-raw-buffer nil
387 "Raw buffer corresponding with the (MIME-View) buffer.")
388 (make-variable-buffer-local 'mime-raw-buffer)
390 (defvar mime-view-original-major-mode nil
391 "Major-mode in mime-raw-buffer.")
392 (make-variable-buffer-local 'mime-view-original-major-mode)
394 (make-variable-buffer-local 'mime::preview/original-window-configuration)
397 ;;; @@ quitting method
400 (defvar mime-view-quitting-method-alist
401 '((mime-show-message-mode
402 . mime-view-quitting-method-for-mime-show-message-mode))
403 "Alist of major-mode vs. quitting-method of mime-view.")
405 (defvar mime-view-over-to-previous-method-alist nil)
406 (defvar mime-view-over-to-next-method-alist nil)
408 (defvar mime-view-show-summary-method nil
409 "Alist of major-mode vs. show-summary-method.")
412 ;;; @@ following method
415 (defvar mime-view-following-method-alist nil
416 "Alist of major-mode vs. following-method of mime-view.")
418 (defvar mime-view-following-required-fields-list
425 ;; hack from Gnus 5.0.4.
427 (defvar mime-view-x-face-to-pbm-command
428 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
430 (defvar mime-view-x-face-command
431 (concat mime-view-x-face-to-pbm-command
433 "String to be executed to display an X-Face field.
434 The command will be executed in a sub-shell asynchronously.
435 The compressed face will be piped to this command.")
437 (defun mime-view-x-face-function ()
438 "Function to display X-Face field. You can redefine to customize."
439 ;; 1995/10/12 (c.f. tm-eng:130)
440 ;; fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
442 (narrow-to-region (point-min) (re-search-forward "^$" nil t))
444 (goto-char (point-min))
445 (if (re-search-forward "^X-Face:[ \t]*" nil t)
446 (let ((beg (match-end 0))
447 (end (std11-field-end))
449 (call-process-region beg end "sh" nil 0 nil
450 "-c" mime-view-x-face-command)
457 (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
463 (or mime-view-redisplay
464 (setq mime::article/content-info (mime-parse-message ctl encoding))
466 (let* ((cinfo mime::article/content-info)
467 (pcl (mime/flatten-content-info cinfo))
468 (the-buf (current-buffer))
472 (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
473 (set-buffer (get-buffer-create obuf))
474 (let ((inhibit-read-only t))
475 ;;(setq buffer-read-only nil)
478 (setq mime-raw-buffer the-buf)
479 (setq mime-view-original-major-mode mode)
480 (setq major-mode 'mime-view-mode)
481 (setq mode-name "MIME-View")
483 (mime-view-display-entity (car pcl) cinfo the-buf obuf)
486 (set-buffer-modified-p nil)
488 (setq buffer-read-only t)
491 (setq mime-view-buffer obuf)
494 (defun mime-view-display-entity (content cinfo ibuf obuf)
495 "Display entity from content-info CONTENT."
496 (let* ((beg (mime::content-info/point-min content))
497 (end (mime::content-info/point-max content))
498 (ctype (mime::content-info/type content))
499 (params (mime::content-info/parameters content))
500 (encoding (mime::content-info/encoding content))
501 (rcnum (mime::content-info/rcnum content))
505 (setq he (if (re-search-forward "^$" nil t)
512 (narrow-to-region beg end)
515 (mime-article/get-subject params encoding)))
519 (narrow-to-region nb nb)
520 (mime-view-entity-button-function rcnum cinfo ctype params subj encoding)
521 (if (mime-view-header-visible-p rcnum cinfo)
522 (mime-preview/display-header beg he)
524 (if (and (null rcnum)
526 ctype mime-view-content-button-visible-ctype-list))
528 (goto-char (point-max))
529 (mime-view-insert-entity-button
530 rcnum cinfo ctype params subj encoding)
532 (cond ((mime-view-body-visible-p rcnum cinfo ctype)
533 (mime-preview/display-body he end
534 rcnum cinfo ctype params subj encoding)
536 ((equal ctype "message/partial")
537 (mime-view-insert-message/partial-button)
540 (null (mime::content-info/children cinfo))
542 (goto-char (point-max))
543 (mime-view-insert-entity-button
544 rcnum cinfo ctype params subj encoding)
546 (mime-view-entity-separator-function rcnum cinfo ctype params subj)
547 (setq ne (point-max))
549 (put-text-property nb ne 'mime-view-raw-buffer ibuf)
550 (put-text-property nb ne 'mime-view-cinfo content)
554 (defun mime-preview/display-header (beg end)
556 (narrow-to-region (point)(point))
557 (insert-buffer-substring mime-raw-buffer beg end)
558 (let ((f (cdr (assq mime-view-original-major-mode
559 mime-view-content-header-filter-alist))))
562 (mime-view-default-content-header-filter)
564 (run-hooks 'mime-view-content-header-filter-hook)
567 (defun mime-preview/display-body (beg end
568 rcnum cinfo ctype params subj encoding)
570 (narrow-to-region (point-max)(point-max))
571 (insert-buffer-substring mime-raw-buffer beg end)
572 (let ((f (cdr (or (assoc ctype mime-view-content-filter-alist)
573 (assq t mime-view-content-filter-alist)))))
575 (funcall f ctype params encoding)
579 (defun mime-view-insert-message/partial-button ()
581 (goto-char (point-max))
582 (if (not (search-backward "\n\n" nil t))
585 (goto-char (point-max))
586 (narrow-to-region (point-max)(point-max))
587 (insert mime-view-announcement-for-message/partial)
588 (mime-add-button (point-min)(point-max)
589 (function mime-view-play-current-entity))
592 (defun mime-article/get-uu-filename (param &optional encoding)
593 (if (member (or encoding
594 (cdr (assq 'encoding param))
596 mime-view-uuencode-encoding-name-list)
598 (or (if (re-search-forward "^begin [0-9]+ " nil t)
599 (if (looking-at ".+$")
600 (buffer-substring (match-beginning 0)(match-end 0))
605 (defun mime-article/get-subject (param &optional encoding)
606 (or (std11-find-field-body '("Content-Description" "Subject"))
608 (if (or (and (setq ret (mime/Content-Disposition))
609 (setq ret (assoc "filename" (cdr ret)))
611 (setq ret (assoc "name" param))
612 (setq ret (assoc "x-name" param))
614 (std11-strip-quoted-string (cdr ret))
616 (mime-article/get-uu-filename param encoding)
620 ;;; @ content information
623 (defun mime-article/point-content-number (p &optional cinfo)
625 (setq cinfo mime::article/content-info)
627 (let ((b (mime::content-info/point-min cinfo))
628 (e (mime::content-info/point-max cinfo))
629 (c (mime::content-info/children cinfo))
631 (if (and (<= b p)(<= p e))
632 (or (let (co ret (sn 0))
636 (setq ret (mime-article/point-content-number p co))
637 (cond ((eq ret t) (throw 'tag (list sn)))
638 (ret (throw 'tag (cons sn ret)))
645 (defun mime-article/rcnum-to-cinfo (rcnum &optional cinfo)
647 (setq cinfo mime::article/content-info)
651 (equal (mime::content-info/rcnum ci) rcnum)
653 (mime/flatten-content-info cinfo)
656 (defun mime-article/cnum-to-cinfo (cn &optional cinfo)
658 (setq cinfo mime::article/content-info)
665 (let ((rc (nth sn (mime::content-info/children cinfo))))
667 (mime-article/cnum-to-cinfo (cdr cn) rc)
671 (defun mime/flatten-content-info (&optional cinfo)
673 (setq cinfo mime::article/content-info)
675 (let ((dest (list cinfo))
676 (rcl (mime::content-info/children cinfo))
679 (setq dest (nconc dest (mime/flatten-content-info (car rcl))))
685 ;;; @ MIME viewer mode
688 (defconst mime-view-menu-title "MIME-View")
689 (defconst mime-view-menu-list
690 '((up "Move to upper content" mime-view-move-to-upper)
691 (previous "Move to previous content" mime-view-move-to-previous)
692 (next "Move to next content" mime-view-move-to-next)
693 (scroll-down "Scroll to previous content" mime-view-scroll-down-entity)
694 (scroll-up "Scroll to next content" mime-view-scroll-up-entity)
695 (play "Play Content" mime-view-play-current-entity)
696 (extract "Extract Content" mime-view-extract-current-entity)
697 (print "Print" mime-view-print-current-entity)
698 (x-face "Show X Face" mime-view-display-x-face)
700 "Menu for MIME Viewer")
702 (cond (running-xemacs
703 (defvar mime-view-xemacs-popup-menu
704 (cons mime-view-menu-title
707 (vector (nth 1 item)(nth 2 item) t)
709 mime-view-menu-list)))
710 (defun mime-view-xemacs-popup-menu (event)
711 "Popup the menu in the MIME Viewer buffer"
713 (select-window (event-window event))
714 (set-buffer (event-buffer event))
715 (popup-menu 'mime-view-xemacs-popup-menu))
716 (defvar mouse-button-2 'button2)
719 (defvar mouse-button-2 [mouse-2])
722 (defun mime-view-define-keymap (&optional default)
723 (let ((mime-view-mode-map (if (keymapp default)
724 (copy-keymap default)
727 (define-key mime-view-mode-map
728 "u" (function mime-view-move-to-upper))
729 (define-key mime-view-mode-map
730 "p" (function mime-view-move-to-previous))
731 (define-key mime-view-mode-map
732 "n" (function mime-view-move-to-next))
733 (define-key mime-view-mode-map
734 "\e\t" (function mime-view-move-to-previous))
735 (define-key mime-view-mode-map
736 "\t" (function mime-view-move-to-next))
737 (define-key mime-view-mode-map
738 " " (function mime-view-scroll-up-entity))
739 (define-key mime-view-mode-map
740 "\M- " (function mime-view-scroll-down-entity))
741 (define-key mime-view-mode-map
742 "\177" (function mime-view-scroll-down-entity))
743 (define-key mime-view-mode-map
744 "\C-m" (function mime-view-next-line-content))
745 (define-key mime-view-mode-map
746 "\C-\M-m" (function mime-view-previous-line-content))
747 (define-key mime-view-mode-map
748 "v" (function mime-view-play-current-entity))
749 (define-key mime-view-mode-map
750 "e" (function mime-view-extract-current-entity))
751 (define-key mime-view-mode-map
752 "\C-c\C-p" (function mime-view-print-current-entity))
753 (define-key mime-view-mode-map
754 "a" (function mime-view-follow-current-entity))
755 (define-key mime-view-mode-map
756 "q" (function mime-view-quit))
757 (define-key mime-view-mode-map
758 "h" (function mime-view-show-summary))
759 (define-key mime-view-mode-map
760 "\C-c\C-x" (function mime-view-kill-buffer))
761 ;; (define-key mime-view-mode-map
762 ;; "<" (function beginning-of-buffer))
763 ;; (define-key mime-view-mode-map
764 ;; ">" (function end-of-buffer))
765 (define-key mime-view-mode-map
766 "?" (function describe-mode))
767 (define-key mime-view-mode-map
768 [tab] (function mime-view-move-to-next))
769 (define-key mime-view-mode-map
770 [delete] (function mime-view-scroll-down-entity))
771 (define-key mime-view-mode-map
772 [backspace] (function mime-view-scroll-down-entity))
773 (if (functionp default)
774 (cond (running-xemacs
775 (set-keymap-default-binding mime-view-mode-map default)
778 (setq mime-view-mode-map
779 (append mime-view-mode-map (list (cons t default))))
782 (define-key mime-view-mode-map
783 mouse-button-2 (function mime-button-dispatcher))
785 (cond (running-xemacs
786 (define-key mime-view-mode-map
787 mouse-button-3 (function mime-view-xemacs-popup-menu))
789 ((>= emacs-major-version 19)
790 (define-key mime-view-mode-map [menu-bar mime-view]
791 (cons mime-view-menu-title
792 (make-sparse-keymap mime-view-menu-title)))
795 (define-key mime-view-mode-map
796 (vector 'menu-bar 'mime-view (car item))
797 (cons (nth 1 item)(nth 2 item))
800 (reverse mime-view-menu-list)
803 (use-local-map mime-view-mode-map)
804 (run-hooks 'mime-view-define-keymap-hook)
807 (defsubst mime-hide-echo-buffer ()
808 "Hide mime-echo buffer."
809 (let ((win (get-buffer-window mime-echo-buffer-name)))
814 (defun mime-view-mode (&optional mother ctl encoding ibuf obuf
815 default-keymap-or-function)
816 "Major mode for viewing MIME message.
818 Here is a list of the standard keys for mime-view-mode.
823 u Move to upper content
824 p or M-TAB Move to previous content
825 n or TAB Move to next content
826 SPC Scroll up or move to next content
827 M-SPC or DEL Scroll down or move to previous content
828 RET Move to next line
829 M-RET Move to previous line
830 v Decode current content as `play mode'
831 e Decode current content as `extract mode'
832 C-c C-p Decode current content as `print mode'
833 a Followup to current content.
836 button-2 Move to point under the mouse cursor
837 and decode current content as `play mode'
840 (let ((buf (get-buffer mime-echo-buffer-name)))
845 (mime-hide-echo-buffer)
847 (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
848 (win-conf (current-window-configuration))
851 (switch-to-buffer ret)
852 (setq mime::preview/original-window-configuration win-conf)
855 (setq mime-mother-buffer mother)
857 (mime-view-define-keymap default-keymap-or-function)
858 (let ((point (next-single-property-change (point-min) 'mime-view-cinfo)))
861 (goto-char (point-min))
862 (search-forward "\n\n" nil t)
864 (run-hooks 'mime-view-mode-hook)
871 (autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t)
873 (defun mime-view-extract-current-entity ()
874 "Extract current entity into file (maybe).
875 It decodes current entity to call internal or external method as
876 \"extract\" mode. The method is selected from variable
877 `mime-acting-condition'."
879 (mime-view-play-current-entity "extract")
882 (defun mime-view-print-current-entity ()
883 "Print current entity (maybe).
884 It decodes current entity to call internal or external method as
885 \"print\" mode. The method is selected from variable
886 `mime-acting-condition'."
888 (mime-view-play-current-entity "print")
895 (defun mime-view-get-original-major-mode ()
896 "Return major-mode of original buffer.
897 If a current buffer has mime-mother-buffer, return original major-mode
898 of the mother-buffer."
899 (if mime-mother-buffer
901 (set-buffer mime-mother-buffer)
902 (mime-view-get-original-major-mode)
904 mime-view-original-major-mode))
906 (defun mime-view-follow-current-entity ()
907 "Write follow message to current entity.
908 It calls following-method selected from variable
909 `mime-view-following-method-alist'."
911 (let ((root-cinfo (get-text-property (point-min) 'mime-view-cinfo))
913 (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo)))
916 (let* ((p-beg (previous-single-property-change (point) 'mime-view-cinfo))
918 (rcnum (mime::content-info/rcnum cinfo))
923 (if (eq (next-single-property-change (point-min)
929 ((eq (next-single-property-change p-beg 'mime-view-cinfo)
933 (setq p-end (next-single-property-change p-beg 'mime-view-cinfo))
935 (setq p-end (point-max))
938 (setq p-end (point-max))
946 (next-single-property-change
947 (point) 'mime-view-cinfo))
949 (let ((rc (mime::content-info/rcnum
950 (get-text-property (point)
952 (or (equal rcnum (nthcdr (- (length rc) len) rc))
957 (setq p-end (point-max))
960 (let* ((mode (mime-view-get-original-major-mode))
961 (new-name (format "%s-%s" (buffer-name) (reverse rcnum)))
963 (the-buf (current-buffer))
964 (a-buf mime-raw-buffer)
967 (set-buffer (setq new-buf (get-buffer-create new-name)))
969 (insert-buffer-substring the-buf p-beg p-end)
970 (goto-char (point-min))
971 (if (mime-view-header-visible-p rcnum root-cinfo)
972 (delete-region (goto-char (point-min))
973 (if (re-search-forward "^$" nil t)
977 (goto-char (point-min))
979 (goto-char (point-min))
980 (let ((rcnum (mime::content-info/rcnum cinfo)) ci str)
985 (setq ci (mime-article/rcnum-to-cinfo rcnum))
988 (mime::content-info/point-min ci)
989 (mime::content-info/point-max ci)
991 (std11-header-string-except
993 (apply (function regexp-or) fields)
995 (if (string= (mime::content-info/type ci)
1002 (setq fields (std11-collect-field-names)
1006 (let ((rest mime-view-following-required-fields-list))
1008 (let ((field-name (car rest)))
1009 (or (std11-field-body field-name)
1015 (set-buffer the-buf)
1016 (set-buffer mime-mother-buffer)
1017 (set-buffer mime-raw-buffer)
1018 (std11-field-body field-name)
1022 (setq rest (cdr rest))
1024 (eword-decode-header)
1026 (let ((f (cdr (assq mode mime-view-following-method-alist))))
1031 "Sorry, following method for %s is not implemented yet."
1040 (defun mime-view-display-x-face ()
1042 (save-window-excursion
1043 (set-buffer mime-raw-buffer)
1044 (mime-view-x-face-function)
1051 (defun mime-view-move-to-upper ()
1052 "Move to upper entity.
1053 If there is no upper entity, call function `mime-view-quit'."
1056 (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo)))
1059 (let ((r (mime-article/rcnum-to-cinfo
1060 (cdr (mime::content-info/rcnum cinfo))
1061 (get-text-property 1 'mime-view-cinfo)))
1064 (while (setq point (previous-single-property-change
1065 (point) 'mime-view-cinfo))
1067 (if (eq r (get-text-property (point) 'mime-view-cinfo))
1074 (defun mime-view-move-to-previous ()
1075 "Move to previous entity.
1076 If there is no previous entity, it calls function registered in
1077 variable `mime-view-over-to-previous-method-alist'."
1079 (while (null (get-text-property (point) 'mime-view-cinfo))
1082 (let ((point (previous-single-property-change (point) 'mime-view-cinfo)))
1085 (let ((f (assq mime-view-original-major-mode
1086 mime-view-over-to-previous-method-alist)))
1092 (defun mime-view-move-to-next ()
1093 "Move to next entity.
1094 If there is no previous entity, it calls function registered in
1095 variable `mime-view-over-to-next-method-alist'."
1097 (let ((point (next-single-property-change (point) 'mime-view-cinfo)))
1100 (let ((f (assq mime-view-original-major-mode
1101 mime-view-over-to-next-method-alist)))
1107 (defun mime-view-scroll-up-entity (&optional h)
1108 "Scroll up current entity.
1109 If reached to (point-max), it calls function registered in variable
1110 `mime-view-over-to-next-method-alist'."
1113 (setq h (1- (window-height)))
1115 (if (= (point) (point-max))
1116 (let ((f (assq mime-view-original-major-mode
1117 mime-view-over-to-next-method-alist)))
1122 (or (next-single-property-change (point) 'mime-view-cinfo)
1125 (if (> (point) point)
1130 (defun mime-view-scroll-down-entity (&optional h)
1131 "Scroll down current entity.
1132 If reached to (point-min), it calls function registered in variable
1133 `mime-view-over-to-previous-method-alist'."
1136 (setq h (1- (window-height)))
1138 (if (= (point) (point-min))
1139 (let ((f (assq mime-view-original-major-mode
1140 mime-view-over-to-previous-method-alist)))
1147 (while (> (point) 1)
1149 (previous-single-property-change (point)
1155 (setq point (point-min))
1157 (forward-line (- h))
1158 (if (< (point) point)
1162 (defun mime-view-next-line-content ()
1164 (mime-view-scroll-up-entity 1)
1167 (defun mime-view-previous-line-content ()
1169 (mime-view-scroll-down-entity 1)
1176 (defun mime-view-quit ()
1177 "Quit from MIME-View buffer.
1178 It calls function registered in variable
1179 `mime-view-quitting-method-alist'."
1181 (let ((r (assq mime-view-original-major-mode
1182 mime-view-quitting-method-alist)))
1187 (defun mime-view-show-summary ()
1189 It calls function registered in variable
1190 `mime-view-show-summary-method'."
1192 (let ((r (assq mime-view-original-major-mode
1193 mime-view-show-summary-method)))
1198 (defun mime-view-kill-buffer ()
1200 (kill-buffer (current-buffer))
1207 (provide 'mime-view)
1209 (run-hooks 'mime-view-load-hook)
1211 ;;; mime-view.el ends here