X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=82dbe45fbffdb7b11d8a2d058e5e79ad790ce566;hb=9bae1ecdc3f7feb67ae2c19fd3f07f96d020f220;hp=f8a44c40cf84b9d24e756cb2d5960a582a56176c;hpb=cf42316783520420a485a82d29825aa4d330c16c;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index f8a44c4..82dbe45 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,7 +31,7 @@ (require 'mel) (require 'eword-decode) (require 'mime-parse) -(require 'mime-text) +(require 'semi-def) (require 'calist) @@ -39,9 +39,9 @@ ;;; (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) ")")) ;;; @ buffer local variables @@ -93,14 +93,118 @@ message/partial, it is called `mother-buffer'.") "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-button +;;; @ 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 ;;; -(defvar mime-view-content-button-visible-ctype-list - '("application/pgp")) +;;; @@ 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." @@ -153,36 +257,11 @@ message/partial, it is called `mother-buffer'.") (function mime-preview-play-current-entity)) )) -(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." - (and (not (mime-root-entity-p entity)) - (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))) - ) - )))))) - -(defun mime-view-entity-button-function (entity message-info subj) - "Insert entity-button of ENTITY conditionally. -Please redefine this function if you want to change default setting." - (if (mime-view-entity-button-visible-p entity message-info) - (mime-view-insert-entity-button entity message-info subj) - )) - -;;; @ entity-header +;;; @@ entity-header ;;; -;;; @@ predicate function +;;; @@@ predicate function ;;; (defvar mime-view-childrens-header-showing-Content-Type-list @@ -191,14 +270,13 @@ Please redefine this function if you want to change default setting." (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))) - (or (null entity-node-id) - (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 + (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) @@ -208,20 +286,7 @@ Please redefine this function if you want to change default setting." (eword-decode-header) ) -(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-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) - )) - -;;; @@ entity field cutter +;;; @@@ entity field cutter ;;; (defvar mime-view-ignored-field-list @@ -264,93 +329,139 @@ Each elements are regexp of field-name.") )))) -;;; @ entity-body +;;; @@ entity-body ;;; -;;; @@ predicate function +;;; @@@ predicate function ;;; -(defvar mime-view-body-visible-condition - '(type - (nil) - (text subtype - (plain) - (enriched) - (rfc822-headers) - (richtext) - (x-latex) - (x-pgp)) - (application subtype - (octet-stream encoding - (nil) - ("7bit") - ("8bit")) - (pgp) - (x-latex) - (x-selection) - (x-comment)) - (message subtype - (delivery-status))) - "Condition-tree to be able to display body of entity.") +(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 '((type . message)(subtype . rfc822) + (childrens-situation (header . visible)))) + +(ctree-set-calist-strictly + 'mime-preview-condition '((type . message)(subtype . news) + (childrens-situation (header . 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))) (defun mime-view-body-visible-p (entity message-info) "Return non-nil if body of ENTITY is visible." - (ctree-match-calist - mime-view-body-visible-condition - (list* (cons 'type (mime-entity-media-type entity)) - (cons 'subtype (mime-entity-media-subtype entity)) - (cons 'encoding (mime-entity-encoding entity)) - (cons 'major-mode major-mode) - (mime-entity-parameters entity)))) - -;; (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-preview buffer. -;; Each elements are string of TYPE/SUBTYPE, e.g. \"text/plain\".") - -;; (defun mime-view-body-visible-p (entity message-info) -;; "Return non-nil if body of ENTITY is visible." -;; (let ((media-type (mime-entity-media-type entity)) -;; (media-subtype (mime-entity-media-subtype entity)) -;; (ctype (mime-entity-type/subtype entity))) -;; (and (member ctype mime-view-visible-media-type-list) -;; (if (and (eq media-type 'application) -;; (eq media-subtype 'octet-stream)) -;; (member (mime-entity-encoding entity) '(nil "7bit" "8bit")) -;; t)))) - - -;;; @@ entity filter + (ctree-match-calist mime-preview-condition + (list* (cons 'type (mime-entity-media-type entity)) + (cons 'subtype (mime-entity-media-subtype entity)) + (cons 'encoding (mime-entity-encoding entity)) + (cons 'major-mode major-mode) + (mime-entity-parameters entity)))) + + +;;; @@@ entity filter ;;; -(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) +(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-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 media-types vs. corresponding MIME-preview 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.") + "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'. + +This value is overridden by buffer local variable `mime-text-decoder' +if it is not nil.") -(defun mime-view-display-body (start end entity message-info subj) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (insert-buffer-substring mime-raw-buffer start end) - (let* ((ctype (mime-entity-type/subtype entity)) - (params (mime-entity-parameters entity)) - (encoding (mime-entity-encoding entity)) - (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)) - ))) (defvar mime-view-announcement-for-message/partial (if (and (>= emacs-major-version 19) window-system) @@ -363,7 +474,7 @@ function. t means default media-type.") \[[ Please press `v' key in this buffer. ]]" )) -(defun mime-view-insert-message/partial-button () +(defun mime-view-insert-message/partial-button (&optional situation) (save-restriction (goto-char (point-max)) (if (not (search-backward "\n\n" nil t)) @@ -377,18 +488,13 @@ function. t means default media-type.") )) -;;; @ entity separator +;;; @@ entity separator ;;; -(defun mime-view-entity-separator-function (entity message-info) - "Insert entity-separator of ENTITY conditionally. -Please redefine this function if you want to change default setting." - (or (mime-view-header-visible-p entity message-info) - (mime-view-body-visible-p entity message-info) - (progn - (goto-char (point-max)) - (insert "\n") - ))) +(defun mime-view-entity-separator-visible-p (entity message-info) + "Return non-nil if separator is needed for ENTITY." + (and (not (mime-view-header-visible-p entity message-info)) + (not (mime-view-body-visible-p entity message-info)))) ;;; @ acting-condition @@ -536,11 +642,9 @@ The compressed face will be piped to this command.") (or mime-view-redisplay (setq mime-raw-message-info (mime-parse-message ctl encoding)) ) - (let* ((message-info mime-raw-message-info) - (pcl (mime-raw-flatten-message-info message-info)) - (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)) @@ -552,10 +656,7 @@ The compressed face will be piped to this command.") (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) message-info 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) @@ -564,31 +665,105 @@ The compressed face will be piped to this command.") (setq mime-preview-buffer obuf) ) -(defun mime-view-display-entity (entity message-info ibuf obuf) - "Display ENTITY." - (let* ((beg (mime-entity-point-min entity)) +(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 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))) + ) + (set-buffer obuf) + (setq nb (point)) + (narrow-to-region nb nb) + ;; 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) + )) + (run-hooks 'mime-view-content-header-filter-hook) + ) + (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 message-button + (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)) - (ctype (if media-type - (if media-subtype - (format "%s/%s" media-type media-subtype) - (symbol-name media-type) - ))) (params (mime-entity-parameters entity)) (encoding (mime-entity-encoding entity)) - (entity-node-id (mime-entity-node-id entity)) - he e nb ne subj) + 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-raw-get-subject params encoding))) @@ -596,36 +771,59 @@ The compressed face will be piped to this command.") (set-buffer obuf) (setq nb (point)) (narrow-to-region nb nb) - (mime-view-entity-button-function entity message-info subj) - (if (mime-view-header-visible-p entity message-info) - (mime-view-display-header beg he) + (if (mime-view-entity-button-visible-p entity message-info) + (mime-view-insert-entity-button entity message-info subj) ) - (if (and (null entity-node-id) - (member - ctype mime-view-content-button-visible-ctype-list)) - (save-excursion - (goto-char (point-max)) - (mime-view-insert-entity-button entity message-info subj) - )) - (cond ((mime-view-body-visible-p entity message-info) - (mime-view-display-body he end entity message-info subj) - ) - ((and (eq media-type 'message)(eq media-subtype 'partial)) - (mime-view-insert-message/partial-button) - ) - ((and (null entity-node-id) - (null (mime-entity-children message-info)) - ) - (goto-char (point-max)) - (mime-view-insert-entity-button entity message-info subj) - )) - (mime-view-entity-separator-function entity message-info) - (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* ((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)))) + (header-is-visible + (cdr (assq 'header situation))) + (body-presentation-method + (cdr (assq 'body-presentation-method situation)))) + (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) + )) + (when (mime-view-entity-separator-visible-p entity message-info) + (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 @@ -655,85 +853,6 @@ The compressed face will be piped to this command.") "")) -;;; @ 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-id))) - -(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)) - - ;;; @ MIME viewer mode ;;;