Lines Matching +defs:gnus +defs:summary +defs:followup +defs:to +defs:mail
0 ;;; gnus-art.el --- article mode commands for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
35 (require 'gnus)
36 (require 'gnus-sum)
37 (require 'gnus-spec)
38 (require 'gnus-int)
39 (require 'gnus-win)
41 (require 'mail-parse)
48 (autoload 'gnus-msg-mail "gnus-msg" nil t)
49 (autoload 'gnus-button-mailto "gnus-msg")
50 (autoload 'gnus-button-reply "gnus-msg" nil t)
54 (defgroup gnus-article nil
56 :link '(custom-manual "(gnus)Article Buffer")
57 :group 'gnus)
59 (defgroup gnus-article-treat nil
61 :link '(custom-manual "(gnus)Article Hiding")
62 :group 'gnus-article)
64 (defgroup gnus-article-hiding nil
66 :link '(custom-manual "(gnus)Article Hiding")
67 :group 'gnus-article)
69 (defgroup gnus-article-highlight nil
71 :link '(custom-manual "(gnus)Article Highlighting")
72 :group 'gnus-article
73 :group 'gnus-visual)
75 (defgroup gnus-article-signature nil
77 :link '(custom-manual "(gnus)Article Signature")
78 :group 'gnus-article)
80 (defgroup gnus-article-headers nil
82 :link '(custom-manual "(gnus)Hiding Headers")
83 :group 'gnus-article)
85 (defgroup gnus-article-washing nil
87 :link '(custom-manual "(gnus)Article Washing")
88 :group 'gnus-article)
90 (defgroup gnus-article-emphasis nil
92 :link '(custom-manual "(gnus)Article Fontisizing")
93 :group 'gnus-article)
95 (defgroup gnus-article-saving nil
97 :link '(custom-manual "(gnus)Saving Articles")
98 :group 'gnus-article)
100 (defgroup gnus-article-mime nil
102 :link '(custom-manual "(gnus)Using MIME")
103 :group 'gnus-article)
105 (defgroup gnus-article-buttons nil
107 :link '(custom-manual "(gnus)Article Buttons")
108 :group 'gnus-article)
110 (defgroup gnus-article-various nil
112 :link '(custom-manual "(gnus)Misc Article")
113 :group 'gnus-article)
115 (defcustom gnus-ignored-headers
158 This variable can also be a list of regexps of headers to be ignored.
159 If `gnus-visible-headers' is non-nil, this variable will be ignored."
163 :group 'gnus-article-hiding)
165 (defcustom gnus-visible-headers
168 This variable can also be a list of regexp of headers to remain visible.
169 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
170 :type '(repeat :value-to-internal (lambda (widget value)
176 :group 'gnus-article-hiding)
178 (defcustom gnus-sorted-header-list
186 :group 'gnus-article-hiding)
188 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
189 "Headers that are only to be displayed if they have interesting data.
193 'newsgroups Newsgroup identical to Gnus group.
194 'to-address To identical to To-address.
195 'to-list To identical to To-list.
196 'cc-list CC identical to To-list.
197 'followup-to Followup-to identical to Newsgroups.
198 'reply-to Reply-to identical to From.
200 'long-to To and/or Cc longer than 1024 characters.
201 'many-to Multiple To and/or Cc."
203 (const :tag "Newsgroups identical to Gnus group." newsgroups)
204 (const :tag "To identical to To-address." to-address)
205 (const :tag "To identical to To-list." to-list)
206 (const :tag "CC identical to To-list." cc-list)
207 (const :tag "Followup-to identical to Newsgroups." followup-to)
208 (const :tag "Reply-to identical to From." reply-to)
210 (const :tag "To and/or Cc longer than 1024 characters." long-to)
211 (const :tag "Multiple To and/or Cc headers." many-to))
212 :group 'gnus-article-hiding)
214 (defcustom gnus-article-skip-boring nil
217 signatures, but will never scroll down to show you a page consisting
219 `gnus-article-boring-faces'."
222 :group 'gnus-article-hiding)
224 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
227 from head to tail looking for a separator. Searches will be done from
232 :group 'gnus-article-signature)
234 (defcustom gnus-signature-limit nil
235 "Provide a limit to what is considered a signature.
247 :group 'gnus-article-signature)
249 (defcustom gnus-hidden-properties '(invisible t intangible t)
250 "Property list to use for hiding text."
252 :group 'gnus-article-hiding)
256 (defcustom gnus-article-x-face-command
258 (if (or (gnus-image-type-available-p 'xface)
259 (gnus-image-type-available-p 'pbm))
260 'gnus-display-x-face-in-from
262 (if (gnus-image-type-available-p 'pbm)
263 'gnus-display-x-face-in-from
266 "*String or function to be executed to display an X-Face header.
268 asynchronously. The compressed face will be piped to this command."
270 (function-item gnus-display-x-face-in-from)
273 :group 'gnus-picon
274 :group 'gnus-article-washing)
276 (defcustom gnus-article-x-face-too-ugly nil
279 :group 'gnus-article-washing)
281 (defcustom gnus-article-banner-alist nil
287 :group 'gnus-article-washing)
289 (gnus-define-group-parameter
292 "Alist of regexps (to match group names) and banner."
293 :variable-group gnus-article-washing
298 (symbol :tag "Item in `gnus-article-banner-alist'" none)
302 "If non-nil, specify how to remove `banners' from articles.
304 Symbol `signature' means to remove signatures delimited by
305 `gnus-signature-separator'. Any other symbol is used to look up a
306 regular expression to match the banner in `gnus-article-banner-alist'.
307 A string is used as a regular expression to match the banner
310 (defcustom gnus-article-address-banner-alist nil
311 "Alist of mail addresses and banners.
313 to match a mail address in the From: header, BANNER is one of a symbol
314 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
315 If ADDRESS matches author's mail address, it will remove things like
325 (symbol :tag "Item in `gnus-article-banner-alist'" none)
329 :group 'gnus-article-washing)
331 (defmacro gnus-emphasis-custom-with-format (&rest body)
337 (defun gnus-emphasis-custom-value-to-external (value)
338 (gnus-emphasis-custom-with-format
346 (defun gnus-emphasis-custom-value-to-internal (value)
347 (gnus-emphasis-custom-with-format
359 (defcustom gnus-emphasis-alist
369 (gnus-emphasis-custom-with-format
374 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
379 ;; so maybe we should map it to `italic'.
381 ;; 2 3 gnus-emphasis-strikethru)
383 2 3 gnus-emphasis-underline))))
384 "*Alist that says how to fontify certain phrases.
389 The first element is a regular expression to be matched. The second
390 is a number that says what regular expression grouping used to find
411 (gnus-emphasis-custom-value-to-external value))))
426 (mapcar 'gnus-emphasis-custom-value-to-internal
429 (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
431 :group 'gnus-article-emphasis)
433 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
434 "A regexp to describe whitespace which should not be emphasized.
439 :group 'gnus-article-emphasis
442 (defface gnus-emphasis-bold '((t (:bold t)))
444 :group 'gnus-article-emphasis)
446 (defface gnus-emphasis-italic '((t (:italic t)))
448 :group 'gnus-article-emphasis)
450 (defface gnus-emphasis-underline '((t (:underline t)))
452 :group 'gnus-article-emphasis)
454 (defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
456 :group 'gnus-article-emphasis)
458 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
460 :group 'gnus-article-emphasis)
462 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
464 :group 'gnus-article-emphasis)
466 (defface gnus-emphasis-underline-bold-italic
470 :group 'gnus-article-emphasis)
472 (defface gnus-emphasis-strikethru (if (featurep 'xemacs)
476 :group 'gnus-article-emphasis)
478 (defface gnus-emphasis-highlight-words
481 :group 'gnus-article-emphasis)
483 (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
489 be fed to `format-time-string'."
491 :link '(custom-manual "(gnus)Article Date")
492 :group 'gnus-article-washing)
494 (defcustom gnus-save-all-headers t
497 the saver function, which is specified by `gnus-default-article-saver',
499 :group 'gnus-article-saving
502 (defcustom gnus-prompt-before-saving 'always
503 "*This variable says how much prompting is to be done when saving articles.
505 saved to the default files. If this variable is `always', each and
510 :group 'gnus-article-saving
515 (defcustom gnus-saved-headers gnus-visible-headers
516 "Headers to keep if `gnus-save-all-headers' is nil.
517 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
520 `gnus-save-all-headers' will be overridden by the `:headers' property
522 `gnus-default-article-saver', might have."
523 :group 'gnus-article-saving
526 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
527 "A function to save articles in your favourite format.
528 The function will be called by way of the `gnus-summary-save-article'
529 command, and friends such as `gnus-summary-save-article-rmail'.
533 * gnus-summary-save-in-rmail (Rmail format)
534 * gnus-summary-save-in-mail (Unix mail format)
535 * gnus-summary-save-in-folder (MH folder)
536 * gnus-summary-save-in-file (article format)
537 * gnus-summary-save-body-in-file (article body)
538 * gnus-summary-save-in-vm (use VM's folder format)
539 * gnus-summary-write-to-file (article format -- overwrite)
540 * gnus-summary-write-body-to-file (article body -- overwrite)
546 only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
547 `gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'.
551 overwrites, articles to a file. This implies that when saving many
552 articles at a time, `gnus-prompt-before-saving' is bound to t and all
554 `gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'.
558 specifies headers to be saved. If it is omitted,
559 `gnus-save-all-headers' and `gnus-saved-headers' control what
561 :group 'gnus-article-saving
562 :type '(radio (function-item gnus-summary-save-in-rmail)
563 (function-item gnus-summary-save-in-mail)
564 (function-item gnus-summary-save-in-folder)
565 (function-item gnus-summary-save-in-file)
566 (function-item gnus-summary-save-body-in-file)
567 (function-item gnus-summary-save-in-vm)
568 (function-item gnus-summary-write-to-file)
569 (function-item gnus-summary-write-body-to-file)
572 (defcustom gnus-article-save-coding-system
577 "Coding system used to save decoded articles to a file.
583 * gnus-summary-save-article-file
584 * gnus-summary-save-article-body-file
585 * gnus-summary-write-article-file
586 * gnus-summary-write-article-body-file
588 and the functions to which you may set `gnus-default-article-saver':
590 * gnus-summary-save-in-file
591 * gnus-summary-save-body-in-file
592 * gnus-summary-write-to-file
593 * gnus-summary-write-body-to-file
596 buffer to a file if the value of this variable is non-nil. Note that
599 :group 'gnus-article-saving
612 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
613 "A function generating a file name to save articles in Rmail format.
615 :group 'gnus-article-saving
618 (defcustom gnus-mail-save-name 'gnus-plain-save-name
619 "A function generating a file name to save articles in Unix mail format.
621 :group 'gnus-article-saving
624 (defcustom gnus-folder-save-name 'gnus-folder-save-name
625 "A function generating a file name to save articles in MH folder.
627 :group 'gnus-article-saving
630 (defcustom gnus-file-save-name 'gnus-numeric-save-name
631 "A function generating a file name to save articles in article format.
634 :group 'gnus-article-saving
637 (defcustom gnus-split-methods
638 '((gnus-article-archive-name)
639 (gnus-article-nndoc-name))
640 "*Variable used to suggest where articles are to be saved.
641 For instance, if you would like to save articles related to Gnus in
642 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
643 you could set this variable to something like:
645 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
649 value is a list of possible files to save in if the match is non-nil.
653 from the buffer of the article to be saved with the newsgroup as the
659 :group 'gnus-article-saving
664 (defcustom gnus-page-delimiter "^\^L"
665 "*Regexp describing what to use as article page delimiters.
669 :group 'gnus-article-various)
671 (defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
673 See `gnus-summary-mode-line-format' for a closer description.
680 :group 'gnus-article-various)
682 (defcustom gnus-article-mode-hook nil
685 :group 'gnus-article-various)
688 ;; Extracted from gnus-xmas-define in order to preserve user settings
690 (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
691 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
692 (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
694 (defcustom gnus-article-menu-hook nil
697 :group 'gnus-article-various)
699 (defcustom gnus-article-prepare-hook nil
702 :group 'gnus-article-various)
704 (make-obsolete-variable 'gnus-article-hide-pgp-hook
707 (defcustom gnus-article-button-face 'bold
713 :group 'gnus-article-buttons)
715 (defcustom gnus-article-mouse-face 'highlight
721 :group 'gnus-article-buttons)
723 (defcustom gnus-signature-face 'gnus-signature
725 Obsolete; use the face `gnus-signature' for customizations instead."
727 :group 'gnus-article-highlight
728 :group 'gnus-article-signature)
730 (defface gnus-signature
734 :group 'gnus-article-highlight
735 :group 'gnus-article-signature)
737 (put 'gnus-signature-face 'face-alias 'gnus-signature)
739 (defface gnus-header-from
749 :group 'gnus-article-headers
750 :group 'gnus-article-highlight)
752 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
754 (defface gnus-header-subject
764 :group 'gnus-article-headers
765 :group 'gnus-article-highlight)
767 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
769 (defface gnus-header-newsgroups
781 :group 'gnus-article-headers
782 :group 'gnus-article-highlight)
784 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
786 (defface gnus-header-name
796 :group 'gnus-article-headers
797 :group 'gnus-article-highlight)
799 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
801 (defface gnus-header-content
810 :group 'gnus-article-headers
811 :group 'gnus-article-highlight)
813 (put 'gnus-header-content-face 'face-alias 'gnus-header-content)
815 (defcustom gnus-header-face-alist
816 '(("From" nil gnus-header-from)
817 ("Subject" nil gnus-header-subject)
818 ("Newsgroups:.*," nil gnus-header-newsgroups)
819 ("" gnus-header-name gnus-header-content))
831 :group 'gnus-article-headers
832 :group 'gnus-article-highlight
841 (defcustom gnus-article-decode-hook
844 "*Hook run to decode charsets in articles."
845 :group 'gnus-article-headers
848 (defcustom gnus-display-mime-function 'gnus-display-mime
849 "Function to display MIME articles."
850 :group 'gnus-article-mime
853 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
854 "Function used to decode headers.")
856 (defvar gnus-decode-address-function 'mail-decode-encoded-address-region
857 "Function used to decode addresses.")
859 (defvar gnus-article-dumbquotes-map
879 "Table for MS-to-Latin1 translation.")
881 (defcustom gnus-ignored-mime-types nil
884 :group 'gnus-article-mime
887 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
889 See also `gnus-buttonized-mime-types' which may override this variable.
890 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
892 :group 'gnus-article-mime
895 (defcustom gnus-buttonized-mime-types nil
897 If set, this variable overrides `gnus-unbuttonized-mime-types'.
898 To see e.g. security buttons you could set this to
899 `(\"multipart/signed\")'. You could also add \"multipart/alternative\" to
900 this list to display radio buttons that allow you to choose one of two
902 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
904 :group 'gnus-article-mime
907 (defcustom gnus-inhibit-mime-unbuttonizing nil
910 as described by the variables `gnus-buttonized-mime-types' and
911 `gnus-unbuttonized-mime-types'."
913 :group 'gnus-article-mime
916 (defcustom gnus-body-boundary-delimiter "_"
917 "String used to delimit header and body.
918 This variable is used by `gnus-article-treat-body-boundary' which can
919 be controlled by `gnus-treat-body-boundary'."
921 :group 'gnus-article-various
925 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
934 :link '(custom-manual "(gnus)Picons")
935 :group 'gnus-picon)
937 (defun gnus-picons-installed-p ()
940 (dolist (database gnus-picon-databases)
945 (defcustom gnus-article-mime-part-function nil
947 This is meant for people who want to do something automatic based
948 on parts -- for instance, adding Vcard info to a database."
949 :group 'gnus-article-mime
953 (defcustom gnus-mime-multipart-functions nil
954 "An alist of MIME types to functions to display them."
956 :group 'gnus-article-mime
959 (defcustom gnus-article-date-lapsed-new-header nil
961 When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
965 :group 'gnus-article-headers
968 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
970 This is meant for people who want to view first matched part.
977 :group 'gnus-article-mime
985 (defcustom gnus-mime-action-alist
986 '(("save to file" . gnus-mime-save-part)
987 ("save and strip" . gnus-mime-save-part-and-strip)
988 ("delete part" . gnus-mime-delete-part)
989 ("display as text" . gnus-mime-inline-part)
990 ("view the part" . gnus-mime-view-part)
991 ("pipe to command" . gnus-mime-pipe-part)
992 ("toggle display" . gnus-article-press-button)
993 ("toggle display" . gnus-article-view-part-as-charset)
994 ("view as type" . gnus-mime-view-part-as-type)
995 ("view internally" . gnus-mime-view-part-internally)
996 ("view externally" . gnus-mime-view-part-externally))
998 :group 'gnus-article-mime
1006 (defvar gnus-part-display-hook nil
1007 "Hook called on parts that are to receive treatment.")
1009 (defvar gnus-article-treat-custom
1018 (defvar gnus-article-treat-head-custom
1022 (defvar gnus-article-treat-types '("text/plain")
1023 "Parts to treat.")
1025 (defvar gnus-inhibit-treatment nil
1026 "Whether to inhibit treatment.")
1028 (defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
1031 See Info node `(gnus)Customizing Articles'."
1032 :group 'gnus-article-treat
1033 :link '(custom-manual "(gnus)Customizing Articles")
1034 :type gnus-article-treat-custom)
1035 (put 'gnus-treat-highlight-signature 'highlight t)
1037 (defcustom gnus-treat-buttonize 100000
1040 See Info node `(gnus)Customizing Articles'."
1041 :group 'gnus-article-treat
1042 :link '(custom-manual "(gnus)Customizing Articles")
1043 :type gnus-article-treat-custom)
1044 (put 'gnus-treat-buttonize 'highlight t)
1046 (defcustom gnus-treat-buttonize-head 'head
1047 "Add buttons to the head.
1049 See Info node `(gnus)Customizing Articles' for details."
1050 :group 'gnus-article-treat
1051 :link '(custom-manual "(gnus)Customizing Articles")
1052 :type gnus-article-treat-head-custom)
1053 (put 'gnus-treat-buttonize-head 'highlight t)
1055 (defcustom gnus-treat-emphasize
1058 (>= (string-to-number emacs-version) 21))
1062 See Info node `(gnus)Customizing Articles' for details."
1063 :group 'gnus-article-treat
1064 :link '(custom-manual "(gnus)Customizing Articles")
1065 :type gnus-article-treat-custom)
1066 (put 'gnus-treat-emphasize 'highlight t)
1068 (defcustom gnus-treat-strip-cr nil
1071 See Info node `(gnus)Customizing Articles' for details."
1073 :group 'gnus-article-treat
1074 :link '(custom-manual "(gnus)Customizing Articles")
1075 :type gnus-article-treat-custom)
1077 (defcustom gnus-treat-unsplit-urls nil
1080 See Info node `(gnus)Customizing Articles' for details."
1082 :group 'gnus-article-treat
1083 :link '(custom-manual "(gnus)Customizing Articles")
1084 :type gnus-article-treat-custom)
1086 (defcustom gnus-treat-leading-whitespace nil
1089 See Info node `(gnus)Customizing Articles' for details."
1091 :group 'gnus-article-treat
1092 :link '(custom-manual "(gnus)Customizing Articles")
1093 :type gnus-article-treat-custom)
1095 (defcustom gnus-treat-hide-headers 'head
1098 See Info node `(gnus)Customizing Articles' for details."
1099 :group 'gnus-article-treat
1100 :link '(custom-manual "(gnus)Customizing Articles")
1101 :type gnus-article-treat-head-custom)
1103 (defcustom gnus-treat-hide-boring-headers nil
1106 See Info node `(gnus)Customizing Articles' for details."
1107 :group 'gnus-article-treat
1108 :link '(custom-manual "(gnus)Customizing Articles")
1109 :type gnus-article-treat-head-custom)
1111 (defcustom gnus-treat-hide-signature nil
1114 See Info node `(gnus)Customizing Articles' for details."
1115 :group 'gnus-article-treat
1116 :link '(custom-manual "(gnus)Customizing Articles")
1117 :type gnus-article-treat-custom)
1119 (defcustom gnus-treat-fill-article nil
1122 See Info node `(gnus)Customizing Articles' for details."
1123 :group 'gnus-article-treat
1124 :link '(custom-manual "(gnus)Customizing Articles")
1125 :type gnus-article-treat-custom)
1127 (defcustom gnus-treat-hide-citation nil
1130 See Info node `(gnus)Customizing Articles' for details."
1131 :group 'gnus-article-treat
1132 :link '(custom-manual "(gnus)Customizing Articles")
1133 :type gnus-article-treat-custom)
1135 (defcustom gnus-treat-hide-citation-maybe nil
1138 See Info node `(gnus)Customizing Articles' for details."
1139 :group 'gnus-article-treat
1140 :link '(custom-manual "(gnus)Customizing Articles")
1141 :type gnus-article-treat-custom)
1143 (defcustom gnus-treat-strip-list-identifiers 'head
1144 "Strip list identifiers from `gnus-list-identifiers`.
1146 See Info node `(gnus)Customizing Articles' for details."
1148 :group 'gnus-article-treat
1149 :link '(custom-manual "(gnus)Customizing Articles")
1150 :type gnus-article-treat-custom)
1152 (make-obsolete-variable 'gnus-treat-strip-pgp
1155 (defcustom gnus-treat-strip-pem nil
1158 See Info node `(gnus)Customizing Articles' for details."
1159 :group 'gnus-article-treat
1160 :link '(custom-manual "(gnus)Customizing Articles")
1161 :type gnus-article-treat-custom)
1163 (defcustom gnus-treat-strip-banner t
1165 The banner to be stripped is specified in the `banner' group parameter.
1167 See Info node `(gnus)Customizing Articles' for details."
1168 :group 'gnus-article-treat
1169 :link '(custom-manual "(gnus)Customizing Articles")
1170 :type gnus-article-treat-custom)
1172 (defcustom gnus-treat-highlight-headers 'head
1175 See Info node `(gnus)Customizing Articles' for details."
1176 :group 'gnus-article-treat
1177 :link '(custom-manual "(gnus)Customizing Articles")
1178 :type gnus-article-treat-head-custom)
1179 (put 'gnus-treat-highlight-headers 'highlight t)
1181 (defcustom gnus-treat-highlight-citation t
1184 See Info node `(gnus)Customizing Articles' for details."
1185 :group 'gnus-article-treat
1186 :link '(custom-manual "(gnus)Customizing Articles")
1187 :type gnus-article-treat-custom)
1188 (put 'gnus-treat-highlight-citation 'highlight t)
1190 (defcustom gnus-treat-date-ut nil
1193 See Info node `(gnus)Customizing Articles' for details."
1194 :group 'gnus-article-treat
1195 :link '(custom-manual "(gnus)Customizing Articles")
1196 :type gnus-article-treat-head-custom)
1198 (defcustom gnus-treat-date-local nil
1201 See Info node `(gnus)Customizing Articles' for details."
1202 :group 'gnus-article-treat
1203 :link '(custom-manual "(gnus)Customizing Articles")
1204 :type gnus-article-treat-head-custom)
1206 (defcustom gnus-treat-date-english nil
1209 See Info node `(gnus)Customizing Articles' for details."
1211 :group 'gnus-article-treat
1212 :link '(custom-manual "(gnus)Customizing Articles")
1213 :type gnus-article-treat-head-custom)
1215 (defcustom gnus-treat-date-lapsed nil
1218 See Info node `(gnus)Customizing Articles' for details."
1219 :group 'gnus-article-treat
1220 :link '(custom-manual "(gnus)Customizing Articles")
1221 :type gnus-article-treat-head-custom)
1223 (defcustom gnus-treat-date-original nil
1226 See Info node `(gnus)Customizing Articles' for details."
1227 :group 'gnus-article-treat
1228 :link '(custom-manual "(gnus)Customizing Articles")
1229 :type gnus-article-treat-head-custom)
1231 (defcustom gnus-treat-date-iso8601 nil
1234 See Info node `(gnus)Customizing Articles' for details."
1236 :group 'gnus-article-treat
1237 :link '(custom-manual "(gnus)Customizing Articles")
1238 :type gnus-article-treat-head-custom)
1240 (defcustom gnus-treat-date-user-defined nil
1242 The format is defined by the `gnus-article-time-format' variable.
1244 See Info node `(gnus)Customizing Articles' for details."
1245 :group 'gnus-article-treat
1246 :link '(custom-manual "(gnus)Customizing Articles")
1247 :type gnus-article-treat-head-custom)
1249 (defcustom gnus-treat-strip-headers-in-body t
1252 See Info node `(gnus)Customizing Articles' for details."
1254 :group 'gnus-article-treat
1255 :link '(custom-manual "(gnus)Customizing Articles")
1256 :type gnus-article-treat-custom)
1258 (defcustom gnus-treat-strip-trailing-blank-lines nil
1261 See Info node `(gnus)Customizing Articles' for details.
1263 When set to t, it also strips trailing blanks in all MIME parts.
1264 Consider to use `last' instead."
1265 :group 'gnus-article-treat
1266 :link '(custom-manual "(gnus)Customizing Articles")
1267 :type gnus-article-treat-custom)
1269 (defcustom gnus-treat-strip-leading-blank-lines nil
1272 See Info node `(gnus)Customizing Articles' for details.
1274 When set to t, it also strips trailing blanks in all MIME parts."
1275 :group 'gnus-article-treat
1276 :link '(custom-manual "(gnus)Customizing Articles")
1277 :type gnus-article-treat-custom)
1279 (defcustom gnus-treat-strip-multiple-blank-lines nil
1282 See Info node `(gnus)Customizing Articles' for details."
1283 :group 'gnus-article-treat
1284 :link '(custom-manual "(gnus)Customizing Articles")
1285 :type gnus-article-treat-custom)
1287 (defcustom gnus-treat-unfold-headers 'head
1290 See Info node `(gnus)Customizing Articles' for details."
1292 :group 'gnus-article-treat
1293 :link '(custom-manual "(gnus)Customizing Articles")
1294 :type gnus-article-treat-custom)
1296 (defcustom gnus-treat-fold-headers nil
1299 See Info node `(gnus)Customizing Articles' for details."
1301 :group 'gnus-article-treat
1302 :link '(custom-manual "(gnus)Customizing Articles")
1303 :type gnus-article-treat-custom)
1305 (defcustom gnus-treat-fold-newsgroups 'head
1308 See Info node `(gnus)Customizing Articles' for details."
1310 :group 'gnus-article-treat
1311 :link '(custom-manual "(gnus)Customizing Articles")
1312 :type gnus-article-treat-custom)
1314 (defcustom gnus-treat-overstrike t
1317 See Info node `(gnus)Customizing Articles' for details."
1318 :group 'gnus-article-treat
1319 :link '(custom-manual "(gnus)Customizing Articles")
1320 :type gnus-article-treat-custom)
1321 (put 'gnus-treat-overstrike 'highlight t)
1323 (make-obsolete-variable 'gnus-treat-display-xface
1324 'gnus-treat-display-x-face)
1326 (defcustom gnus-treat-display-x-face
1328 (gnus-image-type-available-p 'xbm)
1331 (and (string-match "^0x" (shell-command-to-string "uncompface"))
1336 See Info node `(gnus)Customizing Articles' and Info node
1337 `(gnus)X-Face' for details."
1338 :group 'gnus-article-treat
1340 :link '(custom-manual "(gnus)Customizing Articles")
1341 :link '(custom-manual "(gnus)X-Face")
1342 :type gnus-article-treat-head-custom
1348 ((boundp 'gnus-treat-display-xface)
1350 ** gnus-treat-display-xface is an obsolete variable;\
1351 use gnus-treat-display-x-face instead")
1352 (default-value 'gnus-treat-display-xface))
1353 ((get 'gnus-treat-display-xface 'saved-value)
1355 ** gnus-treat-display-xface is an obsolete variable;\
1356 use gnus-treat-display-x-face instead")
1357 (eval (car (get 'gnus-treat-display-xface 'saved-value))))
1360 (put 'gnus-treat-display-x-face 'highlight t)
1362 (defcustom gnus-treat-display-face
1364 (gnus-image-type-available-p 'png)
1368 See Info node `(gnus)Customizing Articles' and Info node
1369 `(gnus)X-Face' for details."
1370 :group 'gnus-article-treat
1372 :link '(custom-manual "(gnus)Customizing Articles")
1373 :link '(custom-manual "(gnus)X-Face")
1374 :type gnus-article-treat-head-custom)
1375 (put 'gnus-treat-display-face 'highlight t)
1377 (defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm)
1380 See Info node `(gnus)Customizing Articles' and Info node
1381 `(gnus)Smileys' for details."
1382 :group 'gnus-article-treat
1384 :link '(custom-manual "(gnus)Customizing Articles")
1385 :link '(custom-manual "(gnus)Smileys")
1386 :type gnus-article-treat-custom)
1387 (put 'gnus-treat-display-smileys 'highlight t)
1389 (defcustom gnus-treat-from-picon
1390 (if (and (gnus-image-type-available-p 'xpm)
1391 (gnus-picons-installed-p))
1395 See Info node `(gnus)Customizing Articles' and Info node
1396 `(gnus)Picons' for details."
1398 :group 'gnus-article-treat
1399 :group 'gnus-picon
1400 :link '(custom-manual "(gnus)Customizing Articles")
1401 :link '(custom-manual "(gnus)Picons")
1402 :type gnus-article-treat-head-custom)
1403 (put 'gnus-treat-from-picon 'highlight t)
1405 (defcustom gnus-treat-mail-picon
1406 (if (and (gnus-image-type-available-p 'xpm)
1407 (gnus-picons-installed-p))
1411 See Info node `(gnus)Customizing Articles' and Info node
1412 `(gnus)Picons' for details."
1414 :group 'gnus-article-treat
1415 :group 'gnus-picon
1416 :link '(custom-manual "(gnus)Customizing Articles")
1417 :link '(custom-manual "(gnus)Picons")
1418 :type gnus-article-treat-head-custom)
1419 (put 'gnus-treat-mail-picon 'highlight t)
1421 (defcustom gnus-treat-newsgroups-picon
1422 (if (and (gnus-image-type-available-p 'xpm)
1423 (gnus-picons-installed-p))
1427 See Info node `(gnus)Customizing Articles' and Info node
1428 `(gnus)Picons' for details."
1430 :group 'gnus-article-treat
1431 :group 'gnus-picon
1432 :link '(custom-manual "(gnus)Customizing Articles")
1433 :link '(custom-manual "(gnus)Picons")
1434 :type gnus-article-treat-head-custom)
1435 (put 'gnus-treat-newsgroups-picon 'highlight t)
1437 (defcustom gnus-treat-body-boundary
1438 (if (or gnus-treat-newsgroups-picon
1439 gnus-treat-mail-picon
1440 gnus-treat-from-picon)
1444 See Info node `(gnus)Customizing Articles' for details."
1446 :group 'gnus-article-treat
1447 :link '(custom-manual "(gnus)Customizing Articles")
1448 :type gnus-article-treat-head-custom)
1450 (defcustom gnus-treat-capitalize-sentences nil
1453 See Info node `(gnus)Customizing Articles' for details."
1455 :group 'gnus-article-treat
1456 :link '(custom-manual "(gnus)Customizing Articles")
1457 :type gnus-article-treat-custom)
1459 (defcustom gnus-treat-wash-html nil
1462 See Info node `(gnus)Customizing Articles' for details."
1464 :group 'gnus-article-treat
1465 :link '(custom-manual "(gnus)Customizing Articles")
1466 :type gnus-article-treat-custom)
1468 (defcustom gnus-treat-fill-long-lines nil
1471 See Info node `(gnus)Customizing Articles' for details."
1472 :group 'gnus-article-treat
1473 :link '(custom-manual "(gnus)Customizing Articles")
1474 :type gnus-article-treat-custom)
1476 (defcustom gnus-treat-play-sounds nil
1479 See Info node `(gnus)Customizing Articles' for details."
1481 :group 'gnus-article-treat
1482 :link '(custom-manual "(gnus)Customizing Articles")
1483 :type gnus-article-treat-custom)
1485 (defcustom gnus-treat-translate nil
1486 "Translate articles from one language to another.
1488 See Info node `(gnus)Customizing Articles' for details."
1490 :group 'gnus-article-treat
1491 :link '(custom-manual "(gnus)Customizing Articles")
1492 :type gnus-article-treat-custom)
1494 (defcustom gnus-treat-x-pgp-sig nil
1496 To automatically treat X-PGP-Sig, set it to head.
1498 See Info node `(gnus)Customizing Articles' for details."
1500 :group 'gnus-article-treat
1502 :link '(custom-manual "(gnus)Customizing Articles")
1503 :type gnus-article-treat-custom)
1505 (defvar gnus-article-encrypt-protocol-alist
1508 ;; Set to nil if more than one protocol added to
1509 ;; gnus-article-encrypt-protocol-alist.
1510 (defcustom gnus-article-encrypt-protocol "PGP"
1517 (defvar gnus-article-wash-function nil
1520 (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
1526 :group 'gnus-article-headers
1529 (defcustom gnus-article-over-scroll nil
1532 :group 'gnus-article
1537 (defvar gnus-english-month-names
1541 (defvar article-goto-body-goes-to-point-min-p nil)
1542 (defvar gnus-article-wash-types nil)
1543 (defvar gnus-article-emphasis-alist nil)
1544 (defvar gnus-article-image-alist nil)
1546 (defvar gnus-article-mime-handle-alist-1 nil)
1547 (defvar gnus-treatment-function-alist
1548 '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
1549 (gnus-treat-strip-banner gnus-article-strip-banner)
1550 (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
1551 (gnus-treat-highlight-signature gnus-article-highlight-signature)
1552 (gnus-treat-buttonize gnus-article-add-buttons)
1553 (gnus-treat-fill-article gnus-article-fill-cited-article)
1554 (gnus-treat-fill-long-lines gnus-article-fill-long-lines)
1555 (gnus-treat-strip-cr gnus-article-remove-cr)
1556 (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1557 (gnus-treat-date-ut gnus-article-date-ut)
1558 (gnus-treat-date-local gnus-article-date-local)
1559 (gnus-treat-date-english gnus-article-date-english)
1560 (gnus-treat-date-original gnus-article-date-original)
1561 (gnus-treat-date-user-defined gnus-article-date-user)
1562 (gnus-treat-date-iso8601 gnus-article-date-iso8601)
1563 (gnus-treat-date-lapsed gnus-article-date-lapsed)
1564 (gnus-treat-display-x-face gnus-article-display-x-face)
1565 (gnus-treat-display-face gnus-article-display-face)
1566 (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
1567 (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
1568 (gnus-treat-hide-signature gnus-article-hide-signature)
1569 (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
1570 (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
1571 (gnus-treat-strip-pem gnus-article-hide-pem)
1572 (gnus-treat-from-picon gnus-treat-from-picon)
1573 (gnus-treat-mail-picon gnus-treat-mail-picon)
1574 (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
1575 (gnus-treat-highlight-headers gnus-article-highlight-headers)
1576 (gnus-treat-highlight-signature gnus-article-highlight-signature)
1577 (gnus-treat-strip-trailing-blank-lines
1578 gnus-article-remove-trailing-blank-lines)
1579 (gnus-treat-strip-leading-blank-lines
1580 gnus-article-strip-leading-blank-lines)
1581 (gnus-treat-strip-multiple-blank-lines
1582 gnus-article-strip-multiple-blank-lines)
1583 (gnus-treat-overstrike gnus-article-treat-overstrike)
1584 (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
1585 (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1586 (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
1587 (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
1588 (gnus-treat-display-smileys gnus-treat-smiley)
1589 (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
1590 (gnus-treat-wash-html gnus-article-wash-html)
1591 (gnus-treat-emphasize gnus-article-emphasize)
1592 (gnus-treat-hide-citation gnus-article-hide-citation)
1593 (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
1594 (gnus-treat-highlight-citation gnus-article-highlight-citation)
1595 (gnus-treat-body-boundary gnus-article-treat-body-boundary)
1596 (gnus-treat-play-sounds gnus-earcon-display)))
1598 (defvar gnus-article-mime-handle-alist nil)
1600 (defvar gnus-article-current-summary nil)
1602 (defvar gnus-article-mode-syntax-table
1615 (defvar gnus-save-article-buffer nil)
1617 (defvar gnus-article-mode-line-format-alist
1618 (nconc '((?w (gnus-article-wash-status) ?s)
1619 (?m (gnus-article-mime-part-status) ?s))
1620 gnus-summary-mode-line-format-alist))
1622 (defvar gnus-number-of-articles-to-be-saved nil)
1624 (defvar gnus-inhibit-hiding nil)
1626 (defvar gnus-article-edit-mode nil)
1630 (defmacro gnus-with-article-headers (&rest forms)
1632 (set-buffer gnus-article-buffer)
1637 (article-narrow-to-head)
1640 (put 'gnus-with-article-headers 'lisp-indent-function 0)
1641 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
1643 (defmacro gnus-with-article-buffer (&rest forms)
1645 (set-buffer gnus-article-buffer)
1649 (put 'gnus-with-article-buffer 'lisp-indent-function 0)
1650 (put 'gnus-with-article-buffer 'edebug-form-spec '(body))
1652 (defun gnus-article-goto-header (header)
1653 "Go to HEADER, which is a regular expression."
1656 (defsubst gnus-article-hide-text (b e props)
1657 "Set text PROPS on the B to E region, extending `intangible' 1 past B."
1658 (gnus-add-text-properties-when 'article-type nil b e props)
1664 (defsubst gnus-article-unhide-text (b e)
1666 (remove-text-properties b e gnus-hidden-properties)
1667 (when (memq 'intangible gnus-hidden-properties)
1671 (defun gnus-article-hide-text-type (b e type)
1673 (gnus-add-wash-type type)
1674 (gnus-article-hide-text
1675 b e (cons 'article-type (cons type gnus-hidden-properties))))
1677 (defun gnus-article-unhide-text-type (b e type)
1679 (gnus-delete-wash-type type)
1681 b e (cons 'article-type (cons type gnus-hidden-properties)))
1682 (when (memq 'intangible gnus-hidden-properties)
1686 (defun gnus-article-hide-text-of-type (type)
1692 (add-text-properties b (incf b) gnus-hidden-properties)))))
1694 (defun gnus-article-delete-text-of-type (type)
1702 (while (if (get-text-property (point) 'gnus-part)
1705 'gnus-part))
1717 (defun gnus-article-delete-invisible-text ()
1726 (defun gnus-article-text-type-exists-p (type)
1730 (defsubst gnus-article-header-rank ()
1731 "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
1732 (let ((list gnus-sorted-header-list)
1745 (unless gnus-inhibit-hiding
1748 (max (1+ (length gnus-sorted-header-list)))
1753 ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
1754 ;; group parameters, so we should go to the summary buffer.
1757 (progn (set-buffer gnus-summary-buffer) t)
1759 (setq ignored (when (not gnus-visible-headers)
1760 (cond ((stringp gnus-ignored-headers)
1761 gnus-ignored-headers)
1762 ((listp gnus-ignored-headers)
1764 gnus-ignored-headers
1766 visible (cond ((stringp gnus-visible-headers)
1767 gnus-visible-headers)
1768 ((and gnus-visible-headers
1769 (listp gnus-visible-headers))
1771 gnus-visible-headers
1775 ;; First we narrow to just the headers.
1776 (article-narrow-to-head)
1777 ;; Hide any "From " lines at the beginning of (mail) articles.
1784 ;; `gnus-ignored-headers' and `gnus-visible-headers' to
1785 ;; select which header lines is to remain visible in the
1795 (gnus-article-header-rank)
1802 (gnus-add-wash-type 'headers)
1811 (interactive (gnus-article-hidden-arg))
1812 (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
1813 (not gnus-show-all-headers))
1817 (list gnus-boring-article-headers)
1820 (article-narrow-to-head)
1829 (gnus-article-hide-text-type
1830 (gnus-point-at-bol)
1839 (when (gnus-string-equal
1840 (gnus-fetch-field "newsgroups")
1841 (gnus-group-real-name
1842 (if (boundp 'gnus-newsgroup-name)
1843 gnus-newsgroup-name
1845 (gnus-article-hide-header "newsgroups")))
1846 ((eq elem 'to-address)
1847 (let ((to (message-fetch-field "to"))
1848 (to-address
1849 (gnus-parameter-to-address
1850 (if (boundp 'gnus-newsgroup-name)
1851 gnus-newsgroup-name ""))))
1852 (when (and to to-address
1854 (gnus-string-equal
1856 (nth 1 (mail-extract-address-components to))
1857 to-address)))
1858 (gnus-article-hide-header "to"))))
1859 ((eq elem 'to-list)
1860 (let ((to (message-fetch-field "to"))
1861 (to-list
1862 (gnus-parameter-to-list
1863 (if (boundp 'gnus-newsgroup-name)
1864 gnus-newsgroup-name ""))))
1865 (when (and to to-list
1867 (gnus-string-equal
1869 (nth 1 (mail-extract-address-components to))
1870 to-list)))
1871 (gnus-article-hide-header "to"))))
1874 (to-list
1875 (gnus-parameter-to-list
1876 (if (boundp 'gnus-newsgroup-name)
1877 gnus-newsgroup-name ""))))
1878 (when (and cc to-list
1880 (gnus-string-equal
1882 (nth 1 (mail-extract-address-components cc))
1883 to-list)))
1884 (gnus-article-hide-header "cc"))))
1885 ((eq elem 'followup-to)
1886 (when (gnus-string-equal
1887 (message-fetch-field "followup-to")
1889 (gnus-article-hide-header "followup-to")))
1890 ((eq elem 'reply-to)
1891 (if (gnus-group-find-parameter
1892 gnus-newsgroup-name 'broken-reply-to)
1893 (gnus-article-hide-header "reply-to")
1895 (reply-to (message-fetch-field "reply-to")))
1898 from reply-to
1903 (mail-extract-address-components from t))
1907 (mail-extract-address-components reply-to t))
1909 (gnus-article-hide-header "reply-to")))))
1911 (let ((date (with-current-buffer gnus-original-article-buffer
1912 ;; If date in `gnus-article-buffer' is localized
1913 ;; (`gnus-treat-date-user-defined'),
1919 (gnus-article-hide-header "date"))))
1920 ((eq elem 'long-to)
1921 (let ((to (message-fetch-field "to"))
1923 (when (> (length to) 1024)
1924 (gnus-article-hide-header "to"))
1926 (gnus-article-hide-header "cc"))))
1927 ((eq elem 'many-to)
1928 (let ((to-count 0)
1931 (while (re-search-forward "^to:" nil t)
1932 (setq to-count (1+ to-count)))
1933 (when (> to-count 1)
1934 (while (> to-count 0)
1937 (re-search-forward "^to:" nil nil to-count)
1939 (narrow-to-region (point) (point-max))
1940 (gnus-article-hide-header "to"))
1941 (setq to-count (1- to-count))))
1951 (narrow-to-region (point) (point-max))
1952 (gnus-article-hide-header "cc"))
1955 (defun gnus-article-hide-header (header)
1959 (gnus-article-hide-text-type
1960 (gnus-point-at-bol)
1968 (defvar gnus-article-normalized-header-length 40
1978 (article-narrow-to-head)
1981 ((< (setq column (- (gnus-point-at-eol) (point)))
1982 gnus-article-normalized-header-length)
1985 (- gnus-article-normalized-header-length column)
1987 ((> column gnus-article-normalized-header-length)
1988 (gnus-put-text-property
1990 (forward-char gnus-article-normalized-header-length)
1992 (gnus-point-at-eol)
2004 Sm*rtq**t*s are M****s***'s unilateral extension to the
2005 iso-8859-1 character map in an attempt to provide more quoting
2010 (article-translate-strings gnus-article-dumbquotes-map))
2012 (defun article-translate-characters (from to)
2013 "Translate all characters in the body of the article according to FROM and TO.
2014 FROM is a string of characters to translate from; to is a string of
2015 characters to translate to."
2025 (aset x (aref from i) (aref to i))
2030 "Translate all string in the body of the article according to MAP.
2031 MAP is an alist where the elements are on the form (\"from\" \"to\")."
2055 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2058 (gnus-article-hide-text-type
2063 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2067 (defun gnus-article-treat-unfold-headers ()
2072 (gnus-with-article-headers
2076 (mail-header-narrow-to-field)
2089 (defun gnus-article-treat-fold-headers ()
2092 (gnus-with-article-headers
2095 (mail-header-narrow-to-field)
2096 (mail-header-fold-field)
2099 (defun gnus-treat-smiley ()
2102 (gnus-with-article-buffer
2103 (if (memq 'smiley gnus-article-wash-types)
2104 (gnus-delete-images 'smiley)
2108 (gnus-add-wash-type 'smiley)
2110 (gnus-add-image 'smiley image)))))))
2112 (defun gnus-article-remove-images ()
2115 (gnus-with-article-buffer
2116 (dolist (elem gnus-article-image-alist)
2117 (gnus-delete-images (car elem)))))
2119 (defun gnus-article-treat-fold-newsgroups ()
2124 (gnus-with-article-headers
2125 (while (gnus-article-goto-header "newsgroups\\|followup-to")
2127 (mail-header-narrow-to-field)
2130 (mail-header-fold-field)
2133 (defun gnus-article-treat-body-boundary ()
2136 (when (and gnus-body-boundary-delimiter
2137 (> (length gnus-body-boundary-delimiter) 0))
2138 (gnus-with-article-headers
2142 (gnus-add-text-properties start (point) '(invisible t intangible t))
2145 (setq str (concat str gnus-body-boundary-delimiter)))
2148 (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
2162 (narrow-to-region (min (1+ (point)) (point-max))
2163 (gnus-point-at-bol))
2204 (not (gnus-annotation-in-region-p
2205 (point) (gnus-point-at-eol))))
2214 (gnus-with-article-headers
2220 (if (and wash-face-p (memq 'face gnus-article-wash-types))
2221 (gnus-delete-images 'face)
2225 (gnus-buffer-live-p gnus-original-article-buffer)
2227 (set-buffer gnus-original-article-buffer))
2229 (mail-narrow-to-head)
2230 (while (gnus-article-goto-header "Face")
2231 (push (mail-header-field-value) faces))))
2234 (let ((from (gnus-article-goto-header "from"))
2241 (when (setq png (gnus-convert-face-to-png (pop faces)))
2242 (setq image (gnus-create-image png 'png t))
2244 (gnus-add-wash-type 'face)
2245 (gnus-add-image 'face image)
2246 (gnus-put-image image nil 'face))))))))))
2252 (gnus-with-article-headers
2257 (if (and wash-face-p (memq 'xface gnus-article-wash-types))
2260 (gnus-delete-images 'xface)
2265 (gnus-buffer-live-p gnus-original-article-buffer)
2267 ;; If type `W f', use gnus-original-article-buffer,
2270 (set-buffer gnus-original-article-buffer))
2272 (mail-narrow-to-head)
2273 (while (gnus-article-goto-header "X-Face")
2274 (push (mail-header-field-value) x-faces))
2276 ;; Sending multiple EOFs to xv doesn't work, so we only do a
2278 (when (stringp gnus-article-x-face-command)
2281 gnus-article-x-face-command
2284 (not gnus-article-x-face-too-ugly)
2286 (not (string-match gnus-article-x-face-too-ugly
2290 (cond ((stringp gnus-article-x-face-command)
2294 (gnus-set-process-query-on-exit-flag
2297 shell-command-switch gnus-article-x-face-command)
2304 ((functionp gnus-article-x-face-command)
2306 (funcall gnus-article-x-face-command face))
2309 gnus-article-x-face-command))))))))))
2315 (set-buffer gnus-article-buffer)
2318 (mail-parse-charset gnus-newsgroup-charset)
2319 (mail-parse-ignored-charsets
2320 (save-excursion (set-buffer gnus-summary-buffer)
2321 gnus-newsgroup-ignored-charsets)))
2322 (mail-decode-encoded-word-region (point-min) (point-max)))))
2326 If PROMPT (the prefix), prompt for a coding system to use."
2330 (mail-parse-charset gnus-newsgroup-charset)
2331 (mail-parse-ignored-charsets
2333 (set-buffer gnus-summary-buffer)
2335 gnus-newsgroup-ignored-charsets))
2339 (article-narrow-to-head)
2342 ctl (and ct (mail-header-parse-content-type ct))
2345 (mm-read-coding-system "Charset to decode: "))
2347 (mail-content-type-get ctl 'charset)))
2348 format (and ctl (mail-content-type-get ctl 'format)))
2350 (setq cte (mail-header-strip cte)))
2356 (narrow-to-region (point) (point-max))
2357 (when (and (eq mail-parse-charset 'gnus-decoded)
2360 (setq charset mail-parse-charset))
2366 (gnus-strip-whitespace cte))))
2372 (mail-parse-charset gnus-newsgroup-charset)
2373 (mail-parse-ignored-charsets
2375 (set-buffer gnus-summary-buffer)
2377 gnus-newsgroup-ignored-charsets))
2393 (funcall gnus-decode-address-function start end)
2394 (funcall gnus-decode-header-function start end))
2401 (method (gnus-find-method-for-group gnus-newsgroup-name)))
2402 (when (and (or gnus-group-name-charset-method-alist
2403 gnus-group-name-charset-group-alist)
2404 (gnus-buffer-live-p gnus-original-article-buffer))
2406 (article-narrow-to-head)
2407 (with-current-buffer gnus-original-article-buffer
2412 (gnus-decode-newsgroups
2413 ;; XXX how to use data in article buffer?
2414 (with-current-buffer gnus-original-article-buffer
2419 gnus-newsgroup-name method))
2422 (with-current-buffer gnus-original-article-buffer
2427 (gnus-decode-newsgroups
2428 ;; XXX how to use data in article buffer?
2429 (with-current-buffer gnus-original-article-buffer
2434 gnus-newsgroup-name method))
2437 (autoload 'idna-to-unicode "idna")
2443 (when gnus-use-idna
2447 (article-narrow-to-head)
2456 (setq unicode (idna-to-unicode ace))))
2468 (if (gnus-buffer-live-p gnus-original-article-buffer)
2469 (with-current-buffer gnus-original-article-buffer
2471 (gnus-fetch-field "content-transfer-encoding"))
2472 (let* ((ct (gnus-fetch-field "content-type"))
2473 (ctl (and ct (mail-header-parse-content-type ct))))
2475 (mail-content-type-get ctl 'charset)))
2481 (setq charset gnus-newsgroup-charset))
2487 (point) (point-max) (mm-charset-to-coding-system charset))))))
2496 (if (gnus-buffer-live-p gnus-original-article-buffer)
2497 (with-current-buffer gnus-original-article-buffer
2499 (gnus-fetch-field "content-transfer-encoding"))
2500 (let* ((ct (gnus-fetch-field "content-type"))
2501 (ctl (and ct (mail-header-parse-content-type ct))))
2503 (mail-content-type-get ctl 'charset)))
2509 (setq charset gnus-newsgroup-charset))
2515 (narrow-to-region (point) (point-max))
2518 (point-min) (point-max) (mm-charset-to-coding-system charset)))))))
2541 (gnus-treat-article nil))))
2547 charset defined in `gnus-summary-show-article-charset-alist' is used."
2557 gnus-summary-show-article-charset-alist))))
2559 (let ((gnus-summary-show-article-charset-alist
2561 (with-current-buffer gnus-summary-buffer
2562 (gnus-summary-show-article 1)))
2564 (when (gnus-buffer-live-p gnus-original-article-buffer)
2565 (with-current-buffer gnus-original-article-buffer
2566 (let* ((ct (gnus-fetch-field "content-type"))
2567 (ctl (and ct (mail-header-parse-content-type ct))))
2569 (mail-content-type-get ctl 'charset)))
2573 (setq charset gnus-newsgroup-charset)))
2577 (narrow-to-region (point) (point-max))
2578 (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
2588 (defun gnus-article-wash-html-with-w3 ()
2599 (defun gnus-article-wash-html-with-w3m ()
2616 (defun gnus-article-wash-html-with-w3m-standalone ()
2633 The `gnus-list-identifiers' variable specifies what to do."
2636 (regexp (if (consp gnus-list-identifiers)
2637 (mapconcat 'identity gnus-list-identifiers " *\\|")
2638 gnus-list-identifiers))
2643 (article-narrow-to-head)
2658 (interactive (gnus-article-hidden-arg))
2659 (unless (gnus-article-check-hidden-text 'pem arg)
2668 (gnus-add-wash-type 'pem)
2669 (gnus-article-hide-text-type
2678 (gnus-article-hide-text-type
2683 `gnus-article-address-banner-alist'."
2688 (when (gnus-parameter-banner gnus-newsgroup-name)
2690 (gnus-parameter-banner gnus-newsgroup-name)))
2691 (when gnus-article-address-banner-alist
2697 (article-narrow-to-head)
2698 (mail-fetch-field "from"))))
2701 (cadr (funcall gnus-extract-address-components
2704 (dolist (pair gnus-article-address-banner-alist)
2714 (gnus-signature-limit nil)
2719 (when (gnus-article-narrow-to-signature)
2724 (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
2736 (set-buffer gnus-article-buffer)
2744 (narrow-to-region start end)
2752 (interactive (gnus-article-hidden-arg))
2753 (unless (gnus-article-check-hidden-text 'signature arg)
2757 (when (gnus-article-narrow-to-signature)
2758 (gnus-article-hide-text-type
2760 (gnus-set-mode-line 'article))
2769 (gnus-delete-line)))))
2780 (gnus-delete-line))))))
2782 (defun article-narrow-to-head ()
2783 "Narrow the buffer to the head of the message.
2784 Point is left at the beginning of the narrowed-to region."
2785 (narrow-to-region
2798 (article-goto-body-goes-to-point-min-p
2815 (unless (gnus-annotation-in-region-p
2821 (unless (gnus-annotation-in-region-p
2862 (defun gnus-article-narrow-to-signature ()
2863 "Narrow to the signature; return t if a signature is found, else nil."
2865 (when (gnus-article-search-signature)
2867 ;; Check whether we have some limits to what we consider
2868 ;; to be a signature.
2869 (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
2870 (list gnus-signature-limit)))
2885 (narrow-to-region (point) (point-max))
2888 (defun gnus-article-search-signature ()
2893 (if (if (stringp gnus-signature-separator)
2894 (re-search-backward gnus-signature-separator nil t)
2895 (let ((seps gnus-signature-separator))
2904 (defun gnus-article-hidden-arg ()
2910 (defun gnus-article-check-hidden-text (type arg)
2916 (let ((hide (gnus-article-hidden-text-p type)))
2922 (gnus-article-show-hidden-text type)
2927 (gnus-article-show-hidden-text type)
2931 (defun gnus-article-hidden-text-p (type)
2943 (defun gnus-article-show-hidden-text (type &optional dummy)
2948 (gnus-remove-text-properties-when
2952 gnus-hidden-properties)))
2953 (gnus-delete-wash-type type)))
2962 "Mapping from time units to seconds.")
2964 (defun gnus-article-forward-header ()
2965 "Move point to the start of the next header.
2976 "Convert DATE date to universal time in the current article.
2977 If TYPE is `local', convert to local time; if it is `lapsed', output
2979 `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
2983 (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
3005 (narrow-to-region pos (or (text-property-any pos (point-max)
3010 (setq bface (get-text-property (gnus-point-at-bol) 'face)
3011 eface (get-text-property (1- (gnus-point-at-eol)) 'face)))
3017 (delete-region (gnus-point-at-bol)
3019 (gnus-article-forward-header)
3021 (delete-region (gnus-point-at-bol)
3023 (gnus-article-forward-header)
3030 (gnus-goto-char pos)
3051 (let ((time (date-to-time date)))
3053 ;; Convert to the local timezone.
3059 ;; Convert to Universal Time.
3079 (with-current-buffer gnus-summary-buffer
3080 gnus-article-time-format)
3082 gnus-article-time-format)))
3098 ;; liable to bug out, so we ignore all errors.
3116 ;; and divide things to see whether that results
3121 ;; The (remaining) seconds are too few to
3127 (concat (if prev ", " "") (int-to-string
3143 (number-to-string (nth 3 dtime))
3152 (nth (1- (nth 4 dtime)) gnus-english-month-names)
3154 (number-to-string (nth 5 dtime))
3163 "Convert the current article date to the local timezone."
3168 "Convert the current article date to something that is proper English."
3173 "Convert the current article date to what it was originally.
3175 function and want to see what the date was before converting."
3180 "Convert the current article date to time lapsed since it was sent."
3185 "Function to be run from a timer to update the lapsed time line."
3193 (when (eq major-mode 'gnus-article-mode)
3202 (defun gnus-start-date-timer (&optional n)
3203 "Start a timer to update the X-Sent header in the article buffers.
3205 is to run."
3209 (gnus-stop-date-timer)
3213 (defun gnus-stop-date-timer ()
3221 "Convert the current article date to the user-defined format.
3222 This format is defined by the `gnus-article-time-format' variable."
3227 "Convert the current article date to ISO8601."
3231 (defmacro gnus-article-save-original-date (&rest forms)
3257 ;; (gnus-article-unhide-text (point-min) (point-max)))))
3265 (article-narrow-to-head)
3271 "Emphasize text according to `gnus-emphasis-alist'."
3272 (interactive (gnus-article-hidden-arg))
3273 (unless (gnus-article-check-hidden-text 'emphasis arg)
3277 (with-current-buffer gnus-summary-buffer
3278 gnus-article-emphasis-alist)
3280 gnus-emphasis-alist))
3283 gnus-hidden-properties))
3295 (gnus-article-hide-text
3297 (gnus-article-unhide-text-type
3299 (gnus-put-overlay-excluding-newlines
3301 (gnus-add-wash-type 'emphasis)
3304 (defun gnus-article-setup-highlight-words (&optional highlight-words)
3306 (unless gnus-article-emphasis-alist
3307 (let ((name (and gnus-newsgroup-name
3308 (gnus-group-real-name gnus-newsgroup-name))))
3309 (make-local-variable 'gnus-article-emphasis-alist)
3310 (setq gnus-article-emphasis-alist
3312 (let ((alist gnus-group-highlight-words-alist) elem highlight)
3319 (if gnus-newsgroup-name
3320 (copy-sequence (gnus-group-find-parameter
3321 gnus-newsgroup-name 'highlight-words t)))
3322 gnus-emphasis-alist)))))
3325 (defvar gnus-summary-article-menu)
3326 (defvar gnus-summary-post-menu))
3330 (defun gnus-article-save (save-buffer file &optional num)
3332 (when (or (get gnus-default-article-saver :headers)
3333 (not gnus-save-all-headers))
3334 ;; Remove headers according to `gnus-saved-headers' or the value
3336 (let ((gnus-visible-headers
3337 (or (symbol-value (get gnus-default-article-saver :headers))
3338 gnus-saved-headers gnus-visible-headers))
3339 (gnus-article-buffer save-buffer))
3344 (if (not gnus-default-article-saver)
3347 ;; `gnus-save-article-buffer' (or so they think), but we
3348 ;; bind that variable to our save-buffer.
3349 (set-buffer gnus-article-buffer)
3350 (let* ((gnus-save-article-buffer save-buffer)
3353 ((not gnus-prompt-before-saving) 'default)
3354 ((eq gnus-prompt-before-saving 'always) nil)
3356 (gnus-number-of-articles-to-be-saved
3357 (when (eq gnus-prompt-before-saving t)
3359 (set-buffer gnus-article-current-summary)
3360 (funcall gnus-default-article-saver filename)))))
3362 (defun gnus-read-save-file-name (prompt &optional filename
3381 (let* ((split-name (gnus-get-split-value gnus-split-methods))
3384 (if (and gnus-number-of-articles-to-be-saved
3385 (> gnus-number-of-articles-to-be-saved 1))
3387 gnus-number-of-articles-to-be-saved)
3413 gnus-article-save-directory))
3417 (t gnus-article-save-directory))))
3431 gnus-article-save-directory
3433 gnus-article-save-directory)))
3436 (gnus-make-directory (file-name-directory file))
3444 (gnus-make-directory (file-name-directory result))
3451 (defun gnus-article-archive-name (group)
3455 (nnheader-concat gnus-article-save-directory
3458 (defun gnus-article-nndoc-name (group)
3460 (when (eq (car (gnus-find-method-for-group group)) 'nndoc)
3461 (gnus-group-get-parameter group 'save-article-group)))
3463 (defun gnus-summary-save-in-rmail (&optional filename)
3464 "Append this article to Rmail file.
3466 Directory to save to is default to `gnus-article-save-directory'."
3467 (setq filename (gnus-read-save-file-name
3469 gnus-rmail-save-name gnus-newsgroup-name
3470 gnus-current-headers 'gnus-newsgroup-last-rmail))
3471 (gnus-eval-in-buffer-window gnus-save-article-buffer
3475 (gnus-output-to-rmail filename))))
3478 (defun gnus-summary-save-in-mail (&optional filename)
3479 "Append this article to Unix mail file.
3481 Directory to save to is default to `gnus-article-save-directory'."
3482 (setq filename (gnus-read-save-file-name
3483 "Save %s in Unix mail file" filename
3484 gnus-mail-save-name gnus-newsgroup-name
3485 gnus-current-headers 'gnus-newsgroup-last-mail))
3486 (gnus-eval-in-buffer-window gnus-save-article-buffer
3492 (mail-file-babyl-p filename))
3493 (rmail-output-to-rmail-file filename t)
3494 (gnus-output-to-mail filename)))))
3497 (put 'gnus-summary-save-in-file :decode t)
3498 (put 'gnus-summary-save-in-file :headers 'gnus-saved-headers)
3499 (defun gnus-summary-save-in-file (&optional filename overwrite)
3500 "Append this article to file.
3502 Directory to save to is default to `gnus-article-save-directory'."
3503 (setq filename (gnus-read-save-file-name
3505 gnus-file-save-name gnus-newsgroup-name
3506 gnus-current-headers 'gnus-newsgroup-last-file))
3507 (gnus-eval-in-buffer-window gnus-save-article-buffer
3514 (gnus-output-to-file filename))))
3517 (put 'gnus-summary-write-to-file :decode t)
3518 (put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file)
3519 (put 'gnus-summary-write-to-file :headers 'gnus-saved-headers)
3520 (defun gnus-summary-write-to-file (&optional filename)
3521 "Write this article to a file, overwriting it if the file exists.
3523 The directory to save in defaults to `gnus-article-save-directory'."
3524 (setq filename (gnus-read-save-file-name
3526 gnus-file-save-name gnus-newsgroup-name
3527 gnus-current-headers nil 'gnus-newsgroup-last-directory))
3528 (gnus-summary-save-in-file filename t))
3530 (put 'gnus-summary-save-body-in-file :decode t)
3531 (defun gnus-summary-save-body-in-file (&optional filename overwrite)
3532 "Append this article body to a file.
3534 The directory to save in defaults to `gnus-article-save-directory'."
3535 (setq filename (gnus-read-save-file-name
3537 gnus-file-save-name gnus-newsgroup-name
3538 gnus-current-headers 'gnus-newsgroup-last-file))
3539 (gnus-eval-in-buffer-window gnus-save-article-buffer
3544 (narrow-to-region (point) (point-max)))
3548 (gnus-output-to-file filename))))
3551 (put 'gnus-summary-write-body-to-file :decode t)
3552 (put 'gnus-summary-write-body-to-file
3553 :function 'gnus-summary-save-body-in-file)
3554 (defun gnus-summary-write-body-to-file (&optional filename)
3555 "Write this article body to a file, overwriting it if the file exists.
3557 The directory to save in defaults to `gnus-article-save-directory'."
3558 (setq filename (gnus-read-save-file-name
3560 gnus-file-save-name gnus-newsgroup-name
3561 gnus-current-headers nil 'gnus-newsgroup-last-directory))
3562 (gnus-summary-save-body-in-file filename t))
3564 (defun gnus-summary-save-in-pipe (&optional command)
3565 "Pipe this article to subprocess."
3568 gnus-last-shell-command)
3569 gnus-last-shell-command)
3575 (if (and gnus-number-of-articles-to-be-saved
3576 (> gnus-number-of-articles-to-be-saved 1))
3578 gnus-number-of-articles-to-be-saved)
3580 gnus-last-shell-command))))
3582 (if gnus-last-shell-command
3583 (setq command gnus-last-shell-command)
3585 (gnus-eval-in-buffer-window gnus-article-buffer
3589 (setq gnus-last-shell-command command))
3591 (defmacro gnus-read-string (prompt &optional initial-contents history
3599 (defun gnus-summary-pipe-to-muttprint (&optional command)
3600 "Pipe this article to muttprint."
3601 (setq command (gnus-read-string
3602 "Print using command: " gnus-summary-muttprint-program
3603 nil gnus-summary-muttprint-program))
3604 (gnus-summary-save-in-pipe command))
3608 (defun gnus-capitalize-newsgroup (newsgroup)
3611 (concat (char-to-string (upcase (aref newsgroup 0)))
3614 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
3616 If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num.
3620 (concat (if (gnus-use-long-file-name 'not-save)
3621 (gnus-capitalize-newsgroup newsgroup)
3622 (gnus-newsgroup-directory-form newsgroup))
3623 "/" (int-to-string (mail-header-number headers)))
3624 gnus-article-save-directory)))
3632 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
3634 If variable `gnus-use-long-file-name' is non-nil, it is
3638 (concat (if (gnus-use-long-file-name 'not-save)
3640 (gnus-newsgroup-directory-form newsgroup))
3641 "/" (int-to-string (mail-header-number headers)))
3642 gnus-article-save-directory)))
3650 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
3652 If variable `gnus-use-long-file-name' is non-nil, it is
3656 (if (gnus-use-long-file-name 'not-save)
3659 (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))
3661 gnus-article-save-directory)))
3663 (defun gnus-sender-save-name (newsgroup headers &optional last-file)
3665 (let ((from (mail-header-from headers)))
3670 gnus-article-save-directory)))
3675 (if (gnus-buffer-live-p gnus-original-article-buffer)
3676 (let ((sig (with-current-buffer gnus-original-article-buffer
3677 (gnus-fetch-field "X-PGP-Sig")))
3683 (insert-buffer-substring gnus-original-article-buffer)
3685 (message-narrow-to-head)
3691 (mail-fetch-field header)
3710 (let ((coding-system-for-write (or gnus-newsgroup-charset
3715 mm-security-handle 'gnus-details)
3717 mm-security-handle 'gnus-info)))))
3721 (message-narrow-to-head)
3724 (setq bface (get-text-property (gnus-point-at-bol) 'face)
3725 eface (get-text-property (1- (gnus-point-at-eol)) 'face))
3730 (narrow-to-region (point) (point))
3749 (if (gnus-buffer-live-p gnus-original-article-buffer)
3750 (canlock-verify gnus-original-article-buffer)))
3760 gfunc (intern (format "gnus-%s" func))))
3767 (set-buffer gnus-article-buffer)
3813 ;; (article-show-all . gnus-article-show-all-headers)
3821 (put 'gnus-article-mode 'mode-class 'special)
3823 (set-keymap-parent gnus-article-mode-map widget-keymap)
3825 (gnus-define-keys gnus-article-mode-map
3826 " " gnus-article-goto-next-page
3827 "\177" gnus-article-goto-prev-page
3828 [delete] gnus-article-goto-prev-page
3829 [backspace] gnus-article-goto-prev-page
3830 "\C-c^" gnus-article-refer-article
3831 "h" gnus-article-show-summary
3832 "s" gnus-article-show-summary
3833 "\C-c\C-m" gnus-article-mail
3834 "?" gnus-article-describe-briefly
3835 "e" gnus-summary-edit-article
3838 "\C-c\C-i" gnus-info-find-node
3839 "\C-c\C-b" gnus-bug
3840 "R" gnus-article-reply-with-original
3841 "F" gnus-article-followup-with-original
3842 "\C-hk" gnus-article-describe-key
3843 "\C-hc" gnus-article-describe-key-briefly
3845 "\C-d" gnus-article-read-summary-keys
3846 "\M-*" gnus-article-read-summary-keys
3847 "\M-#" gnus-article-read-summary-keys
3848 "\M-^" gnus-article-read-summary-keys
3849 "\M-g" gnus-article-read-summary-keys)
3852 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
3854 (defun gnus-article-make-menu-bar ()
3855 (unless (boundp 'gnus-article-commands-menu)
3856 (gnus-summary-make-menu-bar))
3857 (gnus-turn-off-edit-menu 'article)
3858 (unless (boundp 'gnus-article-article-menu)
3860 gnus-article-article-menu gnus-article-mode-map ""
3862 ["Scroll forwards" gnus-article-goto-next-page t]
3863 ["Scroll backwards" gnus-article-goto-prev-page t]
3864 ["Show summary" gnus-article-show-summary t]
3865 ["Fetch Message-ID at point" gnus-article-refer-article t]
3866 ["Mail to address at point" gnus-article-mail t]
3867 ["Send a bug report" gnus-bug t]))
3870 gnus-article-treatment-menu gnus-article-mode-map ""
3873 ["Hide headers" gnus-article-hide-headers t]
3874 ["Hide signature" gnus-article-hide-signature t]
3875 ["Hide citation" gnus-article-hide-citation t]
3876 ["Treat overstrike" gnus-article-treat-overstrike t]
3877 ["Remove carriage return" gnus-article-remove-cr t]
3878 ["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
3879 ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
3880 ["Remove base64" gnus-article-de-base64-unreadable t]
3881 ["Treat html" gnus-article-wash-html t]
3882 ["Remove newlines from within URLs" gnus-article-unsplit-urls t]
3883 ["Decode HZ" gnus-article-decode-HZ t]))
3885 ;; Note "Commands" menu is defined in gnus-sum.el for consistency
3887 ;; Note "Post" menu is defined in gnus-sum.el for consistency
3889 (gnus-run-hooks 'gnus-article-menu-hook)))
3891 (defun gnus-article-mode ()
3896 The following commands are available in addition to all summary mode
3898 \\<gnus-article-mode-map>
3899 \\[gnus-article-next-page]\t Scroll the article one page forwards
3900 \\[gnus-article-prev-page]\t Scroll the article one page backwards
3901 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
3902 \\[gnus-article-show-summary]\t Display the summary buffer
3903 \\[gnus-article-mail]\t Send a reply to the address near point
3904 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
3905 \\[gnus-info-find-node]\t Go to the Gnus info node"
3908 (gnus-simplify-mode-line)
3910 (setq major-mode 'gnus-article-mode)
3912 (use-local-map gnus-article-mode-map)
3913 (when (gnus-visual-p 'article-menu 'menu)
3914 (gnus-article-make-menu-bar)
3915 (when gnus-summary-tool-bar-map
3916 (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
3917 (gnus-update-format-specifications nil 'article-mode)
3918 (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
3919 (set (make-local-variable 'gnus-page-broken) nil)
3920 (make-local-variable 'gnus-button-marker-list)
3921 (make-local-variable 'gnus-article-current-summary)
3922 (make-local-variable 'gnus-article-mime-handles)
3923 (make-local-variable 'gnus-article-decoded-p)
3924 (make-local-variable 'gnus-article-mime-handle-alist)
3925 (make-local-variable 'gnus-article-wash-types)
3926 (make-local-variable 'gnus-article-image-alist)
3927 (make-local-variable 'gnus-article-charset)
3928 (make-local-variable 'gnus-article-ignored-charsets)
3932 (gnus-set-default-directory)
3935 (set-syntax-table gnus-article-mode-syntax-table)
3937 (gnus-run-mode-hooks 'gnus-article-mode-hook))
3939 ;; Internal variables. Are `gnus-button-regexp' and `gnus-button-last' used
3941 (defvar gnus-button-regexp nil)
3942 (defvar gnus-button-marker-list nil
3943 "Regexp matching any of the regexps from `gnus-button-alist'.")
3944 (defvar gnus-button-last nil
3945 "The value of `gnus-button-alist' when `gnus-button-regexp' was build.")
3947 (defun gnus-article-setup-buffer ()
3949 (let* ((name (if gnus-single-article-buffer "*Article*"
3950 (concat "*Article " gnus-newsgroup-name "*")))
3955 (setq gnus-article-buffer name)
3956 (setq gnus-original-article-buffer original)
3957 (setq gnus-article-mime-handle-alist nil)
3958 ;; This might be a variable local to the summary buffer.
3959 (unless gnus-single-article-buffer
3961 (set-buffer gnus-summary-buffer)
3962 (setq gnus-article-buffer name)
3963 (setq gnus-original-article-buffer original)
3964 (gnus-set-global-variables)))
3965 (gnus-article-setup-highlight-words)
3968 (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
3970 (setq major-mode 'gnus-original-article-mode)
3971 (make-local-variable 'gnus-original-article))
3974 (if gnus-article-edit-mode
3978 (gnus-kill-buffer name)
3985 (set (make-local-variable 'gnus-article-edit-mode) nil)
3986 (when gnus-article-mime-handles
3987 (mm-destroy-parts gnus-article-mime-handles)
3988 (setq gnus-article-mime-handles nil))
3989 ;; Set it to nil in article-buffer!
3990 (setq gnus-article-mime-handle-alist nil)
3994 (setq gnus-button-marker-list nil)
3995 (unless (eq major-mode 'gnus-article-mode)
3996 (gnus-article-mode))
3999 (set-buffer (gnus-get-buffer-create name))
4000 (gnus-article-mode)
4001 (make-local-variable 'gnus-summary-buffer)
4002 (gnus-summary-set-local-parameters gnus-newsgroup-name)
4007 (defun gnus-article-set-window-start (&optional line)
4009 (gnus-get-buffer-window gnus-article-buffer t)
4011 (set-buffer gnus-article-buffer)
4015 (gnus-message 6 "Moved to bookmark")
4020 (defun gnus-article-prepare (article &optional all-headers header)
4026 ;; Make sure we start in a summary buffer.
4027 (unless (eq major-mode 'gnus-summary-mode)
4028 (set-buffer gnus-summary-buffer))
4029 (setq gnus-summary-buffer (current-buffer))
4030 (let* ((gnus-article (if header (mail-header-number header) article))
4031 (summary-buffer (current-buffer))
4032 (gnus-tmp-internal-hook gnus-article-internal-prepare-hook)
4033 (group gnus-newsgroup-name)
4036 (gnus-article-setup-buffer)
4037 (set-buffer gnus-article-buffer)
4043 (gnus-request-article-this-buffer
4048 (not (memq article gnus-newsgroup-sparse)))
4049 (setq gnus-article-current
4050 (cons gnus-newsgroup-name article))
4051 (set-buffer gnus-summary-buffer)
4052 (setq gnus-current-article article)
4053 (if (and (memq article gnus-newsgroup-undownloaded)
4054 (not (gnus-online (gnus-find-method-for-group
4055 gnus-newsgroup-name))))
4057 (gnus-summary-set-agent-mark article)
4059 (gnus-summary-mark-article article gnus-canceled-mark)
4060 (unless (memq article gnus-newsgroup-sparse)
4061 (gnus-error 1 "No such article (may have expired or been canceled)")))))
4066 (set-buffer summary-buffer)
4067 (push article gnus-newsgroup-history)
4068 (setq gnus-last-article gnus-current-article
4069 gnus-current-article 0
4070 gnus-current-headers nil
4071 gnus-article-current nil)
4073 (gnus-configure-windows 'summary)
4074 (gnus-configure-windows 'article))
4075 (gnus-set-global-variables))
4076 (let ((gnus-article-mime-handle-alist-1
4077 gnus-article-mime-handle-alist))
4078 (gnus-set-mode-line 'article)))
4083 (not (eq article gnus-current-article)))
4085 ;; `gnus-current-article' must be an article number.
4087 (set-buffer summary-buffer)
4088 (push article gnus-newsgroup-history)
4089 (setq gnus-last-article gnus-current-article
4090 gnus-current-article article
4091 gnus-current-headers
4092 (gnus-summary-article-header gnus-current-article)
4093 gnus-article-current
4094 (cons gnus-newsgroup-name gnus-current-article))
4095 (unless (vectorp gnus-current-headers)
4096 (setq gnus-current-headers nil))
4097 (gnus-summary-goto-subject gnus-current-article)
4098 (when (gnus-summary-show-thread)
4099 ;; If the summary buffer really was folded, the
4100 ;; previous goto may not actually have gone to
4103 (gnus-summary-goto-subject gnus-current-article))
4104 (gnus-run-hooks 'gnus-mark-article-hook)
4105 (gnus-set-mode-line 'summary)
4106 (when (gnus-visual-p 'article-highlight 'highlight)
4107 (gnus-run-hooks 'gnus-visual-mark-article-hook))
4109 (gnus-set-global-variables)
4110 (setq gnus-have-all-headers
4111 (or all-headers gnus-show-all-headers))))
4113 (gnus-configure-windows 'article))
4116 (gnus-article-prepare-display)
4119 (when gnus-break-pages
4120 (gnus-narrow-to-page)))
4121 (let ((gnus-article-mime-handle-alist-1
4122 gnus-article-mime-handle-alist))
4123 (gnus-set-mode-line 'article))
4128 (gnus-configure-windows 'article)
4132 (defun gnus-article-prepare-display ()
4136 (let ((gnus-article-buffer (current-buffer))
4139 (unless (eq major-mode 'gnus-article-mode)
4140 (gnus-article-mode))
4142 gnus-article-wash-types nil
4143 gnus-article-image-alist nil)
4144 (gnus-run-hooks 'gnus-tmp-internal-hook)
4145 (when gnus-display-mime-function
4146 (funcall gnus-display-mime-function))
4147 (gnus-run-hooks 'gnus-article-prepare-hook)))
4153 (defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
4166 `(gnus)Formatting Variables'.")
4168 (defvar gnus-mime-button-line-format-alist
4169 '((?t gnus-tmp-type ?s)
4170 (?T gnus-tmp-type-long ?s)
4171 (?n gnus-tmp-name ?s)
4172 (?d gnus-tmp-description ?s)
4173 (?p gnus-tmp-id ?s)
4174 (?l gnus-tmp-length ?d)
4175 (?e gnus-tmp-dots ?s)))
4177 (defvar gnus-mime-button-commands
4178 '((gnus-article-press-button "\r" "Toggle Display")
4179 (gnus-mime-view-part "v" "View Interactively...")
4180 (gnus-mime-view-part-as-type "t" "View As Type...")
4181 (gnus-mime-view-part-as-charset "C" "View As charset...")
4182 (gnus-mime-save-part "o" "Save...")
4183 (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
4184 (gnus-mime-delete-part "d" "Delete part")
4185 (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
4186 (gnus-mime-inline-part "i" "View As Text, In This Buffer")
4187 (gnus-mime-view-part-internally "E" "View Internally")
4188 (gnus-mime-view-part-externally "e" "View Externally")
4189 (gnus-mime-print-part "p" "Print")
4190 (gnus-mime-pipe-part "|" "Pipe To Command...")
4191 (gnus-mime-action-on-part "." "Take action on the part...")))
4193 (defun gnus-article-mime-part-status ()
4194 (if gnus-article-mime-handle-alist-1
4195 (if (eq 1 (length gnus-article-mime-handle-alist-1))
4197 (format " (%d parts)" (length gnus-article-mime-handle-alist-1)))
4200 (defvar gnus-mime-button-map
4202 (unless (>= (string-to-number emacs-version) 21)
4204 (set-keymap-parent map gnus-article-mode-map))
4205 (define-key map gnus-mouse-2 'gnus-article-push-button)
4206 (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
4207 (dolist (c gnus-mime-button-commands)
4212 gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
4216 gnus-mime-button-commands)))
4234 (defun gnus-mime-button-menu (event prefix)
4241 (gnus-article-check-buffer)
4242 (popup-menu gnus-mime-button-menu nil prefix))))
4244 (defun gnus-mime-view-all-parts (&optional handles)
4248 (set-buffer gnus-article-buffer)
4249 (let ((handles (or handles gnus-article-mime-handles))
4250 (mail-parse-charset gnus-newsgroup-charset)
4251 (mail-parse-ignored-charsets
4252 (with-current-buffer gnus-summary-buffer
4253 gnus-newsgroup-ignored-charsets)))
4262 (defun gnus-mime-save-part-and-strip ()
4265 (gnus-article-check-buffer)
4266 (when (gnus-group-read-only-p)
4268 (when (mm-complicated-handles gnus-article-mime-handles)
4271 (when (gnus-yes-or-no-p "\
4273 (let* ((data (get-text-property (point) 'gnus-data))
4275 (handles gnus-article-mime-handles))
4285 (mail-header-encode-parameter "name" (file-name-nondirectory file)))
4295 (set-buffer gnus-summary-buffer)
4296 (gnus-article-edit-article
4299 (let ((mail-parse-charset (or gnus-article-charset
4300 ',gnus-newsgroup-charset))
4301 (mail-parse-ignored-charsets
4302 (or gnus-article-ignored-charsets
4303 ',gnus-newsgroup-ignored-charsets))
4306 (insert-buffer-substring gnus-original-article-buffer)
4307 (mime-to-mml ',handles)
4308 (setq gnus-article-mime-handles nil)
4312 (gnus-make-local-hook 'kill-buffer-hook)
4315 (let ((mail-parse-charset (or gnus-article-charset
4316 ',gnus-newsgroup-charset))
4319 (mail-parse-ignored-charsets
4320 (or gnus-article-ignored-charsets
4321 ',gnus-newsgroup-ignored-charsets)))
4322 (mml-to-mime)
4327 (gnus-summary-edit-article-done
4328 ,(or (mail-header-references gnus-current-headers) "")
4329 ,(gnus-group-read-only-p)
4330 ,gnus-summary-buffer no-highlight)))))))
4332 (defun gnus-mime-delete-part ()
4336 (gnus-article-check-buffer)
4337 (when (gnus-group-read-only-p)
4339 (when (mm-complicated-handles gnus-article-mime-handles)
4342 (when (gnus-yes-or-no-p "\
4344 (let* ((data (get-text-property (point) 'gnus-data))
4345 (handles gnus-article-mime-handles)
4348 (mail-decode-encoded-word-string (or (mm-handle-description data)
4351 (or (mail-content-type-get (mm-handle-disposition data) 'filename)
4374 (set-buffer gnus-summary-buffer)
4376 ;; `gnus-mime-save-part-and-strip') isn't necessary?
4377 (gnus-article-edit-article
4380 (let ((mail-parse-charset (or gnus-article-charset
4381 ',gnus-newsgroup-charset))
4382 (mail-parse-ignored-charsets
4383 (or gnus-article-ignored-charsets
4384 ',gnus-newsgroup-ignored-charsets))
4387 (insert-buffer-substring gnus-original-article-buffer)
4388 (mime-to-mml ',handles)
4389 (setq gnus-article-mime-handles nil)
4393 (gnus-make-local-hook 'kill-buffer-hook)
4396 (let ((mail-parse-charset (or gnus-article-charset
4397 ',gnus-newsgroup-charset))
4400 (mail-parse-ignored-charsets
4401 (or gnus-article-ignored-charsets
4402 ',gnus-newsgroup-ignored-charsets)))
4403 (mml-to-mime)
4408 (gnus-summary-edit-article-done
4409 ,(or (mail-header-references gnus-current-headers) "")
4410 ,(gnus-group-read-only-p)
4411 ,gnus-summary-buffer no-highlight)))))
4412 ;; Not in `gnus-mime-save-part-and-strip':
4413 (gnus-article-edit-done)
4414 (gnus-summary-expand-window)
4415 (gnus-summary-show-article))
4417 (defun gnus-mime-save-part ()
4420 (gnus-article-check-buffer)
4421 (let ((data (get-text-property (point) 'gnus-data)))
4425 (defun gnus-mime-pipe-part ()
4426 "Pipe the MIME part under point to a process."
4428 (gnus-article-check-buffer)
4429 (let ((data (get-text-property (point) 'gnus-data)))
4433 (defun gnus-mime-view-part ()
4436 (gnus-article-check-buffer)
4437 (let ((data (get-text-property (point) 'gnus-data)))
4439 (setq gnus-article-mime-handles
4441 gnus-article-mime-handles (setq data (copy-sequence data))))
4444 (defun gnus-mime-view-part-as-type-internal ()
4445 (gnus-article-check-buffer)
4446 (let* ((handle (get-text-property (point) 'gnus-data))
4449 (mail-content-type-get (mm-handle-type handle) 'name)
4455 (defun gnus-mime-view-part-as-type (&optional mime-type pred)
4457 If non-nil, PRED is a predicate to use during completion to limit the
4462 (let ((default (gnus-mime-view-part-as-type-internal)))
4469 (gnus-article-check-buffer)
4470 (let ((handle (get-text-property (point) 'gnus-data)))
4485 (setq gnus-article-mime-handles
4486 (mm-merge-handles gnus-article-mime-handles handle))
4487 (gnus-mm-display-part handle))))
4492 ;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
4495 (defun gnus-mime-jka-compr-maybe-uncompress ()
4519 (defun gnus-mime-copy-part (&optional handle)
4524 (gnus-article-check-buffer)
4525 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4530 (mail-content-type-get (mm-handle-type handle) 'name)
4531 (mail-content-type-get (mm-handle-disposition handle)
4536 (switch-to-buffer buffer)
4538 ;; We do it this way to make `normal-mode' set the appropriate mode.
4542 (gnus-mime-jka-compr-maybe-uncompress)
4547 (defun gnus-mime-print-part (&optional handle filename)
4550 (gnus-article-check-buffer)
4551 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4559 (mm-save-part-to-file handle file)
4569 (gnus-print-buffer))
4572 (defun gnus-mime-inline-part (&optional handle arg)
4575 (gnus-article-check-buffer)
4576 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4586 (setq charset (or (mail-content-type-get
4588 gnus-newsgroup-charset)))
4594 gnus-summary-show-article-charset-alist))
4603 (setq charset (mm-charset-to-coding-system
4607 (mm-string-to-multibyte contents)))
4610 (defun gnus-mime-strip-charset-parameters (handle)
4613 (mapc #'gnus-mime-strip-charset-parameters (cdr handle))
4625 (defun gnus-mime-view-part-as-charset (&optional handle arg)
4629 (gnus-article-check-buffer)
4630 (let ((handle (or handle (get-text-property (point) 'gnus-data)))
4631 (fun (get-text-property (point) 'gnus-callback))
4632 (gnus-newsgroup-ignored-charsets 'gnus-all)
4633 gnus-newsgroup-charset form preferred parts)
4638 (setq gnus-newsgroup-charset
4639 (or (cdr (assq arg gnus-summary-show-article-charset-alist))
4641 (gnus-mime-strip-charset-parameters handle)
4644 (assq 'gnus-mime-display-alternative form)))
4650 (get-text-property (point) 'gnus-data))))
4651 (setq parts (get-text-property (point) 'gnus-part))
4653 gnus-article-mime-handle-alist)))
4661 (defun gnus-mime-view-part-externally (&optional handle)
4664 (gnus-article-check-buffer)
4665 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4668 (mail-parse-charset gnus-newsgroup-charset)
4669 (mail-parse-ignored-charsets
4670 (with-current-buffer gnus-summary-buffer
4671 gnus-newsgroup-ignored-charsets))
4676 (gnus-mime-view-part-as-type
4683 (defun gnus-mime-view-part-internally (&optional handle)
4687 (gnus-article-check-buffer)
4688 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4691 (mail-parse-charset gnus-newsgroup-charset)
4692 (mail-parse-ignored-charsets
4693 (with-current-buffer gnus-summary-buffer
4694 gnus-newsgroup-ignored-charsets))
4697 (gnus-mime-view-part-as-type
4704 (defun gnus-mime-action-on-part (&optional action)
4707 (list (completing-read "Action: " gnus-mime-action-alist nil t)))
4708 (gnus-article-check-buffer)
4709 (let ((action-pair (assoc action gnus-mime-action-alist)))
4713 (defun gnus-article-part-wrapper (n function)
4714 (let ((window (get-buffer-window gnus-article-buffer 'visible))
4717 ;; It is necessary to select the article window so that
4718 ;; `gnus-article-goto-part' may really move the point.
4720 (gnus-select-frame-set-input-focus (window-frame window))
4724 (when (> n (length gnus-article-mime-handle-alist))
4726 (gnus-article-goto-part n)
4727 (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
4729 (gnus-select-frame-set-input-focus frame)))))
4731 (defun gnus-article-pipe-part (n)
4734 (gnus-article-part-wrapper n 'mm-pipe-part))
4736 (defun gnus-article-save-part (n)
4739 (gnus-article-part-wrapper n 'mm-save-part))
4741 (defun gnus-article-interactively-view-part (n)
4744 (gnus-article-part-wrapper n 'mm-interactively-view-part))
4746 (defun gnus-article-copy-part (n)
4749 (gnus-article-part-wrapper n 'gnus-mime-copy-part))
4751 (defun gnus-article-view-part-as-charset (n)
4755 (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
4757 (defun gnus-article-view-part-externally (n)
4760 (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
4762 (defun gnus-article-inline-part (n)
4765 (gnus-article-part-wrapper n 'gnus-mime-inline-part))
4767 (defun gnus-article-mime-match-handle-first (condition)
4769 (let ((alist gnus-article-mime-handle-alist) ihandle n)
4781 (gnus-article-goto-part (car ihandle))
4787 (defun gnus-article-view-part (&optional n)
4791 (set-buffer gnus-article-buffer)
4792 (or (numberp n) (setq n (gnus-article-mime-match-handle-first
4793 gnus-article-mime-match-handle-function)))
4794 (when (> n (length gnus-article-mime-handle-alist))
4796 (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
4797 (when (gnus-article-goto-part n)
4799 (gnus-article-press-button)
4800 (when (eq (gnus-mm-display-part handle) 'internal)
4801 (gnus-set-window-start)))))))
4803 (defsubst gnus-article-mime-total-parts ()
4804 (if (bufferp (car gnus-article-mime-handles))
4806 (1- (length gnus-article-mime-handles))))
4808 (defun gnus-mm-display-part (handle)
4810 (let ((id (get-text-property (point) 'gnus-part))
4816 (mail-parse-charset gnus-newsgroup-charset)
4817 (mail-parse-ignored-charsets
4818 (if (gnus-buffer-live-p gnus-summary-buffer)
4820 (set-buffer gnus-summary-buffer)
4821 gnus-newsgroup-ignored-charsets)
4825 (let ((win (gnus-get-buffer-window (current-buffer) t))
4835 (narrow-to-region (point)
4838 ;; We narrow to the part itself and
4842 (narrow-to-region (point) (point-max))
4843 (gnus-treat-article
4845 (gnus-article-mime-total-parts)
4850 (gnus-delete-line)
4851 (gnus-insert-mime-button
4855 (defun gnus-article-goto-part (n)
4856 "Go to MIME part N."
4857 (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
4859 (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
4860 (let ((gnus-tmp-name
4861 (or (mail-content-type-get (mm-handle-type handle) 'name)
4862 (mail-content-type-get (mm-handle-disposition handle) 'filename)
4863 (mail-content-type-get (mm-handle-type handle) 'url)
4865 (gnus-tmp-type (mm-handle-media-type handle))
4866 (gnus-tmp-description
4867 (mail-decode-encoded-word-string (or (mm-handle-description handle)
4869 (gnus-tmp-dots
4873 (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
4875 gnus-tmp-type-long b e)
4876 (when (string-match ".*/" gnus-tmp-name)
4877 (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
4878 (setq gnus-tmp-type-long (concat gnus-tmp-type
4879 (and (not (equal gnus-tmp-name ""))
4880 (concat "; " gnus-tmp-name))))
4881 (unless (equal gnus-tmp-description "")
4882 (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
4886 (gnus-eval-format
4887 gnus-mime-button-line-format gnus-mime-button-line-format-alist
4888 `(,@(gnus-local-map-property gnus-mime-button-map)
4889 gnus-callback gnus-mm-display-part
4890 gnus-part ,gnus-tmp-id
4892 gnus-data ,handle))
4900 :action 'gnus-widget-press-button
4901 :button-keymap gnus-mime-button-map
4904 ;; Needed to properly clear the message due to a bug in
4910 (aref gnus-mouse-2 0)
4915 (with-current-buffer (gnus-overlay-buffer overlay)
4916 (widget-get (widget-at (gnus-overlay-start overlay))
4920 (aref gnus-down-mouse-3 0))))))
4922 (defun gnus-widget-press-button (elems el)
4924 (gnus-article-press-button))
4926 (defvar gnus-displaying-mime nil)
4928 (defun gnus-display-mime (&optional ihandles)
4932 (let ((window (get-buffer-window gnus-article-buffer))
4936 ;; We have to do this since selecting the window
4943 ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
4944 (when gnus-article-emulate-mime
4946 (gnus-article-emulate-mime
4949 (not gnus-displaying-mime))
4951 (when gnus-article-mime-handles
4952 (mm-destroy-parts gnus-article-mime-handles)
4953 (setq gnus-article-mime-handle-alist nil));; A trick.
4954 (setq gnus-article-mime-handles handles)
4955 ;; We allow users to glean info from the handles.
4956 (when gnus-article-mime-part-function
4957 (gnus-mime-part-function handles)))
4963 (not gnus-displaying-mime))
4967 (let ((gnus-displaying-mime t))
4968 (gnus-mime-display-part handles)))
4971 (narrow-to-region (point) (point-max))
4972 (gnus-treat-article nil 1 1)
4979 (narrow-to-region (point-min) (point))
4980 (gnus-article-save-original-date
4981 (gnus-treat-article 'head)))))))
4987 (defcustom gnus-mime-display-multipart-as-mixed nil
4991 `gnus-mime-display-multipart-alternative-as-mixed' and
4992 `gnus-mime-display-multipart-related-as-mixed'."
4993 :group 'gnus-article-mime
4996 (defcustom gnus-mime-display-multipart-alternative-as-mixed nil
4999 :group 'gnus-article-mime
5002 (defcustom gnus-mime-display-multipart-related-as-mixed nil
5009 :group 'gnus-article-mime
5012 (defun gnus-mime-display-part (handle)
5018 (gnus-mime-display-single handle))
5020 ((cdr (assoc (car handle) gnus-mime-multipart-functions))
5021 (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
5025 (not (or gnus-mime-display-multipart-as-mixed
5026 gnus-mime-display-multipart-alternative-as-mixed)))
5027 (let ((id (1+ (length gnus-article-mime-handle-alist))))
5028 (push (cons id handle) gnus-article-mime-handle-alist)
5029 (gnus-mime-display-alternative (cdr handle) nil nil id)))
5032 (not (or gnus-mime-display-multipart-as-mixed
5033 gnus-mime-display-multipart-related-as-mixed)))
5035 ;;;!!!to the first part.
5036 ;;(gnus-mime-display-part (cadr handle))
5038 ;;;!!! Unfortunately we are unable to let W3 display those
5040 ;;(gnus-mime-display-mixed (cdr handle))
5042 (gnus-mime-display-part (cadr handle)))
5044 (gnus-add-wash-type 'signed)
5045 (gnus-mime-display-security handle))
5047 (gnus-add-wash-type 'encrypted)
5048 (gnus-mime-display-security handle))
5051 (gnus-mime-display-mixed (cdr handle)))))
5053 (defun gnus-mime-part-function (handles)
5055 (mapcar 'gnus-mime-part-function (cdr handles))
5056 (funcall gnus-article-mime-part-function handles)))
5058 (defun gnus-mime-display-mixed (handles)
5059 (mapcar 'gnus-mime-display-part handles))
5061 (defun gnus-mime-display-single (handle)
5063 (ignored gnus-ignored-mime-types)
5086 (let ((id (1+ (length gnus-article-mime-handle-alist)))
5088 (push (cons id handle) gnus-article-mime-handle-alist)
5097 (not (gnus-unbuttonized-mime-type-p type)))
5098 (gnus-insert-mime-button
5100 (gnus-article-insert-newline)
5109 (let ((mail-parse-charset gnus-newsgroup-charset)
5110 (mail-parse-ignored-charsets
5112 (set-buffer gnus-summary-buffer)
5114 gnus-newsgroup-ignored-charsets)))
5121 (gnus-article-insert-newline)
5124 (let ((charset (mail-content-type-get (mm-handle-type handle)
5128 ((eq charset 'gnus-decoded)
5137 (narrow-to-region beg (point))
5138 (gnus-treat-article
5140 (gnus-article-mime-total-parts)
5143 (defun gnus-unbuttonized-mime-type-p (type)
5144 "Say whether TYPE is to be unbuttonized."
5145 (unless gnus-inhibit-mime-unbuttonizing
5147 (let ((types gnus-unbuttonized-mime-types))
5152 (let ((types gnus-buttonized-mime-types))
5157 (defun gnus-article-insert-newline ()
5159 (gnus-put-text-property
5160 (point) (progn (insert "\n") (point)) 'gnus-undeletable t))
5162 (defun gnus-mime-display-alternative (handles &optional preferred ibegend id)
5170 (narrow-to-region (car ibegend)
5184 (not (gnus-unbuttonized-mime-type-p
5186 (gnus-add-text-properties
5191 `(gnus-callback
5194 (setq gnus-article-mime-handle-alist
5195 ',gnus-article-mime-handle-alist))
5196 (gnus-mime-display-alternative
5198 ,@(gnus-local-map-property gnus-mime-button-map)
5199 ,gnus-mouse-face-prop ,gnus-article-mouse-face
5200 face ,gnus-article-button-face
5201 gnus-part ,id
5204 :action 'gnus-widget-press-button
5205 :button-keymap gnus-widget-button-keymap)
5208 (gnus-add-text-properties
5215 `(gnus-callback
5218 (setq gnus-article-mime-handle-alist
5219 ',gnus-article-mime-handle-alist))
5220 (gnus-mime-display-alternative
5222 ,@(gnus-local-map-property gnus-mime-button-map)
5223 ,gnus-mouse-face-prop ,gnus-article-mouse-face
5224 face ,gnus-article-button-face
5225 gnus-part ,id
5226 gnus-data ,handle))
5228 :action 'gnus-widget-press-button
5229 :button-keymap gnus-widget-button-keymap)
5234 (gnus-display-mime preferred)
5235 (let ((mail-parse-charset gnus-newsgroup-charset)
5236 (mail-parse-ignored-charsets
5237 (save-excursion (set-buffer gnus-summary-buffer)
5238 gnus-newsgroup-ignored-charsets)))
5243 (narrow-to-region (car begend) (point-max))
5244 (gnus-treat-article
5245 nil (length gnus-article-mime-handle-alist)
5246 (gnus-article-mime-total-parts)
5253 (defconst gnus-article-wash-status-strings
5278 representing the particular washing function, ON is the string to use
5280 is the string to use when it is inactive.")
5282 (defun gnus-article-wash-status-entry (key value)
5283 (let ((entry (assoc key gnus-article-wash-status-strings)))
5286 (defun gnus-article-wash-status ()
5289 (set-buffer gnus-article-buffer)
5290 (let ((cite (memq 'cite gnus-article-wash-types))
5291 (headers (memq 'headers gnus-article-wash-types))
5292 (boring (memq 'boring-headers gnus-article-wash-types))
5293 (pgp (memq 'pgp gnus-article-wash-types))
5294 (pem (memq 'pem gnus-article-wash-types))
5295 (signed (memq 'signed gnus-article-wash-types))
5296 (encrypted (memq 'encrypted gnus-article-wash-types))
5297 (signature (memq 'signature gnus-article-wash-types))
5298 (overstrike (memq 'overstrike gnus-article-wash-types))
5299 (emphasis (memq 'emphasis gnus-article-wash-types)))
5301 (gnus-article-wash-status-entry 'cite cite)
5302 (gnus-article-wash-status-entry 'headers (or headers boring))
5303 (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted))
5304 (gnus-article-wash-status-entry 'signature signature)
5305 (gnus-article-wash-status-entry 'overstrike overstrike)
5306 (gnus-article-wash-status-entry 'emphasis emphasis)))))
5308 (defun gnus-add-wash-type (type)
5309 "Add a washing of TYPE to the current status."
5310 (add-to-list 'gnus-article-wash-types type))
5312 (defun gnus-delete-wash-type (type)
5313 "Add a washing of TYPE to the current status."
5314 (setq gnus-article-wash-types (delq type gnus-article-wash-types)))
5316 (defun gnus-add-image (category image)
5317 "Add IMAGE of CATEGORY to the list of displayed images."
5318 (let ((entry (assq category gnus-article-image-alist)))
5321 (push entry gnus-article-image-alist))
5324 (defun gnus-delete-images (category)
5326 (let ((entry (assq category gnus-article-image-alist)))
5328 (gnus-remove-image image category))
5329 (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
5330 (gnus-delete-wash-type category)))
5332 (defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
5334 (defun gnus-article-maybe-hide-headers ()
5335 "Hide unwanted headers if `gnus-have-all-headers' is nil.
5337 (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
5338 (not (save-excursion (set-buffer gnus-summary-buffer)
5339 gnus-have-all-headers)))
5340 (not gnus-inhibit-hiding))
5341 (gnus-article-hide-headers)))
5345 (defun gnus-output-to-file (file-name)
5346 "Append the current article to a file named FILE-NAME.
5347 If `gnus-article-save-coding-system' is non-nil, it is used to encode
5348 text and used as the value of the coding cookie which is added to the
5353 (coding gnus-article-save-coding-system)
5371 ;; save it to file.
5375 ;; If the coding system is not suitable to encode the text,
5392 (message "Appended to %s" file-name))
5396 (defun gnus-narrow-to-page (&optional arg)
5397 "Narrow the article buffer to a page.
5402 (set-buffer gnus-article-buffer)
5406 (when (gnus-visual-p 'page-marker)
5408 (gnus-remove-text-with-property 'gnus-prev)
5409 (gnus-remove-text-with-property 'gnus-next)))
5418 (setq gnus-page-broken
5420 (when gnus-page-broken
5421 (narrow-to-region
5426 (when (and (gnus-visual-p 'page-marker)
5430 (gnus-insert-prev-page-button)))
5431 (when (and (gnus-visual-p 'page-marker)
5435 (gnus-insert-next-page-button))))))
5439 (defun gnus-article-goto-next-page ()
5442 (when (gnus-article-next-page)
5444 (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
5447 (defun gnus-article-goto-prev-page ()
5451 (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
5452 (gnus-article-prev-page nil)))
5454 ;; This is cleaner but currently breaks `gnus-pick-mode':
5456 ;; (defun gnus-article-goto-next-page ()
5459 ;; (gnus-eval-in-buffer-window gnus-summary-buffer
5460 ;; (gnus-summary-next-page)))
5462 ;; (defun gnus-article-goto-prev-page ()
5465 ;; (gnus-eval-in-buffer-window gnus-summary-buffer
5466 ;; (gnus-summary-prev-page)))
5468 (defun gnus-article-next-page (&optional lines)
5471 Argument LINES specifies lines to be scrolled up."
5473 (move-to-window-line -1)
5479 (if (or (not gnus-page-broken)
5486 (when gnus-article-over-scroll
5487 (gnus-article-next-page-1 lines))
5489 (gnus-narrow-to-page 1) ;Go to next page.
5492 (gnus-article-next-page-1 lines)
5495 (defmacro gnus-article-beginning-of-window ()
5496 "Move point to the beginning of the window.
5500 '(move-to-window-line 0)
5501 '(move-to-window-line
5509 (defun gnus-article-next-page-1 (lines)
5526 (gnus-article-beginning-of-window))
5528 (defun gnus-article-prev-page (&optional lines)
5530 Argument LINES specifies lines to be scrolled down."
5532 (move-to-window-line 0)
5533 (if (and gnus-page-broken
5537 (gnus-narrow-to-page -1) ;Go to previous page.
5546 (gnus-article-beginning-of-window))))
5548 (defun gnus-article-only-boring-p ()
5551 not have a face in `gnus-article-boring-faces'."
5552 (when (and gnus-article-skip-boring
5553 (boundp 'gnus-article-boring-faces)
5554 (symbol-value 'gnus-article-boring-faces))
5560 (when (not (gnus-intersection
5561 (gnus-faces-at (point))
5562 (symbol-value 'gnus-article-boring-faces)))
5566 (defun gnus-article-refer-article ()
5570 (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
5571 (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
5572 (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
5574 (set-buffer gnus-summary-buffer)
5575 (gnus-summary-refer-article msg-id))
5578 (defun gnus-article-show-summary ()
5579 "Reconfigure windows to show summary buffer."
5581 (if (not (gnus-buffer-live-p gnus-summary-buffer))
5582 (error "There is no summary buffer for this article buffer")
5583 (gnus-article-set-globals)
5584 (gnus-configure-windows 'article)
5585 (gnus-summary-goto-subject gnus-current-article)
5586 (gnus-summary-position-point)))
5588 (defun gnus-article-describe-briefly ()
5591 (gnus-message 6 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
5593 (defun gnus-article-summary-command ()
5594 "Execute the last keystroke in the summary buffer."
5599 (switch-to-buffer gnus-article-current-summary 'norecord)
5606 (defun gnus-article-summary-command-nosave ()
5607 "Execute the last keystroke in the summary buffer."
5610 (pop-to-buffer gnus-article-current-summary 'norecord)
5614 (defun gnus-article-check-buffer ()
5616 (unless (equal major-mode 'gnus-article-mode)
5619 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
5620 "Read a summary buffer key sequence and execute it from the article buffer."
5622 (gnus-article-check-buffer)
5631 (up-to-top
5635 (set-buffer gnus-article-current-summary)
5636 (let (gnus-pick-mode)
5639 (events-to-keys (read-key-sequence nil))
5649 (pop-to-buffer gnus-article-current-summary 'norecord)
5651 (let (gnus-pick-mode)
5657 (set-buffer gnus-article-current-summary))
5661 (pop-to-buffer gnus-article-buffer 'norecord)))
5668 (pop-to-buffer gnus-article-current-summary 'norecord))
5669 ((setq win (get-buffer-window gnus-article-current-summary))
5672 (switch-to-buffer gnus-article-current-summary 'norecord)))
5675 (if (and (setq func (let (gnus-pick-mode)
5685 (setq selected (gnus-summary-select-article))
5703 (defun gnus-article-describe-key (key)
5706 (gnus-article-check-buffer)
5707 (if (eq (key-binding key) 'gnus-article-read-summary-keys)
5709 (set-buffer gnus-article-current-summary)
5710 (let (gnus-pick-mode)
5714 (setq key (events-to-keys
5719 (string-to-list key)))
5724 (defun gnus-article-describe-key-briefly (key &optional insert)
5727 (gnus-article-check-buffer)
5728 (if (eq (key-binding key) 'gnus-article-read-summary-keys)
5730 (set-buffer gnus-article-current-summary)
5731 (let (gnus-pick-mode)
5735 (setq key (events-to-keys
5740 (string-to-list key)))
5745 (defun gnus-article-reply-with-original (&optional wide)
5746 "Start composing a reply mail to the current message.
5750 (let ((article (cdr gnus-article-current))
5752 (if (not (gnus-mark-active-p))
5753 (with-current-buffer gnus-summary-buffer
5754 (gnus-summary-reply (list (list article)) wide))
5760 (with-current-buffer gnus-summary-buffer
5761 (gnus-summary-reply
5764 (defun gnus-article-followup-with-original ()
5765 "Compose a followup to the current article.
5769 (let ((article (cdr gnus-article-current))
5771 (if (not (gnus-mark-active-p))
5772 (with-current-buffer gnus-summary-buffer
5773 (gnus-summary-followup (list (list article))))
5779 (with-current-buffer gnus-summary-buffer
5780 (gnus-summary-followup
5783 (defun gnus-article-hide (&optional arg force)
5788 (interactive (append (gnus-article-hidden-arg) (list 'force)))
5789 (gnus-article-hide-headers arg)
5790 (gnus-article-hide-list-identifiers arg)
5791 (gnus-article-hide-citation-maybe arg force)
5792 (gnus-article-hide-signature arg))
5794 (defun gnus-article-maybe-highlight ()
5796 (when (gnus-visual-p 'article-highlight 'highlight)
5797 (gnus-article-highlight-some)))
5799 (defun gnus-check-group-server ()
5800 ;; Make sure the connection to the server is alive.
5801 (unless (gnus-server-opened
5802 (gnus-find-method-for-group gnus-newsgroup-name))
5803 (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
5804 (gnus-request-group gnus-newsgroup-name t)))
5809 (defun gnus-request-article-this-buffer (article group)
5815 (gnus-kill-all-overlays)
5816 (setq group (or group gnus-newsgroup-name))
5818 ;; Using `gnus-request-article' directly will insert the article into
5819 ;; `nntp-server-buffer' - so we'll save some time by not having to
5823 ;; headers for it, so we'll have to get those.
5825 (gnus-read-header article))
5831 gnus-summary-buffer
5832 (get-buffer gnus-summary-buffer)
5833 (gnus-buffer-exists-p gnus-summary-buffer))
5835 (set-buffer gnus-summary-buffer)
5836 (let ((header (gnus-summary-article-header article)))
5839 ((memq article gnus-newsgroup-sparse)
5842 (setq article (mail-header-id header))
5843 (setq sparse-header (gnus-read-header article))
5844 (setq gnus-newsgroup-sparse
5845 (delq article gnus-newsgroup-sparse)))
5848 (setq article (mail-header-id header)))
5852 (gnus-request-pseudo-article header))))
5854 (let ((method (gnus-find-method-for-group
5855 gnus-newsgroup-name)))
5859 (mail-header-id header))))
5863 (gnus-group-enter-directory dir))))))))
5866 ;; Refuse to select canceled articles.
5868 gnus-summary-buffer
5869 (get-buffer gnus-summary-buffer)
5870 (gnus-buffer-exists-p gnus-summary-buffer)
5872 (set-buffer gnus-summary-buffer)
5873 (assq article gnus-newsgroup-reads)))
5874 gnus-canceled-mark))
5876 ;; We first check `gnus-original-article-buffer'.
5877 ((and (get-buffer gnus-original-article-buffer)
5880 (set-buffer gnus-original-article-buffer)
5881 (and (equal (car gnus-original-article) group)
5882 (eq (cdr gnus-original-article) article))))
5883 (insert-buffer-substring gnus-original-article-buffer)
5886 ((and gnus-keep-backlog
5887 (gnus-backlog-request-article group article (current-buffer)))
5890 ((gnus-async-request-fetched-article group article (current-buffer))
5891 (gnus-async-prefetch-next group article gnus-summary-buffer)
5892 (when (and (numberp article) gnus-keep-backlog)
5893 (gnus-backlog-enter-article group article (current-buffer)))
5896 ((and gnus-use-cache
5898 (gnus-cache-request-article article group))
5901 ((gnus-agent-request-article article group)
5906 (let ((gnus-override-method gnus-override-method)
5908 gnus-refer-article-method))
5909 (backend (car (gnus-find-method-for-group
5910 gnus-newsgroup-name)))
5917 (when (and (null gnus-override-method)
5919 (setq gnus-override-method (pop methods)))
5921 (when (eq gnus-override-method 'current)
5922 (setq gnus-override-method
5923 (with-current-buffer gnus-summary-buffer
5924 gnus-current-select-method)))
5926 (gnus-kill-all-overlays)
5927 (let ((gnus-newsgroup-name group))
5928 (gnus-check-group-server))
5930 ((gnus-request-article article group (current-buffer))
5932 (gnus-async-prefetch-next group article
5933 gnus-summary-buffer)
5934 (when gnus-keep-backlog
5935 (gnus-backlog-enter-article
5939 (setq gnus-override-method (pop methods)))
5949 ;; Associate this article with the current summary buffer.
5950 (setq gnus-article-current-summary gnus-summary-buffer)
5953 ;; and place it in the buffer it's supposed to be in.
5954 (when (and (get-buffer gnus-article-buffer)
5956 (buffer-name (get-buffer gnus-article-buffer))))
5958 (if (get-buffer gnus-original-article-buffer)
5959 (set-buffer gnus-original-article-buffer)
5960 (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
5962 (setq major-mode 'gnus-original-article-mode)
5966 (insert-buffer-substring gnus-article-buffer))
5967 (setq gnus-original-article (cons group article)))
5970 (run-hooks 'gnus-article-decode-hook)
5972 (setq gnus-article-decoded-p gnus-article-decode-hook))
5979 (set-buffer gnus-summary-buffer)
5980 (gnus-summary-update-article do-update-line sparse-header)
5981 (gnus-summary-goto-subject do-update-line nil t)
5982 (set-window-point (gnus-get-buffer-window (current-buffer) t)
5990 (defcustom gnus-article-edit-mode-hook nil
5992 :group 'gnus-article-various
5995 (defvar gnus-article-edit-done-function nil)
5997 (defvar gnus-article-edit-mode-map nil)
5998 (defvar gnus-article-edit-mode nil)
6001 (unless gnus-article-edit-mode-map
6002 (setq gnus-article-edit-mode-map (make-keymap))
6003 (set-keymap-parent gnus-article-edit-mode-map text-mode-map)
6005 (gnus-define-keys gnus-article-edit-mode-map
6007 "\C-c\C-c" gnus-article-edit-done
6008 "\C-c\C-k" gnus-article-edit-exit
6009 "\C-c\C-f\C-t" message-goto-to
6015 "\C-c\C-f\C-r" message-goto-reply-to
6018 "\C-c\C-f\C-f" message-goto-followup-to
6019 "\C-c\C-f\C-m" message-goto-mail-followup-to
6021 "\C-c\C-f\C-u" message-goto-summary
6023 "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to
6027 "\C-c\C-t" message-insert-to
6032 "\C-c\C-z" message-kill-to-signature
6039 (gnus-define-keys (gnus-article-edit-wash-map
6040 "\C-c\C-w" gnus-article-edit-mode-map)
6041 "f" gnus-article-edit-full-stops))
6044 gnus-article-edit-mode-field-menu gnus-article-edit-mode-map ""
6046 ["Fetch To" message-insert-to t]
6049 ["To" message-goto-to t]
6053 ["Reply-To" message-goto-reply-to t]
6054 ["Summary" message-goto-summary t]
6057 ["Followup-To" message-goto-followup-to t]
6058 ["Mail-Followup-To" message-goto-mail-followup-to t]
6063 (define-derived-mode gnus-article-edit-mode message-mode "Article Edit"
6067 \\{gnus-article-edit-mode-map}"
6068 (make-local-variable 'gnus-article-edit-done-function)
6069 (make-local-variable 'gnus-prev-winconf)
6072 (set (make-local-variable 'mail-header-separator) "")
6073 (set (make-local-variable 'gnus-article-edit-mode) t)
6080 (defun gnus-article-edit (&optional force)
6082 This will have permanent effect only in mail groups.
6087 (gnus-group-read-only-p))
6089 (gnus-article-date-original)
6090 (gnus-article-edit-article
6094 (gnus-summary-edit-article-done
6095 ,(or (mail-header-references gnus-current-headers) "")
6096 ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
6098 (defun gnus-article-edit-article (start-func exit-func)
6101 (set-buffer gnus-article-buffer)
6105 (gnus-article-edit-mode))
6108 (gnus-configure-windows 'edit-article)
6109 (setq gnus-article-edit-done-function exit-func)
6110 (setq gnus-prev-winconf winconf)
6111 (gnus-message 6 "C-c C-c to end edits")))
6113 (defun gnus-article-edit-done (&optional arg)
6116 (let ((func gnus-article-edit-done-function)
6120 (winconf gnus-prev-winconf))
6124 ;; The cache and backlog have to be flushed somewhat.
6125 (when gnus-keep-backlog
6126 (gnus-backlog-remove-article
6127 (car gnus-article-current) (cdr gnus-article-current)))
6130 (when (get-buffer gnus-original-article-buffer)
6131 (set-buffer gnus-original-article-buffer)
6132 (setq gnus-original-article nil)))
6133 (when gnus-use-cache
6134 (gnus-cache-update-article
6135 (car gnus-article-current) (cdr gnus-article-current)))
6138 (gnus-set-text-properties (point-min) (point-max) nil)
6139 (gnus-article-mode)
6144 (gnus-summary-show-article))
6146 (defun gnus-article-edit-exit ()
6155 (if (gnus-buffer-live-p gnus-original-article-buffer)
6156 (insert-buffer-substring gnus-original-article-buffer))
6157 (let ((winconf gnus-prev-winconf))
6159 (gnus-article-mode)
6161 ;; Tippy-toe some to make sure that point remains where it was.
6166 (gnus-summary-show-article)))
6168 (defun gnus-article-edit-full-stops ()
6185 (defcustom gnus-button-url-regexp
6190 :group 'gnus-article-buttons
6193 (defcustom gnus-button-valid-fqdn-regexp
6197 :group 'gnus-article-buttons
6201 (defcustom gnus-button-valid-localpart-regexp
6203 "Regular expression that matches a localpart of mail addresses or MIDs."
6205 :group 'gnus-article-buttons
6208 (defcustom gnus-button-man-handler 'manual-entry
6209 "Function to use for displaying man pages.
6216 :group 'gnus-article-buttons)
6218 (defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
6220 If the default site is too slow, try to find a CTAN mirror, see
6222 the variable `gnus-button-handle-ctan'."
6224 :group 'gnus-article-buttons
6225 :link '(custom-manual "(gnus)Group Parameters")
6231 (defcustom gnus-button-ctan-handler 'browse-url
6232 "Function to use for displaying CTAN links.
6237 :group 'gnus-article-buttons)
6239 (defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
6242 :group 'gnus-article-buttons
6246 (defcustom gnus-button-ctan-directory-regexp
6253 It should match all directories in the top level of `gnus-ctan-url'."
6255 :group 'gnus-article-buttons
6258 (defcustom gnus-button-mid-or-mail-regexp
6259 (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@"
6260 gnus-button-valid-fqdn-regexp
6262 "Regular expression that matches a message ID or a mail address."
6264 :group 'gnus-article-buttons
6267 (defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic
6268 "What to do when the button on a string as \"foo123@bar.invalid\" is pushed.
6269 Strings like this can be either a message ID or a mail address. If it is one
6270 of the symbols `mid' or `mail', Gnus will always assume that the string is a
6271 message ID or a mail address, respectively. If this variable is set to the
6274 must return `mid', `mail', `invalid' or `ask'."
6276 :group 'gnus-article-buttons
6278 gnus-button-mid-or-mail-heuristic)
6281 (const mail)))
6283 (defcustom gnus-button-mid-or-mail-heuristic-alist
6311 ;; compensation for TDMA dated mail addresses:
6335 "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
6337 A negative RATE indicates a message IDs, whereas a positive indicates a mail
6338 address. The REGEXP is processed with `case-fold-search' set to nil."
6340 :group 'gnus-article-buttons
6344 (defun gnus-button-mid-or-mail-heuristic (mid-or-mail)
6345 "Guess whether MID-OR-MAIL is a message ID or a mail address.
6346 Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail
6349 (list gnus-button-mid-or-mail-heuristic-alist)
6352 (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1")))
6353 (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen)
6360 mid-or-mail)
6361 (gnus-message 8 "`%s' is a known mail address." mid-or-mail)
6362 (setq result 'mail))
6363 (when (string-match "@.*@\\| " mid-or-mail)
6364 (gnus-message 8 "`%s' is invalid." mid-or-mail)
6366 ;; Nothing more to do, if result is not a number here...
6373 (when (string-match regexp mid-or-mail)
6375 (gnus-message
6377 mid-or-mail regexp rate result)))
6380 (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'."
6381 mid-or-mail result))
6383 (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail)
6385 ((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail)
6386 ;; Long local part should contain realname if e-mail address,
6391 (gnus-message
6393 mid-or-mail rate result))
6395 mid-or-mail)
6398 (gnus-message
6400 mid-or-mail -5.0 result))
6403 (gnus-message
6404 9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result)))))
6405 (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result)
6411 ((> result 10.0) 'mail)
6414 (defun gnus-button-handle-mid-or-mail (mid-or-mail)
6415 (let* ((pref gnus-button-prefer-mid-or-mail) guessed
6416 (url-mid (concat "news" ":" mid-or-mail))
6417 (url-mailto (concat "mailto" ":" mid-or-mail)))
6418 (gnus-message 9 "mid-or-mail=%s" mid-or-mail)
6423 (gnus-replace-in-string mid-or-mail "^<\\|>$" "")))
6424 (if (or (eq 'mid guessed) (eq 'mail guessed))
6429 (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? "))
6430 (setq pref 'mail)
6433 (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid)
6434 (gnus-button-handle-news url-mid))
6435 ((eq pref 'mail)
6436 (gnus-message 8 "calling `gnus-url-mailto' %s" url-mailto)
6437 (gnus-url-mailto url-mailto))
6438 (t (gnus-message 3 "Invalid string.")))))
6440 (defun gnus-button-handle-custom (url)
6442 (customize-apropos (gnus-url-unhex-string url)))
6444 (defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
6449 (defun gnus-button-handle-describe-function (url)
6453 (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
6455 (defun gnus-button-handle-describe-variable (url)
6459 (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
6461 (defun gnus-button-handle-symbol (url)
6468 (t (gnus-message 3 "`%s' is not a known function of variable." url)))))
6470 (defun gnus-button-handle-describe-key (url)
6473 (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))
6477 (gnus-message 3 "Invalid key sequence in button: %s" key-string))))
6479 (defun gnus-button-handle-apropos (url)
6481 (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
6483 (defun gnus-button-handle-apropos-command (url)
6486 (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
6488 (defun gnus-button-handle-apropos-variable (url)
6492 (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
6494 (defun gnus-button-handle-apropos-documentation (url)
6498 (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
6500 (defun gnus-button-handle-library (url)
6502 (gnus-message 9 "url=`%s'" url)
6504 (file (gnus-replace-in-string (or lib "") "\.elc" ".el")))
6506 (gnus-message 1 "Cannot locale library `%s'." url)
6509 (defun gnus-button-handle-ctan (url)
6512 gnus-button-ctan-handler
6514 gnus-ctan-url
6515 (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp ""))))
6517 (defcustom gnus-button-tex-level 5
6520 positives are possible. Note that you can set this variable local to
6522 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
6523 how to set variables in specific groups."
6525 :group 'gnus-article-buttons
6526 :link '(custom-manual "(gnus)Group Parameters")
6529 (defcustom gnus-button-man-level 5
6532 positives are possible. Note that you can set this variable local to
6534 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
6535 how to set variables in specific groups."
6537 :group 'gnus-article-buttons
6538 :link '(custom-manual "(gnus)Group Parameters")
6541 (defcustom gnus-button-emacs-level 5
6544 positives are possible. Note that you can set this variable local to
6546 probably a good idea. See Info node `(gnus)Group Parameters' and the variable
6547 `gnus-parameters' on how to set variables in specific groups."
6549 :group 'gnus-article-buttons
6550 :link '(custom-manual "(gnus)Group Parameters")
6553 (defcustom gnus-button-message-level 5
6554 "*Integer that says how many buttons for news or mail messages will appear.
6557 ;; mail addresses, MIDs, URLs for news, ...
6559 :group 'gnus-article-buttons
6562 (defcustom gnus-button-browse-level 5
6566 ;; stuff handled by `browse-url' or `gnus-button-embedded-url'
6568 :group 'gnus-article-buttons
6571 (defcustom gnus-button-alist
6573 0 (>= gnus-button-message-level 0) gnus-button-handle-news 3)
6575 gnus-button-valid-localpart-regexp "@[a-z0-9.-]+[a-z]\\)")
6576 0 t gnus-button-handle-news 2)
6578 1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
6580 0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
6583 0 (>= gnus-button-message-level 0) gnus-button-message-id 2)
6585 2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
6587 0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
6590 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
6592 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
6595 gnus-button-ctan-directory-regexp
6597 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
6599 gnus-button-ctan-directory-regexp
6601 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1)
6604 gnus-button-ctan-directory-regexp
6606 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
6609 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
6612 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1)
6615 1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2)
6617 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
6620 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
6623 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2)
6625 (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1)
6629 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1)
6631 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1)
6633 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
6635 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
6636 ;; The following entries may lead to many false positives so don't enable
6640 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
6642 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
6643 ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
6644 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
6646 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
6648 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
6650 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1)
6652 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
6654 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
6656 ;; Unlike the other regexps we really have to require quoting
6657 ;; here to determine where it ends.
6658 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
6661 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6664 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6667 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6669 (gnus-button-url-regexp
6670 0 (>= gnus-button-browse-level 0) browse-url 0)
6673 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
6674 gnus-button-handle-man 1)
6677 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
6678 gnus-button-handle-man 1)
6682 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
6683 ;; MID or mail: To avoid too many false positives we don't try to catch
6684 ;; all kind of allowed MIDs or mail addresses. Domain part must contain
6686 ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist'
6688 (gnus-button-mid-or-mail-regexp
6689 0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1))
6694 also be Lisp expression evaluating to a string),
6696 FORM: is a Lisp expression which must eval to true for the button to
6698 CALLBACK: is the function to call when the user push this button, and each
6699 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
6703 :group 'gnus-article-buttons
6712 (defcustom gnus-header-button-alist
6714 0 (>= gnus-button-message-level 0) gnus-button-message-id 0)
6716 1 (>= gnus-button-message-level 0) gnus-button-reply 1)
6718 0 (>= gnus-button-message-level 0) gnus-msg-mail 0)
6719 ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp
6720 0 (>= gnus-button-browse-level 0) browse-url 0)
6721 ("^Subject:" gnus-button-url-regexp
6722 0 (>= gnus-button-browse-level 0) browse-url 0)
6723 ("^[^:]+:" gnus-button-url-regexp
6724 0 (>= gnus-button-browse-level 0) browse-url 0)
6726 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
6728 1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
6729 "*Alist of headers and regexps to match buttons in article heads.
6731 This alist is very similar to `gnus-button-alist', except that each
6736 HEADER is a regexp to match a header. For a fuller explanation, see
6737 `gnus-button-alist'."
6738 :group 'gnus-article-buttons
6739 :group 'gnus-article-headers
6751 (defun gnus-article-push-button (event)
6753 If the text under the mouse pointer has a `gnus-callback' property,
6754 call it with the value of the `gnus-data' text property."
6758 (data (get-text-property pos 'gnus-data))
6759 (fun (get-text-property pos 'gnus-callback)))
6764 (defun gnus-article-press-button ()
6766 If the text at point has a `gnus-callback' property,
6767 call it with the value of the `gnus-data' text property."
6769 (let ((data (get-text-property (point) 'gnus-data))
6770 (fun (get-text-property (point) 'gnus-callback)))
6774 (defun gnus-article-highlight (&optional force)
6776 This function calls `gnus-article-highlight-headers',
6777 `gnus-article-highlight-citation',
6778 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
6781 (gnus-article-highlight-headers)
6782 (gnus-article-highlight-citation force)
6783 (gnus-article-highlight-signature)
6784 (gnus-article-add-buttons force)
6785 (gnus-article-add-buttons-to-head))
6787 (defun gnus-article-highlight-some (&optional force)
6789 This function calls `gnus-article-highlight-headers',
6790 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
6793 (gnus-article-highlight-headers)
6794 (gnus-article-highlight-signature)
6795 (gnus-article-add-buttons))
6797 (defun gnus-article-highlight-headers ()
6798 "Highlight article headers as specified by `gnus-header-face-alist'."
6801 (set-buffer gnus-article-buffer)
6803 (let ((alist gnus-header-face-alist)
6808 (article-narrow-to-head)
6827 (gnus-put-text-property from (point) 'face header-face))
6834 (gnus-put-text-property from (point) 'face field-face))))))))
6836 (defun gnus-article-highlight-signature ()
6839 `gnus-signature-separator' using the face `gnus-signature'."
6842 (set-buffer gnus-article-buffer)
6846 (when (and gnus-signature-face
6847 (gnus-article-narrow-to-signature))
6848 (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
6849 'face gnus-signature-face)
6851 (gnus-article-search-signature)
6854 (gnus-article-add-button start (1- end) 'gnus-signature-toggle
6857 (defun gnus-button-in-region-p (b e prop)
6861 (defun gnus-article-add-buttons (&optional force)
6864 specified by `gnus-button-alist'."
6867 (set-buffer gnus-article-buffer)
6871 (alist gnus-button-alist)
6875 (while (setq marker (pop gnus-button-marker-list))
6879 (when (setq entry (gnus-button-entry))
6882 'gnus-callback nil))
6884 (setq gnus-button-marker-list new-list))
6897 (not (gnus-button-in-region-p
6898 start end 'gnus-callback)))
6901 (gnus-article-add-button
6902 start end 'gnus-button-push
6904 gnus-button-marker-list))))))))))
6906 ;; Add buttons to the head of an article.
6907 (defun gnus-article-add-buttons-to-head ()
6908 "Add buttons to the head of the article."
6911 (set-buffer gnus-article-buffer)
6916 (alist gnus-header-button-alist)
6918 (article-narrow-to-head)
6939 (gnus-article-add-button
6947 (defun gnus-article-add-button (from to fun &optional data)
6949 (when gnus-article-button-face
6950 (gnus-overlay-put (gnus-make-overlay from to)
6951 'face gnus-article-button-face))
6952 (gnus-add-text-properties
6953 from to
6954 (nconc (and gnus-article-mouse-face
6955 (list gnus-mouse-face-prop gnus-article-mouse-face))
6956 (list 'gnus-callback fun)
6957 (and data (list 'gnus-data data))))
6958 (widget-convert-button 'link from to :action 'gnus-widget-press-button
6959 :button-keymap gnus-widget-button-keymap))
6963 (defun gnus-article-set-globals ()
6965 (set-buffer gnus-summary-buffer)
6966 (gnus-set-global-variables)))
6968 (defun gnus-signature-toggle (end)
6970 (set-buffer gnus-article-buffer)
6975 (gnus-delete-wash-type 'signature)
6976 (gnus-remove-text-properties-when
6979 gnus-hidden-properties))))
6980 (gnus-add-wash-type 'signature)
6981 (gnus-add-text-properties-when
6984 gnus-hidden-properties)))))
6985 (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
6986 (gnus-set-mode-line 'article))))
6988 (defun gnus-button-entry ()
6989 ;; Return the first entry in `gnus-button-alist' matching this place.
6990 (let ((alist gnus-button-alist)
6999 (defun gnus-button-push (marker)
7003 (let* ((entry (gnus-button-entry))
7008 (gnus-set-text-properties
7019 (gnus-message 1 "You must define `%S' to use this button"
7022 (defun gnus-parse-news-url (url)
7033 (string-to-number (match-string 3))
7049 (defun gnus-button-handle-news (url)
7052 (gnus-parse-news-url url)
7056 (set-buffer gnus-summary-buffer)
7058 (let ((gnus-refer-article-method
7060 gnus-refer-article-method))
7062 (gnus-message 7 "Fetching %s with %s"
7063 message-id gnus-refer-article-method)
7064 (gnus-summary-refer-article message-id))
7065 (gnus-summary-refer-article message-id))))
7067 (gnus-button-fetch-group url)))))
7069 (defun gnus-button-handle-man (url)
7071 (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
7072 (when (eq gnus-button-man-handler 'woman)
7073 (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
7074 (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
7075 (funcall gnus-button-man-handler url))
7077 (defun gnus-button-handle-info-url (url)
7082 (gnus-info-find-node
7083 (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
7085 ")" (gnus-url-unhex-string (match-string 2 url)))))
7088 (gnus-replace-in-string
7089 (gnus-replace-in-string url "[\n\t ]+" " ") "\"" ""))
7090 (gnus-info-find-node url))
7093 (defun gnus-button-handle-info-url-gnome (url)
7097 (gnus-info-find-node
7099 (gnus-url-unhex-string
7102 (or (gnus-url-unhex-string
7107 (defun gnus-button-handle-info-url-kde (url)
7109 (gnus-info-find-node (gnus-url-unhex-string url)))
7111 (defun gnus-button-handle-info-keystrokes (url)
7113 ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
7118 (defun gnus-button-message-id (message-id)
7121 (set-buffer gnus-summary-buffer)
7122 (gnus-summary-refer-article message-id)))
7124 (defun gnus-button-fetch-group (address)
7128 (gnus-group-read-ephemeral-group address gnus-select-method)
7134 (gnus-group-read-ephemeral-group
7142 (and (match-end 6) (list (string-to-number (match-string 6 address))))))))
7144 (defun gnus-url-parse-query-string (query &optional downcase)
7152 (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
7153 val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
7162 (defun gnus-url-mailto (url)
7163 ;; Send mail to someone
7166 (let (to args subject func)
7167 (setq args (gnus-url-parse-query-string
7171 (concat "to=" (match-string 1 url) "&"
7173 (concat "to=" url)))
7176 (gnus-msg-mail)
7182 (insert (gnus-replace-in-string
7190 (defun gnus-button-embedded-url (address)
7192 (browse-url (gnus-strip-whitespace address)))
7196 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
7197 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
7199 (defvar gnus-prev-page-map
7203 (set-keymap-parent map gnus-article-mode-map))
7204 (define-key map gnus-mouse-2 'gnus-button-prev-page)
7205 (define-key map "\r" 'gnus-button-prev-page)
7208 (defvar gnus-next-page-map
7212 (set-keymap-parent map gnus-article-mode-map))
7213 (define-key map gnus-mouse-2 'gnus-button-next-page)
7214 (define-key map "\r" 'gnus-button-next-page)
7217 (defun gnus-insert-prev-page-button ()
7220 (gnus-eval-format
7221 gnus-prev-page-line-format nil
7222 `(,@(gnus-local-map-property gnus-prev-page-map)
7223 gnus-prev t
7224 gnus-callback gnus-article-button-prev-page
7231 :action 'gnus-button-prev-page
7232 :button-keymap gnus-prev-page-map)))
7234 (defun gnus-button-next-page (&optional args more-args)
7235 "Go to the next page."
7238 (select-window (gnus-get-buffer-window gnus-article-buffer t))
7239 (gnus-article-next-page)
7242 (defun gnus-button-prev-page (&optional args more-args)
7243 "Go to the prev page."
7246 (select-window (gnus-get-buffer-window gnus-article-buffer t))
7247 (gnus-article-prev-page)
7250 (defun gnus-insert-next-page-button ()
7253 (gnus-eval-format gnus-next-page-line-format nil
7254 `(,@(gnus-local-map-property gnus-next-page-map)
7255 gnus-next t
7256 gnus-callback gnus-article-button-next-page
7263 :action 'gnus-button-next-page
7264 :button-keymap gnus-next-page-map)))
7266 (defun gnus-article-button-next-page (arg)
7267 "Go to the next page."
7270 (select-window (gnus-get-buffer-window gnus-article-buffer t))
7271 (gnus-article-next-page)
7274 (defun gnus-article-button-prev-page (arg)
7275 "Go to the prev page."
7278 (select-window (gnus-get-buffer-window gnus-article-buffer t))
7279 (gnus-article-prev-page)
7282 (defvar gnus-decode-header-methods
7283 '(mail-decode-encoded-word-region)
7284 "List of methods used to decode headers.
7287 is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a
7288 \(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups
7292 \((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
7293 mail-decode-encoded-word-region
7297 (defvar gnus-decode-header-methods-cache nil)
7299 (defun gnus-multi-decode-header (start end)
7300 "Apply the functions from `gnus-encoded-word-methods' that match."
7301 (unless (and gnus-decode-header-methods-cache
7302 (eq gnus-newsgroup-name
7303 (car gnus-decode-header-methods-cache)))
7304 (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
7307 (nconc gnus-decode-header-methods-cache (list x))
7308 (if (and gnus-newsgroup-name
7309 (string-match (car x) gnus-newsgroup-name))
7310 (nconc gnus-decode-header-methods-cache
7312 gnus-decode-header-methods))
7313 (let ((xlist gnus-decode-header-methods-cache))
7316 (narrow-to-region start end)
7324 (defun gnus-treat-article (condition &optional part-number total-parts type)
7326 (alist gnus-treatment-function-alist)
7327 (article-goto-body-goes-to-point-min-p t)
7331 (let ((list gnus-article-treat-types))
7335 (highlightp (gnus-visual-p 'article-highlight 'highlight))
7337 (gnus-run-hooks 'gnus-part-display-hook)
7341 (when (gnus-buffer-live-p gnus-summary-buffer)
7342 (set-buffer gnus-summary-buffer))
7346 (gnus-treat-predicate val)
7360 (defun gnus-treat-predicate (val)
7368 (apply 'gnus-or (mapcar `(lambda (s)
7369 (string-match s ,(or gnus-newsgroup-name "")))
7375 (apply 'gnus-or (mapcar 'gnus-treat-predicate val)))
7377 (apply 'gnus-and (mapcar 'gnus-treat-predicate val)))
7379 (not (gnus-treat-predicate (car val))))
7395 (defun gnus-article-encrypt-body (protocol &optional n)
7399 (or gnus-article-encrypt-protocol
7401 gnus-article-encrypt-protocol-alist
7404 (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
7407 (if (member gnus-newsgroup-name '("nndraft:delayed"
7411 gnus-newsgroup-name))
7412 (gnus-summary-iterate n
7414 (set-buffer gnus-summary-buffer)
7415 (let ((mail-parse-charset gnus-newsgroup-charset)
7416 (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
7417 (summary-buffer gnus-summary-buffer)
7419 (gnus-set-global-variables)
7420 (when (gnus-group-read-only-p)
7422 (gnus-summary-show-article t)
7424 (or (mail-header-references gnus-current-headers) ""))
7425 (set-buffer gnus-article-buffer)
7430 (message-narrow-to-head)
7434 (message-narrow-to-field)
7440 (message-narrow-to-head)
7446 (narrow-to-region point (point-max))
7448 (message-options-set 'message-sender user-mail-address)
7449 (message-options-set 'message-recipients user-mail-address)
7455 (gnus-summary-edit-article-done
7456 references nil summary-buffer t))
7457 (when gnus-keep-backlog
7458 (gnus-backlog-remove-article
7459 (car gnus-article-current) (cdr gnus-article-current)))
7461 (when (get-buffer gnus-original-article-buffer)
7462 (set-buffer gnus-original-article-buffer)
7463 (setq gnus-original-article nil)))
7464 (when gnus-use-cache
7465 (gnus-cache-update-article
7466 (car gnus-article-current) (cdr gnus-article-current))))))))
7468 (defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n"
7475 (defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n"
7482 (defvar gnus-mime-security-button-line-format-alist
7483 '((?t gnus-tmp-type ?s)
7484 (?i gnus-tmp-info ?s)
7485 (?d gnus-tmp-details ?s)
7486 (?D gnus-tmp-pressed-details ?s)))
7488 (defvar gnus-mime-security-button-map
7490 (unless (>= (string-to-number emacs-version) 21)
7491 (set-keymap-parent map gnus-article-mode-map))
7492 (define-key map gnus-mouse-2 'gnus-article-push-button)
7493 (define-key map "\r" 'gnus-article-press-button)
7496 (defvar gnus-mime-security-details-buffer nil)
7498 (defvar gnus-mime-security-button-pressed nil)
7500 (defvar gnus-mime-security-show-details-inline t
7503 (defun gnus-mime-security-verify-or-decrypt (handle)
7505 (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
7510 (narrow-to-region (point) (point))
7519 (gnus-mime-display-security handle)
7527 (defun gnus-mime-security-show-details (handle)
7528 (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
7530 (gnus-message 5 "No details.")
7531 (if gnus-mime-security-show-details-inline
7532 (let ((gnus-mime-security-button-pressed
7533 (not (get-text-property (point) 'gnus-mime-details)))
7534 (gnus-mime-security-button-line-format
7535 (get-text-property (point) 'gnus-line-format))
7538 (while (eq (get-text-property (point) 'gnus-line-format)
7539 gnus-mime-security-button-line-format)
7543 (narrow-to-region (point) (point))
7544 (gnus-insert-mime-security-button handle))
7548 'gnus-line-format
7549 gnus-mime-security-button-line-format)
7552 (if (gnus-buffer-live-p gnus-mime-security-details-buffer)
7553 (with-current-buffer gnus-mime-security-details-buffer
7556 (setq gnus-mime-security-details-buffer
7557 (gnus-get-buffer-create "*MIME Security Details*")))
7558 (with-current-buffer gnus-mime-security-details-buffer
7561 (pop-to-buffer gnus-mime-security-details-buffer)))))
7563 (defun gnus-mime-security-press-button (handle)
7565 (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
7566 (gnus-mime-security-show-details handle)
7567 (gnus-mime-security-verify-or-decrypt handle))))
7569 (defun gnus-insert-mime-security-button (handle &optional displayed)
7571 (gnus-tmp-type
7579 (gnus-tmp-info
7580 (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
7582 (gnus-tmp-details
7583 (mm-handle-multipart-ctl-parameter handle 'gnus-details))
7584 gnus-tmp-pressed-details
7586 (setq gnus-tmp-details
7587 (if gnus-tmp-details
7588 (concat "\n" gnus-tmp-details)
7590 (setq gnus-tmp-pressed-details
7591 (if gnus-mime-security-button-pressed gnus-tmp-details ""))
7595 (gnus-eval-format
7596 gnus-mime-security-button-line-format
7597 gnus-mime-security-button-line-format-alist
7598 `(,@(gnus-local-map-property gnus-mime-security-button-map)
7599 gnus-callback gnus-mime-security-press-button
7600 gnus-line-format ,gnus-mime-security-button-line-format
7601 gnus-mime-details ,gnus-mime-security-button-pressed
7603 gnus-data ,handle))
7611 :action 'gnus-widget-press-button
7612 :button-keymap gnus-mime-security-button-map
7615 ;; Needed to properly clear the message due to a bug in
7621 (aref gnus-mouse-2 0))))))
7623 (defun gnus-mime-display-security (handle)
7625 (narrow-to-region (point) (point))
7626 (unless (gnus-unbuttonized-mime-type-p (car handle))
7627 (gnus-insert-mime-security-button handle))
7628 (gnus-mime-display-mixed (cdr handle))
7631 (unless (gnus-unbuttonized-mime-type-p (car handle))
7632 (let ((gnus-mime-security-button-line-format
7633 gnus-mime-security-button-end-line-format))
7634 (gnus-insert-mime-security-button handle)))
7636 handle 'gnus-region
7640 (gnus-ems-redefine)
7642 (provide 'gnus-art)
7644 (run-hooks 'gnus-art-load-hook)
7647 ;;; gnus-art.el ends here