(require 'mime-parse)
(require 'semi-def)
(require 'calist)
+(require 'alist)
(require 'mailcap)
;;; @@ in raw-buffer
;;;
-(defvar mime-raw-message-info
+(defvar mime-raw-message-info nil
"Information about structure of message.
Please use reference function `mime-entity-SLOT' to get value of SLOT.
Following is a list of slots of the structure:
-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)
+buffer buffer includes this entity (buffer).
+node-id node-id (list of integers)
+header-start minimum point of header in raw-buffer
+header-end maximum point of header in raw-buffer
+body-start minimum point of body in raw-buffer
+body-end maximum point of body in raw-buffer
+content-type content-type (content-type)
+content-disposition content-disposition (content-disposition)
+encoding Content-Transfer-Encoding (string or nil)
+children entities included in this entity (list of entity)
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)
+
+(defvar mime-raw-representation-type nil
+ "Representation-type of mime-raw-buffer.
+It must be nil, `binary' or `cooked'.
+If it is nil, `mime-raw-representation-type-alist' is used as default
+value.
+Notice that this variable is usually used as buffer local variable in
+raw-buffer.")
+
+(make-variable-buffer-local 'mime-raw-representation-type)
+
(defvar mime-raw-representation-type-alist
'((mime-show-message-mode . binary)
(mime-temp-message-mode . binary)
(setq children (cdr children)))
message-info))))
+(defsubst mime-entity-parent (entity &optional message-info)
+ "Return mother entity of ENTITY.
+If optional argument MESSAGE-INFO is not specified,
+`mime-raw-message-info' in buffer of ENTITY is used."
+ (mime-raw-find-entity-from-node-id
+ (cdr (mime-entity-node-id entity))
+ (or message-info
+ (save-excursion
+ (set-buffer (mime-entity-buffer entity))
+ mime-raw-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,
"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))
+ (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
(defun mime-raw-flatten-message-info (&optional message-info)
"Return list of entity in mime-raw-buffer.
;;; @@@ predicate function
;;;
-(defun mime-view-entity-button-visible-p (entity message-info)
+(defun mime-view-entity-button-visible-p (entity)
"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))
(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)))
+ (let ((mother-entity (mime-entity-parent entity)))
(or (not (eq (mime-entity-media-type mother-entity)
'multipart))
(not (eq (mime-entity-media-subtype mother-entity)
;;; @@@ entity button generator
;;;
-(defun mime-view-insert-entity-button (entity message-info subj)
+(defun mime-view-insert-entity-button (entity subject)
"Insert entity-button of ENTITY."
(let ((entity-node-id (mime-entity-node-id entity))
(params (mime-entity-parameters entity)))
(setq access-type (cdr access-type))
(if server
(format "%s %s ([%s] %s)"
- num subj access-type (cdr server))
+ num subject access-type (cdr server))
(let ((site (cdr (assoc "site" params)))
(dir (cdr (assoc "directory" params)))
)
(format "%s %s ([%s] %s:%s)"
- num subj access-type site dir)
+ num subject access-type site dir)
)))
)
(t
(charset (cdr (assoc "charset" params)))
(encoding (mime-entity-encoding entity)))
(concat
- num " " subj
+ num " " subject
(let ((rest
(format " <%s/%s%s%s>"
media-type media-subtype
(body-presentation-method . mime-preview-text/plain)))
(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . multipart)(subtype . alternative)
+ (body . visible)
+ (body-presentation-method . mime-preview-multipart/alternative)))
+
+(ctree-set-calist-strictly
'mime-preview-condition '((type . message)(subtype . partial)
(body-presentation-method
. mime-preview-message/partial-button)))
(default-situation
(cdr (assq 'childrens-situation situation))))
(while children
- (mime-view-display-entity (car children) mime-raw-message-info
+ (mime-view-display-entity (car children)
+ (save-excursion
+ (set-buffer mime-raw-buffer)
+ mime-raw-message-info)
mime-raw-buffer (current-buffer)
default-situation)
(setq children (cdr children))
)))
+(defcustom mime-view-type-subtype-score-alist
+ '(((text . enriched) . 3)
+ ((text . richtext) . 2)
+ ((text . plain) . 1)
+ (t . 0))
+ "Alist MEDIA-TYPE vs corresponding score.
+MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default."
+ :group 'mime-view
+ :type '(repeat (cons (choice :tag "Media-Type"
+ (item :tag "Type/Subtype"
+ (cons symbol symbol))
+ (item :tag "Type" symbol)
+ (item :tag "Default" t))
+ integer)))
+
+(defun mime-preview-multipart/alternative (entity situation)
+ (let* ((children (mime-entity-children entity))
+ (default-situation
+ (cdr (assq 'childrens-situation situation)))
+ (i 0)
+ (p 0)
+ (max-score 0)
+ (situations
+ (mapcar (function
+ (lambda (child)
+ (let ((situation
+ (or (ctree-match-calist
+ mime-preview-condition
+ (append
+ (or (mime-entity-content-type child)
+ (make-mime-content-type 'text 'plain))
+ (list* (cons 'encoding
+ (mime-entity-encoding child))
+ (cons 'major-mode major-mode)
+ default-situation)))
+ default-situation)))
+ (if (cdr (assq 'body-presentation-method situation))
+ (let ((score
+ (cdr
+ (or (assoc
+ (cons
+ (cdr (assq 'type situation))
+ (cdr (assq 'subtype situation)))
+ mime-view-type-subtype-score-alist)
+ (assq
+ (cdr (assq 'type situation))
+ mime-view-type-subtype-score-alist)
+ (assq
+ t
+ mime-view-type-subtype-score-alist)
+ ))))
+ (if (> score max-score)
+ (setq p i
+ max-score score)
+ )))
+ (setq i (1+ i))
+ situation)
+ ))
+ children)))
+ (setq i 0)
+ (while children
+ (let ((situation (car situations)))
+ (mime-view-display-entity (car children)
+ (save-excursion
+ (set-buffer mime-raw-buffer)
+ mime-raw-message-info)
+ mime-raw-buffer (current-buffer)
+ default-situation
+ (if (= i p)
+ situation
+ (del-alist 'body-presentation-method
+ (copy-alist situation))))
+ )
+ (setq children (cdr children)
+ situations (cdr situations)
+ i (1+ i))
+ )))
+
;;; @ acting-condition
;;;
)
(defun mime-view-display-entity (entity message-info ibuf obuf
- default-situation)
+ default-situation
+ &optional situation)
(let* ((start (mime-entity-point-min entity))
(end (mime-entity-point-max entity))
(content-type (mime-entity-content-type entity))
(narrow-to-region start end)
(setq subj (eword-decode-string (mime-raw-get-subject entity)))
)
- (let* ((situation
- (or
- (ctree-match-calist mime-preview-condition
- (append
- (or content-type
- (make-mime-content-type 'text 'plain))
- (list* (cons 'encoding encoding)
- (cons 'major-mode major-mode)
- default-situation)))
- 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)))
- (children (mime-entity-children entity)))
+ (or situation
+ (setq situation
+ (or (ctree-match-calist mime-preview-condition
+ (append
+ (or content-type
+ (make-mime-content-type
+ 'text 'plain))
+ (list* (cons 'encoding encoding)
+ (cons 'major-mode major-mode)
+ default-situation)))
+ default-situation)))
+ (let ((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)))
+ (children (mime-entity-children entity)))
(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 (mime-view-entity-button-visible-p entity)
+ (mime-view-insert-entity-button entity subj)
))
(if header-is-visible
(save-restriction
(t
(when button-is-invisible
(goto-char (point-max))
- (mime-view-insert-entity-button entity message-info subj)
+ (mime-view-insert-entity-button entity subj)
)
(or header-is-visible
(progn
projects / elisp / semi.git / blobdiff