(const :tag "Default" t))
integer)))
+(defcustom mime-view-mailcap-files
+ (if (memq system-type '(ms-dos ms-windows windows-nt))
+ '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
+ '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
+ "/usr/local/etc/mailcap"))
+ "*Search path of mailcap files."
+ :group 'mime
+ :type '(repeat file))
+
+(defvar mime-view-automatic-conversion
+ (cond ((featurep 'xemacs)
+ 'automatic-conversion)
+ ((boundp 'MULE)
+ '*autoconv*)
+ (t
+ 'undecided)))
+
;;; @ in raw-buffer (representation space)
;;;
'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)
+ ;; Kludge.
+ `(or (eq (or (cdr (assq '*entity-button ,situation))
+ (cdr (assq 'entity-button ,situation)))
+ 'visible)
+ (and (not (eq (or (cdr (assq '*entity-button ,situation))
+ (cdr (assq 'entity-button ,situation)))
+ 'invisible))
+ (mime-view-entity-button-visible-p entity))))
+
;;; @ presentation of preview
;;;
(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 . rfc822)
- (body-presentation-method . nil)
- (childrens-situation (header . visible)
- (entity-button . invisible))))
+ '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 . news)
- (body-presentation-method . nil)
- (childrens-situation (header . visible)
- (entity-button . invisible))))
+ '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 . 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 . external-body)
+ (body . visible)
+ (body-presentation-method . nil)
+ (childrens-situation (header . invisible)
+ (body . invisible)
+ (entity-button . visible))))
;;; @@@ entity presentation
(defun mime-display-text/plain (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
- (mime-insert-text-content entity)
+ (condition-case nil
+ (mime-insert-text-content entity)
+ (error
+ (message "Wrong Content-Transfer-Encoding: %s"
+ (mime-entity-encoding entity))
+ (if (fboundp 'mime-entity-body)
+ (insert (mime-entity-body entity))
+ (insert ""))))
(run-hooks 'mime-text-decode-hook)
(goto-char (point-max))
(if (not (eq (char-after (1- (point))) ?\n))
(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
+ (if (fboundp 'mime-entity-body)
+ ;; FLIM 1.14
+ (mime-entity-body entity)
+ ;; #### This is wrong, but...
+ (mime-entity-content entity))
+ (or (cdr (assq 'encoding situation))
+ (if (fboundp 'mime-entity-body)
+ (mime-entity-encoding entity)
+ "7bit")))
+ (or (cdr (assq 'coding situation))
+ 'binary)))))
+
(defun mime-display-text/richtext (entity situation)
(save-restriction
(narrow-to-region (point-max)(point-max))
(defvar mime-view-announcement-for-message/partial
(if (and (>= emacs-major-version 19) window-system)
"\
-\[[ This is message/partial style split message. ]]
-\[[ Please press `v' key in this buffer ]]
-\[[ or click here by mouse button-2. ]]"
+This is message/partial style split message.
+Please press `v' key in this buffer or click here by mouse button-2."
"\
-\[[ This is message/partial style split message. ]]
-\[[ Please press `v' key in this buffer. ]]"))
+This is message/partial style split message.
+Please press `v' key in this buffer."))
(defun mime-display-message/partial-button (&optional entity situation)
(save-restriction
(if (not (search-backward "\n\n" nil t))
(insert "\n"))
(goto-char (point-max))
- (narrow-to-region (point-max)(point-max))
- (insert mime-view-announcement-for-message/partial)
- (mime-add-button (point-min)(point-max)
- #'mime-preview-play-current-entity)))
+ ;;(narrow-to-region (point-max)(point-max))
+ ;;(insert mime-view-announcement-for-message/partial)
+ ;; (mime-add-button (point-min)(point-max)
+ ;; #'mime-preview-play-current-entity)
+ (mime-insert-button mime-view-announcement-for-message/partial
+ #'mime-preview-play-current-entity)))
(defun mime-display-multipart/mixed (entity situation)
(let ((children (mime-entity-children entity))
situations (cdr situations)
i (1+ i)))))
+(defun mime-display-multipart/encrypted (entity situation)
+ (let ((children (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 (car children) nil default-situation)
+ (mime-display-entity (cadr children) nil
+ (put-alist '*entity-button
+ 'invisible default-situation))
+ (del-alist '*entity-button default-situation)
+ (setq children (nth 2 children))
+ ;; This shouldn't happen.
+ (while children
+ (mime-display-entity (car children) nil default-situation)
+ (setq children (cdr children)))))
+
(defun mime-display-detect-application/octet-stream (entity situation)
"Detect unknown ENTITY and display it inline.
This can only handle gzipped contents."
(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))
+ mime-view-automatic-conversion))
+ 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))))
-
+ mime-view-automatic-conversion)
+ mime-view-automatic-conversion))
+ (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."
(interactive)
- (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)
- 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))))
- (save-excursion
- (save-restriction
- (narrow-to-region (point) (point))
- (mime-display-entity entity (if (eq (assq 'body situation)
- 'invisible)
- situation
- (put-alist 'body 'visible
- situation))))
- (if (and (bolp) (eolp))
- (delete-char 1))))))
+ (mime-preview-toggle-content t))
(defun mime-preview-buttonize ()
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((inhibit-read-only t)
- point)
+ (let (point)
(while (setq point (next-single-property-change
(point) 'mime-view-entity))
(goto-char point)
- (unless (get-text-property (point) 'mime-button-callback)
- (mime-view-insert-entity-button
- (get-text-property (point) 'mime-view-entity)))))))
+ (unless (get-text-property (point) 'mime-button)
+ (mime-preview-toggle-button t))))))
(defun mime-preview-unbuttonize ()
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((inhibit-read-only t)
- point)
+ (let (point)
(while (setq point (next-single-property-change
(point) 'mime-view-entity))
(goto-char point)
- (if (get-text-property (point) 'mime-button-callback)
- (delete-region (point) (save-excursion
- (goto-char
- (next-single-property-change
- (point) 'mime-button-callback)))))))))
+ (when (get-text-property (point) 'mime-button)
+ ;; Remove invisible text following XPM buttons.
+ (static-if (featurep 'xemacs)
+ (let ((extent (extent-at (point) nil 'invisible))
+ (inhibit-read-only t))
+ (if extent
+ (delete-region (extent-start-position extent)
+ (extent-end-position extent)))))
+ (mime-preview-toggle-button 'hide))))))
;;; @ acting-condition
(defvar mime-acting-condition nil
"Condition-tree about how to process entity.")
-(if (file-readable-p mailcap-file)
- (let ((entries (mailcap-parse-file)))
- (while entries
- (let ((entry (car entries))
- view print shared)
- (while entry
- (let* ((field (car entry))
- (field-type (car field)))
- (cond ((eq field-type 'view) (setq view field))
- ((eq field-type 'print) (setq print field))
- ((memq field-type '(compose composetyped edit)))
- (t (setq shared (cons field shared)))))
- (setq entry (cdr entry)))
- (setq shared (nreverse shared))
- (ctree-set-calist-with-default
- 'mime-acting-condition
- (append shared (list '(mode . "play")(cons 'method (cdr view)))))
- (if print
- (ctree-set-calist-with-default
- 'mime-acting-condition
- (append shared
- (list '(mode . "print")(cons 'method (cdr view)))))))
- (setq entries (cdr entries)))))
+(defvar mime-view-mailcap-parsed-p nil)
+
+;; ### Fix flim
+(defun mime-view-parse-mailcap-files (&optional path)
+ (if (not (or path (setq path (getenv "MAILCAPS"))))
+ (setq path mime-view-mailcap-files))
+ (let ((fnames (reverse
+ (if (stringp path)
+ (parse-colon-path path)
+ path)))
+ fname)
+ (setq mim-view-mailcap-parsed-p t)
+ (with-temp-buffer
+ (while fnames
+ (setq fname (car fnames))
+ (when (and (file-readable-p fname)
+ (file-regular-p fname))
+ (insert-file-contents fname)
+ (unless (bolp)
+ (insert "\n")))
+ (setq fnames (cdr fnames)))
+ (mailcap-parse-buffer))))
+
+(defun mime-view-parse-mailcap (&optional path force)
+ "Parse out all the mailcaps specified in a path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system. If FORCE, re-parse even if already
+parsed. If PATH is omitted, use the value of `mime-view-mailcap-files'."
+ (interactive (list nil t))
+ (when (or (not mime-view-mailcap-parsed-p)
+ force)
+ (let ((entries (mime-view-parse-mailcap-files path)))
+ (while entries
+ (let ((entry (car entries))
+ view print shared)
+ (while entry
+ (let* ((field (car entry))
+ (field-type (car field)))
+ (cond ((eq field-type 'view)
+ (setq view field))
+ ((eq field-type 'print)
+ (setq print field))
+ ((memq field-type '(compose composetyped edit)))
+ (t
+ (setq shared (cons field shared)))))
+ (setq entry (cdr entry)))
+ (setq shared (nreverse shared))
+ (ctree-set-calist-with-default
+ 'mime-acting-condition
+ (append shared
+ (list '(mode . "play") (cons 'method (cdr view)))))
+ (if print
+ (ctree-set-calist-with-default
+ 'mime-acting-condition
+ (append shared
+ (list '(mode . "print") (cons 'method (cdr view)))))))
+ (setq entries (cdr entries))))))
+
+(mime-view-parse-mailcap)
(ctree-set-calist-strictly
'mime-acting-condition
(append (mime-entity-situation entity)
default-situation))
default-situation)))
- (let ((button-is-visible
- ;; Kludge.
- (or (eq (or (cdr (assq '*entity-button situation))
- (cdr (assq 'entity-button situation)))
- 'visible)
- (and (not (eq (or (cdr (assq '*entity-button situation))
- (cdr (assq 'entity-button situation)))
- 'invisible))
- (mime-view-entity-button-visible-p entity))))
+ (let ((button-is-visible (mime-view-button-is-visible situation))
(header-is-visible
(mime-view-header-is-visible situation))
(header-presentation-method
- (or (cdr (assq 'header-presentation-method situation))
+ (or (cdr (assq '*header-presentation-method situation))
+ (cdr (assq 'header-presentation-method situation))
(cdr (assq (cdr (assq 'major-mode situation))
mime-header-presentation-method-alist))))
(body-is-visible
(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.
(eq 'inline
(mime-content-disposition-type
(mime-entity-content-disposition entity))))
- ;; This is attachment
- (setq header-is-visible nil
- body-is-visible nil)
- (put-alist 'header 'invisible situation)
- (put-alist 'body 'invisible situation))
+ ;; This is attachment.
+ ;; But show header when this is root entity.
+ (if (mime-root-entity-p entity)
+ (progn (setq body-is-visible nil)
+ (put-alist 'body 'invisible situation))
+ (setq header-is-visible nil)
+ (put-alist 'header 'invisible situation)))
(set-buffer preview-buffer)
(setq nb (point))
(save-restriction
(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)))))
(define-key mime-view-mode-map
"\C-c\C-t\C-h" (function mime-preview-toggle-header))
(define-key mime-view-mode-map
+ "\C-c\C-th" (function mime-preview-toggle-header))
+ (define-key mime-view-mode-map
"\C-c\C-t\C-c" (function mime-preview-toggle-content))
(define-key mime-view-mode-map
+ "\C-c\C-tc" (function mime-preview-toggle-content))
+ (define-key mime-view-mode-map
+ "\C-c\C-tH" (function mime-preview-toggle-all-header))
+ (define-key mime-view-mode-map
+ "\C-c\C-tb" (function mime-preview-toggle-button))
+ (define-key mime-view-mode-map
"\C-c\C-p" (function mime-preview-print-current-entity))
(define-key mime-view-mode-map
"a" (function mime-preview-follow-current-entity))
(setq major-mode 'mime-view-mode)
(setq mode-name "MIME-View")
(mime-display-entity message nil
- `((entity-button . invisible)
- (header . visible)
- (major-mode . ,original-major-mode))
+ (list (cons 'entity-button 'invisible)
+ (cons 'header 'visible)
+ (cons 'major-mode original-major-mode))
preview-buffer)
(mime-view-define-keymap default-keymap-or-function)
(set (make-local-variable 'line-move-ignore-invisible) t)
entity))
(get-text-property
(next-single-property-change
- (car position) 'mime-button-callback
+ (car position) 'mime-button
nil (point-max))
'mime-view-entity-header))))
(let* ((mode (mime-preview-original-major-mode 'recursive))
(save-excursion
(set-buffer (setq new-buf (get-buffer-create new-name)))
(erase-buffer)
- (unless header-exists
- (insert ?\n))
;; Compatibility kludge.
;; FSF Emacs can only take substring of current-buffer.
(insert
(set-buffer the-buf)
(buffer-substring-no-properties (car position)
(cdr position))))
+ (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
(if (and (eq (mime-entity-media-type entity) 'message)
(progn (goto-char point)
(recenter next-screen-context-lines))
(condition-case nil
- (scroll-up h)
+ (let (window-pixel-scroll-increment)
+ (scroll-up h))
(end-of-buffer
(goto-char (point-max))))))))
(progn (goto-char point)
(recenter (* -1 next-screen-context-lines)))
(condition-case nil
- (scroll-down h)
+ (let (window-pixel-scroll-increment)
+ (scroll-down h))
(beginning-of-buffer
(goto-char (point-min))))))))
(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 ()
- "Toggle display of entity header."
- (interactive)
+(defun mime-preview-toggle-header (&optional show)
+ "Toggle display of entity header.
+When prefix is given, it always displays the header."
+ (interactive "P")
(let ((inhibit-read-only t)
(mime-view-force-inline-types t)
(position (mime-preview-entity-boundary))
(setq header-is-visible (mime-view-header-is-visible situation))
(save-excursion
(delete-region (car position) (cdr position))
- (if header-is-visible
- (mime-display-entity entity
- (put-alist '*entity-button 'visible
- (put-alist '*header 'invisible
- situation)))
- (mime-display-entity entity
- (put-alist '*entity-button 'invisible
- (put-alist '*header 'visible
- situation)))))))
-
-(defun mime-preview-toggle-content ()
- "Toggle display of entity body."
- (interactive)
+ (if (or show (not header-is-visible))
+ (mime-display-entity
+ entity
+ (del-alist '*entity-button
+ (put-alist '*header 'visible
+ situation)))
+ (mime-display-entity
+ entity
+ (put-alist '*entity-button
+ 'visible
+ (put-alist '*header 'invisible
+ situation)))))))
+
+(defun mime-preview-toggle-all-header (&optional show)
+ "Toggle display of entity header.
+When prefix is given, it always displays the header."
+ (interactive "P")
+ (let ((inhibit-read-only t)
+ (mime-view-force-inline-types t)
+ (position (mime-preview-entity-boundary))
+ entity header-is-visible situation)
+ (setq entity (get-text-property (car position) 'mime-view-entity)
+ situation (get-text-property (car position) 'mime-view-situation))
+ (setq header-is-visible (mime-view-header-is-visible situation))
+ (save-excursion
+ (delete-region (car position) (cdr position))
+ (if (or show (not header-is-visible))
+ (mime-display-entity
+ entity
+ (del-alist '*entity-button
+ (del-alist '*header
+ (del-alist '*header-presentation-method
+ situation))))
+ (mime-display-entity
+ entity
+ (put-alist
+ '*entity-button
+ 'visible
+ (put-alist
+ '*header 'invisible
+ (put-alist '*header-presentation-method
+ #'(lambda (entity situation)
+ (mime-insert-header
+ entity nil '(".*")))
+ situation))))))))
+
+(defun mime-preview-toggle-content (&optional show)
+ "Toggle display of entity body.
+When prefix is given, it always displays the content."
+ (interactive "P")
(let ((inhibit-read-only t)
(mime-view-force-inline-types t)
(position (mime-preview-entity-boundary))
(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 (mime-view-children-is-invisible situation)
- (put-alist '*children 'visible situation)
- (put-alist '*children 'invisible situation))
- (if (mime-view-body-is-visible situation)
- (put-alist '*body 'invisible situation)
- (put-alist '*body 'visible 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))))
+(defun mime-preview-toggle-button (&optional condition)
+ "Toggle display of entity button.
+When prefix is given, it always displays the content.
+If condition is 'hide, hide all buttons."
+ (interactive "P")
+ (let ((inhibit-read-only t)
+ (mime-view-force-inline-types t)
+ (position (mime-preview-entity-boundary))
+ entity situation button-is-visible)
+ (setq entity (get-text-property (car position) 'mime-view-entity)
+ situation (get-text-property (car position) 'mime-view-situation)
+ button-is-visible (mime-view-button-is-visible situation))
+ (save-excursion
+ (delete-region (car position) (cdr position))
+ (if (or (eq condition 'hide)
+ (and (not condition) button-is-visible))
+ (mime-display-entity entity
+ (put-alist '*entity-button
+ 'invisible situation))
+ (mime-display-entity entity
+ (put-alist '*entity-button
+ 'visible situation))))))
+
;;; @@ quitting
;;;
projects / elisp / semi.git / blobdiff