Lines Matching +refs:gnus +refs:current +refs:move +refs:group
0 ;;; gnus-art.el --- article mode commands for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
35 (require 'gnus)
36 (require 'gnus-sum)
37 (require 'gnus-spec)
38 (require 'gnus-int)
39 (require 'gnus-win)
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
159 If `gnus-visible-headers' is non-nil, this variable will be ignored."
163 :group 'gnus-article-hiding)
165 (defcustom gnus-visible-headers
169 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
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)
193 'newsgroups Newsgroup identical to Gnus group.
203 (const :tag "Newsgroups identical to Gnus group." newsgroups)
212 :group 'gnus-article-hiding)
214 (defcustom gnus-article-skip-boring nil
219 `gnus-article-boring-faces'."
222 :group 'gnus-article-hiding)
224 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
232 :group 'gnus-article-signature)
234 (defcustom gnus-signature-limit nil
247 :group 'gnus-article-signature)
249 (defcustom gnus-hidden-properties '(invisible t intangible t)
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
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)
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'.
310 (defcustom gnus-article-address-banner-alist nil
314 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
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)))))
381 ;; 2 3 gnus-emphasis-strikethru)
383 2 3 gnus-emphasis-underline))))
399 (group :tag "Default"
411 (gnus-emphasis-custom-value-to-external value))))
412 (widget-group-value-create widget))
414 (integer :format "Match group: %v")
415 (integer :format "Emphasize group: %v")
417 (group :tag "Simple"
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"
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"
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
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
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'.
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'.
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
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
599 :group 'gnus-article-saving
612 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
615 :group 'gnus-article-saving
618 (defcustom gnus-mail-save-name 'gnus-plain-save-name
621 :group 'gnus-article-saving
624 (defcustom gnus-folder-save-name 'gnus-folder-save-name
627 :group 'gnus-article-saving
630 (defcustom gnus-file-save-name 'gnus-numeric-save-name
634 :group 'gnus-article-saving
637 (defcustom gnus-split-methods
638 '((gnus-article-archive-name)
639 (gnus-article-nndoc-name))
642 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
645 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
659 :group 'gnus-article-saving
664 (defcustom gnus-page-delimiter "^\^L"
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
843 article-decode-group-name article-decode-idna-rhs)
845 :group 'gnus-article-headers
848 (defcustom gnus-display-mime-function 'gnus-display-mime
850 :group 'gnus-article-mime
853 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
856 (defvar gnus-decode-address-function 'mail-decode-encoded-address-region
859 (defvar gnus-article-dumbquotes-map
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'.
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 "_"
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
949 :group 'gnus-article-mime
953 (defcustom gnus-mime-multipart-functions nil
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
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
1009 (defvar gnus-article-treat-custom
1018 (defvar gnus-article-treat-head-custom
1022 (defvar gnus-article-treat-types '("text/plain")
1025 (defvar gnus-inhibit-treatment nil
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
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
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.
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.
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)
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
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
1498 See Info node `(gnus)Customizing Articles' for details."
1500 :group 'gnus-article-treat
1501 :group 'mime-security
1502 :link '(custom-manual "(gnus)Customizing Articles")
1503 :type gnus-article-treat-custom)
1505 (defvar gnus-article-encrypt-protocol-alist
1509 ;; gnus-article-encrypt-protocol-alist.
1510 (defcustom gnus-article-encrypt-protocol "PGP"
1515 :group 'mime-security)
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
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)
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)
1656 (defsubst gnus-article-hide-text (b e props)
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)
1687 "Hide text of TYPE in the current buffer."
1692 (add-text-properties b (incf b) gnus-hidden-properties)))))
1694 (defun gnus-article-delete-text-of-type (type)
1695 "Delete text of TYPE in the current buffer."
1702 (while (if (get-text-property (point) 'gnus-part)
1705 'gnus-part))
1717 (defun gnus-article-delete-invisible-text ()
1718 "Delete all invisible text in the current buffer."
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)))
1750 (cur (current-buffer))
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
1784 ;; `gnus-ignored-headers' and `gnus-visible-headers' to
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)
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")))
1849 (gnus-parameter-to-address
1850 (if (boundp 'gnus-newsgroup-name)
1851 gnus-newsgroup-name ""))))
1854 (gnus-string-equal
1858 (gnus-article-hide-header "to"))))
1862 (gnus-parameter-to-list
1863 (if (boundp 'gnus-newsgroup-name)
1864 gnus-newsgroup-name ""))))
1867 (gnus-string-equal
1871 (gnus-article-hide-header "to"))))
1875 (gnus-parameter-to-list
1876 (if (boundp 'gnus-newsgroup-name)
1877 gnus-newsgroup-name ""))))
1880 (gnus-string-equal
1884 (gnus-article-hide-header "cc"))))
1886 (when (gnus-string-equal
1889 (gnus-article-hide-header "followup-to")))
1891 (if (gnus-group-find-parameter
1892 gnus-newsgroup-name 'broken-reply-to)
1893 (gnus-article-hide-header "reply-to")
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'),
1917 (< (days-between (current-time-string) date)
1919 (gnus-article-hide-header "date"))))
1924 (gnus-article-hide-header "to"))
1926 (gnus-article-hide-header "cc"))))
1940 (gnus-article-hide-header "to"))
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
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)
2010 (article-translate-strings gnus-article-dumbquotes-map))
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 ()
2069 Only the headers that fit into the current window width will be
2072 (gnus-with-article-headers
2089 (defun gnus-article-treat-fold-headers ()
2092 (gnus-with-article-headers
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 ()
2121 Only the headers that fit into the current window width will be
2124 (gnus-with-article-headers
2125 (while (gnus-article-goto-header "newsgroups\\|followup-to")
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)))))
2155 (width (window-width (get-buffer-window (current-buffer)))))
2161 (when (>= (current-column) (min fill-column width))
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)
2223 (save-current-buffer
2225 (gnus-buffer-live-p gnus-original-article-buffer)
2227 (set-buffer gnus-original-article-buffer))
2230 (while (gnus-article-goto-header "Face")
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)
2263 (save-current-buffer
2265 (gnus-buffer-live-p gnus-original-article-buffer)
2267 ;; If type `W f', use gnus-original-article-buffer,
2268 ;; otherwise use the current buffer because displaying
2270 (set-buffer gnus-original-article-buffer))
2273 (while (gnus-article-goto-header "X-Face")
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)
2320 (save-excursion (set-buffer gnus-summary-buffer)
2321 gnus-newsgroup-ignored-charsets)))
2330 (mail-parse-charset gnus-newsgroup-charset)
2333 (set-buffer gnus-summary-buffer)
2335 gnus-newsgroup-ignored-charsets))
2357 (when (and (eq mail-parse-charset 'gnus-decoded)
2366 (gnus-strip-whitespace cte))))
2372 (mail-parse-charset gnus-newsgroup-charset)
2375 (set-buffer gnus-summary-buffer)
2377 gnus-newsgroup-ignored-charsets))
2381 (when (search-forward "\n\n" nil 'move)
2393 (funcall gnus-decode-address-function start end)
2394 (funcall gnus-decode-header-function start end))
2397 (defun article-decode-group-name ()
2398 "Decode group names in `Newsgroups:'."
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))
2407 (with-current-buffer gnus-original-article-buffer
2412 (gnus-decode-newsgroups
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
2429 (with-current-buffer gnus-original-article-buffer
2434 gnus-newsgroup-name method))
2440 "Decode IDNA strings in RHS in various headers in current buffer.
2443 (when gnus-use-idna
2465 (interactive (list 'force current-prefix-arg))
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"))
2481 (setq charset gnus-newsgroup-charset))
2493 (interactive (list 'force current-prefix-arg))
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"))
2509 (setq charset gnus-newsgroup-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"))
2573 (setq charset gnus-newsgroup-charset)))
2578 (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
2588 (defun gnus-article-wash-html-with-w3 ()
2589 "Wash the current buffer with w3."
2599 (defun gnus-article-wash-html-with-w3m ()
2600 "Wash the current buffer with emacs-w3m."
2616 (defun gnus-article-wash-html-with-w3m-standalone ()
2617 "Wash the current buffer with w3m."
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))
2655 "Toggle hiding of any PEM headers and signatures in the current article.
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
2682 "Strip the banners specified by the `banner' group parameter and by
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
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)
2749 "Hide the signature in the current article.
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))))))
2815 (unless (gnus-annotation-in-region-p
2821 (unless (gnus-annotation-in-region-p
2862 (defun gnus-article-narrow-to-signature ()
2865 (when (gnus-article-search-signature)
2869 (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
2870 (list gnus-signature-limit)))
2888 (defun gnus-article-search-signature ()
2889 "Search the current buffer for the signature separator.
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 ()
2905 "Return the current prefix arg as a number, or 0 if no prefix."
2906 (list (if current-prefix-arg
2907 (prefix-numeric-value current-prefix-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)
2932 "Say whether the current buffer contains hidden text of type 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)))
2964 (defun gnus-article-forward-header ()
2966 If the current header is a continuation header, this can be several
2976 "Convert DATE date to universal time in the current article.
2979 `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
2983 (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
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)
3055 (let ((tz (car (current-time-zone time))))
3056 (format "Date: %s %s%02d%02d" (current-time-string time)
3062 (current-time-string
3066 (ls (- (cadr tm) (car (current-time-zone time)))))
3079 (with-current-buffer gnus-summary-buffer
3080 gnus-article-time-format)
3082 gnus-article-time-format)))
3088 (let ((tz (car (current-time-zone time))))
3099 (let* ((now (current-time))
3152 (nth (1- (nth 4 dtime)) gnus-english-month-names)
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.
3180 "Convert the current article date to time lapsed since it was sent."
3193 (when (eq major-mode 'gnus-article-mode)
3199 (move-marker mark nil))))
3202 (defun gnus-start-date-timer (&optional n)
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)))))
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
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
3363 function group headers variable
3366 (funcall function group headers (symbol-value variable)))
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)
3399 ;; A single group name is returned.
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)
3452 "Return the first instance of an \"Archive-name\" in the current buffer."
3455 (nnheader-concat gnus-article-save-directory
3458 (defun gnus-article-nndoc-name (group)
3459 "If GROUP is an nndoc group, return the name of the parent 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)
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)
3481 Directory to save to is default to `gnus-article-save-directory'."
3482 (setq filename (gnus-read-save-file-name
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
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)
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)
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)
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
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)
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)
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)
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)
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.
3617 Otherwise, it is like ~/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))
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
3635 ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num."
3638 (concat (if (gnus-use-long-file-name 'not-save)
3640 (gnus-newsgroup-directory-form newsgroup))
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
3653 ~/News/news.group. Otherwise, it is like ~/News/news/group/news."
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)
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)
3710 (let ((coding-system-for-write (or gnus-newsgroup-charset
3715 mm-security-handle 'gnus-details)
3717 mm-security-handle 'gnus-info)))))
3724 (setq bface (get-text-property (gnus-point-at-bol) 'face)
3725 eface (get-text-property (1- (gnus-point-at-eol)) 'face))
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 ()
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)
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))
3973 (with-current-buffer name
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))
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))
3997 (current-buffer))
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)
4003 (current-buffer)))))
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)
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
4044 article group))))
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)")))))
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.
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)
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))
4127 (set-window-point (get-buffer-window (current-buffer)) (point))
4128 (gnus-configure-windows 'article)
4132 (defun gnus-article-prepare-display ()
4133 "Make the current buffer look like a nice article."
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
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)
4247 (save-current-buffer
4248 (set-buffer gnus-article-buffer)
4249 (let ((handles (or handles gnus-article-mime-handles))
4250 (mail-parse-charset gnus-newsgroup-charset)
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)
4267 (error "The current group does not support deleting of parts"))
4268 (when (mm-complicated-handles gnus-article-mime-handles)
4270 The current article has a complicated MIME structure, giving up..."))
4271 (when (gnus-yes-or-no-p "\
4273 (let* ((data (get-text-property (point) 'gnus-data))
4275 (handles gnus-article-mime-handles))
4278 (with-current-buffer (mm-handle-buffer data)
4295 (set-buffer gnus-summary-buffer)
4296 (gnus-article-edit-article
4299 (let ((mail-parse-charset (or gnus-article-charset
4300 ',gnus-newsgroup-charset))
4302 (or gnus-article-ignored-charsets
4303 ',gnus-newsgroup-ignored-charsets))
4306 (insert-buffer-substring gnus-original-article-buffer)
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))
4320 (or gnus-article-ignored-charsets
4321 ',gnus-newsgroup-ignored-charsets)))
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)
4338 (error "The current group does not support deleting of parts"))
4339 (when (mm-complicated-handles gnus-article-mime-handles)
4341 The current article has a complicated MIME structure, giving up..."))
4342 (when (gnus-yes-or-no-p "\
4344 (let* ((data (get-text-property (point) 'gnus-data))
4345 (handles gnus-article-mime-handles)
4356 (with-current-buffer (mm-handle-buffer data)
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))
4383 (or gnus-article-ignored-charsets
4384 ',gnus-newsgroup-ignored-charsets))
4387 (insert-buffer-substring gnus-original-article-buffer)
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))
4401 (or gnus-article-ignored-charsets
4402 ',gnus-newsgroup-ignored-charsets)))
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 ()
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))
4455 (defun gnus-mime-view-part-as-type (&optional mime-type pred)
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))))
4495 (defun gnus-mime-jka-compr-maybe-uncompress ()
4496 "Uncompress the current buffer if `auto-compression-mode' is enabled.
4519 (defun gnus-mime-copy-part (&optional handle)
4524 (gnus-article-check-buffer)
4525 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4542 (gnus-mime-jka-compr-maybe-uncompress)
4547 (defun gnus-mime-print-part (&optional handle filename)
4549 (interactive (list nil (ps-print-preprint current-prefix-arg)))
4550 (gnus-article-check-buffer)
4551 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4569 (gnus-print-buffer))
4572 (defun gnus-mime-inline-part (&optional handle arg)
4573 "Insert the MIME part under point into the current buffer."
4574 (interactive (list nil current-prefix-arg))
4575 (gnus-article-check-buffer)
4576 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4588 gnus-newsgroup-charset)))
4594 gnus-summary-show-article-charset-alist))
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)
4626 "Insert the MIME part under point into the current buffer using the
4628 (interactive (list nil current-prefix-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)
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)
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))
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)
4790 (save-current-buffer
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)
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))
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)
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
4865 (gnus-tmp-type (mm-handle-media-type handle))
4866 (gnus-tmp-description
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
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))
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)
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)))
4972 (gnus-treat-article nil 1 1)
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)))
5036 ;;(gnus-mime-display-part (cadr handle))
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)
5065 (move nil)
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)
5102 (setq move t))
5106 (when move
5109 (let ((mail-parse-charset gnus-newsgroup-charset)
5112 (set-buffer gnus-summary-buffer)
5114 gnus-newsgroup-ignored-charsets)))
5118 (when move
5121 (gnus-article-insert-newline)
5128 ((eq charset 'gnus-decoded)
5129 (with-current-buffer (mm-handle-buffer handle)
5138 (gnus-treat-article
5140 (gnus-article-mime-total-parts)
5143 (defun gnus-unbuttonized-mime-type-p (type)
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)
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)
5237 (save-excursion (set-buffer gnus-summary-buffer)
5238 gnus-newsgroup-ignored-charsets)))
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
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)
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
5351 (let* ((artbuf (current-buffer))
5353 (coding gnus-article-save-coding-system)
5396 (defun gnus-narrow-to-page (&optional arg)
5398 If given a numerical ARG, move forward ARG pages."
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)))
5412 (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
5414 (re-search-forward page-delimiter nil 'move arg)))
5418 (setq gnus-page-broken
5420 (when gnus-page-broken
5423 (if (re-search-forward page-delimiter nil 'move)
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)
5469 "Show the next page of the current article.
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 ()
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)
5529 "Show previous page of current article.
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 ()
5581 (if (not (gnus-buffer-live-p gnus-summary-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 ()
5596 (let ((obuf (current-buffer))
5597 (owin (current-window-configuration))
5599 (switch-to-buffer gnus-article-current-summary 'norecord)
5600 (setq func (lookup-key (current-local-map) (this-command-keys)))
5604 (set-window-point (get-buffer-window (current-buffer)) (point))))
5606 (defun gnus-article-summary-command-nosave ()
5610 (pop-to-buffer gnus-article-current-summary 'norecord)
5611 (setq func (lookup-key (current-local-map) (this-command-keys)))
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)
5622 (gnus-article-check-buffer)
5635 (set-buffer gnus-article-current-summary)
5636 (let (gnus-pick-mode)
5649 (pop-to-buffer gnus-article-current-summary 'norecord)
5651 (let (gnus-pick-mode)
5652 (setq func (lookup-key (current-local-map) keys))))
5657 (set-buffer gnus-article-current-summary))
5661 (pop-to-buffer gnus-article-buffer 'norecord)))
5663 (let ((obuf (current-buffer))
5664 (owin (current-window-configuration))
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)))
5673 (setq in-buffer (current-buffer))
5675 (if (and (setq func (let (gnus-pick-mode)
5676 (lookup-key (current-local-map) keys)))
5684 (when (eq in-buffer (current-buffer))
5685 (setq selected (gnus-summary-select-article))
5691 (set-window-start (get-buffer-window (current-buffer))
5693 (set-window-point (get-buffer-window (current-buffer))
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)
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)
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)
5784 "Hide all the gruft in the current article.
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 ()
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
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)
5843 (setq sparse-header (gnus-read-header article))
5844 (setq gnus-newsgroup-sparse
5845 (delq article gnus-newsgroup-sparse)))
5852 (gnus-request-pseudo-article header))))
5854 (let ((method (gnus-find-method-for-group
5855 gnus-newsgroup-name)))
5863 (gnus-group-enter-directory dir))))))))
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
5936 group article (current-buffer))))
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)
5954 (when (and (get-buffer gnus-article-buffer)
5955 (equal (buffer-name (current-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))
5978 (let ((buf (current-buffer)))
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
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 ""
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)
6073 (set (make-local-variable 'gnus-article-edit-mode) t)
6080 (defun gnus-article-edit (&optional force)
6081 "Edit the current article.
6087 (gnus-group-read-only-p))
6088 (error "The current newsgroup does not support article editing"))
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)
6099 "Start editing the contents of the current article buffer."
6100 (let ((winconf (current-window-configuration)))
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)
6117 (buf (current-buffer))
6120 (winconf gnus-prev-winconf))
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 ()
6151 (let ((curbuf (current-buffer))
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)
6162 (save-current-buffer
6164 (set-window-start (get-buffer-window (current-buffer)) window-start)
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
6205 :group 'gnus-article-buttons
6208 (defcustom gnus-button-man-handler 'manual-entry
6216 :group 'gnus-article-buttons)
6218 (defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
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
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
6264 :group 'gnus-article-buttons
6267 (defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic
6276 :group 'gnus-article-buttons
6278 gnus-button-mid-or-mail-heuristic)
6283 (defcustom gnus-button-mid-or-mail-heuristic-alist
6335 "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
6340 :group 'gnus-article-buttons
6344 (defun gnus-button-mid-or-mail-heuristic (mid-or-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)
6361 (gnus-message 8 "`%s' is a known mail address." mid-or-mail)
6364 (gnus-message 8 "`%s' is invalid." mid-or-mail)
6375 (gnus-message
6380 (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'."
6383 (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail)
6391 (gnus-message
6398 (gnus-message
6403 (gnus-message
6405 (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result)
6414 (defun gnus-button-handle-mid-or-mail (mid-or-mail)
6415 (let* ((pref gnus-button-prefer-mid-or-mail) guessed
6418 (gnus-message 9 "mid-or-mail=%s" mid-or-mail)
6423 (gnus-replace-in-string mid-or-mail "^<\\|>$" "")))
6433 (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid)
6434 (gnus-button-handle-news url-mid))
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
6522 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
6525 :group 'gnus-article-buttons
6526 :link '(custom-manual "(gnus)Group Parameters")
6529 (defcustom gnus-button-man-level 5
6534 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
6537 :group 'gnus-article-buttons
6538 :link '(custom-manual "(gnus)Group Parameters")
6541 (defcustom gnus-button-emacs-level 5
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
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)
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)
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)
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))
6703 :group 'gnus-article-buttons
6710 (integer :tag "Regexp group")))))
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))
6731 This alist is very similar to `gnus-button-alist', except that each
6737 `gnus-button-alist'."
6738 :group 'gnus-article-buttons
6739 :group 'gnus-article-headers
6747 (integer :tag "Regexp group")))))
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)
6775 "Highlight current article.
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)
6788 "Highlight current article.
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)
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))))))))))
6907 (defun gnus-article-add-buttons-to-head ()
6911 (set-buffer gnus-article-buffer)
6916 (alist gnus-header-button-alist)
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
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))
7006 (args (mapcar (lambda (group)
7007 (let ((string (match-string group)))
7008 (gnus-set-text-properties
7019 (gnus-message 1 "You must define `%S' to use this button"
7022 (defun gnus-parse-news-url (url)
7023 (let (scheme server port group message-id articles)
7041 (setq group (match-string 1)
7044 (setq group (match-string 1)))
7047 (list scheme server port group message-id articles)))
7049 (defun gnus-button-handle-news (url)
7051 (destructuring-bind (scheme server port group message-id articles)
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))))
7066 (group
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)
7127 ;; This is just a simple group url.
7128 (gnus-group-read-ephemeral-group address gnus-select-method)
7134 (gnus-group-read-ephemeral-group
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)
7167 (setq args (gnus-url-parse-query-string
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)
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)
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)
7270 (select-window (gnus-get-buffer-window gnus-article-buffer t))
7271 (gnus-article-next-page)
7274 (defun gnus-article-button-prev-page (arg)
7278 (select-window (gnus-get-buffer-window gnus-article-buffer t))
7279 (gnus-article-prev-page)
7282 (defvar gnus-decode-header-methods
7292 \((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
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))
7324 (defun gnus-treat-article (condition &optional part-number total-parts type)
7326 (alist gnus-treatment-function-alist)
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
7403 current-prefix-arg))
7404 (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
7407 (if (member gnus-newsgroup-name '("nndraft:delayed"
7410 (error "Can't encrypt the article in group %s"
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)
7421 (error "The current newsgroup does not support article encrypt"))
7422 (gnus-summary-show-article t)
7424 (or (mail-header-references gnus-current-headers) ""))
7425 (set-buffer gnus-article-buffer)
7455 (gnus-summary-edit-article-done
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
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))
7511 (with-current-buffer (mm-handle-multipart-original-buffer handle)
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)
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
7621 (aref gnus-mouse-2 0))))))
7623 (defun gnus-mime-display-security (handle)
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