(require 'alist)
(require 'mime-conf)
+(eval-when-compile (require 'static))
+
;;; @ version
;;;
(defun mime-view-read-situation-examples-file (&optional file)
(or file
(setq file mime-situation-examples-file))
- (if (file-readable-p file)
+ (if (and file
+ (file-readable-p file))
(with-temp-buffer
(insert-file-contents file)
(setq mime-situation-examples-file-coding-system
- (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system)
- ;; (static-cond
- ;; ((boundp 'buffer-file-coding-system)
- ;; (symbol-value 'buffer-file-coding-system))
- ;; ((boundp 'file-coding-system)
- ;; (symbol-value 'file-coding-system))
- ;; (t nil))
+ (static-cond
+ ((boundp 'buffer-file-coding-system)
+ (symbol-value 'buffer-file-coding-system))
+ ((boundp 'file-coding-system)
+ (symbol-value 'file-coding-system))
+ (t nil))
+ ;; (and (boundp 'buffer-file-coding-system)
+ ;; buffer-file-coding-system)
)
- (condition-case nil
+ (condition-case error
(eval-buffer)
- (error nil))
+ (error (message "%s is broken: %s" file (cdr error))))
;; format check
(condition-case nil
(let ((i 0))
(defun mime-save-situation-examples ()
(if (or mime-preview-situation-example-list
mime-acting-situation-example-list)
- (let ((file mime-situation-examples-file))
+ (let ((file mime-situation-examples-file)
+ print-length print-level)
(with-temp-buffer
(insert ";;; " (file-name-nondirectory file) "\n")
(insert "\n;; This file is generated automatically by "
(insert "\n;;; "
(file-name-nondirectory file)
" ends here.\n")
- (setq buffer-file-coding-system
- mime-situation-examples-file-coding-system)
- ;; (static-cond
- ;; ((boundp 'buffer-file-coding-system)
- ;; (setq buffer-file-coding-system
- ;; mime-situation-examples-file-coding-system))
- ;; ((boundp 'file-coding-system)
- ;; (setq file-coding-system
- ;; mime-situation-examples-file-coding-system)))
+ (static-cond
+ ((boundp 'buffer-file-coding-system)
+ (setq buffer-file-coding-system
+ mime-situation-examples-file-coding-system))
+ ((boundp 'file-coding-system)
+ (setq file-coding-system
+ mime-situation-examples-file-coding-system)))
+ ;; (setq buffer-file-coding-system
+ ;; mime-situation-examples-file-coding-system)
(setq buffer-file-name file)
(save-buffer)))))
)))
)
(t
- (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)))
+ (let* ((charset (cdr (assoc "charset" params)))
+ (encoding (mime-entity-encoding entity))
+ (rest (format " <%s/%s%s%s>"
+ (mime-entity-media-type entity)
+ (mime-entity-media-subtype entity)
+ (if charset
+ (concat "; " charset)
+ "")
+ (if encoding
+ (concat " (" encoding ")")
+ ""))))
(concat
num " " subject
- (let ((rest
- (format " <%s/%s%s%s>"
- media-type media-subtype
- (if charset
- (concat "; " charset)
- "")
- (if encoding
- (concat " (" encoding ")")
- ""))))
- (if (>= (+ (current-column)(length rest))(window-width))
- "\n\t")
- rest)))
+ (if (>= (+ (current-column)(length rest))(window-width))
+ "\n\t")
+ rest))
)))
(function mime-preview-play-current-entity))
))
(ctree-set-calist-strictly
'mime-preview-condition
+ '((type . multipart)(subtype . related)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/related)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
'((type . multipart)(subtype . t)
(body . visible)
(body-presentation-method . mime-display-multipart/mixed)))
situations (cdr situations)
i (1+ i)))))
+(defun mime-display-multipart/related (entity situation)
+ (let* ((param-start (mime-parse-msg-id
+ (std11-lexical-analyze
+ (cdr (assoc "start"
+ (mime-content-type-parameters
+ (mime-entity-content-type entity)))))))
+ (start (or (and param-start (mime-find-entity-from-content-id
+ param-start
+ entity))
+ (car (mime-entity-children entity))))
+ (original-major-mode-cell (assq 'major-mode situation))
+ (default-situation (cdr (assq 'childrens-situation situation))))
+ (if original-major-mode-cell
+ (setq default-situation
+ (cons original-major-mode-cell default-situation)))
+ (mime-display-entity start nil default-situation)))
;;; @ acting-condition
;;;
;;; @@ utility
;;;
-(defun mime-preview-find-boundary-info (&optional get-mother)
+(defun mime-preview-find-boundary-info (&optional with-children)
+ "Return boundary information of current part.
+If WITH-CHILDREN, refer boundary surrounding current part and its branches."
(let (entity
p-beg p-end
entity-node-id len)
((null entity-node-id)
(setq p-end (point-max))
)
- (get-mother
+ (with-children
(save-excursion
- (goto-char p-end)
(catch 'tag
(let (e i)
(while (setq e
(point) 'mime-view-entity))
(goto-char e)
(let ((rc (mime-entity-node-id
- (get-text-property (1- (point))
+ (get-text-property (point)
'mime-view-entity))))
(or (and (>= (setq i (- (length rc) len)) 0)
(equal entity-node-id (nthcdr i rc)))
(throw 'tag nil)))
- (setq p-end e)))
+ (setq p-end (or (next-single-property-change
+ (point) 'mime-view-entity)
+ (point-max)))))
(setq p-end (point-max))))
))
(vector p-beg p-end entity)))
(if (functionp f)
(funcall f new-buf)
(message
- (format
- "Sorry, following method for %s is not implemented yet."
- mode))
+ "Sorry, following method for %s is not implemented yet."
+ mode)
))
)))
;;;
(defun mime-preview-toggle-display (type &optional display)
- (let ((situation (mime-preview-find-boundary-info))
+ (let ((situation (mime-preview-find-boundary-info t))
(sym (intern (concat "*" (symbol-name type))))
entity p-beg p-end)
(setq p-beg (aref situation 0)
(provide 'mime-view)
+(eval-when-compile
+ (setq mime-situation-examples-file nil)
+ ;; to avoid to read situation-examples-file at compile time.
+ )
+
(mime-view-read-situation-examples-file)
;;; mime-view.el ends here
projects / elisp / semi.git / blobdiff