X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=8bed980654f980c9f5e3973240d8d433365f90a6;hb=fdf0d2ef6690df77363ccecb0c23f0bf74110bad;hp=ac068786a8c4e9dec2e87fdb5e2684f88ee2e609;hpb=28187bb367d31f343c613384672d1aab36f7d5f2;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index ac06878..8bed980 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -126,7 +126,7 @@ "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:" "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" - "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:" + "^MBOX-Line" "^Priority:" "^X400-[-A-Za-z]+:" "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:" "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:" "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:" @@ -215,7 +215,9 @@ regexp. If it matches, the text in question is not a signature." ;; gnus-xmas.el overrides this for XEmacs. ((and (fboundp 'image-type-available-p) (image-type-available-p 'xbm)) - 'gnus-article-display-xface) + (if (module-installed-p 'x-face-e21) + 'x-face-decode-message-header + 'gnus-article-display-xface)) ((and (not (featurep 'xemacs)) window-system (module-installed-p 'x-face-mule)) @@ -229,6 +231,9 @@ display -")) If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." :type '(choice string + (function-item + :tag "x-face-decode-message-header (x-face-e21)" + x-face-decode-message-header) (function-item gnus-article-display-xface) (function-item x-face-mule-gnus-article-display-x-face) function) @@ -624,7 +629,8 @@ displayed by the first non-nil matching CONTENT face." "Function used to decode headers.") (defvar gnus-article-dumbquotes-map - '(("\202" ",") + '(("\200" "EUR") + ("\202" ",") ("\203" "f") ("\204" ",,") ("\205" "...") @@ -1013,10 +1019,21 @@ See the manual for details." :group 'gnus-article-treat :type gnus-article-treat-custom) +(defcustom gnus-treat-x-pgp-sig nil + "Verify X-PGP-Sig. +To automatically treat X-PGP-Sig, set it to head. +Valid values are nil, t, `head', `last', an integer or a predicate. +See the manual for details." + :group 'gnus-article-treat + :group 'mime-security + :type gnus-article-treat-custom) + (defvar gnus-article-encrypt-protocol-alist '(("PGP" . mml2015-self-encrypt))) -(defcustom gnus-article-encrypt-protocol nil +;; Set to nil if more than one protocol added to +;; gnus-article-encrypt-protocol-alist. +(defcustom gnus-article-encrypt-protocol "PGP" "The protocol used for encrypt articles. It is a string, such as \"PGP\". If nil, ask user." :type 'string @@ -1032,6 +1049,7 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar gnus-treatment-function-alist '((gnus-treat-decode-article-as-default-mime-charset gnus-article-decode-article-as-default-mime-charset) + (gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) (gnus-treat-strip-banner gnus-article-strip-banner) (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) (gnus-treat-buttonize gnus-article-add-buttons) @@ -1076,7 +1094,8 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar gnus-article-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?- "w" table) + ;; This causes the citation match run O(2^n). + ;; (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?> ")" table) (modify-syntax-entry ?< "(" table) table) @@ -1096,11 +1115,12 @@ Initialized from `text-mode-syntax-table.") (defsubst gnus-article-hide-text (b e props) "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (add-text-properties b e props) + (gnus-add-text-properties-when 'article-type nil b e props) (when (memq 'intangible props) (put-text-property (max (1- b) (point-min)) b 'intangible (cddr (memq 'intangible props))))) + (defsubst gnus-article-unhide-text (b e) "Remove hidden text properties from region between B and E." (remove-text-properties b e gnus-hidden-properties) @@ -2132,24 +2152,16 @@ means show, 0 means toggle." 'hidden nil))) -(defun gnus-article-show-hidden-text (type &optional hide) +(defun gnus-article-show-hidden-text (type &optional dummy) "Show all hidden text of type TYPE. -If HIDE, hide the text instead." - (save-excursion - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (end (point-min)) - beg) - (while (setq beg (text-property-any end (point-max) 'article-type type)) - (goto-char beg) - (setq end (or - (text-property-not-all beg (point-max) 'article-type type) - (point-max))) - (if hide - (gnus-article-hide-text beg end gnus-hidden-properties) - (gnus-article-unhide-text beg end)) - (goto-char end)) - t))) +Originally it is hide instead of DUMMY." + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t)) + (gnus-remove-text-properties-when + 'article-type type + (point-min) (point-max) + (cons 'article-type (cons type + gnus-hidden-properties))))) (defconst article-time-units `((year . ,(* 365.25 24 60 60)) @@ -2745,6 +2757,79 @@ If variable `gnus-use-long-file-name' is non-nil, it is (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))) gnus-article-save-directory))) +(defun article-verify-x-pgp-sig () + "Verify X-PGP-Sig." + (interactive) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (let ((sig (with-current-buffer gnus-original-article-buffer + (gnus-fetch-field "X-PGP-Sig"))) + items info headers) + (when (and sig + mml2015-use + (mml2015-clear-verify-function)) + (with-temp-buffer + (insert-buffer gnus-original-article-buffer) + (setq items (split-string sig)) + (message-narrow-to-head) + (let ((inhibit-point-motion-hooks t) + (case-fold-search t)) + ;; Don't verify multiple headers. + (setq headers (mapconcat (lambda (header) + (concat header ": " + (mail-fetch-field header) "\n")) + (split-string (nth 1 items) ",") ""))) + (delete-region (point-min) (point-max)) + (insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n") + (insert "X-Signed-Headers: " (nth 1 items) "\n") + (insert headers) + (widen) + (forward-line) + (while (not (eobp)) + (if (looking-at "^-") + (insert "- ")) + (forward-line)) + (insert "\n-----BEGIN PGP SIGNATURE-----\n") + (insert "Version: " (car items) "\n\n") + (insert (mapconcat 'identity (cddr items) "\n")) + (insert "\n-----END PGP SIGNATURE-----\n") + (let ((mm-security-handle (list (format "multipart/signed")))) + (mml2015-clean-buffer) + (let ((coding-system-for-write (or gnus-newsgroup-charset + 'iso-8859-1))) + (funcall (mml2015-clear-verify-function))) + (setq info + (or (mm-handle-multipart-ctl-parameter + mm-security-handle 'gnus-details) + (mm-handle-multipart-ctl-parameter + mm-security-handle 'gnus-info))))) + (when info + (let (buffer-read-only bface eface) + (save-restriction + (message-narrow-to-head) + (goto-char (point-max)) + (forward-line -1) + (setq bface (get-text-property (gnus-point-at-bol) 'face) + eface (get-text-property (1- (gnus-point-at-eol)) 'face)) + (message-remove-header "X-Gnus-PGP-Verify") + (if (re-search-forward "^X-PGP-Sig:" nil t) + (forward-line) + (goto-char (point-max))) + (narrow-to-region (point) (point)) + (insert "X-Gnus-PGP-Verify: " info "\n") + (goto-char (point-min)) + (forward-line) + (while (not (eobp)) + (if (not (looking-at "^[ \t]")) + (insert " ")) + (forward-line)) + ;; Do highlighting. + (goto-char (point-min)) + (when (looking-at "\\([^:]+\\): *") + (put-text-property (match-beginning 1) (1+ (match-end 1)) + 'face bface) + (put-text-property (match-end 0) (point-max) + 'face eface))))))))) + (eval-and-compile (mapcar (lambda (func) @@ -2765,6 +2850,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (call-interactively ',afunc) (apply ',afunc args)))))))) '(article-hide-headers + article-verify-x-pgp-sig article-hide-boring-headers article-toggle-headers article-treat-overstrike @@ -2826,6 +2912,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ">" end-of-buffer "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug + "\C-hk" gnus-article-describe-key + "\C-hc" gnus-article-describe-key-briefly "\C-d" gnus-article-read-summary-keys "\M-*" gnus-article-read-summary-keys @@ -2856,6 +2944,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is (decf c)) keys)))) +(eval-when-compile + (defvar gnus-article-commands-menu)) + (defun gnus-article-make-menu-bar () (gnus-turn-off-edit-menu 'article) (unless (boundp 'gnus-article-article-menu) @@ -2885,7 +2976,12 @@ If variable `gnus-use-long-file-name' is non-nil, it is (define-key gnus-article-mode-map [menu-bar post] (cons "Post" gnus-summary-post-menu))) - (gnus-run-hooks 'gnus-article-menu-hook))) + (gnus-run-hooks 'gnus-article-menu-hook)) + ;; Add the menu. + (when (boundp 'gnus-article-commands-menu) + (easy-menu-add gnus-article-commands-menu gnus-article-mode-map)) + (when (boundp 'gnus-summary-post-menu) + (easy-menu-add gnus-summary-post-menu gnus-article-mode-map))) (defun gnus-article-mode () "Major mode for displaying an article. @@ -3329,9 +3425,9 @@ value of the variable `gnus-show-mime' is non-nil." (defun gnus-mime-button-menu (event) "Construct a context-sensitive menu of MIME commands." (interactive "e") - (save-excursion + (save-window-excursion (let ((pos (event-start event))) - (set-buffer (window-buffer (posn-window pos))) + (select-window (posn-window pos)) (goto-char (posn-point pos)) (gnus-article-check-buffer) (let ((response (x-popup-menu @@ -3350,11 +3446,14 @@ value of the variable `gnus-show-mime' is non-nil." (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) - (if (stringp (car handles)) - (gnus-mime-view-all-parts (cdr handles)) - (mapcar 'mm-display-part handles))))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) + (mm-remove-parts handles) + (goto-char (point-min)) + (or (search-forward "\n\n") (goto-char (point-max))) + (let (buffer-read-only) + (delete-region (point) (point-max))) + (mm-display-parts handles)))) (defun gnus-mime-save-part-and-strip () "Save the MIME part under point then replace it with an external body." @@ -3850,16 +3949,20 @@ In no internal viewer is available, use an external viewer." (not gnus-mime-display-multipart-as-mixed)) ;;;!!!We should find the start part, but we just default ;;;!!!to the first part. - (gnus-mime-display-part (cadr handle))) - ;; Other multiparts are handled like multipart/mixed. + ;;(gnus-mime-display-part (cadr handle)) + ;;;!!! Most multipart/related is an HTML message plus images. + ;;;!!! Unfortunately we are unable to let W3 display those + ;;;!!! included images, so we just display it as a mixed multipart. + (gnus-mime-display-mixed (cdr handle))) ((equal (car handle) "multipart/signed") (or (memq 'signed gnus-article-wash-types) (push 'signed gnus-article-wash-types)) - (gnus-mime-display-mixed (cdr handle))) + (gnus-mime-display-security handle)) ((equal (car handle) "multipart/encrypted") (or (memq 'encrypted gnus-article-wash-types) (push 'encrypted gnus-article-wash-types)) - (gnus-mime-display-mixed (cdr handle))) + (gnus-mime-display-security handle)) + ;; Other multiparts are handled like multipart/mixed. (t (gnus-mime-display-mixed (cdr handle))))) @@ -3971,6 +4074,7 @@ In no internal viewer is available, use an external viewer." (unless (setq not-pref (cadr (member preferred ihandles))) (setq not-pref (car ihandles))) (when (or ibegend + (not preferred) (not (gnus-unbuttonized-mime-type-p "multipart/alternative"))) (gnus-add-text-properties @@ -4304,26 +4408,58 @@ Argument LINES specifies lines to be scrolled down." (switch-to-buffer summary 'norecord)) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. - (if (setq func (let (gnus-pick-mode) - (lookup-key (current-local-map) keys))) + (if (and (setq func (let (gnus-pick-mode) + (lookup-key (current-local-map) keys))) + (functionp func)) (progn (call-interactively func) - (setq new-sum-point (point))) - (ding)) - (when (eq in-buffer (current-buffer)) - (setq selected (gnus-summary-select-article)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (when (eq selected 'old) - (article-goto-body) - (set-window-start (get-buffer-window (current-buffer)) - 1) - (set-window-point (get-buffer-window (current-buffer)) - (point))) - (let ((win (get-buffer-window gnus-article-current-summary))) - (when win - (set-window-point win new-sum-point)))))))) + (setq new-sum-point (point)) + (when (eq in-buffer (current-buffer)) + (setq selected (gnus-summary-select-article)) + (set-buffer obuf) + (unless not-restore-window + (set-window-configuration owin)) + (when (eq selected 'old) + (article-goto-body) + (set-window-start (get-buffer-window (current-buffer)) + 1) + (set-window-point (get-buffer-window (current-buffer)) + (point))) + (let ((win (get-buffer-window gnus-article-current-summary))) + (when win + (set-window-point win new-sum-point)))) ) + (switch-to-buffer gnus-article-buffer) + (ding)))))) + +(defun gnus-article-describe-key (key) + "Display documentation of the function invoked by KEY. KEY is a string." + (interactive "kDescribe key: ") + (gnus-article-check-buffer) + (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (save-excursion + (set-buffer gnus-article-current-summary) + (let (gnus-pick-mode) + (push (elt key 0) unread-command-events) + (setq key (if (featurep 'xemacs) + (events-to-keys (read-key-sequence "Describe key: ")) + (read-key-sequence "Describe key: ")))) + (describe-key key)) + (describe-key key))) + +(defun gnus-article-describe-key-briefly (key &optional insert) + "Display documentation of the function invoked by KEY. KEY is a string." + (interactive "kDescribe key: \nP") + (gnus-article-check-buffer) + (if (eq (key-binding key) 'gnus-article-read-summary-keys) + (save-excursion + (set-buffer gnus-article-current-summary) + (let (gnus-pick-mode) + (push (elt key 0) unread-command-events) + (setq key (if (featurep 'xemacs) + (events-to-keys (read-key-sequence "Describe key: ")) + (read-key-sequence "Describe key: ")))) + (describe-key-briefly key insert)) + (describe-key-briefly key insert))) (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. @@ -5085,9 +5221,15 @@ specified by `gnus-button-alist'." (inhibit-point-motion-hooks t) (limit (next-single-property-change end 'mime-view-entity nil (point-max)))) - (if (get-text-property end 'invisible) - (gnus-article-unhide-text end limit) - (gnus-article-hide-text end limit gnus-hidden-properties))))) + (if (text-property-any end limit 'article-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end limit + (cons 'article-type (cons 'signature + gnus-hidden-properties))) + (gnus-add-text-properties-when + 'article-type nil end limit + (cons 'article-type (cons 'signature + gnus-hidden-properties))))))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. @@ -5455,73 +5597,234 @@ For example: (t (error "%S is not a valid value" val)))) -(defun gnus-article-encrypt (protocol) - "Replace the article with encrypted one." +(defun gnus-article-encrypt-body (protocol &optional n) + "Encrypt the article body." (interactive (list (or gnus-article-encrypt-protocol (completing-read "Encrypt protocol: " gnus-article-encrypt-protocol-alist - nil t)))) + nil t)) + current-prefix-arg)) (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) (unless func (error (format "Can't find the encrypt protocol %s" protocol))) (if (equal gnus-newsgroup-name "nndraft:drafts") (error "Can't encrypt the article in group nndraft:drafts.")) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) - (summary-buffer gnus-summary-buffer) - references point) - (gnus-set-global-variables) - (when (gnus-group-read-only-p) - (error "The current newsgroup does not support article encrypt")) - (gnus-summary-show-article t) - (setq references + (if (equal gnus-newsgroup-name "nndraft:queue") + (error "Don't encrypt the article in group nndraft:queue.")) + (gnus-summary-iterate n + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) + (summary-buffer gnus-summary-buffer) + references point) + (gnus-set-global-variables) + (when (gnus-group-read-only-p) + (error "The current newsgroup does not support article encrypt")) + (gnus-summary-show-article t) + (setq references (or (mail-header-references gnus-current-headers) "")) - (set-buffer gnus-article-buffer) - (let* ((buffer-read-only nil) - (headers - (mapcar (lambda (field) - (and (save-restriction - (message-narrow-to-head) - (goto-char (point-min)) - (search-forward field nil t)) - (prog2 - (message-narrow-to-field) - (buffer-substring (point-min) (point-max)) - (delete-region (point-min) (point-max)) - (widen)))) - '("Content-Type:" "Content-Transfer-Encoding:" - "Content-Disposition:")))) - (message-narrow-to-head) - (message-remove-header "MIME-Version") - (goto-char (point-max)) - (setq point (point)) - (insert (apply 'concat headers)) - (widen) - (narrow-to-region point (point-max)) - (let ((message-options message-options)) - (message-options-set 'message-sender user-mail-address) - (message-options-set 'message-recipients user-mail-address) - (message-options-set 'message-sign-encrypt 'not) - (funcall func)) - (goto-char (point-min)) - (insert "MIME-Version: 1.0\n") - (widen) - (gnus-summary-edit-article-done - references nil summary-buffer t)) - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))))))) + (set-buffer gnus-article-buffer) + (let* ((buffer-read-only nil) + (headers + (mapcar (lambda (field) + (and (save-restriction + (message-narrow-to-head) + (goto-char (point-min)) + (search-forward field nil t)) + (prog2 + (message-narrow-to-field) + (buffer-substring (point-min) (point-max)) + (delete-region (point-min) (point-max)) + (widen)))) + '("Content-Type:" "Content-Transfer-Encoding:" + "Content-Disposition:")))) + (message-narrow-to-head) + (message-remove-header "MIME-Version") + (goto-char (point-max)) + (setq point (point)) + (insert (apply 'concat headers)) + (widen) + (narrow-to-region point (point-max)) + (let ((message-options message-options)) + (message-options-set 'message-sender user-mail-address) + (message-options-set 'message-recipients user-mail-address) + (message-options-set 'message-sign-encrypt 'not) + (funcall func)) + (goto-char (point-min)) + (insert "MIME-Version: 1.0\n") + (widen) + (gnus-summary-edit-article-done + references nil summary-buffer t)) + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (save-excursion + (when (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq gnus-original-article nil))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current)))))))) + +(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n" + "The following specs can be used: +%t The security MIME type +%i Additional info +%d Details +%D Details if button is pressed") + +(defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n" + "The following specs can be used: +%t The security MIME type +%i Additional info +%d Details +%D Details if button is pressed") + +(defvar gnus-mime-security-button-line-format-alist + '((?t gnus-tmp-type ?s) + (?i gnus-tmp-info ?s) + (?d gnus-tmp-details ?s) + (?D gnus-tmp-pressed-details ?s))) + +(defvar gnus-mime-security-button-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map gnus-article-mode-map) + (define-key map gnus-mouse-2 'gnus-article-push-button) + (define-key map "\r" 'gnus-article-press-button) + map)) + +(defvar gnus-mime-security-details-buffer nil) + +(defvar gnus-mime-security-button-pressed nil) + +(defvar gnus-mime-security-show-details-inline t + "If non-nil, show details in the article buffer.") + +(defun gnus-mime-security-verify-or-decrypt (handle) + (mm-remove-parts (cdr handle)) + (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) + buffer-read-only) + (when region + (delete-region (car region) (cdr region)) + (set-marker (car region) nil) + (set-marker (cdr region) nil))) + (with-current-buffer (mm-handle-multipart-original-buffer handle) + (let* ((mm-verify-option 'known) + (mm-decrypt-option 'known) + (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) + (unless (eq nparts (cdr handle)) + (mm-destroy-parts (cdr handle)) + (setcdr handle nparts)))) + (let ((point (point)) + buffer-read-only) + (gnus-mime-display-security handle) + (goto-char point))) + +(defun gnus-mime-security-show-details (handle) + (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) + (if details + (if gnus-mime-security-show-details-inline + (let ((gnus-mime-security-button-pressed t) + (gnus-mime-security-button-line-format + (get-text-property (point) 'gnus-line-format)) + buffer-read-only) + (forward-char -1) + (while (eq (get-text-property (point) 'gnus-line-format) + gnus-mime-security-button-line-format) + (forward-char -1)) + (forward-char) + (delete-region (point) + (or (text-property-not-all + (point) (point-max) + 'gnus-line-format + gnus-mime-security-button-line-format) + (point-max))) + (gnus-insert-mime-security-button handle)) + (if (gnus-buffer-live-p gnus-mime-security-details-buffer) + (with-current-buffer gnus-mime-security-details-buffer + (erase-buffer) + t) + (setq gnus-mime-security-details-buffer + (gnus-get-buffer-create "*MIME Security Details*"))) + (with-current-buffer gnus-mime-security-details-buffer + (insert details) + (goto-char (point-min))) + (pop-to-buffer gnus-mime-security-details-buffer)) + (gnus-message 5 "No details.")))) + +(defun gnus-mime-security-press-button (handle) + (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) + (gnus-mime-security-show-details handle) + (gnus-mime-security-verify-or-decrypt handle))) + +(defun gnus-insert-mime-security-button (handle &optional displayed) + (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) + (gnus-tmp-type + (concat + (or (nth 2 (assoc protocol mm-verify-function-alist)) + (nth 2 (assoc protocol mm-decrypt-function-alist)) + "Unknown") + (if (equal (car handle) "multipart/signed") + " Signed" " Encrypted") + " Part")) + (gnus-tmp-info + (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) + "Undecided")) + (gnus-tmp-details + (mm-handle-multipart-ctl-parameter handle 'gnus-details)) + gnus-tmp-pressed-details + b e) + (setq gnus-tmp-details + (if gnus-tmp-details + (concat "\n" gnus-tmp-details) "")) + (setq gnus-tmp-pressed-details + (if gnus-mime-security-button-pressed gnus-tmp-details "")) + (unless (bolp) + (insert "\n")) + (setq b (point)) + (gnus-eval-format + gnus-mime-security-button-line-format + gnus-mime-security-button-line-format-alist + `(local-map ,gnus-mime-security-button-map + keymap ,gnus-mime-security-button-map + gnus-callback gnus-mime-security-press-button + gnus-line-format ,gnus-mime-security-button-line-format + article-type annotation + gnus-data ,handle)) + (setq e (point)) + (widget-convert-button + 'link b e + :mime-handle handle + :action 'gnus-widget-press-button + :button-keymap gnus-mime-security-button-map + :help-echo + (lambda (widget/window &optional overlay pos) + ;; Needed to properly clear the message due to a bug in + ;; wid-edit (XEmacs only). + (if (boundp 'help-echo-owns-message) + (setq help-echo-owns-message t)) + (format + "%S: show detail" + (aref gnus-mouse-2 0)))))) + +(defun gnus-mime-display-security (handle) + (save-restriction + (narrow-to-region (point) (point)) + (gnus-insert-mime-security-button handle) + (gnus-mime-display-mixed (cdr handle)) + (unless (bolp) + (insert "\n")) + (let ((gnus-mime-security-button-line-format + gnus-mime-security-button-end-line-format)) + (gnus-insert-mime-security-button handle)) + (mm-set-handle-multipart-parameter handle 'gnus-region + (cons (set-marker (make-marker) + (point-min)) + (set-marker (make-marker) + (point-max)))))) ;;; @ for mime-view