`binary' or `cooked'.")
-(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-message-structure' is used."
- (or message-info
- (setq message-info mime-message-structure))
- (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))))
+;; (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-message-structure' is used."
+;; (or message-info
+;; (setq message-info mime-message-structure))
+;; (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))))
+;; (make-obsolete 'mime-raw-find-entity-from-point "don't use it.")
;;; @ in preview-buffer (presentation space)
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-raw-buffer nil
+;; "Raw buffer corresponding with the (MIME-preview) buffer.")
+;; (make-variable-buffer-local 'mime-raw-buffer)
(defvar mime-preview-original-window-configuration nil
"Window-configuration before mime-view-mode is called.")
(make-variable-buffer-local 'mime-preview-original-window-configuration)
-(defun mime-preview-original-major-mode (&optional recursive)
+(defun mime-preview-original-major-mode (&optional recursive point)
"Return major-mode of original buffer.
If optional argument RECURSIVE is non-nil and current buffer has
mime-mother-buffer, it returns original major-mode of the
(set-buffer mime-mother-buffer)
(mime-preview-original-major-mode recursive)
)
- (save-excursion
- (set-buffer
- (mime-entity-buffer
- (get-text-property (point-min) 'mime-view-entity)))
- major-mode)))
+ (cdr (assq 'original-major-mode
+ (get-text-property (or point (point)) 'mime-view-situation)))))
;;; @ entity information
situation)))
;; major-mode
- (or (assq 'major-mode situation)
- (setq situation
- (cons (cons 'major-mode
- (with-current-buffer (mime-entity-buffer entity)
- major-mode))
- situation)))
+ ;; (or (assq 'major-mode situation)
+ ;; (setq situation
+ ;; (cons (cons 'major-mode
+ ;; (with-current-buffer (mime-entity-buffer entity)
+ ;; major-mode))
+ ;; situation)))
situation))
""))
-(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-message-structure' 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-message-structure' is used."
- (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.
-If optional argument MESSAGE-INFO is not specified,
-`mime-message-structure' is used."
- (or message-info
- (setq message-info mime-message-structure))
- (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))
+;; (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-message-structure' is used."
+;; (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
+
+;; (make-obsolete 'mime-raw-point-to-entity-node-id "don't use it.")
+
+;; (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-message-structure' is used."
+;; (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
+
+;; (make-obsolete 'mime-raw-point-to-entity-number "don't use it.")
+
+;; (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-message-structure' is used."
+;; (or message-info
+;; (setq message-info mime-message-structure))
+;; (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
;;; @@@ predicate function
;;;
+(in-calist-package 'mime-view)
+
(defun mime-calist::field-match-method-as-default-rule (calist
field-type field-value)
(let ((s-field (assq field-type calist)))
(defun mime-display-multipart/mixed (entity situation)
(let ((children (mime-entity-children entity))
+ (original-major-mode (cdr (assq 'major-mode situation)))
(default-situation
(cdr (assq 'childrens-situation situation))))
+ (if original-major-mode
+ (setq default-situation
+ (cons (cons 'major-mode original-major-mode)
+ default-situation))
+ )
(while children
(mime-display-entity (car children) nil default-situation)
(setq children (cdr children))
(defun mime-display-multipart/alternative (entity situation)
(let* ((children (mime-entity-children entity))
+ (original-major-mode (cdr (assq 'major-mode situation)))
(default-situation
(cdr (assq 'childrens-situation situation)))
(i 0)
(p 0)
(max-score 0)
- (situations
+ situations)
+ (if original-major-mode
+ (setq default-situation
+ (cons (cons 'major-mode original-major-mode)
+ default-situation))
+ )
+ (setq situations
(mapcar (function
(lambda (child)
(let ((situation
(setq i (1+ i))
situation)
))
- children)))
+ children))
(setq i 0)
(while children
(let ((child (car children))
default-situation preview-buffer)
(or preview-buffer
(setq preview-buffer (current-buffer)))
- (let* ((raw-buffer (mime-entity-buffer entity))
- (start (mime-entity-point-min entity))
- e nb ne)
- (set-buffer raw-buffer)
- (goto-char start)
+ (let* (e nb ne nhb nbb)
+ (mime-goto-header-start-point entity)
+ (in-calist-package 'mime-view)
(or situation
(setq situation
(or (ctree-match-calist mime-preview-condition
(mime-view-insert-entity-button entity)
))
(when header-is-visible
+ (setq nhb (point))
(if header-presentation-method
(funcall header-presentation-method entity situation)
(mime-insert-header entity
mime-view-ignored-field-list
mime-view-visible-field-list))
+ (run-hooks 'mime-display-header-hook)
+ (put-text-property nhb (point-max) 'mime-view-entity-header entity)
(goto-char (point-max))
(insert "\n")
- (run-hooks 'mime-display-header-hook)
)
+ (setq nbb (point))
(cond (children)
((functionp body-presentation-method)
(funcall body-presentation-method entity situation)
(setq ne (point-max))
(widen)
(put-text-property nb ne 'mime-view-entity entity)
+ (put-text-property nb ne 'mime-view-situation situation)
+ (put-text-property nbb ne 'mime-view-entity-body entity)
(goto-char ne)
(if children
(if (functionp body-presentation-method)
;;;###autoload
(defun mime-display-message (message &optional preview-buffer
- mother default-keymap-or-function)
+ mother default-keymap-or-function
+ original-major-mode)
"View MESSAGE in MIME-View mode.
Optional argument PREVIEW-BUFFER specifies the buffer of the
keymap of MIME-View mode."
(mime-maybe-hide-echo-buffer)
(let ((win-conf (current-window-configuration))
- (raw-buffer (mime-entity-buffer message)))
+ ;; (raw-buffer (mime-entity-buffer message))
+ )
(or preview-buffer
(setq preview-buffer
- (concat "*Preview-" (buffer-name raw-buffer) "*")))
- (set-buffer raw-buffer)
- (setq mime-preview-buffer preview-buffer)
+ (concat "*Preview-" (mime-entity-name message) "*")))
+ ;; (set-buffer raw-buffer)
+ ;; (setq mime-preview-buffer preview-buffer)
(let ((inhibit-read-only t))
(set-buffer (get-buffer-create preview-buffer))
(widen)
(erase-buffer)
- (setq mime-raw-buffer raw-buffer)
+ ;; (setq mime-raw-buffer raw-buffer)
(if mother
(setq mime-mother-buffer mother)
)
(setq major-mode 'mime-view-mode)
(setq mode-name "MIME-View")
(mime-display-entity message nil
- '((entity-button . invisible)
- (header . visible))
+ `((entity-button . invisible)
+ (header . visible)
+ (major-mode . ,original-major-mode))
preview-buffer)
(mime-view-define-keymap default-keymap-or-function)
(let ((point
(run-hooks 'mime-view-mode-hook)
(set-buffer-modified-p nil)
(setq buffer-read-only t)
- (or (get-buffer-window preview-buffer)
- (let ((r-win (get-buffer-window raw-buffer)))
- (if r-win
- (set-window-buffer r-win preview-buffer)
- (let ((m-win (and mother (get-buffer-window mother))))
- (if m-win
- (set-window-buffer m-win preview-buffer)
- (switch-to-buffer preview-buffer)
- )))))
- )))
+ preview-buffer)))
;;;###autoload
(defun mime-view-buffer (&optional raw-buffer preview-buffer mother
(if (eq representation-type 'binary)
(setq representation-type 'buffer)
)
- (mime-display-message
- (mime-open-entity representation-type raw-buffer)
- preview-buffer mother default-keymap-or-function))
+ (setq preview-buffer (mime-display-message
+ (mime-open-entity representation-type raw-buffer)
+ preview-buffer mother default-keymap-or-function))
+ (or (get-buffer-window preview-buffer)
+ (let ((r-win (get-buffer-window raw-buffer)))
+ (if r-win
+ (set-window-buffer r-win preview-buffer)
+ (let ((m-win (and mother (get-buffer-window mother))))
+ (if m-win
+ (set-window-buffer m-win preview-buffer)
+ (switch-to-buffer preview-buffer)
+ ))))))
(defun mime-view-mode (&optional mother ctl encoding
raw-buffer preview-buffer
(let* ((p-beg
(previous-single-property-change (point) 'mime-view-entity))
p-end
+ ph-end
(entity-node-id (mime-entity-node-id entity))
(len (length entity-node-id))
)
(setq p-end (point-max))
))
))
+ (setq ph-end
+ (previous-single-property-change p-end 'mime-view-entity-header))
+ (if (or (null ph-end)
+ (< ph-end p-beg))
+ (setq ph-end p-beg)
+ )
(let* ((mode (mime-preview-original-major-mode 'recursive))
(new-name
(format "%s-%s" (buffer-name) (reverse entity-node-id)))
new-buf
(the-buf (current-buffer))
- (a-buf mime-raw-buffer)
+ (a-buf (mime-entity-buffer entity))
fields)
(save-excursion
(set-buffer (setq new-buf (get-buffer-create new-name)))
(erase-buffer)
- (insert-buffer-substring the-buf p-beg p-end)
+ (insert-buffer-substring the-buf ph-end p-end)
+ (when (= ph-end p-beg)
+ (goto-char (point-min))
+ (insert ?\n))
(goto-char (point-min))
(let ((entity-node-id (mime-entity-node-id entity)) ci str)
(while (progn
(concat "^"
(apply (function regexp-or) fields)
":") ""))))
- (if (and
- (eq (mime-entity-media-type ci) 'message)
- (eq (mime-entity-media-subtype ci) 'rfc822))
+ (if (and (eq (mime-entity-media-type ci) 'message)
+ (eq (mime-entity-media-subtype ci) 'rfc822))
nil
(if str
(insert str)
projects / elisp / semi.git / blobdiff