X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=37735e82dfaf74cdecec9e48395d6ce7d3996b7b;hb=18bf539f8b2e2fa59c57f25f911d44cea94e9a8e;hp=ef05a15af558e9399126534d336f3e42542668ba;hpb=2e2f5b06a5d30fdf57394f764f2a36929f0e5f63;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index ef05a15..37735e8 100644 --- a/mime-view.el +++ b/mime-view.el @@ -3,8 +3,8 @@ ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Created: 1994/7/13 -;; Renamed: 1994/8/31 from tm-body.el +;; Created: 1994/07/13 +;; Renamed: 1994/08/31 from tm-body.el ;; Renamed: 1997/02/19 from tm-view.el ;; Keywords: MIME, multimedia, mail, news @@ -31,156 +31,220 @@ (require 'mel) (require 'eword-decode) (require 'mime-parse) -(require 'mime-text) +(require 'semi-def) +(require 'calist) ;;; @ version ;;; (defconst mime-view-version-string - `,(concat "SEMI MIME-View " - (mapconcat #'number-to-string (cdr semi-version) ".") - " (" (car semi-version) ")")) + `,(concat (car mime-module-version) " MIME-View " + (mapconcat #'number-to-string (cddr mime-module-version) ".") + " (" (cadr mime-module-version) ")")) ;;; @ variables ;;; -(defvar mime-acting-condition - '(((type . text)(subtype . plain) - (method "tm-plain" nil 'file "" 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . text)(subtype . html) - (method "tm-html" nil 'file "" 'encoding 'mode 'name) - (mode . "play") - ) - ((type . text)(subtype . x-rot13-47) - (method . mime-method-to-display-caesar) - (mode . "play") - ) - ((type . text)(subtype . x-rot13-47-48) - (method . mime-method-to-display-caesar) - (mode . "play") - ) - - ((type . audio)(subtype . basic) - (method "tm-au" nil 'file "" 'encoding 'mode 'name) - (mode . "play") - ) - - ((type . image) - (method "tm-image" nil 'file "" 'encoding 'mode 'name) - (mode "play" "print") - ) - - ((type . video)(subtype . mpeg) - (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name) - (mode . "play") - ) - - ((type . application)(subtype . postscript) - (method "tm-ps" nil 'file "" 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . application)(subtype . octet-stream) - (method . mime-method-to-save)(mode "play" "print") - ) - - ((type . message)(subtype . external-body) - ("access-type" . "anon-ftp") - (method . mime-method-to-display-message/external-ftp) - ) - ((type . message)(subtype . rfc822) - (method . mime-method-to-display-message/rfc822) - (mode . "play") - ) - ((type . message)(subtype . partial) - (method . mime-method-to-store-message/partial) - (mode . "play") - ) - - ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file) - (mode . "play") - ) - ((method . mime-method-to-save)(mode . "extract")) - )) +(defgroup mime-view nil + "MIME view mode" + :group 'mime) -(defvar mime-view-childrens-header-showing-Content-Type-list - '("message/rfc822" "message/news")) +(defcustom mime-view-find-every-acting-situation nil + "*Find every available acting-situation if non-nil." + :group 'mime-view + :type 'boolean) -(defvar mime-view-visible-media-type-list - '("text/plain" nil "text/richtext" "text/enriched" - "text/rfc822-headers" - "text/x-latex" "application/x-latex" - "message/delivery-status" - "application/pgp" "text/x-pgp" - "application/octet-stream" - "application/x-selection" "application/x-comment") - "*List of media-types to be able to display in MIME-View buffer. -Each elements are string of TYPE/SUBTYPE, e.g. \"text/plain\".") +(defcustom mime-view-acting-example-file "~/.mime-example" + "*File name of example about acting-situation demonstrated by user." + :group 'mime-view + :type 'file) -(defvar mime-view-content-button-visible-ctype-list - '("application/pgp")) -(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) +;;; @ buffer local variables +;;; -(defvar mime-view-ignored-field-list - '(".*Received" ".*Path" ".*Id" "References" - "Replied" "Errors-To" - "Lines" "Sender" ".*Host" "Xref" - "Content-Type" "Precedence" - "Status" "X-VM-.*") - "All fields that match this list will be hidden in MIME preview buffer. -Each elements are regexp of field-name. [mime-view.el]") +;;; @@ in raw-buffer +;;; -(defvar mime-view-ignored-field-regexp - (concat "^" - (apply (function regexp-or) mime-view-ignored-field-list) - ":")) +(defvar mime-raw-message-info + "Information about structure of message. +Please use reference function `mime-entity-SLOT' to get value of SLOT. -(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id") - "All fields that match this list will be displayed in MIME preview buffer. -Each elements are regexp of field-name.") +Following is a list of slots of the structure: -(defvar mime-view-redisplay nil) +node-id reversed entity-number (list of integers) +point-min beginning point of region in raw-buffer +point-max end point of region in raw-buffer +type media-type (symbol) +subtype media-subtype (symbol) +type/subtype media-type/subtype (string or nil) +parameters parameter of Content-Type field (association list) +encoding Content-Transfer-Encoding (string or nil) +children entities included in this entity (list of content-infos) -(defvar mime-view-announcement-for-message/partial - (if (and (>= emacs-major-version 19) window-system) - "\ -\[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer ]] -\[[ or click here by mouse button-2. ]]" - "\ -\[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer. ]]" - )) +If an entity includes other entities in its body, such as multipart or +message/rfc822, `mime-entity' structures of them are included in +`children', so the `mime-entity' structure become a tree.") +(make-variable-buffer-local 'mime-raw-message-info) +(defvar mime-preview-buffer nil + "MIME-preview buffer corresponding with the (raw) buffer.") +(make-variable-buffer-local 'mime-preview-buffer) -;;; @@ entity button + +;;; @@ in preview-buffer ;;; -(defun mime-view-insert-entity-button (rcnum cinfo - media-type media-subtype params - subj encoding) - "Insert entity-button." - (mime-insert-button - (let ((access-type (assoc "access-type" params)) - (num (or (cdr (assoc "x-part-number" params)) - (if (consp rcnum) - (mapconcat (function - (lambda (num) - (format "%s" (1+ num)) - )) - (reverse rcnum) ".") - "0")) - )) - (cond (access-type - (let ((server (assoc "server" params))) - (setq access-type (cdr access-type)) - (if server - (format "%s %s ([%s] %s)" - num subj access-type (cdr server)) +(defvar mime-mother-buffer nil + "Mother buffer corresponding with the (MIME-preview) buffer. +If current MIME-preview buffer is generated by other buffer, such as +message/partial, it is called `mother-buffer'.") +(make-variable-buffer-local 'mime-mother-buffer) + +(defvar mime-raw-buffer nil + "Raw buffer corresponding with the (MIME-preview) buffer.") +(make-variable-buffer-local 'mime-raw-buffer) + +(defvar mime-preview-original-major-mode nil + "Major-mode of mime-raw-buffer.") +(make-variable-buffer-local 'mime-preview-original-major-mode) + +(defvar mime-preview-original-window-configuration nil + "Window-configuration before mime-view-mode is called.") +(make-variable-buffer-local 'mime-preview-original-window-configuration) + + +;;; @ entity information +;;; + +(defsubst mime-raw-find-entity-from-node-id (entity-node-id + &optional message-info) + "Return entity from ENTITY-NODE-ID in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (mime-raw-find-entity-from-number (reverse entity-node-id) message-info)) + +(defun mime-raw-find-entity-from-number (entity-number &optional message-info) + "Return entity from ENTITY-NUMBER in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (or message-info + (setq message-info mime-raw-message-info)) + (if (eq entity-number t) + message-info + (let ((sn (car entity-number))) + (if (null sn) + message-info + (let ((rc (nth sn (mime-entity-children message-info)))) + (if rc + (mime-raw-find-entity-from-number (cdr entity-number) rc) + )) + )))) + +(defun mime-raw-find-entity-from-point (point &optional message-info) + "Return entity from POINT in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (or message-info + (setq message-info mime-raw-message-info)) + (if (and (<= (mime-entity-point-min message-info) point) + (<= point (mime-entity-point-max message-info))) + (let ((children (mime-entity-children message-info))) + (catch 'tag + (while children + (let ((ret + (mime-raw-find-entity-from-point point (car children)))) + (if ret + (throw 'tag ret) + )) + (setq children (cdr children))) + message-info)))) + +(defsubst mime-raw-point-to-entity-node-id (point &optional message-info) + "Return entity-node-id from POINT in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (mime-entity-node-id (mime-raw-find-entity-from-point point message-info))) + +(defsubst mime-raw-point-to-entity-number (point &optional message-info) + "Return entity-number from POINT in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (reverse (mime-raw-point-to-entity-node-id point message-info))) + +(defsubst mime-raw-entity-parent (entity &optional message-info) + "Return mother entity of ENTITY. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (mime-raw-find-entity-from-node-id (cdr (mime-entity-node-id entity)) + message-info)) + +(defun mime-raw-flatten-message-info (&optional message-info) + "Return list of entity in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (or message-info + (setq message-info mime-raw-message-info)) + (let ((dest (list message-info)) + (rcl (mime-entity-children message-info))) + (while rcl + (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl)))) + (setq rcl (cdr rcl))) + dest)) + + +;;; @ presentation of preview +;;; + +;;; @@ entity-button +;;; + +;;; @@@ predicate function +;;; + +(defun mime-view-entity-button-visible-p (entity message-info) + "Return non-nil if header of ENTITY is visible. +Please redefine this function if you want to change default setting." + (let ((media-type (mime-entity-media-type entity)) + (media-subtype (mime-entity-media-subtype entity))) + (or (not (eq media-type 'application)) + (and (not (eq media-subtype 'x-selection)) + (or (not (eq media-subtype 'octet-stream)) + (let ((mother-entity + (mime-raw-entity-parent entity message-info))) + (or (not (eq (mime-entity-media-type mother-entity) + 'multipart)) + (not (eq (mime-entity-media-subtype mother-entity) + 'encrypted))) + ) + ))))) + +;;; @@@ entity button generator +;;; + +(defun mime-view-insert-entity-button (entity message-info subj) + "Insert entity-button of ENTITY." + (let ((entity-node-id (mime-entity-node-id entity)) + (params (mime-entity-parameters entity))) + (mime-insert-button + (let ((access-type (assoc "access-type" params)) + (num (or (cdr (assoc "x-part-number" params)) + (if (consp entity-node-id) + (mapconcat (function + (lambda (num) + (format "%s" (1+ num)) + )) + (reverse entity-node-id) ".") + "0")) + )) + (cond (access-type + (let ((server (assoc "server" params))) + (setq access-type (cdr access-type)) + (if server + (format "%s %s ([%s] %s)" + num subj access-type (cdr server)) (let ((site (cdr (assoc "site" params))) (dir (cdr (assoc "directory" params))) ) @@ -189,7 +253,10 @@ Each elements are regexp of field-name.") ))) ) (t - (let ((charset (cdr (assoc "charset" params)))) + (let ((media-type (mime-entity-media-type entity)) + (media-subtype (mime-entity-media-subtype entity)) + (charset (cdr (assoc "charset" params))) + (encoding (mime-entity-encoding entity))) (concat num " " subj (let ((rest @@ -205,33 +272,59 @@ Each elements are regexp of field-name.") "\n\t") rest))) ))) - (function mime-view-play-current-entity)) + (function mime-preview-play-current-entity)) + )) + + +;;; @@ entity-header +;;; + +;;; @@@ predicate function +;;; + +;; (defvar mime-view-childrens-header-showing-Content-Type-list +;; '("message/rfc822" "message/news")) + +;; (defun mime-view-header-visible-p (entity message-info) +;; "Return non-nil if header of ENTITY is visible." +;; (let ((entity-node-id (mime-entity-node-id entity))) +;; (member (mime-entity-type/subtype +;; (mime-raw-find-entity-from-node-id +;; (cdr entity-node-id) message-info)) +;; mime-view-childrens-header-showing-Content-Type-list) +;; )) + +;;; @@@ entity header filter +;;; + +(defvar mime-view-content-header-filter-alist nil) + +(defun mime-view-default-content-header-filter () + (mime-view-cut-header) + (eword-decode-header) ) -(defun mime-view-entity-button-function (rcnum cinfo - media-type media-subtype - params subj encoding) - "Insert entity button conditionally. -Please redefine this function if you want to change default setting." - (or (null rcnum) - (and (eq media-type 'application) - (or (eq media-subtype 'x-selection) - (and (eq media-subtype 'octet-stream) - (let ((entity-info - (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))) - (and (eq (mime-entity-info-media-type entity-info) - 'multipart) - (eq (mime-entity-info-media-subtype entity-info) - 'encrypted) - ))))) - (mime-view-insert-entity-button - rcnum cinfo media-type media-subtype params subj encoding) - )) - - -;;; @@ content header filter +;;; @@@ entity field cutter ;;; +(defvar mime-view-ignored-field-list + '(".*Received" ".*Path" ".*Id" "References" + "Replied" "Errors-To" + "Lines" "Sender" ".*Host" "Xref" + "Content-Type" "Precedence" + "Status" "X-VM-.*") + "All fields that match this list will be hidden in MIME preview buffer. +Each elements are regexp of field-name.") + +(defvar mime-view-ignored-field-regexp + (concat "^" + (apply (function regexp-or) mime-view-ignored-field-list) + ":")) + +(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id") + "All fields that match this list will be displayed in MIME preview buffer. +Each elements are regexp of field-name.") + (defun mime-view-cut-header () (goto-char (point-min)) (while (re-search-forward mime-view-ignored-field-regexp nil t) @@ -253,101 +346,268 @@ Please redefine this function if you want to change default setting." (point-max)))) )))) -(defun mime-view-default-content-header-filter () - (mime-view-cut-header) - (eword-decode-header) - ) -(defvar mime-view-content-header-filter-alist nil) - - -;;; @@ content filter +;;; @@ entity-body ;;; -(defvar mime-view-content-filter-alist - '(("text/enriched" . mime-view-filter-for-text/enriched) - ("text/richtext" . mime-view-filter-for-text/richtext) - (t . mime-view-filter-for-text/plain) - ) - "Alist of media-types vs. corresponding MIME-View filter functions. -Each element looks like (TYPE/SUBTYPE . FUNCTION) or (t . FUNCTION). -TYPE/SUBTYPE is a string of media-type and FUNCTION is a filter -function. t means default media-type.") - - -;;; @@ entity separator +;;; @@@ predicate function ;;; -(defun mime-view-entity-separator-function (rcnum cinfo - media-type media-subtype - params subj) - "Insert entity separator conditionally. -Please redefine this function if you want to change default setting." - (or (mime-view-header-visible-p rcnum cinfo) - (mime-view-body-visible-p rcnum cinfo media-type media-subtype) - (progn - (goto-char (point-max)) - (insert "\n") - ))) - - -;;; @@ buffer local variables -;;; - -;;; @@@ in raw buffer +(defun mime-calist::field-match-method-as-default-rule (calist + field-type field-value) + (let ((s-field (assq field-type calist))) + (cond ((null s-field) + (cons (cons field-type field-value) calist) + ) + (t calist)))) + +(define-calist-field-match-method + 'header #'mime-calist::field-match-method-as-default-rule) + +(define-calist-field-match-method + 'body #'mime-calist::field-match-method-as-default-rule) + + +(defvar mime-preview-condition nil + "Condition-tree about how to display entity.") + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . application)(subtype . octet-stream) + (encoding . nil) + (body . visible))) +(ctree-set-calist-strictly + 'mime-preview-condition '((type . application)(subtype . octet-stream) + (encoding . "7bit") + (body . visible))) +(ctree-set-calist-strictly + 'mime-preview-condition '((type . application)(subtype . octet-stream) + (encoding . "8bit") + (body . visible))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . application)(subtype . pgp) + (body . visible))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . application)(subtype . x-latex) + (body . visible))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . application)(subtype . x-selection) + (body . visible))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . application)(subtype . x-comment) + (body . visible))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . message)(subtype . delivery-status) + (body . visible))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((body . visible) + (body-presentation-method . with-filter) + (body-filter . mime-preview-filter-for-text/plain))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . nil) + (body . visible) + (body-presentation-method . with-filter) + (body-filter . mime-preview-filter-for-text/plain))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . text)(subtype . enriched) + (body . visible) + (body-presentation-method . with-filter) + (body-filter + . mime-preview-filter-for-text/enriched))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . text)(subtype . richtext) + (body . visible) + (body-presentation-method . with-filter) + (body-filter + . mime-preview-filter-for-text/richtext))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . text)(subtype . t) + (body . visible) + (body-presentation-method . with-filter) + (body-filter . mime-preview-filter-for-text/plain))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . message)(subtype . partial) + (body-presentation-method + . mime-view-insert-message/partial-button))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . message)(subtype . rfc822) + (body-presentation-method . nil) + (childrens-situation (header . visible) + (entity-button . invisible)))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . message)(subtype . news) + (body-presentation-method . nil) + (childrens-situation (header . visible) + (entity-button . invisible)))) + + +;;; @@@ entity filter ;;; -(defvar mime-raw-content-info - "Information about structure of message. -Please use reference function `mime::content-info/SLOT-NAME' to -reference slot of content-info. Their argument is only content-info. - -Following is a list of slots of the structure: - -rcnum reversed content-number (list) -point-min beginning point of region in raw-buffer -point-max end point of region in raw-buffer -type media-type/subtype (string or nil) -parameters parameter of Content-Type field (association list) -encoding Content-Transfer-Encoding (string or nil) -children entities included in this entity (list of content-infos) - -If a entity includes other entities in its body, such as multipart or -message/rfc822, content-infos of other entities are included in -`children', so content-info become a tree.") -(make-variable-buffer-local 'mime-raw-content-info) +(autoload 'mime-preview-filter-for-text/plain "mime-text") +(autoload 'mime-preview-filter-for-text/enriched "mime-text") +(autoload 'mime-preview-filter-for-text/richtext "mime-text") -(defvar mime-view-buffer nil - "MIME View buffer corresponding with the (raw) buffer.") -(make-variable-buffer-local 'mime-view-buffer) +(defvar mime-text-decoder-alist + '((mime-show-message-mode . mime-text-decode-buffer) + (mime-temp-message-mode . mime-text-decode-buffer) + (t . mime-text-decode-buffer-maybe) + ) + "Alist of major-mode vs. mime-text-decoder. +Each element looks like (SYMBOL . FUNCTION). SYMBOL is major-mode or +t. t means default. +Specification of FUNCTION is described in DOC-string of variable +`mime-text-decoder'. -;;; @@@ in view buffer -;;; +This value is overridden by buffer local variable `mime-text-decoder' +if it is not nil.") -(defvar mime-mother-buffer nil - "Mother buffer corresponding with the (MIME-View) buffer. -If current MIME-View buffer is generated by other buffer, such as -message/partial, it is called `mother-buffer'.") -(make-variable-buffer-local 'mime-mother-buffer) -(defvar mime-raw-buffer nil - "Raw buffer corresponding with the (MIME-View) buffer.") -(make-variable-buffer-local 'mime-raw-buffer) +(defvar mime-view-announcement-for-message/partial + (if (and (>= emacs-major-version 19) window-system) + "\ +\[[ This is message/partial style split message. ]] +\[[ Please press `v' key in this buffer ]] +\[[ or click here by mouse button-2. ]]" + "\ +\[[ This is message/partial style split message. ]] +\[[ Please press `v' key in this buffer. ]]" + )) -(defvar mime-view-original-major-mode nil - "Major-mode in mime-raw-buffer.") -(make-variable-buffer-local 'mime-view-original-major-mode) +(defun mime-view-insert-message/partial-button (&optional situation) + (save-restriction + (goto-char (point-max)) + (if (not (search-backward "\n\n" nil t)) + (insert "\n") + ) + (goto-char (point-max)) + (narrow-to-region (point-max)(point-max)) + (insert mime-view-announcement-for-message/partial) + (mime-add-button (point-min)(point-max) + #'mime-preview-play-current-entity) + )) -(make-variable-buffer-local 'mime::preview/original-window-configuration) +;;; @ acting-condition +;;; -;;; @@ quitting method +(defvar mime-acting-condition nil + "Condition-tree about how to process entity.") + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . t)(subtype . t)(mode . "play") + (method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . t)(subtype . t)(mode . "extract") + (method . mime-method-to-save))) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . plain)(mode . "play") + (method "tm-plain" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . plain)(mode . "print") + (method "tm-plain" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . html)(mode . "play") + (method "tm-html" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . x-rot13-47)(mode . "play") + (method . mime-method-to-display-caesar) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . text)(subtype . x-rot13-47-48)(mode . "play") + (method . mime-method-to-display-caesar) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . audio)(subtype . basic)(mode . "play") + (method "tm-au" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . image)(mode . "play") + (method "tm-image" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . image)(mode . "print") + (method "tm-image" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . video)(subtype . mpeg)(mode . "play") + (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . postscript)(mode . "play") + (method "tm-ps" nil 'file "" 'encoding 'mode 'name) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . postscript)(mode . "print") + (method "tm-ps" nil 'file "" 'encoding 'mode 'name) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . message)(subtype . rfc822)(mode . "play") + (method . mime-method-to-display-message/rfc822) + )) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . message)(subtype . partial)(mode . "play") + (method . mime-method-to-store-message/partial) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . message)(subtype . external-body) + ("access-type" . "anon-ftp") + (method . mime-method-to-display-message/external-ftp) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . octet-stream) + (method . mime-method-to-save) + )) + + +;;; @ quitting method ;;; -(defvar mime-view-quitting-method-alist +(defvar mime-preview-quitting-method-alist '((mime-show-message-mode - . mime-view-quitting-method-for-mime-show-message-mode)) + . mime-preview-quitting-method-for-mime-show-message-mode)) "Alist of major-mode vs. quitting-method of mime-view.") (defvar mime-view-over-to-previous-method-alist nil) @@ -357,7 +617,7 @@ message/partial, it is called `mother-buffer'.") "Alist of major-mode vs. show-summary-method.") -;;; @@ following method +;;; @ following method ;;; (defvar mime-view-following-method-alist nil @@ -367,7 +627,7 @@ message/partial, it is called `mother-buffer'.") '("From")) -;;; @@ X-Face +;;; @ X-Face ;;; ;; hack from Gnus 5.0.4. @@ -399,9 +659,21 @@ The compressed face will be piped to this command.") )))) +;;; @ miscellaneous +;;; + +(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) + +(defvar mime-raw-buffer-coding-system-alist + `((t . ,(mime-charset-to-coding-system default-mime-charset))) + "Alist of major-mode vs. corresponding coding-system of `mime-raw-buffer'.") + + ;;; @ buffer setup ;;; +(defvar mime-view-redisplay nil) + (defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf) (if ibuf (progn @@ -409,13 +681,11 @@ The compressed face will be piped to this command.") (set-buffer ibuf) )) (or mime-view-redisplay - (setq mime-raw-content-info (mime-parse-message ctl encoding)) + (setq mime-raw-message-info (mime-parse-message ctl encoding)) ) - (let* ((cinfo mime-raw-content-info) - (pcl (mime/flatten-content-info cinfo)) - (the-buf (current-buffer)) - (mode major-mode) - ) + (let ((message-info mime-raw-message-info) + (the-buf (current-buffer)) + (mode major-mode)) (or obuf (setq obuf (concat "*Preview-" (buffer-name the-buf) "*"))) (set-buffer (get-buffer-create obuf)) @@ -424,127 +694,185 @@ The compressed face will be piped to this command.") (widen) (erase-buffer) (setq mime-raw-buffer the-buf) - (setq mime-view-original-major-mode mode) + (setq mime-preview-original-major-mode mode) (setq major-mode 'mime-view-mode) (setq mode-name "MIME-View") - (while pcl - (mime-view-display-entity (car pcl) cinfo the-buf obuf) - (setq pcl (cdr pcl)) - ) + (mime-view-display-message message-info the-buf obuf) (set-buffer-modified-p nil) ) (setq buffer-read-only t) (set-buffer the-buf) ) - (setq mime-view-buffer obuf) + (setq mime-preview-buffer obuf) ) -(defun mime-view-display-entity (content cinfo ibuf obuf) - "Display entity from content-info CONTENT." - (let* ((beg (mime-entity-info-point-min content)) - (end (mime-entity-info-point-max content)) - (media-type (mime-entity-info-media-type content)) - (media-subtype (mime-entity-info-media-subtype content)) - (ctype (if media-type - (if media-subtype - (format "%s/%s" media-type media-subtype) - (symbol-name media-type) - ))) - (params (mime-entity-info-parameters content)) - (encoding (mime-entity-info-encoding content)) - (rcnum (mime-entity-info-rnum content)) - he e nb ne subj) +(defun mime-view-display-message (message-info ibuf obuf) + (let* ((start (mime-entity-point-min message-info)) + (end (mime-entity-point-max message-info)) + (media-type (mime-entity-media-type message-info)) + (media-subtype (mime-entity-media-subtype message-info)) + (params (mime-entity-parameters message-info)) + (encoding (mime-entity-encoding message-info)) + end-of-header e nb ne subj) (set-buffer ibuf) - (goto-char beg) - (setq he (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - end)) - (if (> he end) - (setq he end) + (goto-char start) + (setq end-of-header (if (re-search-forward "^$" nil t) + (1+ (match-end 0)) + end)) + (if (> end-of-header end) + (setq end-of-header end) ) (save-restriction - (narrow-to-region beg end) + (narrow-to-region start end) (setq subj (eword-decode-string - (mime-article/get-subject params encoding))) + (mime-raw-get-subject params encoding))) ) (set-buffer obuf) (setq nb (point)) (narrow-to-region nb nb) - (mime-view-entity-button-function - rcnum cinfo media-type media-subtype params subj encoding) - (if (mime-view-header-visible-p rcnum cinfo) - (mime-view-display-header beg he) - ) - (if (and (null rcnum) - (member - ctype mime-view-content-button-visible-ctype-list)) - (save-excursion - (goto-char (point-max)) - (mime-view-insert-entity-button - rcnum cinfo media-type media-subtype params subj encoding) + ;; Insert message-header + (save-restriction + (narrow-to-region (point)(point)) + (insert-buffer-substring mime-raw-buffer start end-of-header) + (let ((f (cdr (assq mime-preview-original-major-mode + mime-view-content-header-filter-alist)))) + (if (functionp f) + (funcall f) + (mime-view-default-content-header-filter) )) - (cond ((mime-view-body-visible-p rcnum cinfo media-type media-subtype) - (mime-view-display-body he end - rcnum cinfo ctype params subj encoding) - ) - ((and (eq media-type 'message)(eq media-subtype 'partial)) - (mime-view-insert-message/partial-button) - ) - ((and (null rcnum) - (null (mime-entity-info-children cinfo)) - ) - (goto-char (point-max)) - (mime-view-insert-entity-button - rcnum cinfo media-type media-subtype params subj encoding) - )) - (mime-view-entity-separator-function - rcnum cinfo media-type media-subtype params subj) - (setq ne (point-max)) - (widen) - (put-text-property nb ne 'mime-view-raw-buffer ibuf) - (put-text-property nb ne 'mime-view-cinfo content) - (goto-char ne) - )) - -(defun mime-view-display-header (beg end) - (save-restriction - (narrow-to-region (point)(point)) - (insert-buffer-substring mime-raw-buffer beg end) - (let ((f (cdr (assq mime-view-original-major-mode - mime-view-content-header-filter-alist)))) - (if (functionp f) - (funcall f) - (mime-view-default-content-header-filter) - )) - (run-hooks 'mime-view-content-header-filter-hook) - )) - -(defun mime-view-display-body (beg end rcnum cinfo ctype params subj encoding) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (insert-buffer-substring mime-raw-buffer beg end) - (let ((f (cdr (or (assoc ctype mime-view-content-filter-alist) - (assq t mime-view-content-filter-alist))))) - (and (functionp f) - (funcall f ctype params encoding) - ) - ))) - -(defun mime-view-insert-message/partial-button () - (save-restriction - (goto-char (point-max)) - (if (not (search-backward "\n\n" nil t)) - (insert "\n") + (run-hooks 'mime-view-content-header-filter-hook) ) - (goto-char (point-max)) - (narrow-to-region (point-max)(point-max)) - (insert mime-view-announcement-for-message/partial) - (mime-add-button (point-min)(point-max) - (function mime-view-play-current-entity)) - )) - -(defun mime-article/get-uu-filename (param &optional encoding) + (let* ((situation + (ctree-match-calist mime-preview-condition + (list* (cons 'type media-type) + (cons 'subtype media-subtype) + (cons 'encoding encoding) + (cons 'major-mode major-mode) + params))) + (message-button + (cdr (assq 'message-button situation))) + (body-presentation-method + (cdr (assq 'body-presentation-method situation)))) + (when (eq message-button 'visible) + (goto-char (point-max)) + (mime-view-insert-entity-button message-info message-info subj) + ) + (cond ((eq body-presentation-method 'with-filter) + (let ((body-filter (cdr (assq 'body-filter situation)))) + (save-restriction + (narrow-to-region (point-max)(point-max)) + (insert-buffer-substring mime-raw-buffer end-of-header end) + (funcall body-filter situation) + ))) + ((functionp body-presentation-method) + (funcall body-presentation-method situation) + ) + ((null (mime-entity-children message-info)) + (goto-char (point-max)) + (mime-view-insert-entity-button message-info message-info subj) + )) + (setq ne (point-max)) + (widen) + (put-text-property nb ne 'mime-view-raw-buffer ibuf) + (put-text-property nb ne 'mime-view-entity message-info) + (goto-char ne) + (let ((children (mime-entity-children message-info)) + (default-situation + (cdr (assq 'childrens-situation situation)))) + (while children + (mime-view-display-entity (car children) message-info ibuf obuf + default-situation) + (setq children (cdr children)) + ))))) + +(defun mime-view-display-entity (entity message-info ibuf obuf + default-situation) + (let* ((start (mime-entity-point-min entity)) + (end (mime-entity-point-max entity)) + (media-type (mime-entity-media-type entity)) + (media-subtype (mime-entity-media-subtype entity)) + (params (mime-entity-parameters entity)) + (encoding (mime-entity-encoding entity)) + end-of-header e nb ne subj) + (set-buffer ibuf) + (goto-char start) + (setq end-of-header (if (re-search-forward "^$" nil t) + (1+ (match-end 0)) + end)) + (if (> end-of-header end) + (setq end-of-header end) + ) + (save-restriction + (narrow-to-region start end) + (setq subj + (eword-decode-string + (mime-raw-get-subject params encoding))) + ) + (let* ((situation + (ctree-match-calist mime-preview-condition + (list* (cons 'type media-type) + (cons 'subtype media-subtype) + (cons 'encoding encoding) + (cons 'major-mode major-mode) + (append params + default-situation)))) + (button-is-invisible + (eq (cdr (assq 'entity-button situation)) 'invisible)) + (header-is-visible + (eq (cdr (assq 'header situation)) 'visible)) + (body-presentation-method + (cdr (assq 'body-presentation-method situation)))) + (set-buffer obuf) + (setq nb (point)) + (narrow-to-region nb nb) + (or button-is-invisible + (if (mime-view-entity-button-visible-p entity message-info) + (mime-view-insert-entity-button entity message-info subj) + )) + (if header-is-visible + (save-restriction + (narrow-to-region (point)(point)) + (insert-buffer-substring mime-raw-buffer start end-of-header) + (let ((f (cdr (assq mime-preview-original-major-mode + mime-view-content-header-filter-alist)))) + (if (functionp f) + (funcall f) + (mime-view-default-content-header-filter) + )) + (run-hooks 'mime-view-content-header-filter-hook) + )) + (cond ((eq body-presentation-method 'with-filter) + (let ((body-filter (cdr (assq 'body-filter situation)))) + (save-restriction + (narrow-to-region (point-max)(point-max)) + (insert-buffer-substring mime-raw-buffer end-of-header end) + (funcall body-filter situation) + ))) + ((functionp body-presentation-method) + (funcall body-presentation-method situation) + )) + (or header-is-visible + body-presentation-method + (progn + (goto-char (point-max)) + (insert "\n") + )) + (setq ne (point-max)) + (widen) + (put-text-property nb ne 'mime-view-raw-buffer ibuf) + (put-text-property nb ne 'mime-view-entity entity) + (goto-char ne) + (let ((children (mime-entity-children entity)) + (default-situation + (cdr (assq 'childrens-situation situation)))) + (while children + (mime-view-display-entity (car children) message-info ibuf obuf + default-situation) + (setq children (cdr children)) + ))))) + +(defun mime-raw-get-uu-filename (param &optional encoding) (if (member (or encoding (cdr (assq 'encoding param)) ) @@ -557,7 +885,7 @@ The compressed face will be piped to this command.") "")) )) -(defun mime-article/get-subject (param &optional encoding) +(defun mime-raw-get-subject (param &optional encoding) (or (std11-find-field-body '("Content-Description" "Subject")) (let (ret) (if (or (and (setq ret (mime/Content-Disposition)) @@ -568,110 +896,24 @@ The compressed face will be piped to this command.") ) (std11-strip-quoted-string (cdr ret)) )) - (mime-article/get-uu-filename param encoding) + (mime-raw-get-uu-filename param encoding) "")) -;;; @ entity information -;;; - -(defun mime-article/point-content-number (p &optional cinfo) - (or cinfo - (setq cinfo mime-raw-content-info) - ) - (let ((b (mime-entity-info-point-min cinfo)) - (e (mime-entity-info-point-max cinfo)) - (c (mime-entity-info-children cinfo)) - ) - (if (and (<= b p)(<= p e)) - (or (let (co ret (sn 0)) - (catch 'tag - (while c - (setq co (car c)) - (setq ret (mime-article/point-content-number p co)) - (cond ((eq ret t) (throw 'tag (list sn))) - (ret (throw 'tag (cons sn ret))) - ) - (setq c (cdr c)) - (setq sn (1+ sn)) - ))) - t)))) - -(defsubst mime-article/rcnum-to-cinfo (rnum &optional cinfo) - (mime-article/cnum-to-cinfo (reverse rnum) cinfo) - ) - -(defun mime-article/cnum-to-cinfo (cn &optional cinfo) - (or cinfo - (setq cinfo mime-raw-content-info) - ) - (if (eq cn t) - cinfo - (let ((sn (car cn))) - (if (null sn) - cinfo - (let ((rc (nth sn (mime-entity-info-children cinfo)))) - (if rc - (mime-article/cnum-to-cinfo (cdr cn) rc) - )) - )))) - -(defun mime/flatten-content-info (&optional cinfo) - (or cinfo - (setq cinfo mime-raw-content-info) - ) - (let ((dest (list cinfo)) - (rcl (mime-entity-info-children cinfo)) - ) - (while rcl - (setq dest (nconc dest (mime/flatten-content-info (car rcl)))) - (setq rcl (cdr rcl)) - ) - dest)) - - -;;; @@ predicate functions -;;; - -(defun mime-view-header-visible-p (rcnum cinfo) - "Return non-nil if header of current entity is visible." - (or (null rcnum) - (member (mime-entity-info-type/subtype - (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)) - mime-view-childrens-header-showing-Content-Type-list) - )) - -(defun mime-view-body-visible-p (rcnum cinfo media-type media-subtype) - (let ((ctype (if media-type - (if media-subtype - (format "%s/%s" media-type media-subtype) - (symbol-name media-type) - )))) - (and (member ctype mime-view-visible-media-type-list) - (if (and (eq media-type 'application) - (eq media-subtype 'octet-stream)) - (let ((ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))) - (member (mime-entity-info-encoding ccinfo) - '(nil "7bit" "8bit")) - ) - t)) - )) - - ;;; @ MIME viewer mode ;;; (defconst mime-view-menu-title "MIME-View") (defconst mime-view-menu-list - '((up "Move to upper content" mime-view-move-to-upper) - (previous "Move to previous content" mime-view-move-to-previous) - (next "Move to next content" mime-view-move-to-next) - (scroll-down "Scroll to previous content" mime-view-scroll-down-entity) - (scroll-up "Scroll to next content" mime-view-scroll-up-entity) - (play "Play Content" mime-view-play-current-entity) - (extract "Extract Content" mime-view-extract-current-entity) - (print "Print" mime-view-print-current-entity) - (x-face "Show X Face" mime-view-display-x-face) + '((up "Move to upper entity" mime-preview-move-to-upper) + (previous "Move to previous entity" mime-preview-move-to-previous) + (next "Move to next entity" mime-preview-move-to-next) + (scroll-down "Scroll-down" mime-preview-scroll-down-entity) + (scroll-up "Scroll-up" mime-preview-scroll-up-entity) + (play "Play current entity" mime-preview-play-current-entity) + (extract "Extract current entity" mime-preview-extract-current-entity) + (print "Print current entity" mime-preview-print-current-entity) + (x-face "Show X Face" mime-preview-display-x-face) ) "Menu for MIME Viewer") @@ -701,39 +943,39 @@ The compressed face will be piped to this command.") (make-sparse-keymap) ))) (define-key mime-view-mode-map - "u" (function mime-view-move-to-upper)) + "u" (function mime-preview-move-to-upper)) (define-key mime-view-mode-map - "p" (function mime-view-move-to-previous)) + "p" (function mime-preview-move-to-previous)) (define-key mime-view-mode-map - "n" (function mime-view-move-to-next)) + "n" (function mime-preview-move-to-next)) (define-key mime-view-mode-map - "\e\t" (function mime-view-move-to-previous)) + "\e\t" (function mime-preview-move-to-previous)) (define-key mime-view-mode-map - "\t" (function mime-view-move-to-next)) + "\t" (function mime-preview-move-to-next)) (define-key mime-view-mode-map - " " (function mime-view-scroll-up-entity)) + " " (function mime-preview-scroll-up-entity)) (define-key mime-view-mode-map - "\M- " (function mime-view-scroll-down-entity)) + "\M- " (function mime-preview-scroll-down-entity)) (define-key mime-view-mode-map - "\177" (function mime-view-scroll-down-entity)) + "\177" (function mime-preview-scroll-down-entity)) (define-key mime-view-mode-map - "\C-m" (function mime-view-next-line-content)) + "\C-m" (function mime-preview-next-line-entity)) (define-key mime-view-mode-map - "\C-\M-m" (function mime-view-previous-line-content)) + "\C-\M-m" (function mime-preview-previous-line-entity)) (define-key mime-view-mode-map - "v" (function mime-view-play-current-entity)) + "v" (function mime-preview-play-current-entity)) (define-key mime-view-mode-map - "e" (function mime-view-extract-current-entity)) + "e" (function mime-preview-extract-current-entity)) (define-key mime-view-mode-map - "\C-c\C-p" (function mime-view-print-current-entity)) + "\C-c\C-p" (function mime-preview-print-current-entity)) (define-key mime-view-mode-map - "a" (function mime-view-follow-current-entity)) + "a" (function mime-preview-follow-current-entity)) (define-key mime-view-mode-map - "q" (function mime-view-quit)) + "q" (function mime-preview-quit)) (define-key mime-view-mode-map - "h" (function mime-view-show-summary)) + "h" (function mime-preview-show-summary)) (define-key mime-view-mode-map - "\C-c\C-x" (function mime-view-kill-buffer)) + "\C-c\C-x" (function mime-preview-kill-buffer)) ;; (define-key mime-view-mode-map ;; "<" (function beginning-of-buffer)) ;; (define-key mime-view-mode-map @@ -741,11 +983,11 @@ The compressed face will be piped to this command.") (define-key mime-view-mode-map "?" (function describe-mode)) (define-key mime-view-mode-map - [tab] (function mime-view-move-to-next)) + [tab] (function mime-preview-move-to-next)) (define-key mime-view-mode-map - [delete] (function mime-view-scroll-down-entity)) + [delete] (function mime-preview-scroll-down-entity)) (define-key mime-view-mode-map - [backspace] (function mime-view-scroll-down-entity)) + [backspace] (function mime-preview-scroll-down-entity)) (if (functionp default) (cond (running-xemacs (set-keymap-default-binding mime-view-mode-map default) @@ -826,13 +1068,14 @@ button-2 Move to point under the mouse cursor ) (prog1 (switch-to-buffer ret) - (setq mime::preview/original-window-configuration win-conf) + (setq mime-preview-original-window-configuration win-conf) (if mother (progn (setq mime-mother-buffer mother) )) (mime-view-define-keymap default-keymap-or-function) - (let ((point (next-single-property-change (point-min) 'mime-view-cinfo))) + (let ((point + (next-single-property-change (point-min) 'mime-view-entity))) (if point (goto-char point) (goto-char (point-min)) @@ -845,73 +1088,75 @@ button-2 Move to point under the mouse cursor ;;; @@ playing ;;; -(autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t) +(autoload 'mime-preview-play-current-entity "mime-play" + "Play current entity." t) -(defun mime-view-extract-current-entity () +(defun mime-preview-extract-current-entity () "Extract current entity into file (maybe). It decodes current entity to call internal or external method as \"extract\" mode. The method is selected from variable `mime-acting-condition'." (interactive) - (mime-view-play-current-entity "extract") + (mime-preview-play-current-entity "extract") ) -(defun mime-view-print-current-entity () +(defun mime-preview-print-current-entity () "Print current entity (maybe). It decodes current entity to call internal or external method as \"print\" mode. The method is selected from variable `mime-acting-condition'." (interactive) - (mime-view-play-current-entity "print") + (mime-preview-play-current-entity "print") ) ;;; @@ following ;;; -(defun mime-view-get-original-major-mode () +(defun mime-preview-original-major-mode () "Return major-mode of original buffer. If a current buffer has mime-mother-buffer, return original major-mode of the mother-buffer." (if mime-mother-buffer (save-excursion (set-buffer mime-mother-buffer) - (mime-view-get-original-major-mode) + (mime-preview-original-major-mode) ) - mime-view-original-major-mode)) + mime-preview-original-major-mode)) -(defun mime-view-follow-current-entity () +(defun mime-preview-follow-current-entity () "Write follow message to current entity. It calls following-method selected from variable `mime-view-following-method-alist'." (interactive) - (let ((root-cinfo (get-text-property (point-min) 'mime-view-cinfo)) - cinfo) - (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo))) + (let (entity) + (while (null (setq entity + (get-text-property (point) 'mime-view-entity))) (backward-char) ) - (let* ((p-beg (previous-single-property-change (point) 'mime-view-cinfo)) + (let* ((p-beg + (previous-single-property-change (point) 'mime-view-entity)) p-end - (rcnum (mime-entity-info-rnum cinfo)) - (len (length rcnum)) + (entity-node-id (mime-entity-node-id entity)) + (len (length entity-node-id)) ) (cond ((null p-beg) (setq p-beg (if (eq (next-single-property-change (point-min) - 'mime-view-cinfo) + 'mime-view-entity) (point)) (point) (point-min))) ) - ((eq (next-single-property-change p-beg 'mime-view-cinfo) + ((eq (next-single-property-change p-beg 'mime-view-entity) (point)) (setq p-beg (point)) )) - (setq p-end (next-single-property-change p-beg 'mime-view-cinfo)) + (setq p-end (next-single-property-change p-beg 'mime-view-entity)) (cond ((null p-end) (setq p-end (point-max)) ) - ((null rcnum) + ((null entity-node-id) (setq p-end (point-max)) ) (t @@ -921,12 +1166,13 @@ It calls following-method selected from variable (let (e) (while (setq e (next-single-property-change - (point) 'mime-view-cinfo)) + (point) 'mime-view-entity)) (goto-char e) - (let ((rc (mime-entity-info-rnum + (let ((rc (mime-entity-node-id (get-text-property (point) - 'mime-view-cinfo)))) - (or (equal rcnum (nthcdr (- (length rc) len) rc)) + 'mime-view-entity)))) + (or (equal entity-node-id + (nthcdr (- (length rc) len) rc)) (throw 'tag nil) )) (setq p-end e) @@ -934,8 +1180,9 @@ It calls following-method selected from variable (setq p-end (point-max)) )) )) - (let* ((mode (mime-view-get-original-major-mode)) - (new-name (format "%s-%s" (buffer-name) (reverse rcnum))) + (let* ((mode (mime-preview-original-major-mode)) + (new-name + (format "%s-%s" (buffer-name) (reverse entity-node-id))) new-buf (the-buf (current-buffer)) (a-buf mime-raw-buffer) @@ -945,40 +1192,34 @@ It calls following-method selected from variable (erase-buffer) (insert-buffer-substring the-buf p-beg p-end) (goto-char (point-min)) - (if (mime-view-header-visible-p rcnum root-cinfo) - (delete-region (goto-char (point-min)) - (if (re-search-forward "^$" nil t) - (match-end 0) - (point-min))) - ) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min)) - (let ((rcnum (mime-entity-info-rnum cinfo)) ci str) + (let ((entity-node-id (mime-entity-node-id entity)) ci str) (while (progn - (setq str - (save-excursion - (set-buffer a-buf) - (setq ci (mime-article/rcnum-to-cinfo rcnum)) - (save-restriction - (narrow-to-region - (mime-entity-info-point-min ci) - (mime-entity-info-point-max ci) - ) - (std11-header-string-except - (concat "^" - (apply (function regexp-or) fields) - ":") "")))) + (setq + str + (save-excursion + (set-buffer a-buf) + (setq + ci + (mime-raw-find-entity-from-node-id entity-node-id)) + (save-restriction + (narrow-to-region + (mime-entity-point-min ci) + (mime-entity-point-max ci) + ) + (std11-header-string-except + (concat "^" + (apply (function regexp-or) fields) + ":") "")))) (if (and - (eq (mime-entity-info-media-type ci) 'message) - (eq (mime-entity-info-media-subtype ci) 'rfc822)) + (eq (mime-entity-media-type ci) 'message) + (eq (mime-entity-media-subtype ci) 'rfc822)) nil (if str (insert str) ) - rcnum)) + entity-node-id)) (setq fields (std11-collect-field-names) - rcnum (cdr rcnum)) + entity-node-id (cdr entity-node-id)) ) ) (let ((rest mime-view-following-required-fields-list)) @@ -1015,7 +1256,7 @@ It calls following-method selected from variable ;;; @@ X-Face ;;; -(defun mime-view-display-x-face () +(defun mime-preview-display-x-face () (interactive) (save-window-excursion (set-buffer mime-raw-buffer) @@ -1026,63 +1267,65 @@ It calls following-method selected from variable ;;; @@ moving ;;; -(defun mime-view-move-to-upper () +(defun mime-preview-move-to-upper () "Move to upper entity. -If there is no upper entity, call function `mime-view-quit'." +If there is no upper entity, call function `mime-preview-quit'." (interactive) (let (cinfo) - (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo))) + (while (null (setq cinfo + (get-text-property (point) 'mime-view-entity))) (backward-char) ) - (let ((r (mime-article/rcnum-to-cinfo - (cdr (mime-entity-info-rnum cinfo)) - (get-text-property 1 'mime-view-cinfo))) + (let ((r (mime-raw-find-entity-from-node-id + (cdr (mime-entity-node-id cinfo)) + (get-text-property 1 'mime-view-entity))) point) (catch 'tag (while (setq point (previous-single-property-change - (point) 'mime-view-cinfo)) + (point) 'mime-view-entity)) (goto-char point) - (if (eq r (get-text-property (point) 'mime-view-cinfo)) + (if (eq r (get-text-property (point) 'mime-view-entity)) (throw 'tag t) ) ) - (mime-view-quit) + (mime-preview-quit) )))) -(defun mime-view-move-to-previous () +(defun mime-preview-move-to-previous () "Move to previous entity. If there is no previous entity, it calls function registered in variable `mime-view-over-to-previous-method-alist'." (interactive) - (while (null (get-text-property (point) 'mime-view-cinfo)) + (while (null (get-text-property (point) 'mime-view-entity)) (backward-char) ) - (let ((point (previous-single-property-change (point) 'mime-view-cinfo))) + (let ((point + (previous-single-property-change (point) 'mime-view-entity))) (if point (goto-char point) - (let ((f (assq mime-view-original-major-mode + (let ((f (assq mime-preview-original-major-mode mime-view-over-to-previous-method-alist))) (if f (funcall (cdr f)) )) ))) -(defun mime-view-move-to-next () +(defun mime-preview-move-to-next () "Move to next entity. If there is no previous entity, it calls function registered in variable `mime-view-over-to-next-method-alist'." (interactive) - (let ((point (next-single-property-change (point) 'mime-view-cinfo))) + (let ((point (next-single-property-change (point) 'mime-view-entity))) (if point (goto-char point) - (let ((f (assq mime-view-original-major-mode + (let ((f (assq mime-preview-original-major-mode mime-view-over-to-next-method-alist))) (if f (funcall (cdr f)) )) ))) -(defun mime-view-scroll-up-entity (&optional h) +(defun mime-preview-scroll-up-entity (&optional h) "Scroll up current entity. If reached to (point-max), it calls function registered in variable `mime-view-over-to-next-method-alist'." @@ -1091,13 +1334,13 @@ If reached to (point-max), it calls function registered in variable (setq h (1- (window-height))) ) (if (= (point) (point-max)) - (let ((f (assq mime-view-original-major-mode + (let ((f (assq mime-preview-original-major-mode mime-view-over-to-next-method-alist))) (if f (funcall (cdr f)) )) (let ((point - (or (next-single-property-change (point) 'mime-view-cinfo) + (or (next-single-property-change (point) 'mime-view-entity) (point-max)))) (forward-line h) (if (> (point) point) @@ -1105,7 +1348,7 @@ If reached to (point-max), it calls function registered in variable ) ))) -(defun mime-view-scroll-down-entity (&optional h) +(defun mime-preview-scroll-down-entity (&optional h) "Scroll down current entity. If reached to (point-min), it calls function registered in variable `mime-view-over-to-previous-method-alist'." @@ -1114,7 +1357,7 @@ If reached to (point-min), it calls function registered in variable (setq h (1- (window-height))) ) (if (= (point) (point-min)) - (let ((f (assq mime-view-original-major-mode + (let ((f (assq mime-preview-original-major-mode mime-view-over-to-previous-method-alist))) (if f (funcall (cdr f)) @@ -1125,7 +1368,7 @@ If reached to (point-min), it calls function registered in variable (while (> (point) 1) (if (setq point (previous-single-property-change (point) - 'mime-view-cinfo)) + 'mime-view-entity)) (throw 'tag t) ) (backward-char) @@ -1137,43 +1380,43 @@ If reached to (point-min), it calls function registered in variable (goto-char point) )))) -(defun mime-view-next-line-content () +(defun mime-preview-next-line-entity () (interactive) - (mime-view-scroll-up-entity 1) + (mime-preview-scroll-up-entity 1) ) -(defun mime-view-previous-line-content () +(defun mime-preview-previous-line-entity () (interactive) - (mime-view-scroll-down-entity 1) + (mime-preview-scroll-down-entity 1) ) ;;; @@ quitting ;;; -(defun mime-view-quit () - "Quit from MIME-View buffer. +(defun mime-preview-quit () + "Quit from MIME-preview buffer. It calls function registered in variable -`mime-view-quitting-method-alist'." +`mime-preview-quitting-method-alist'." (interactive) - (let ((r (assq mime-view-original-major-mode - mime-view-quitting-method-alist))) + (let ((r (assq mime-preview-original-major-mode + mime-preview-quitting-method-alist))) (if r (funcall (cdr r)) ))) -(defun mime-view-show-summary () +(defun mime-preview-show-summary () "Show summary. It calls function registered in variable `mime-view-show-summary-method'." (interactive) - (let ((r (assq mime-view-original-major-mode + (let ((r (assq mime-preview-original-major-mode mime-view-show-summary-method))) (if r (funcall (cdr r)) ))) -(defun mime-view-kill-buffer () +(defun mime-preview-kill-buffer () (interactive) (kill-buffer (current-buffer)) )