+(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)))))
+
+(defun mh-mime-security-button-face (info)
+ "Return the button face to use for encrypted/signed mail based on INFO."
+ (cond ((string-match "OK" info) ;Decrypted mail
+ 'mh-show-pgg-good)
+ ((string-match "Failed" info) ;Decryption failed or signature invalid
+ 'mh-show-pgg-bad)
+ ((string-match "Undecided" info);Unprocessed mail
+ 'mh-show-pgg-unknown)
+ ((string-match "Untrusted" info);Key not trusted
+ 'mh-show-pgg-unknown)
+ (t
+ 'mh-show-pgg-good)))
+
+\f
+
+;;; Button Handlers
+
+(defun mh-folder-mime-action (part-index action include-security-flag)
+ "Go to PART-INDEX and carry out ACTION.
+
+If PART-INDEX is nil then go to the next part in the buffer. The
+search for the next buffer wraps around if end of buffer is reached.
+If argument INCLUDE-SECURITY-FLAG is non-nil then include security
+info buttons when searching for a suitable parts."
+ (unless mh-showing-mode
+ (mh-show))
+ (mh-in-show-buffer (mh-show-buffer)
+ (let ((criterion
+ (cond (part-index
+ (lambda (p)
+ (let ((part (get-text-property p 'mh-part)))
+ (and (integerp part) (= part part-index)))))
+ (t (lambda (p)
+ (if include-security-flag
+ (get-text-property p 'mh-data)
+ (integerp (get-text-property p 'mh-part)))))))
+ (point (point)))
+ (cond ((and (get-text-property point 'mh-part)
+ (or (null part-index)
+ (= (get-text-property point 'mh-part) part-index)))
+ (funcall action))
+ ((and (get-text-property point 'mh-data)
+ include-security-flag
+ (null part-index))
+ (funcall action))
+ (t
+ (mh-goto-next-button nil criterion)
+ (if (= (point) point)
+ (message "No matching MIME part found")
+ (funcall action)))))))
+
+;;;###mh-autoload
+(defun mh-goto-next-button (backward-flag &optional criterion)
+ "Search for next button satisfying criterion.
+
+If BACKWARD-FLAG is non-nil search backward in the buffer for a mime
+button.
+If CRITERION is a function or a symbol which has a function binding
+then that function must return non-nil at the button we stop."
+ (unless (or (and (symbolp criterion) (fboundp criterion))
+ (functionp criterion))
+ (setq criterion (lambda (x) t)))
+ ;; Move to the next button in the buffer satisfying criterion
+ (goto-char (or (save-excursion
+ (beginning-of-line)
+ ;; Find point before current button
+ (let ((point-before-current-button
+ (save-excursion
+ (while (get-text-property (point) 'mh-data)
+ (unless (= (forward-line
+ (if backward-flag 1 -1))
+ 0)
+ (if backward-flag
+ (goto-char (point-min))
+ (goto-char (point-max)))))
+ (point))))
+ ;; Skip over current button
+ (while (and (get-text-property (point) 'mh-data)
+ (not (if backward-flag (bobp) (eobp))))
+ (forward-line (if backward-flag -1 1)))
+ ;; Stop at next MIME button if any exists.
+ (block loop
+ (while (/= (progn
+ (unless (= (forward-line
+ (if backward-flag -1 1))
+ 0)
+ (if backward-flag
+ (goto-char (point-max))
+ (goto-char (point-min)))
+ (beginning-of-line))
+ (point))
+ point-before-current-button)
+ (when (and (get-text-property (point) 'mh-data)
+ (funcall criterion (point)))
+ (return-from loop (point))))
+ nil)))
+ (point))))
+
+(defun mh-widget-press-button (widget el)
+ "Callback for widget, WIDGET.
+Parameter EL is unused."
+ (goto-char (widget-get widget :from))
+ (mh-press-button))
+
+(defun mh-press-button ()
+ "View contents of button.
+
+This command is a toggle so if you use it again on the same
+attachment, the attachment is hidden."
+ (interactive)
+ (let ((mm-inline-media-tests mh-mm-inline-media-tests)
+ (data (get-text-property (point) 'mh-data))
+ (function (get-text-property (point) 'mh-callback))
+ (buffer-read-only nil)
+ (folder mh-show-folder-buffer))
+ (flet ((mm-handle-set-external-undisplayer
+ (handle function)
+ (mh-handle-set-external-undisplayer folder handle function)))
+ (when (and function (eolp))
+ (backward-char))
+ (unwind-protect (and function (funcall function data))
+ (set-buffer-modified-p nil)))))
+
+(defun mh-push-button (event)
+ "Click MIME button for EVENT.
+
+If the MIME part is visible then it is removed. Otherwise the
+part is displayed. This function is called when the mouse is used
+to click the MIME button."
+ (interactive "e")
+ (mh-do-at-event-location event
+ (let ((folder mh-show-folder-buffer)
+ (mm-inline-media-tests mh-mm-inline-media-tests)
+ (data (get-text-property (point) 'mh-data))
+ (function (get-text-property (point) 'mh-callback)))
+ (flet ((mm-handle-set-external-undisplayer (handle func)
+ (mh-handle-set-external-undisplayer folder handle func)))
+ (and function (funcall function data))))))