'visible))
(defmacro mime-view-children-is-invisible (situation)
- `(eq (cdr (or (assq '*children ,situation)))
+ `(eq (cdr (or (assq '*children ,situation)
+ (assq 'children ,situation)))
'invisible))
(defmacro mime-view-button-is-visible (situation)
(if body-is-invisible
" ..."
""))
- (function mime-preview-play-current-entity)
- (if body-is-invisible
- 'invisible))))
+ (function mime-preview-play-current-entity))))
;;; @@ entity-header
(body-presentation-method . mime-display-multipart/alternative)))
(ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . partial)
- (body-presentation-method
- . mime-display-message/partial-button)))
+ 'mime-preview-condition
+ '((type . multipart)(subtype . t)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/mixed)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . partial)
+ (body . visible)
+ (body-presentation-method . mime-display-message/partial-button)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . rfc822)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/mixed)
+ (childrens-situation (header . visible)
+ (entity-button . invisible))))
(ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . rfc822)
- (body-presentation-method . nil)
- (childrens-situation (header . visible)
- (entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . news)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/mixed)
+ (childrens-situation (header . visible)
+ (entity-button . invisible))))
+;; message/external-body has only one child.
(ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . news)
- (body-presentation-method . nil)
- (childrens-situation (header . visible)
- (entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . external-body)
+ (body . visible)
+ (body-presentation-method . nil)
+ (childrens-situation (header . invisible)
+ (body . invisible)
+ (entity-button . visible))))
;;; @@@ entity presentation
(mime-add-url-buttons)
(run-hooks 'mime-display-text/plain-hook)))
+(defun mime-display-text (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max) (point-max))
+ (insert
+ (decode-coding-string
+ (mime-decode-string (mime-entity-content entity)
+ (cdr (assq 'encoding situation)))
+ (or (cdr (assq 'coding situation))
+ 'binary)))))
+
(defun mime-display-text/richtext (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
(defun mime-display-gzipped (entity situation)
"Ungzip gzipped part and display."
(insert
- (with-temp-buffer
- (insert (mime-entity-content entity))
- (as-binary-process
- (call-process-region (point-min) (point-max) "gzip" t t
- nil "-cd"))
- (buffer-string (point-min) (point-max))))
- t)
+ (decode-coding-string
+ (with-temp-buffer
+ ;; #### Kludge to make FSF Emacs happy.
+ (if (featurep 'xemacs)
+ (insert (mime-entity-content entity))
+ (let ((content (mime-entity-content entity)))
+ (if (not (multibyte-string-p content))
+ ;; I really hate this brain-damaged function.
+ (set-buffer-multibyte nil))
+ (insert content)))
+ (as-binary-process
+ (call-process-region (point-min) (point-max) "gzip" t t
+ nil "-cd"))
+ ;; Oh my goodness.
+ (when (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte t))
+ (buffer-string))
+ 'undecided))
+ t)
(defun mime-preview-inline ()
"View part as text without code conversion."
With prefix, it prompts for coding-system."
(interactive "P")
(let ((inhibit-read-only t)
- (entity (get-text-property (point) 'mime-view-entity))
- (situation (get-text-property (point) 'mime-view-situation))
+ (mime-view-force-inline-types t)
+ (position (mime-preview-entity-boundary))
(coding (if ask-coding
(or (read-coding-system "Coding system: ")
'undecided)
'undecided))
- start)
- (when (and entity
- (not (get-text-property (point) 'mime-view-entity-header))
- (not (memq (mime-entity-media-type entity)
- '(multipart message))))
- (setq start (or (and (not (mime-entity-parent entity))
- (1+ (previous-single-property-change
- (point)
- 'mime-view-entity-header)))
- (and (not (eq (point) (point-min)))
- (not (eq (get-text-property (1- (point))
- 'mime-view-entity)
- entity))
- (point))
- (previous-single-property-change (point)
- 'mime-view-entity)
- (point)))
- (delete-region start
- (1-
- (or (next-single-property-change (point)
- 'mime-view-entity)
- (point-max))))
- (setq start (point))
- (if (mime-view-entity-button-visible-p entity)
- (mime-view-insert-entity-button entity))
- (insert (decode-coding-string (mime-entity-content entity) coding))
- (if (and (bolp) (eolp))
- (delete-char 1)
- (forward-char 1))
- (add-text-properties start (point)
- (list 'mime-view-entity entity
- 'mime-view-situation situation))
- (goto-char start))))
-
+ (cte (if ask-coding
+ (completing-read "Content Transfer Encoding: "
+ (mime-encoding-alist) nil t)))
+ entity situation)
+ (setq entity (get-text-property (car position) 'mime-view-entity)
+ situation (get-text-property (car position) 'mime-view-situation))
+ (setq situation
+ (put-alist
+ 'encoding cte
+ (put-alist
+ 'coding coding
+ (put-alist
+ 'body-presentation-method 'mime-display-text
+ (put-alist '*body 'visible situation)))))
+ (save-excursion
+ (delete-region (car position) (cdr position))
+ (mime-display-entity entity situation))))
(defun mime-preview-type ()
"View part as text without code conversion."
(body-presentation-method
(cdr (assq 'body-presentation-method situation)))
(children (mime-entity-children entity))
- (children-is-invisible (eq (cdr (assq '*children situation))
- 'invisible))
nb ne nhb nbb)
;; Check if attachment is specified.
;; if inline is forced or not.
(put-text-property nb ne 'mime-view-situation situation)
(put-text-property nbb ne 'mime-view-entity-body entity)
(goto-char ne)
- (if (and children
- (not children-is-invisible))
+ (if (and children body-is-visible)
(if (functionp body-presentation-method)
(funcall body-presentation-method entity situation)
(mime-display-multipart/mixed entity situation)))))
(if header-exists
(delete-region (goto-char (point-min))
(re-search-forward "^$"))
+ (goto-char (point-min))
(insert "\n"))
(goto-char (point-min))
(let ((current-entity
(let ((entity (get-text-property point 'mime-view-entity))
(start (previous-single-property-change (1+ point) 'mime-view-entity
nil (point-min)))
- (end point)
- done)
- (while (and (mime-entity-children entity)
- (not done))
- (if (mime-view-children-is-invisible
- (get-text-property point 'mime-view-situation))
- (setq done t)
- ;; If the part is shown, search the last part.
- (let ((child (car (last (mime-entity-children entity)))))
- (while (not (eq (get-text-property point 'mime-view-entity) child))
- (setq point (next-single-property-change point 'mime-view-entity)))
- (setq entity child))))
- (setq end (next-single-property-change point 'mime-view-entity
- nil (point-max)))
+ end done)
+ (if (not (mime-entity-node-id entity))
+ (setq end (point-max))
+ (while (and (mime-entity-children entity)
+ (not done))
+ (if (not (mime-view-body-is-visible
+ (get-text-property point 'mime-view-situation)))
+ (setq done t)
+ ;; If the part is shown, search the last part.
+ (let* ((child (car (last (mime-entity-children entity))))
+ (node-id (mime-entity-node-id child))
+ (tmp-node-id (mime-entity-node-id
+ (get-text-property point
+ 'mime-view-entity))))
+ (while (or (< (length tmp-node-id)
+ (length node-id))
+ (not (eq (nthcdr (- (length tmp-node-id)
+ (length node-id))
+ tmp-node-id)
+ node-id)))
+ (setq point
+ (next-single-property-change point 'mime-view-entity)
+ tmp-node-id (mime-entity-node-id
+ (get-text-property point
+ 'mime-view-entity))))
+ (setq entity child))))
+ (setq end (next-single-property-change
+ point 'mime-view-entity nil (point-max))))
(cons start end)))
(defun mime-preview-toggle-header (&optional show)
(setq entity (get-text-property (car position) 'mime-view-entity)
situation (get-text-property (car position) 'mime-view-situation))
(setq situation
- (if (mime-entity-children entity)
- ;; Entity body is always invisible for composite types.
- (if (or show (mime-view-children-is-invisible situation))
- (del-alist
- '*entity-button
- (put-alist '*children 'visible situation))
- (put-alist
- '*entity-button 'visible
- (put-alist '*children 'invisible situation)))
- (if (or show (not (mime-view-body-is-visible situation)))
- (del-alist
- '*entity-button
- (put-alist '*body 'visible situation))
- (put-alist
- '*entity-button 'visible
- (put-alist '*body 'invisible situation)))))
+ (if (or show (not (mime-view-body-is-visible situation)))
+ (del-alist
+ '*entity-button
+ (put-alist '*body 'visible situation))
+ (put-alist
+ '*entity-button 'visible
+ (put-alist '*body 'invisible situation))))
(save-excursion
(delete-region (car position) (cdr position))
(mime-display-entity entity situation))))
projects / elisp / semi.git / blobdiff