Following is a list of slots of the structure:
-node-id reversed entity-number (list of integers)
+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
"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)
(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-entity-situation (entity)
+ "Return situation of ENTITY."
+ (append (or (mime-entity-content-type entity)
+ (make-mime-content-type 'text 'plain))
+ (list (cons 'encoding (mime-entity-encoding entity))
+ (cons 'major-mode
+ (save-excursion
+ (set-buffer (mime-entity-buffer entity))
+ major-mode)))
+ ))
+
+
+(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
+
+(defun mime-raw-get-uu-filename ()
+ (save-excursion
+ (if (re-search-forward "^begin [0-9]+ " nil t)
+ (if (looking-at ".+$")
+ (buffer-substring (match-beginning 0)(match-end 0))
+ ))))
+
+(defun mime-raw-get-subject (entity)
+ (or (std11-find-field-body '("Content-Description" "Subject"))
+ (let ((ret (mime-entity-content-disposition entity)))
+ (and ret
+ (setq ret (mime-content-disposition-filename ret))
+ (std11-strip-quoted-string ret)
+ ))
+ (let ((ret (mime-entity-content-type entity)))
+ (and ret
+ (setq ret
+ (cdr
+ (let ((param (mime-content-type-parameters ret)))
+ (or (assoc "name" param)
+ (assoc "x-name" param))
+ )))
+ (std11-strip-quoted-string ret)
+ ))
+ (if (member (mime-entity-encoding entity)
+ mime-view-uuencode-encoding-name-list)
+ (mime-raw-get-uu-filename))
+ ""))
+
+
(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
(while children
(mime-view-display-entity (car children)
(save-excursion
- (set-buffer mime-raw-buffer)
+ (set-buffer (mime-entity-buffer entity))
mime-raw-message-info)
- mime-raw-buffer (current-buffer)
+ (current-buffer)
default-situation)
(setq children (cdr children))
)))
(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)))
+ (append (mime-entity-situation child)
+ default-situation))
default-situation)))
(if (cdr (assq 'body-presentation-method situation))
(let ((score
children)))
(setq i 0)
(while children
- (let ((situation (car situations)))
- (mime-view-display-entity (car children)
+ (let ((child (car children))
+ (situation (car situations)))
+ (mime-view-display-entity child
(save-excursion
- (set-buffer mime-raw-buffer)
+ (set-buffer (mime-entity-buffer child))
mime-raw-message-info)
- mime-raw-buffer (current-buffer)
+ (current-buffer)
default-situation
(if (= i p)
situation
(copy-alist situation))))
)
(setq children (cdr children)
- situation (cdr situations)
+ situations (cdr situations)
i (1+ i))
)))
))))
-;;; @ miscellaneous
-;;;
-
-(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
-
-
;;; @ buffer setup
;;;
-(defvar mime-view-redisplay nil)
-
-(defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf)
- (if ibuf
- (progn
- (get-buffer ibuf)
- (set-buffer ibuf)
- ))
- (or mime-view-redisplay
- (setq mime-raw-message-info (mime-parse-message ctl encoding))
- )
- (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))
- (let ((inhibit-read-only t))
- ;;(setq buffer-read-only nil)
- (widen)
- (erase-buffer)
- (setq mime-raw-buffer the-buf)
- (setq mime-preview-original-major-mode mode)
- (setq major-mode 'mime-view-mode)
- (setq mode-name "MIME-View")
- (mime-view-display-entity message-info message-info
- the-buf obuf
- '((entity-button . invisible)
- (header . visible)
- ))
- (set-buffer-modified-p nil)
- )
- (setq buffer-read-only t)
- (set-buffer the-buf)
- )
- (setq mime-preview-buffer obuf)
- )
-
-(defun mime-view-display-entity (entity message-info ibuf obuf
+(defun mime-view-display-entity (entity message-info obuf
default-situation
&optional situation)
- (let* ((start (mime-entity-point-min entity))
+ (let* ((raw-buffer (mime-entity-buffer entity))
+ (start (mime-entity-point-min entity))
(end (mime-entity-point-max entity))
- (content-type (mime-entity-content-type entity))
- (encoding (mime-entity-encoding entity))
- end-of-header e nb ne subj)
- (set-buffer ibuf)
+ original-major-mode end-of-header e nb ne subj)
+ (set-buffer raw-buffer)
+ (setq original-major-mode major-mode)
(goto-char start)
(setq end-of-header (if (re-search-forward "^$" nil t)
(1+ (match-end 0))
(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)))
+ (append (mime-entity-situation entity)
+ default-situation))
default-situation)))
(let ((button-is-invisible
(eq (cdr (assq 'entity-button situation)) 'invisible))
(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
(narrow-to-region (point)(point))
- (insert-buffer-substring mime-raw-buffer start end-of-header)
- (let ((f (cdr (assq mime-preview-original-major-mode
+ (insert-buffer-substring raw-buffer start end-of-header)
+ (let ((f (cdr (assq original-major-mode
mime-view-content-header-filter-alist))))
(if (functionp f)
(funcall f)
(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)
+ (insert-buffer-substring raw-buffer end-of-header end)
(funcall body-filter situation)
)))
(children)
(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
))
(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)
(if children
))
)))
-(defun mime-raw-get-uu-filename ()
- (save-excursion
- (if (re-search-forward "^begin [0-9]+ " nil t)
- (if (looking-at ".+$")
- (buffer-substring (match-beginning 0)(match-end 0))
- ))))
-
-(defun mime-raw-get-subject (entity)
- (or (std11-find-field-body '("Content-Description" "Subject"))
- (let ((ret (mime-entity-content-disposition entity)))
- (and ret
- (setq ret (mime-content-disposition-filename ret))
- (std11-strip-quoted-string ret)
- ))
- (let ((ret (mime-entity-content-type entity)))
- (and ret
- (setq ret
- (cdr
- (let ((param (mime-content-type-parameters ret)))
- (or (assoc "name" param)
- (assoc "x-name" param))
- )))
- (std11-strip-quoted-string ret)
- ))
- (if (member (mime-entity-encoding entity)
- mime-view-uuencode-encoding-name-list)
- (mime-raw-get-uu-filename))
- ""))
-
;;; @ MIME viewer mode
;;;
(bury-buffer buf)
))))
-(defun mime-view-mode (&optional mother ctl encoding ibuf obuf
+(defvar mime-view-redisplay nil)
+
+(defun mime-view-display-message (message &optional preview-buffer
+ mother default-keymap-or-function)
+ (mime-maybe-hide-echo-buffer)
+ (let ((win-conf (current-window-configuration))
+ (raw-buffer (mime-entity-buffer message)))
+ (or preview-buffer
+ (setq preview-buffer
+ (concat "*Preview-" (buffer-name raw-buffer) "*")))
+ (set-buffer raw-buffer)
+ (setq mime-raw-message-info (mime-parse-message))
+ (setq mime-preview-buffer preview-buffer)
+ (let ((inhibit-read-only t))
+ (switch-to-buffer preview-buffer)
+ (widen)
+ (erase-buffer)
+ (setq mime-raw-buffer raw-buffer)
+ (if mother
+ (setq mime-mother-buffer mother)
+ )
+ (setq mime-preview-original-window-configuration win-conf)
+ (setq major-mode 'mime-view-mode)
+ (setq mode-name "MIME-View")
+ (mime-view-display-entity message message
+ preview-buffer
+ '((entity-button . invisible)
+ (header . visible)
+ ))
+ (mime-view-define-keymap default-keymap-or-function)
+ (let ((point
+ (next-single-property-change (point-min) 'mime-view-entity)))
+ (if point
+ (goto-char point)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ ))
+ (run-hooks 'mime-view-mode-hook)
+ ))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ )
+
+(defun mime-view-buffer (&optional raw-buffer preview-buffer mother
+ default-keymap-or-function)
+ (interactive)
+ (mime-view-display-message
+ (save-excursion
+ (if raw-buffer (set-buffer raw-buffer))
+ (mime-parse-message)
+ )
+ preview-buffer mother default-keymap-or-function))
+
+(defun mime-view-mode (&optional mother ctl encoding
+ raw-buffer preview-buffer
default-keymap-or-function)
"Major mode for viewing MIME message.
and decode current content as `play mode'
"
(interactive)
- (mime-maybe-hide-echo-buffer)
- (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf))
- (win-conf (current-window-configuration))
- )
- (prog1
- (switch-to-buffer ret)
- (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-entity)))
- (if point
- (goto-char point)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- ))
- (run-hooks 'mime-view-mode-hook)
- )))
+ (mime-view-display-message
+ (save-excursion
+ (if raw-buffer (set-buffer raw-buffer))
+ (or mime-view-redisplay
+ (mime-parse-message ctl encoding))
+ )
+ preview-buffer mother default-keymap-or-function))
;;; @@ playing
;;; @@ following
;;;
-(defun mime-preview-original-major-mode ()
+(defun mime-preview-original-major-mode (&optional recursive)
"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
+ (if (and recursive mime-mother-buffer)
(save-excursion
(set-buffer mime-mother-buffer)
- (mime-preview-original-major-mode)
+ (mime-preview-original-major-mode recursive)
)
- mime-preview-original-major-mode))
+ (save-excursion
+ (set-buffer
+ (mime-entity-buffer
+ (get-text-property (point-min) 'mime-view-entity)))
+ major-mode)))
(defun mime-preview-follow-current-entity ()
"Write follow message to current entity.
(setq p-end (point-max))
))
))
- (let* ((mode (mime-preview-original-major-mode))
+ (let* ((mode (mime-preview-original-major-mode 'recursive))
(new-name
(format "%s-%s" (buffer-name) (reverse entity-node-id)))
new-buf
(goto-char (1- point))
(mime-preview-move-to-previous)
)
- (let ((f (assq mime-preview-original-major-mode
+ (let ((f (assq (mime-preview-original-major-mode)
mime-view-over-to-previous-method-alist)))
(if f
(funcall (cdr f))
(if (null (get-text-property point 'mime-view-entity))
(mime-preview-move-to-next)
))
- (let ((f (assq mime-preview-original-major-mode
+ (let ((f (assq (mime-preview-original-major-mode)
mime-view-over-to-next-method-alist)))
(if f
(funcall (cdr f))
(setq h (1- (window-height)))
)
(if (= (point) (point-max))
- (let ((f (assq mime-preview-original-major-mode
+ (let ((f (assq (mime-preview-original-major-mode)
mime-view-over-to-next-method-alist)))
(if f
(funcall (cdr f))
(setq h (1- (window-height)))
)
(if (= (point) (point-min))
- (let ((f (assq mime-preview-original-major-mode
- mime-view-over-to-previous-method-alist)))
+ (let ((f (assq (mime-preview-original-major-mode)
+ mime-view-over-to-previous-method-alist)))
(if f
(funcall (cdr f))
))
- (let (point)
- (save-excursion
- (catch 'tag
- (while (not (bobp))
- (if (setq point
- (previous-single-property-change (point)
- 'mime-view-entity))
- (throw 'tag t)
- )
- (backward-char)
- )
- (setq point (point-min))
- ))
+ (let ((point
+ (or (previous-single-property-change (point) 'mime-view-entity)
+ (point-min))))
(forward-line (- h))
(if (< (point) point)
(goto-char point)
It calls function registered in variable
`mime-preview-quitting-method-alist'."
(interactive)
- (let ((r (assq mime-preview-original-major-mode
+ (let ((r (assq (mime-preview-original-major-mode)
mime-preview-quitting-method-alist)))
(if r
(funcall (cdr r))
It calls function registered in variable
`mime-view-show-summary-method'."
(interactive)
- (let ((r (assq mime-preview-original-major-mode
+ (let ((r (assq (mime-preview-original-major-mode)
mime-view-show-summary-method)))
(if r
(funcall (cdr r))
projects / elisp / semi.git / blobdiff