"^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:"
"Banner alist for stripping.
For example,
((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+ :version "21.1"
+ :type '(repeat (cons symbol regexp))
+ :group 'gnus-article-washing)
+
+(defcustom gnus-article-banner-alist nil
+ "Banner alist for stripping.
+For example,
+ ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+ :version "21.1"
:type '(repeat (cons symbol regexp))
:group 'gnus-article-washing)
Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
The former avoids underlining of leading and trailing whitespace,
and the latter avoids underlining any whitespace at all."
+ :version "21.1"
:group 'gnus-article-emphasis
:type 'regexp)
"Function used to decode headers.")
(defvar gnus-article-dumbquotes-map
- '(("\202" ",")
+ '(("\200" "EUR")
+ ("\202" ",")
("\203" "f")
("\204" ",,")
("\205" "...")
(defcustom gnus-ignored-mime-types nil
"List of MIME types that should be ignored by Gnus."
+ :version "21.1"
:group 'gnus-article-mime
:type '(repeat regexp))
(defcustom gnus-unbuttonized-mime-types '(".*/.*")
"List of MIME types that should not be given buttons when rendered inline."
+ :version "21.1"
:group 'gnus-article-mime
:type '(repeat regexp))
:type 'function)
(defcustom gnus-mime-multipart-functions nil
- "An alist of MIME types to functions to display them.")
+ "An alist of MIME types to functions to display them."
+ :version "21.1"
+ :group 'gnus-article-mime
+ :type 'alist)
(defcustom gnus-article-date-lapsed-new-header nil
"Whether the X-Sent and Date headers can coexist.
When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
either replace the old \"Date:\" header (if this variable is nil), or
be added below it (otherwise)."
+ :version "21.1"
:group 'gnus-article-headers
:type 'boolean)
undisplayed part is used. For a function, the first part which
the function return `t' is used. For `nil', the first part is
used."
+ :version "21.1"
:group 'gnus-article-mime
:type '(choice
(item :tag "first" :value nil)
:type '(repeat (cons (string :tag "name")
(function))))
+(defcustom gnus-mime-action-alist
+ '(("save to file" . gnus-mime-save-part)
+ ("display as text" . gnus-mime-inline-part)
+ ("view the part" . gnus-mime-view-part)
+ ("pipe to command" . gnus-mime-pipe-part)
+ ("toggle display" . gnus-article-press-button)
+ ("view as type" . gnus-mime-view-part-as-type)
+ ("internalize type" . gnus-mime-internalize-part)
+ ("externalize type" . gnus-mime-externalize-part))
+ "An alist of actions that run on the MIME attachment."
+ :version "21.1"
+ :group 'gnus-article-mime
+ :type '(repeat (cons (string :tag "name")
+ (function))))
+
;;;
;;; The treatment variables
;;;
:group 'gnus-article-treat
:type gnus-article-treat-custom)
+(defcustom gnus-treat-hide-citation-maybe nil
+ "Hide cited text.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
(defcustom gnus-treat-strip-list-identifiers 'head
"Strip list identifiers from `gnus-list-identifiers`.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
+ :version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
"Display the date in the ISO8601 format.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
+ :version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
"Strip the X-No-Archive header line from the beginning of the body.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
+ :version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
"Capitalize sentence-starting words.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
+ :version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
"Play sounds.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
+ :version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
"Translate articles from one language to another.
Valid values are nil, t, `head', `last', an integer or a predicate.
See the manual for details."
+ :version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
-(defcustom gnus-treat-x-pgp-sig 'head
+(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
(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)
'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))
(defun article-verify-x-pgp-sig ()
"Verify X-PGP-Sig."
(interactive)
- (let ((sig (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "X-PGP-Sig")))
- items info headers)
- (when (and sig (mm-uu-pgp-signed-test))
- (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
+ (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)
- (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))
+ (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 (not (looking-at "^[ \t]"))
- (insert " "))
+ (if (looking-at "^-")
+ (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))))))))
+ (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
">" 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
(substitute-key-definition
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
+(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)
(easy-menu-define
gnus-article-treatment-menu gnus-article-mode-map ""
+ ;; Fixme: this should use :active (and maybe :visible).
'("Treatment"
["Hide headers" gnus-article-hide-headers t]
["Hide signature" gnus-article-hide-signature t]
(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)))
+
+;; Fixme: do something for the Emacs tool bar in Article mode a la
+;; Summary.
(defun gnus-article-mode ()
"Major mode for displaying an article.
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map gnus-article-mode-map)
+ ;; Not for Emacs 21: fixme better.
+ ;; (set-keymap-parent map gnus-article-mode-map)
(define-key map gnus-mouse-2 'gnus-article-push-button)
(define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(mail-parse-ignored-charsets
(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))))
+ (when handles
+ (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."
(interactive)
(gnus-article-check-buffer)
(let* ((data (get-text-property (point) 'gnus-data))
- (file (mm-save-part data))
+ (file (and data (mm-save-part data)))
param)
(when file
(with-current-buffer (mm-handle-buffer data)
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
- (mm-save-part data)))
+ (when data
+ (mm-save-part data))))
(defun gnus-mime-pipe-part ()
"Pipe the MIME part under point to a process."
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
- (mm-pipe-part data)))
+ (when data
+ (mm-pipe-part data))))
(defun gnus-mime-view-part ()
"Interactively choose a viewing method for the MIME part under point."
(interactive)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
- (mm-interactively-view-part data)))
+ (when data
+ (mm-interactively-view-part data))))
(defun gnus-mime-view-part-as-type-internal ()
(gnus-article-check-buffer)
(gnus-mime-view-part-as-type-internal))))
(gnus-article-check-buffer)
(let ((handle (get-text-property (point) 'gnus-data)))
- (gnus-mm-display-part
- (mm-make-handle (mm-handle-buffer handle)
- (cons mime-type (cdr (mm-handle-type handle)))
- (mm-handle-encoding handle)
- (mm-handle-undisplayer handle)
- (mm-handle-disposition handle)
- (mm-handle-description handle)
- (mm-handle-cache handle)
- (mm-handle-id handle)))))
-
+ (when handle
+ (gnus-mm-display-part
+ (mm-make-handle (mm-handle-buffer handle)
+ (cons mime-type (cdr (mm-handle-type handle)))
+ (mm-handle-encoding handle)
+ (mm-handle-undisplayer handle)
+ (mm-handle-disposition handle)
+ (mm-handle-description handle)
+ (mm-handle-cache handle)
+ (mm-handle-id handle))))))
+
(defun gnus-mime-copy-part (&optional handle)
"Put the the MIME part under point into a new buffer."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (contents (mm-get-part handle))|
- (base (file-name-nondirectory
- (or
- (mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-type handle)
- 'filename)
- "*decoded*")))
- (buffer (generate-new-buffer base)))
- (switch-to-buffer buffer)
- (insert contents)
- ;; We do it this way to make `normal-mode' set the appropriate mode.
- (unwind-protect
- (progn
- (setq buffer-file-name (expand-file-name base))
- (normal-mode))
- (setq buffer-file-name nil))
- (goto-char (point-min))))
+ (contents (and handle (mm-get-part handle)))
+ (base (and handle
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get (mm-handle-type handle) 'name)
+ (mail-content-type-get (mm-handle-type handle)
+ 'filename)
+ "*decoded*"))))
+ (buffer (and base (generate-new-buffer base))))
+ (when contents
+ (switch-to-buffer buffer)
+ (insert contents)
+ ;; We do it this way to make `normal-mode' set the appropriate mode.
+ (unwind-protect
+ (progn
+ (setq buffer-file-name (expand-file-name base))
+ (normal-mode))
+ (setq buffer-file-name nil))
+ (goto-char (point-min)))))
(defun gnus-mime-inline-part (&optional handle arg)
"Insert the MIME part under point into the current buffer."
contents charset
(b (point))
buffer-read-only)
- (if (and (not arg) (mm-handle-undisplayer handle))
- (mm-remove-part handle)
- (setq contents (mm-get-part handle))
- (cond
- ((not arg)
- (setq charset (or (mail-content-type-get
- (mm-handle-type handle) 'charset)
- gnus-newsgroup-charset)))
- ((numberp arg)
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (setq charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (read-coding-system "Charset: ")))))
- (forward-line 2)
- (mm-insert-inline handle
- (if (and charset
- (setq charset (mm-charset-to-coding-system
- charset))
- (not (eq charset 'ascii)))
- (mm-decode-coding-string contents charset)
- contents))
- (goto-char b))))
+ (when handle
+ (if (and (not arg) (mm-handle-undisplayer handle))
+ (mm-remove-part handle)
+ (setq contents (mm-get-part handle))
+ (cond
+ ((not arg)
+ (setq charset (or (mail-content-type-get
+ (mm-handle-type handle) 'charset)
+ gnus-newsgroup-charset)))
+ ((numberp arg)
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
+ (setq charset
+ (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))))
+ (forward-line 2)
+ (mm-insert-inline handle
+ (if (and charset
+ (setq charset (mm-charset-to-coding-system
+ charset))
+ (not (eq charset 'ascii)))
+ (mm-decode-coding-string contents charset)
+ contents))
+ (goto-char b)))))
(defun gnus-mime-view-part-as-charset (&optional handle arg)
"Insert the MIME part under point into the current buffer."
contents charset
(b (point))
buffer-read-only)
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (let ((gnus-newsgroup-charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (read-coding-system "Charset: ")))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
+ (let ((gnus-newsgroup-charset
+ (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))
(gnus-newsgroup-ignored-charsets 'gnus-all))
- (gnus-article-press-button))))
+ (gnus-article-press-button)))))
(defun gnus-mime-externalize-part (&optional handle)
"View the MIME part under point with an external viewer."
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)
- (mm-display-part handle))))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle)))))
(defun gnus-mime-internalize-part (&optional handle)
"View the MIME part under point with an internal viewer.
(mail-parse-ignored-charsets
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-ignored-charsets)))
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)
- (mm-display-part handle))))
+ (when handle
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle)
+ (mm-display-part handle)))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
(if action-pair
(funcall (cdr action-pair)))))
-
(defun gnus-article-part-wrapper (n function)
(save-current-buffer
(set-buffer gnus-article-buffer)
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
- `(local-map ,gnus-mime-button-map
- keymap ,gnus-mime-button-map
- gnus-callback gnus-mm-display-part
- gnus-part ,gnus-tmp-id
- article-type annotation
- gnus-data ,handle))
+ `(keymap ,gnus-mime-button-map
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil
+ (list 'local-map gnus-mime-button-map))
+ gnus-callback gnus-mm-display-part
+ gnus-part ,gnus-tmp-id
+ article-type annotation
+ gnus-data ,handle))
(setq e (point))
(widget-convert-button
'link b e
((equal (car handle) "multipart/signed")
(or (memq 'signed gnus-article-wash-types)
(push 'signed gnus-article-wash-types))
- (gnus-insert-mime-security-button handle)
- (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-insert-mime-security-button handle)
- (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)))))
',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',not-pref ',begend ,id))
- local-map ,gnus-mime-button-map
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil ;; XEmacs doesn't care
+ (list 'local-map gnus-mime-button-map))
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
keymap ,gnus-mime-button-map
',gnus-article-mime-handle-alist))
(gnus-mime-display-alternative
',ihandles ',handle ',begend ,id))
- local-map ,gnus-mime-button-map
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil ;; XEmacs doesn't care
+ (list 'local-map gnus-mime-button-map))
,gnus-mouse-face-prop ,gnus-article-mouse-face
face ,gnus-article-button-face
keymap ,gnus-mime-button-map
(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.
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t))
- (if (get-text-property end 'invisible)
- (gnus-article-unhide-text end (point-max))
- (gnus-article-hide-text end (point-max) gnus-hidden-properties)))))
+ (if (text-property-any end (point-max) 'article-type 'signature)
+ (gnus-remove-text-properties-when
+ 'article-type 'signature end (point-max)
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties)))
+ (gnus-add-text-properties-when
+ 'article-type nil end (point-max)
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties)))))))
(defun gnus-button-entry ()
;; Return the first entry in `gnus-button-alist' matching this place.
(gnus-cache-update-article
(car gnus-article-current) (cdr gnus-article-current))))))))
-(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]]%)%}\n"
+(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")
+%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)))
+ (?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)
+ ;; Not for Emacs 21: fixme better.
+ ;;(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
- (progn
+ (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)
(setq gnus-mime-security-details-buffer
(gnus-get-buffer-create "*MIME Security Details*")))
(with-current-buffer gnus-mime-security-details-buffer
- (insert details))
+ (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
(nth 2 (assoc protocol mm-decrypt-function-alist))
"Unknown")
(if (equal (car handle) "multipart/signed")
- " Signed" " Encrypted")))
+ " 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-show-details
- article-type annotation
- gnus-data ,handle))
+ `(keymap ,gnus-mime-security-button-map
+ ,@(if (>= (string-to-number emacs-version) 21)
+ nil ;; XEmacs doesn't care
+ (list 'local-map 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
"%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))))))
+
(gnus-ems-redefine)
(provide 'gnus-art)
projects / gnus / blobdiff