+(defun mh-mime-maybe-display-alternatives (alternatives)
+ "Show buttons for ALTERNATIVES.
+If `mh-mime-display-alternatives-flag' is non-nil then display
+buttons for alternative parts that are usually suppressed."
+ (when (and mh-display-buttons-for-alternatives-flag alternatives)
+ (insert "\n----------------------------------------------------\n")
+ (insert "Alternatives:\n")
+ (dolist (x alternatives)
+ (insert "\n")
+ (mh-insert-mime-button x (mh-mime-part-index x) nil))
+ (insert "\n----------------------------------------------------\n")))
+
+(defun mh-mime-display-security (handle)
+ "Display PGP encrypted/signed message, HANDLE."
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert "\n")
+ (mh-insert-mime-security-button handle)
+ (mh-mime-display-mixed (cdr handle))
+ (insert "\n")
+ (let ((mh-mime-security-button-line-format
+ mh-mime-security-button-end-line-format))
+ (mh-insert-mime-security-button handle))
+ (mh-mm-set-handle-multipart-parameter
+ handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
+
+(defun mh-mime-display-single (handle)
+ "Display a leaf node, HANDLE in the MIME tree."
+ (let* ((type (mm-handle-media-type handle))
+ (small-image-flag (mh-small-image-p handle))
+ (attachmentp (equal (car (mm-handle-disposition handle))
+ "attachment"))
+ (inlinep (and (equal (car (mm-handle-disposition handle)) "inline")
+ (mm-inlinable-p handle)
+ (mm-inlined-p handle)))
+ (displayp (or inlinep ; show if inline OR
+ (mh-inline-vcard-p handle); inline vcard OR
+ (and (not attachmentp) ; if not an attachment
+ (or small-image-flag ; and small image
+ ; and user wants inline
+ (and (not (equal
+ (mm-handle-media-supertype handle)
+ "image"))
+ (mm-inlinable-p handle)
+ (mm-inlined-p handle)))))))
+ (save-restriction
+ (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
+ (cond ((and mh-pgp-support-flag
+ (equal type "application/pgp-signature"))
+ nil) ; skip signatures as they are already handled...
+ ((not displayp)
+ (insert "\n")
+ (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
+ ((and displayp
+ (not mh-display-buttons-for-inline-parts-flag))
+ (or (mm-display-part handle)
+ (mm-display-part handle))
+ (mh-signature-highlight handle))
+ ((and displayp
+ mh-display-buttons-for-inline-parts-flag)
+ (insert "\n")
+ (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
+ (forward-line -1)
+ (mh-mm-display-part handle)))
+ (goto-char (point-max)))))
+
+;; There is a bug in Gnus inline image display due to which an extra line
+;; gets inserted every time it is viewed. To work around that problem we are
+;; using an extra property 'mh-region to remember the region that is added
+;; when the button is clicked. The region is then deleted to make sure that
+;; no extra lines get inserted.
+(defun mh-mm-display-part (handle)
+ "Toggle display of button for MIME part, HANDLE."
+ (beginning-of-line)
+ (let ((id (get-text-property (point) 'mh-part))
+ (point (point))
+ (window (selected-window))
+ (mail-parse-charset 'nil)
+ (mail-parse-ignored-charsets nil)
+ region buffer-read-only)
+ (save-excursion
+ (unwind-protect
+ (let ((win (get-buffer-window (current-buffer) t)))
+ (when win
+ (select-window win))
+ (goto-char point)
+
+ (if (mm-handle-displayed-p handle)
+ ;; This will remove the part.
+ (progn
+ ;; Delete the button and displayed part (if any)
+ (let ((region (get-text-property point 'mh-region)))
+ (when region
+ (mh-funcall-if-exists
+ remove-images (car region) (cdr region)))
+ (mm-display-part handle)
+ (when region
+ (delete-region (car region) (cdr region))))
+ ;; Delete button (if it still remains). This happens for
+ ;; externally displayed parts where the previous step does
+ ;; nothing.
+ (unless (eolp)
+ (delete-region (point) (progn (forward-line) (point)))))
+ (save-restriction
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (narrow-to-region (point) (point))
+ ;; Maybe we need another unwind-protect here.
+ (when (equal (mm-handle-media-supertype handle) "image")
+ (insert "\n"))
+ (when (and (not (eq (ignore-errors (mm-display-part handle))
+ 'inline))
+ (equal (mm-handle-media-supertype handle)
+ "image"))
+ (goto-char (point-min))
+ (delete-char 1))
+ (when (equal (mm-handle-media-supertype handle) "text")
+ (when (eq mh-highlight-citation-style 'gnus)
+ (mh-gnus-article-highlight-citation))
+ (mh-display-smileys)
+ (mh-display-emphasis)
+ (mh-signature-highlight handle))
+ (setq region (cons (progn (goto-char (point-min))
+ (point-marker))
+ (progn (goto-char (point-max))
+ (point-marker)))))))
+ (when (window-live-p window)
+ (select-window window))
+ (goto-char point)
+ (beginning-of-line)
+ (mh-insert-mime-button handle id (mm-handle-displayed-p handle))
+ (goto-char point)
+ (when region
+ (add-text-properties (mh-line-beginning-position)
+ (mh-line-end-position)
+ `(mh-region ,region)))))))
+
+(defun mh-mime-part-index (handle)
+ "Generate the button number for MIME part, HANDLE.
+Notice that a hash table is used to display the same number when
+buttons need to be displayed multiple times (for instance when
+nested messages are opened)."
+ (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
+ (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
+ (incf (mh-mime-parts-count (mh-buffer-data))))))
+
+(defun mh-small-image-p (handle)
+ "Decide whether HANDLE is a \"small\" image that can be displayed inline.
+This is only useful if a Content-Disposition header is not present."
+ (let ((media-test (caddr (assoc (car (mm-handle-type handle))
+ mh-mm-inline-media-tests)))
+ (mm-inline-large-images t))
+ (and media-test
+ (equal (mm-handle-media-supertype handle) "image")
+ (funcall media-test handle) ; Since mm-inline-large-images is T,
+ ; this only tells us if the image is
+ ; something that emacs can display
+ (let* ((image (mm-get-image handle)))
+ (or (mh-do-in-xemacs
+ (and (mh-funcall-if-exists glyphp image)
+ (< (glyph-width image)
+ (or mh-max-inline-image-width (window-pixel-width)))
+ (< (glyph-height image)
+ (or mh-max-inline-image-height
+ (window-pixel-height)))))
+ (mh-do-in-gnu-emacs
+ (let ((size (mh-funcall-if-exists image-size image)))
+ (and size
+ (< (cdr size) (or mh-max-inline-image-height
+ (1- (window-height))))
+ (< (car size) (or mh-max-inline-image-width
+ (window-width)))))))))))
+
+(defun mh-inline-vcard-p (handle)
+ "Decide if HANDLE is a vcard that must be displayed inline."
+ (let ((type (mm-handle-type handle)))
+ (and (or (featurep 'vcard) (fboundp 'vcard-pretty-print))
+ (consp type)
+ (equal (car type) "text/x-vcard")
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (not (mh-signature-separator-p)))))))
+
+(defun mh-signature-highlight (&optional handle)
+ "Highlight message signature in HANDLE.
+The optional argument, HANDLE is a MIME handle if the function is
+being used to highlight the signature in a MIME part."
+ (let ((regexp
+ (cond ((not handle) "^-- $")
+ ((not (and (equal (mm-handle-media-supertype handle) "text")
+ (equal (mm-handle-media-subtype handle) "html")))
+ "^-- $")
+ ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$")
+ (t "^--$"))))
+ (save-excursion
+ (goto-char (point-max))
+ (when (re-search-backward regexp nil t)
+ (mh-do-in-gnu-emacs
+ (let ((ov (make-overlay (point) (point-max))))
+ (overlay-put ov 'face 'mh-show-signature)
+ (overlay-put ov 'evaporate t)))
+ (mh-do-in-xemacs
+ (set-extent-property (make-extent (point) (point-max))
+ 'face 'mh-show-signature))))))
+
+\f
+
+;;; Button Display
+
+;; Shush compiler.
+(defvar dots) ; XEmacs
+(defvar type) ; XEmacs
+(defvar ov) ; XEmacs
+
+(defun mh-insert-mime-button (handle index displayed)
+ "Insert MIME button for HANDLE.
+INDEX is the part number that will be DISPLAYED. It is also used
+by commands like \"K v\" which operate on individual MIME parts."
+ ;; The button could be displayed by a previous decode. In that case
+ ;; undisplay it if we need a hidden button.
+ (when (and (mm-handle-displayed-p handle) (not displayed))
+ (mm-display-part handle))
+ (let ((name (or (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename)
+ (mail-content-type-get (mm-handle-type handle) 'url)
+ ""))
+ (type (mm-handle-media-type handle))
+ (description (mail-decode-encoded-word-string
+ (or (mm-handle-description handle) "")))
+ (dots (if (or displayed (mm-handle-displayed-p handle)) " " "..."))
+ long-type begin end)
+ (if (string-match ".*/" name) (setq name (substring name (match-end 0))))
+ (setq long-type (concat type (and (not (equal name ""))
+ (concat "; " name))))
+ (unless (equal description "")
+ (setq long-type (concat " --- " long-type)))
+ (unless (bolp) (insert "\n"))
+ (setq begin (point))
+ (gnus-eval-format
+ mh-mime-button-line-format mh-mime-button-line-format-alist
+ `(,@(mh-gnus-local-map-property mh-mime-button-map)
+ mh-callback mh-mm-display-part
+ mh-part ,index
+ mh-data ,handle))
+ (setq end (point))
+ (widget-convert-button
+ 'link begin end
+ :mime-handle handle
+ :action 'mh-widget-press-button
+ :button-keymap mh-mime-button-map
+ :help-echo
+ "Mouse-2 click or press RET (in show buffer) to toggle display")
+ (dolist (ov (mh-funcall-if-exists overlays-in begin end))
+ (mh-funcall-if-exists overlay-put ov 'evaporate t))))
+
+;; Shush compiler.
+(defvar mm-verify-function-alist) ; < Emacs 22
+(defvar mm-decrypt-function-alist) ; < Emacs 22
+(defvar pressed-details) ; XEmacs
+
+(defun mh-insert-mime-security-button (handle)
+ "Display buttons for PGP message, HANDLE."
+ (let* ((protocol (mh-mm-handle-multipart-ctl-parameter handle 'protocol))
+ (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
+ (nth 2 (assoc protocol mm-decrypt-function-alist))
+ "Unknown"))
+ (type (concat crypto-type
+ (if (equal (car handle) "multipart/signed")
+ " Signed" " Encrypted")
+ " Part"))
+ (info (or (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ "Undecided"))
+ (details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details))
+ pressed-details begin end face)
+ (setq details (if details (concat "\n" details) ""))
+ (setq pressed-details (if mh-mime-security-button-pressed details ""))
+ (setq face (mh-mime-security-button-face info))
+ (unless (bolp) (insert "\n"))
+ (setq begin (point))
+ (gnus-eval-format
+ mh-mime-security-button-line-format
+ mh-mime-security-button-line-format-alist
+ `(,@(mh-gnus-local-map-property mh-mime-security-button-map)
+ mh-button-pressed ,mh-mime-security-button-pressed
+ mh-callback mh-mime-security-press-button
+ mh-line-format ,mh-mime-security-button-line-format
+ mh-data ,handle))
+ (setq end (point))
+ (widget-convert-button 'link begin end
+ :mime-handle handle
+ :action 'mh-widget-press-button
+ :button-keymap mh-mime-security-button-map
+ :button-face face
+ :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
+ (dolist (ov (mh-funcall-if-exists overlays-in begin end))
+ (mh-funcall-if-exists overlay-put ov 'evaporate t))
+ (when (equal info "Failed")
+ (let* ((type (if (equal (car handle) "multipart/signed")
+ "verification" "decryption"))
+ (warning (if (equal type "decryption")
+ "(passphrase may be incorrect)" "")))
+ (message "%s %s failed %s" crypto-type type warning)))))