• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.10.1/emacs-93/emacs/lisp/gnus/

Lines Matching +defs:gnus +defs:article +defs:display +defs:face

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
55 "Article display."
56 :link '(custom-manual "(gnus)Article Buffer")
57 :group 'gnus)
59 (defgroup gnus-article-treat nil
60 "Treating article parts."
61 :link '(custom-manual "(gnus)Article Hiding")
62 :group 'gnus-article)
64 (defgroup gnus-article-hiding nil
65 "Hiding article parts."
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
106 "Pushable buttons in the article buffer."
107 :link '(custom-manual "(gnus)Article Buttons")
108 :group 'gnus-article)
110 (defgroup gnus-article-various nil
111 "Other article options."
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
183 be placed first in the article buffer in the sequence specified by
186 :group 'gnus-article-hiding)
188 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
212 :group 'gnus-article-hiding)
214 (defcustom gnus-article-skip-boring nil
216 By default, if you set this t, then Gnus will display citations and
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
265 display -"))
266 "*String or function to be executed to display an X-Face header.
268 asynchronously. The compressed face will be piped to this command."
270 (function-item gnus-display-x-face-in-from)
273 :group 'gnus-picon
274 :group 'gnus-article-washing)
276 (defcustom gnus-article-x-face-too-ugly nil
277 "Regexp matching posters whose face shouldn't be shown automatically."
279 :group 'gnus-article-washing)
281 (defcustom gnus-article-banner-alist nil
287 :group 'gnus-article-washing)
289 (gnus-define-group-parameter
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))))
393 is the face used for highlighting."
411 (gnus-emphasis-custom-value-to-external value))))
416 face)
424 face)))
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"
484 "Format for display of Date headers in article bodies.
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
506 every article that is saved will be preceded by a prompt, even when
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
595 Those commands and functions save just text displayed in the article
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
631 "A function generating a file name to save articles in article format.
634 :group 'gnus-article-saving
637 (defcustom gnus-split-methods
638 '((gnus-article-archive-name)
639 (gnus-article-nndoc-name))
642 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
645 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
652 article. If the match is a symbol, that symbol will be funcalled
653 from the buffer of the article to be saved with the newsgroup as the
659 :group 'gnus-article-saving
664 (defcustom gnus-page-delimiter "^\^L"
665 "*Regexp describing what to use as article page delimiters.
669 :group 'gnus-article-various)
671 (defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
672 "*The format specification for the article mode line.
673 See `gnus-summary-mode-line-format' for a closer description.
677 %w The article washing status.
678 %m The number of MIME parts in the article."
680 :group 'gnus-article-various)
682 (defcustom gnus-article-mode-hook nil
683 "*A hook for Gnus article mode."
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
695 "*Hook run after the creation of the article mode menu."
697 :group 'gnus-article-various)
699 (defcustom gnus-article-prepare-hook nil
700 "*A hook called after an article has been prepared in the article buffer."
702 :group 'gnus-article-various)
704 (make-obsolete-variable 'gnus-article-hide-pgp-hook
707 (defcustom gnus-article-button-face 'bold
708 "Face used for highlighting buttons in the article buffer.
710 An article button is a piece of text that you can activate by pressing
712 :type 'face
713 :group 'gnus-article-buttons)
715 (defcustom gnus-article-mouse-face 'highlight
716 "Face used for mouse highlighting in the article buffer.
718 Article buttons will be displayed in this face when the cursor is
720 :type 'face
721 :group 'gnus-article-buttons)
723 (defcustom gnus-signature-face 'gnus-signature
724 "Face used for highlighting a signature in the article buffer.
725 Obsolete; use the face `gnus-signature' for customizations instead."
726 :type 'face
727 :group 'gnus-article-highlight
728 :group 'gnus-article-signature)
730 (defface gnus-signature
733 "Face used for highlighting a signature in the article buffer."
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
779 In the default setup this face is only used for crossposted
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))
820 "*Controls highlighting of article headers.
825 header and NAME and CONTENT are either face names or nil.
827 The name of each header field will be displayed using the face
830 be displayed by the first non-nil matching CONTENT face."
831 :group 'gnus-article-headers
832 :group 'gnus-article-highlight
836 (face :value default))
839 (face :value default)))))
841 (defcustom gnus-article-decode-hook
842 '(article-decode-charset article-decode-encoded-words
843 article-decode-group-name article-decode-idna-rhs)
845 :group 'gnus-article-headers
848 (defcustom gnus-display-mime-function 'gnus-display-mime
849 "Function to display MIME articles."
850 :group 'gnus-article-mime
853 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
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'.
900 this list to display radio buttons that allow you to choose one of two
902 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
904 :group 'gnus-article-mime
907 (defcustom gnus-inhibit-mime-unbuttonizing nil
910 as described by the variables `gnus-buttonized-mime-types' and
911 `gnus-unbuttonized-mime-types'."
913 :group 'gnus-article-mime
916 (defcustom gnus-body-boundary-delimiter "_"
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
954 "An alist of MIME types to functions to display them."
956 :group 'gnus-article-mime
959 (defcustom gnus-article-date-lapsed-new-header nil
961 When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
965 :group 'gnus-article-headers
968 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
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
1120 "Fill the article.
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
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
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"
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
1530 "If non-nil, allow scrolling the article buffer even when there no more text."
1532 :group 'gnus-article
1537 (defvar gnus-english-month-names
1541 (defvar article-goto-body-goes-to-point-min-p nil)
1542 (defvar gnus-article-wash-types nil)
1543 (defvar gnus-article-emphasis-alist nil)
1544 (defvar gnus-article-image-alist nil)
1546 (defvar gnus-article-mime-handle-alist-1 nil)
1547 (defvar gnus-treatment-function-alist
1548 '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
1549 (gnus-treat-strip-banner gnus-article-strip-banner)
1550 (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
1551 (gnus-treat-highlight-signature gnus-article-highlight-signature)
1552 (gnus-treat-buttonize gnus-article-add-buttons)
1553 (gnus-treat-fill-article gnus-article-fill-cited-article)
1554 (gnus-treat-fill-long-lines gnus-article-fill-long-lines)
1555 (gnus-treat-strip-cr gnus-article-remove-cr)
1556 (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1557 (gnus-treat-date-ut gnus-article-date-ut)
1558 (gnus-treat-date-local gnus-article-date-local)
1559 (gnus-treat-date-english gnus-article-date-english)
1560 (gnus-treat-date-original gnus-article-date-original)
1561 (gnus-treat-date-user-defined gnus-article-date-user)
1562 (gnus-treat-date-iso8601 gnus-article-date-iso8601)
1563 (gnus-treat-date-lapsed gnus-article-date-lapsed)
1564 (gnus-treat-display-x-face gnus-article-display-x-face)
1565 (gnus-treat-display-face gnus-article-display-face)
1566 (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
1567 (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
1568 (gnus-treat-hide-signature gnus-article-hide-signature)
1569 (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
1570 (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
1571 (gnus-treat-strip-pem gnus-article-hide-pem)
1572 (gnus-treat-from-picon gnus-treat-from-picon)
1573 (gnus-treat-mail-picon gnus-treat-mail-picon)
1574 (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
1575 (gnus-treat-highlight-headers gnus-article-highlight-headers)
1576 (gnus-treat-highlight-signature gnus-article-highlight-signature)
1577 (gnus-treat-strip-trailing-blank-lines
1578 gnus-article-remove-trailing-blank-lines)
1579 (gnus-treat-strip-leading-blank-lines
1580 gnus-article-strip-leading-blank-lines)
1581 (gnus-treat-strip-multiple-blank-lines
1582 gnus-article-strip-multiple-blank-lines)
1583 (gnus-treat-overstrike gnus-article-treat-overstrike)
1584 (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
1585 (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1586 (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
1587 (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
1588 (gnus-treat-display-smileys gnus-treat-smiley)
1589 (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
1590 (gnus-treat-wash-html gnus-article-wash-html)
1591 (gnus-treat-emphasize gnus-article-emphasize)
1592 (gnus-treat-hide-citation gnus-article-hide-citation)
1593 (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
1594 (gnus-treat-highlight-citation gnus-article-highlight-citation)
1595 (gnus-treat-body-boundary gnus-article-treat-body-boundary)
1596 (gnus-treat-play-sounds gnus-earcon-display)))
1598 (defvar gnus-article-mime-handle-alist nil)
1599 (defvar article-lapsed-timer nil)
1600 (defvar gnus-article-current-summary nil)
1602 (defvar gnus-article-mode-syntax-table
1608 ;; make M-. in article buffers work for `foo' strings
1612 "Syntax table used in article mode buffers.
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)
1628 ;;; Macros for dealing with the article buffer.
1630 (defmacro gnus-with-article-headers (&rest forms)
1632 (set-buffer gnus-article-buffer)
1637 (article-narrow-to-head)
1640 (put 'gnus-with-article-headers 'lisp-indent-function 0)
1641 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
1643 (defmacro gnus-with-article-buffer (&rest forms)
1645 (set-buffer gnus-article-buffer)
1649 (put 'gnus-with-article-buffer 'lisp-indent-function 0)
1650 (put 'gnus-with-article-buffer 'edebug-form-spec '(body))
1652 (defun gnus-article-goto-header (header)
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)
1691 (while (setq b (text-property-any b e 'article-type type))
1692 (add-text-properties b (incf b) gnus-hidden-properties)))))
1694 (defun gnus-article-delete-text-of-type (type)
1702 (while (if (get-text-property (point) 'gnus-part)
1705 'gnus-part))
1710 (when (eq (get-text-property b 'article-type) 'multipart)
1712 (while (setq b (text-property-any b (point-max) 'article-type type))
1714 b (or (text-property-not-all b (point-max) 'article-type type)
1717 (defun gnus-article-delete-invisible-text ()
1726 (defun gnus-article-text-type-exists-p (type)
1728 (text-property-any (point-min) (point-max) 'article-type 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)
1741 (defun article-hide-headers (&optional arg delete)
1745 (unless gnus-inhibit-hiding
1748 (max (1+ (length gnus-sorted-header-list)))
1753 ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
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
1776 (article-narrow-to-head)
1784 ;; `gnus-ignored-headers' and `gnus-visible-headers' to
1786 ;; article buffer.
1795 (gnus-article-header-rank)
1802 (gnus-add-wash-type 'headers)
1804 '(article-type headers dummy-invisible t))
1807 (defun article-hide-boring-headers (&optional arg)
1811 (interactive (gnus-article-hidden-arg))
1812 (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
1813 (not gnus-show-all-headers))
1817 (list gnus-boring-article-headers)
1820 (article-narrow-to-head)
1829 (gnus-article-hide-text-type
1830 (gnus-point-at-bol)
1839 (when (gnus-string-equal
1840 (gnus-fetch-field "newsgroups")
1841 (gnus-group-real-name
1842 (if (boundp 'gnus-newsgroup-name)
1843 gnus-newsgroup-name
1845 (gnus-article-hide-header "newsgroups")))
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'),
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
1971 (defun article-normalize-headers ()
1978 (article-narrow-to-head)
1981 ((< (setq column (- (gnus-point-at-eol) (point)))
1982 gnus-article-normalized-header-length)
1985 (- gnus-article-normalized-header-length column)
1987 ((> column gnus-article-normalized-header-length)
1988 (gnus-put-text-property
1990 (forward-char gnus-article-normalized-header-length)
1992 (gnus-point-at-eol)
1999 (defun article-treat-dumbquotes ()
2010 (article-translate-strings gnus-article-dumbquotes-map))
2012 (defun article-translate-characters (from to)
2013 "Translate all characters in the body of the article according to FROM and TO.
2017 (when (article-goto-body)
2029 (defun article-translate-strings (map)
2030 "Translate all string in the body of the article according to MAP.
2033 (when (article-goto-body)
2041 (defun article-treat-overstrike ()
2045 (when (article-goto-body)
2055 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2056 (put-text-property (point) (1+ (point)) 'face 'bold))
2058 (gnus-article-hide-text-type
2061 (- (point) 2) (1- (point)) 'face 'underline))
2063 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2065 (point) (1+ (point)) 'face 'underline)))))))))
2067 (defun gnus-article-treat-unfold-headers ()
2072 (gnus-with-article-headers
2089 (defun gnus-article-treat-fold-headers ()
2092 (gnus-with-article-headers
2099 (defun gnus-treat-smiley ()
2100 "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
2102 (gnus-with-article-buffer
2103 (if (memq 'smiley gnus-article-wash-types)
2104 (gnus-delete-images 'smiley)
2105 (article-goto-body)
2108 (gnus-add-wash-type 'smiley)
2110 (gnus-add-image 'smiley image)))))))
2112 (defun gnus-article-remove-images ()
2113 "Remove all images from the article buffer."
2115 (gnus-with-article-buffer
2116 (dolist (elem gnus-article-image-alist)
2117 (gnus-delete-images (car elem)))))
2119 (defun gnus-article-treat-fold-newsgroups ()
2124 (gnus-with-article-headers
2125 (while (gnus-article-goto-header "newsgroups\\|followup-to")
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)))))
2150 (defun article-fill-long-lines ()
2157 (article-goto-body)
2163 (gnus-point-at-bol))
2170 (defun article-capitalize-sentences ()
2176 (article-goto-body)
2181 (defun article-remove-cr ()
2193 (defun article-remove-trailing-blank-lines ()
2194 "Remove all trailing blank lines from the article."
2204 (not (gnus-annotation-in-region-p
2205 (point) (gnus-point-at-eol))))
2210 (defun article-display-face ()
2213 (let ((wash-face-p buffer-read-only))
2214 (gnus-with-article-headers
2216 ;; the same article, without any intended toggle semantic (as typing `W
2217 ;; D d' would have). So face deletion must occur only when we come from
2220 (if (and wash-face-p (memq 'face gnus-article-wash-types))
2221 (gnus-delete-images 'face)
2222 (let (face faces from)
2224 (when (and wash-face-p
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))))))))))
2248 (defun article-display-x-face (&optional force)
2249 "Look for an X-Face header and display it if present."
2251 (let ((wash-face-p buffer-read-only)) ;; When type `W f'
2252 (gnus-with-article-headers
2254 (when (process-status "article-x-face")
2255 (delete-process "article-x-face"))
2256 ;; See the comment in `article-display-face'.
2257 (if (and wash-face-p (memq 'xface gnus-article-wash-types))
2260 (gnus-delete-images 'xface)
2262 (let (x-faces from face)
2264 (when (and wash-face-p
2265 (gnus-buffer-live-p gnus-original-article-buffer)
2267 ;; If type `W f', use gnus-original-article-buffer,
2270 (set-buffer gnus-original-article-buffer))
2273 (while (gnus-article-goto-header "X-Face")
2277 ;; single external face.
2278 (when (stringp gnus-article-x-face-command)
2281 gnus-article-x-face-command
2283 ;; Check whether this face is censored.
2284 (not gnus-article-x-face-too-ugly)
2286 (not (string-match gnus-article-x-face-too-ugly
2288 (while (setq face (pop x-faces))
2289 ;; We display the face.
2290 (cond ((stringp gnus-article-x-face-command)
2294 (gnus-set-process-query-on-exit-flag
2296 "article-x-face" nil shell-file-name
2297 shell-command-switch gnus-article-x-face-command)
2300 (insert face)
2301 (process-send-region "article-x-face"
2303 (process-send-eof "article-x-face")))
2304 ((functionp gnus-article-x-face-command)
2306 (funcall gnus-article-x-face-command face))
2309 gnus-article-x-face-command))))))))))
2311 (defun article-decode-mime-words ()
2312 "Decode all MIME-encoded words in the article."
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)))
2324 (defun article-decode-charset (&optional prompt)
2325 "Decode charset-encoded text in the article.
2330 (mail-parse-charset gnus-newsgroup-charset)
2333 (set-buffer gnus-summary-buffer)
2335 gnus-newsgroup-ignored-charsets))
2339 (article-narrow-to-head)
2357 (when (and (eq mail-parse-charset 'gnus-decoded)
2363 (not format)) ;; article with format will decode later.
2366 (gnus-strip-whitespace cte))))
2369 (defun article-decode-encoded-words ()
2372 (mail-parse-charset gnus-newsgroup-charset)
2375 (set-buffer gnus-summary-buffer)
2377 gnus-newsgroup-ignored-charsets))
2393 (funcall gnus-decode-address-function start end)
2394 (funcall gnus-decode-header-function start end))
2397 (defun article-decode-group-name ()
2401 (method (gnus-find-method-for-group gnus-newsgroup-name)))
2402 (when (and (or gnus-group-name-charset-method-alist
2403 gnus-group-name-charset-group-alist)
2404 (gnus-buffer-live-p gnus-original-article-buffer))
2406 (article-narrow-to-head)
2407 (with-current-buffer gnus-original-article-buffer
2412 (gnus-decode-newsgroups
2413 ;; XXX how to use data in article buffer?
2414 (with-current-buffer gnus-original-article-buffer
2419 gnus-newsgroup-name method))
2422 (with-current-buffer gnus-original-article-buffer
2427 (gnus-decode-newsgroups
2428 ;; XXX how to use data in article buffer?
2429 (with-current-buffer gnus-original-article-buffer
2434 gnus-newsgroup-name method))
2439 (defun article-decode-idna-rhs ()
2443 (when gnus-use-idna
2447 (article-narrow-to-head)
2460 (defun article-de-quoted-unreadable (&optional force read-charset)
2461 "Translate a quoted-printable-encoded article.
2462 If FORCE, decode the article whether it is marked as quoted-printable
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))
2485 (article-goto-body)
2489 (defun article-de-base64-unreadable (&optional force read-charset)
2490 "Translate a base64 article.
2491 If FORCE, decode the article whether it is marked as base64 not.
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))
2513 (article-goto-body)
2523 (defun article-decode-HZ ()
2524 "Translate a HZ-encoded article."
2531 (defun article-unsplit-urls ()
2541 (gnus-treat-article nil))))
2544 (defun article-wash-html (&optional read-charset)
2545 "Format an HTML article.
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)))
2574 (article-goto-body)
2578 (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
2588 (defun gnus-article-wash-html-with-w3 ()
2599 (defun gnus-article-wash-html-with-w3m ()
2614 (eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
2616 (defun gnus-article-wash-html-with-w3m-standalone ()
2620 (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'.
2631 (defun article-hide-list-identifiers ()
2633 The `gnus-list-identifiers' variable specifies what to do."
2636 (regexp (if (consp gnus-list-identifiers)
2637 (mapconcat 'identity gnus-list-identifiers " *\\|")
2638 gnus-list-identifiers))
2643 (article-narrow-to-head)
2654 (defun article-hide-pem (&optional arg)
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
2681 (defun article-strip-banner ()
2683 `gnus-article-address-banner-alist'."
2688 (when (gnus-parameter-banner gnus-newsgroup-name)
2689 (article-really-strip-banner
2690 (gnus-parameter-banner gnus-newsgroup-name)))
2691 (when gnus-article-address-banner-alist
2697 (article-narrow-to-head)
2701 (cadr (funcall gnus-extract-address-components
2704 (dolist (pair gnus-article-address-banner-alist)
2707 (article-really-strip-banner (cdr pair)))))))))))))
2709 (defun article-really-strip-banner (banner)
2714 (gnus-signature-limit nil)
2716 (article-goto-body)
2719 (when (gnus-article-narrow-to-signature)
2724 (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
2731 (defun article-babel ()
2732 "Translate article using an online translation service."
2736 (set-buffer gnus-article-buffer)
2737 (when (article-goto-body)
2748 (defun article-hide-signature (&optional arg)
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))
2762 (defun article-strip-headers-in-body ()
2766 (article-goto-body)
2769 (gnus-delete-line)))))
2771 (defun article-strip-leading-blank-lines ()
2772 "Remove all blank lines from the beginning of the article."
2777 (when (article-goto-body)
2780 (gnus-delete-line))))))
2782 (defun article-narrow-to-head ()
2792 (defun article-goto-body ()
2798 (article-goto-body-goes-to-point-min-p
2806 (defun article-strip-multiple-blank-lines ()
2813 (article-goto-body)
2815 (unless (gnus-annotation-in-region-p
2819 (article-goto-body)
2821 (unless (gnus-annotation-in-region-p
2825 (defun article-strip-leading-space ()
2826 "Remove all white space from the beginning of the lines in the article."
2831 (article-goto-body)
2835 (defun article-strip-trailing-space ()
2836 "Remove all white space from the end of the lines in the article."
2841 (article-goto-body)
2845 (defun article-strip-blank-lines ()
2848 (article-strip-leading-blank-lines)
2849 (article-remove-trailing-blank-lines)
2850 (article-strip-multiple-blank-lines))
2852 (defun article-strip-all-blank-lines ()
2858 (article-goto-body)
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 ()
2893 (if (if (stringp gnus-signature-separator)
2894 (re-search-backward gnus-signature-separator nil t)
2895 (let ((seps gnus-signature-separator))
2904 (defun gnus-article-hidden-arg ()
2910 (defun gnus-article-check-hidden-text (type arg)
2916 (let ((hide (gnus-article-hidden-text-p type)))
2922 (gnus-article-show-hidden-text type)
2927 (gnus-article-show-hidden-text type)
2931 (defun gnus-article-hidden-text-p (type)
2933 (let ((pos (text-property-any (point-min) (point-max) 'article-type type)))
2938 (text-property-any (1+ pos) (point-max) 'article-type type)))
2943 (defun gnus-article-show-hidden-text (type &optional dummy)
2948 (gnus-remove-text-properties-when
2949 'article-type type
2951 (cons 'article-type (cons type
2952 gnus-hidden-properties)))
2953 (gnus-delete-wash-type type)))
2955 (defconst article-time-units
2964 (defun gnus-article-forward-header ()
2975 (defun article-date-ut (&optional type highlight)
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)
2987 (article-lapsed-timer
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)
3031 (insert (article-make-date-line date (or type 'ut)))
3039 'face bface)
3041 'face eface))
3046 (defun article-make-date-line (date type)
3071 ;; Get the original date from the article.
3079 (with-current-buffer gnus-summary-buffer
3080 gnus-article-time-format)
3082 gnus-article-time-format)))
3132 article-time-units "")
3134 ;; article was sent in the future.
3152 (nth (1- (nth 4 dtime)) gnus-english-month-names)
3162 (defun article-date-local (&optional highlight)
3163 "Convert the current article date to the local timezone."
3165 (article-date-ut 'local highlight))
3167 (defun article-date-english (&optional highlight)
3168 "Convert the current article date to something that is proper English."
3170 (article-date-ut 'english highlight))
3172 (defun article-date-original (&optional highlight)
3173 "Convert the current article date to what it was originally.
3177 (article-date-ut 'original highlight))
3179 (defun article-date-lapsed (&optional highlight)
3180 "Convert the current article date to time lapsed since it was sent."
3182 (article-date-ut 'lapsed highlight))
3184 (defun article-update-date-lapsed ()
3193 (when (eq major-mode 'gnus-article-mode)
3197 (article-date-lapsed t))
3202 (defun gnus-start-date-timer (&optional n)
3203 "Start a timer to update the X-Sent header in the article buffers.
3209 (gnus-stop-date-timer)
3210 (setq article-lapsed-timer
3211 (nnheader-run-at-time 1 n 'article-update-date-lapsed)))
3213 (defun gnus-stop-date-timer ()
3216 (when article-lapsed-timer
3217 (nnheader-cancel-timer article-lapsed-timer)
3218 (setq article-lapsed-timer nil)))
3220 (defun article-date-user (&optional highlight)
3221 "Convert the current article date to the user-defined format.
3222 This format is defined by the `gnus-article-time-format' variable."
3224 (article-date-ut 'user highlight))
3226 (defun article-date-iso8601 (&optional highlight)
3227 "Convert the current article date to ISO8601."
3229 (article-date-ut 'iso8601 highlight))
3231 (defmacro gnus-article-save-original-date (&rest forms)
3252 ;; (defun article-show-all ()
3253 ;; "Show all hidden text in the article buffer."
3257 ;; (gnus-article-unhide-text (point-min) (point-max)))))
3259 (defun article-remove-leading-whitespace ()
3265 (article-narrow-to-head)
3270 (defun article-emphasize (&optional arg)
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))
3282 (props (append '(article-type emphasis)
3283 gnus-hidden-properties))
3284 regexp elem beg invisible visible face)
3285 (article-goto-body)
3292 face (nth 3 elem))
3295 (gnus-article-hide-text
3297 (gnus-article-unhide-text-type
3299 (gnus-put-overlay-excluding-newlines
3300 (match-beginning visible) (match-end visible) 'face face)
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)
3331 "Save the currently selected article."
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))
3342 (article-hide-headers 1 t))))
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
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)
3388 "this article")))
3413 gnus-article-save-directory))
3417 (t gnus-article-save-directory))))
3431 gnus-article-save-directory
3433 gnus-article-save-directory)))
3436 (gnus-make-directory (file-name-directory file))
3444 (gnus-make-directory (file-name-directory result))
3451 (defun gnus-article-archive-name (group)
3455 (nnheader-concat gnus-article-save-directory
3458 (defun gnus-article-nndoc-name (group)
3460 (when (eq (car (gnus-find-method-for-group group)) 'nndoc)
3461 (gnus-group-get-parameter group 'save-article-group)))
3463 (defun gnus-summary-save-in-rmail (&optional filename)
3464 "Append this article to Rmail file.
3466 Directory to save to is default to `gnus-article-save-directory'."
3467 (setq filename (gnus-read-save-file-name
3469 gnus-rmail-save-name gnus-newsgroup-name
3470 gnus-current-headers 'gnus-newsgroup-last-rmail))
3471 (gnus-eval-in-buffer-window gnus-save-article-buffer
3475 (gnus-output-to-rmail filename))))
3478 (defun gnus-summary-save-in-mail (&optional filename)
3479 "Append this article to Unix mail file.
3481 Directory to save to is default to `gnus-article-save-directory'."
3482 (setq filename (gnus-read-save-file-name
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)
3500 "Append this article to file.
3502 Directory to save to is default to `gnus-article-save-directory'."
3503 (setq filename (gnus-read-save-file-name
3505 gnus-file-save-name gnus-newsgroup-name
3506 gnus-current-headers 'gnus-newsgroup-last-file))
3507 (gnus-eval-in-buffer-window gnus-save-article-buffer
3514 (gnus-output-to-file filename))))
3517 (put 'gnus-summary-write-to-file :decode t)
3518 (put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file)
3519 (put 'gnus-summary-write-to-file :headers 'gnus-saved-headers)
3520 (defun gnus-summary-write-to-file (&optional filename)
3521 "Write this article to a file, overwriting it if the file exists.
3523 The directory to save in defaults to `gnus-article-save-directory'."
3524 (setq filename (gnus-read-save-file-name
3526 gnus-file-save-name gnus-newsgroup-name
3527 gnus-current-headers nil 'gnus-newsgroup-last-directory))
3528 (gnus-summary-save-in-file filename t))
3530 (put 'gnus-summary-save-body-in-file :decode t)
3531 (defun gnus-summary-save-body-in-file (&optional filename overwrite)
3532 "Append this article body to a file.
3534 The directory to save in defaults to `gnus-article-save-directory'."
3535 (setq filename (gnus-read-save-file-name
3537 gnus-file-save-name gnus-newsgroup-name
3538 gnus-current-headers 'gnus-newsgroup-last-file))
3539 (gnus-eval-in-buffer-window gnus-save-article-buffer
3543 (when (article-goto-body)
3548 (gnus-output-to-file filename))))
3551 (put 'gnus-summary-write-body-to-file :decode t)
3552 (put 'gnus-summary-write-body-to-file
3553 :function 'gnus-summary-save-body-in-file)
3554 (defun gnus-summary-write-body-to-file (&optional filename)
3555 "Write this article body to a file, overwriting it if the file exists.
3557 The directory to save in defaults to `gnus-article-save-directory'."
3558 (setq filename (gnus-read-save-file-name
3560 gnus-file-save-name gnus-newsgroup-name
3561 gnus-current-headers nil 'gnus-newsgroup-last-directory))
3562 (gnus-summary-save-body-in-file filename t))
3564 (defun gnus-summary-save-in-pipe (&optional command)
3565 "Pipe this article to subprocess."
3568 gnus-last-shell-command)
3569 gnus-last-shell-command)
3575 (if (and gnus-number-of-articles-to-be-saved
3576 (> gnus-number-of-articles-to-be-saved 1))
3578 gnus-number-of-articles-to-be-saved)
3579 "this article"))
3580 gnus-last-shell-command))))
3582 (if gnus-last-shell-command
3583 (setq command gnus-last-shell-command)
3585 (gnus-eval-in-buffer-window gnus-article-buffer
3589 (setq gnus-last-shell-command command))
3591 (defmacro gnus-read-string (prompt &optional initial-contents history
3599 (defun gnus-summary-pipe-to-muttprint (&optional command)
3600 "Pipe this article to muttprint."
3601 (setq command (gnus-read-string
3602 "Print using command: " gnus-summary-muttprint-program
3603 nil gnus-summary-muttprint-program))
3604 (gnus-summary-save-in-pipe command))
3608 (defun gnus-capitalize-newsgroup (newsgroup)
3614 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
3616 If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num.
3620 (concat (if (gnus-use-long-file-name 'not-save)
3621 (gnus-capitalize-newsgroup newsgroup)
3622 (gnus-newsgroup-directory-form newsgroup))
3624 gnus-article-save-directory)))
3632 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
3634 If variable `gnus-use-long-file-name' is non-nil, it is
3638 (concat (if (gnus-use-long-file-name 'not-save)
3640 (gnus-newsgroup-directory-form newsgroup))
3642 gnus-article-save-directory)))
3650 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
3652 If variable `gnus-use-long-file-name' is non-nil, it is
3656 (if (gnus-use-long-file-name 'not-save)
3659 (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))
3661 gnus-article-save-directory)))
3663 (defun gnus-sender-save-name (newsgroup headers &optional last-file)
3670 gnus-article-save-directory)))
3672 (defun article-verify-x-pgp-sig ()
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))
3742 'face bface)
3744 'face eface)))))))))
3746 (defun article-verify-cancel-lock ()
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)
3771 '(article-hide-headers
3772 article-verify-x-pgp-sig
3773 article-verify-cancel-lock
3774 article-hide-boring-headers
3775 article-treat-overstrike
3776 article-fill-long-lines
3777 article-capitalize-sentences
3778 article-remove-cr
3779 article-remove-leading-whitespace
3780 article-display-x-face
3781 article-display-face
3782 article-de-quoted-unreadable
3783 article-de-base64-unreadable
3784 article-decode-HZ
3785 article-wash-html
3786 article-unsplit-urls
3787 article-hide-list-identifiers
3788 article-strip-banner
3789 article-babel
3790 article-hide-pem
3791 article-hide-signature
3792 article-strip-headers-in-body
3793 article-remove-trailing-blank-lines
3794 article-strip-leading-blank-lines
3795 article-strip-multiple-blank-lines
3796 article-strip-leading-space
3797 article-strip-trailing-space
3798 article-strip-blank-lines
3799 article-strip-all-blank-lines
3800 article-date-local
3801 article-date-english
3802 article-date-iso8601
3803 article-date-original
3804 article-date-ut
3805 article-decode-mime-words
3806 article-decode-charset
3807 article-decode-encoded-words
3808 article-date-user
3809 article-date-lapsed
3810 article-emphasize
3811 article-treat-dumbquotes
3812 article-normalize-headers
3813 ;; (article-show-all . gnus-article-show-all-headers)
3818 ;;; Gnus article mode
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 ()
3892 "Major mode for displaying an article.
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)
3930 (set (make-local-variable 'nobreak-char-display) nil)
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 ()
3948 "Initialize the article 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)
3966 ;; Init original article buffer.
3968 (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
3970 (setq major-mode 'gnus-original-article-mode)
3971 (make-local-variable 'gnus-original-article))
3974 (if gnus-article-edit-mode
3978 (gnus-kill-buffer name)
3985 (set (make-local-variable 'gnus-article-edit-mode) nil)
3986 (when gnus-article-mime-handles
3987 (mm-destroy-parts gnus-article-mime-handles)
3988 (setq gnus-article-mime-handles nil))
3989 ;; Set it to nil in article-buffer!
3990 (setq gnus-article-mime-handle-alist nil)
3994 (setq gnus-button-marker-list nil)
3995 (unless (eq major-mode 'gnus-article-mode)
3996 (gnus-article-mode))
3999 (set-buffer (gnus-get-buffer-create name))
4000 (gnus-article-mode)
4001 (make-local-variable 'gnus-summary-buffer)
4002 (gnus-summary-set-local-parameters gnus-newsgroup-name)
4005 ;; Set article window start at LINE, where LINE is the number of lines
4006 ;; from the head of the article.
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)
4021 "Prepare ARTICLE in article mode buffer.
4022 ARTICLE should either be an article number or a Message-ID.
4023 If ARTICLE is an id, HEADER should be the article headers.
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))
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))))
4045 ;; There is no such article.
4047 (when (and (numberp article)
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)))
4079 ;; The result from the `request' was an actual article -
4081 ;; article buffer.
4082 (when (and (numberp article)
4083 (not (eq article gnus-current-article)))
4084 ;; Seems like a new article has been selected.
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)
4101 ;; the right article, but the thread root instead.
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))
4114 (when (or (numberp article)
4115 (stringp 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))
4124 (article-goto-body)
4128 (gnus-configure-windows 'article)
4132 (defun gnus-article-prepare-display ()
4133 "Make the current buffer look like a nice article."
4134 ;; Hooks for getting information from the 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)
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)))
4260 (mm-display-parts handles))))))
4262 (defun gnus-mime-save-part-and-strip ()
4265 (gnus-article-check-buffer)
4266 (when (gnus-group-read-only-p)
4268 (when (mm-complicated-handles gnus-article-mime-handles)
4270 The current article has a complicated MIME structure, giving up..."))
4271 (when (gnus-yes-or-no-p "\
4272 Deleting parts may malfunction or destroy the article; continue? ")
4273 (let* ((data (get-text-property (point) 'gnus-data))
4275 (handles gnus-article-mime-handles))
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)
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 "\
4343 Deleting parts may malfunction or destroy the article; continue? ")
4344 (let* ((data (get-text-property (point) 'gnus-data))
4345 (handles gnus-article-mime-handles)
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 ()
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)
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)
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)
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)))
4666 (mm-user-display-methods nil)
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
4681 (mm-display-part handle))))))
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
4702 (mm-display-part handle))))))
4704 (defun gnus-mime-action-on-part (&optional action)
4707 (list (completing-read "Action: " gnus-mime-action-alist nil t)))
4708 (gnus-article-check-buffer)
4709 (let ((action-pair (assoc action gnus-mime-action-alist)))
4713 (defun gnus-article-part-wrapper (n function)
4714 (let ((window (get-buffer-window gnus-article-buffer 'visible))
4717 ;; It is necessary to select the article window so that
4718 ;; `gnus-article-goto-part' may really move the point.
4720 (gnus-select-frame-set-input-focus (window-frame window))
4724 (when (> n (length gnus-article-mime-handle-alist))
4726 (gnus-article-goto-part n)
4727 (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
4729 (gnus-select-frame-set-input-focus frame)))))
4731 (defun gnus-article-pipe-part (n)
4734 (gnus-article-part-wrapper n 'mm-pipe-part))
4736 (defun gnus-article-save-part (n)
4739 (gnus-article-part-wrapper n 'mm-save-part))
4741 (defun gnus-article-interactively-view-part (n)
4744 (gnus-article-part-wrapper n 'mm-interactively-view-part))
4746 (defun gnus-article-copy-part (n)
4749 (gnus-article-part-wrapper n 'gnus-mime-copy-part))
4751 (defun gnus-article-view-part-as-charset (n)
4755 (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
4757 (defun gnus-article-view-part-externally (n)
4760 (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
4762 (defun gnus-article-inline-part (n)
4765 (gnus-article-part-wrapper n 'gnus-mime-inline-part))
4767 (defun gnus-article-mime-match-handle-first (condition)
4769 (let ((alist gnus-article-mime-handle-alist) ihandle n)
4781 (gnus-article-goto-part (car ihandle))
4787 (defun gnus-article-view-part (&optional n)
4791 (set-buffer gnus-article-buffer)
4792 (or (numberp n) (setq n (gnus-article-mime-match-handle-first
4793 gnus-article-mime-match-handle-function)))
4794 (when (> n (length gnus-article-mime-handle-alist))
4796 (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
4797 (when (gnus-article-goto-part n)
4799 (gnus-article-press-button)
4800 (when (eq (gnus-mm-display-part handle) 'internal)
4801 (gnus-set-window-start)))))))
4803 (defsubst gnus-article-mime-total-parts ()
4804 (if (bufferp (car gnus-article-mime-handles))
4806 (1- (length gnus-article-mime-handles))))
4808 (defun gnus-mm-display-part (handle)
4810 (let ((id (get-text-property (point) 'gnus-part))
4816 (mail-parse-charset gnus-newsgroup-charset)
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))
4833 (mm-display-part handle)
4837 (mm-display-part handle)
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
4891 article-type annotation
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))
4965 (article-goto-body)
4967 (let ((gnus-displaying-mime t))
4968 (gnus-mime-display-part handles)))
4970 (article-goto-body)
4972 (gnus-treat-article nil 1 1)
4978 (article-goto-body)
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))
5038 ;;;!!! Unfortunately we are unable to let W3 display those
5039 ;;;!!! included images, so we just display it as a mixed multipart.
5040 ;;(gnus-mime-display-mixed (cdr handle))
5041 ;;;!!! No, w3 can display everything just fine.
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)
5066 display text)
5078 (mm-automatic-display-p handle)
5082 (mm-automatic-external-display-p type)))
5083 (setq display t)
5086 (let ((id (1+ (length gnus-article-mime-handle-alist)))
5088 (push (cons id handle) gnus-article-mime-handle-alist)
5089 (when (and display
5096 (when (or (not display)
5097 (not (gnus-unbuttonized-mime-type-p type)))
5098 (gnus-insert-mime-button
5099 handle id (list (or display (and not-attachment text))))
5100 (gnus-article-insert-newline)
5105 (display
5109 (let ((mail-parse-charset gnus-newsgroup-charset)
5112 (set-buffer gnus-summary-buffer)
5114 gnus-newsgroup-ignored-charsets)))
5115 (mm-display-part handle t))
5121 (gnus-article-insert-newline)
5128 ((eq charset 'gnus-decoded)
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
5202 article-type multipart))
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)))
5239 (mm-display-part preferred)
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
5279 in the article mode line when the washing function is active, and OFF
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 ()
5287 "Return a string which display status of article washing."
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)
5310 (add-to-list 'gnus-article-wash-types type))
5312 (defun gnus-delete-wash-type (type)
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
5349 top of a file. Otherwise, this function saves a raw article without
5353 (coding gnus-article-save-coding-system)
5396 (defun gnus-narrow-to-page (&optional arg)
5397 "Narrow the article buffer to a page.
5402 (set-buffer gnus-article-buffer)
5406 (when (gnus-visual-p 'page-marker)
5408 (gnus-remove-text-with-property 'gnus-prev)
5409 (gnus-remove-text-with-property 'gnus-next)))
5418 (setq gnus-page-broken
5420 (when gnus-page-broken
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 ()
5440 "Show the next page of the article."
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 ()
5448 "Show the previous page of the article."
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 ()
5457 ;; "Show the next page of the article."
5459 ;; (gnus-eval-in-buffer-window gnus-summary-buffer
5460 ;; (gnus-summary-next-page)))
5462 ;; (defun gnus-article-goto-prev-page ()
5463 ;; "Show the next page of the article."
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.
5470 If end of article, return non-nil. Otherwise return nil.
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 ()
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.
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 ()
5549 "Decide whether there is only boring text remaining in the article.
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 ()
5567 "Read article specified by message-id around point."
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))
5582 (error "There is no summary buffer for this article buffer")
5583 (gnus-article-set-globals)
5584 (gnus-configure-windows 'article)
5585 (gnus-summary-goto-subject gnus-current-article)
5586 (gnus-summary-position-point)))
5588 (defun gnus-article-describe-briefly ()
5589 "Describe article mode commands 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 ()
5599 (switch-to-buffer gnus-article-current-summary 'norecord)
5606 (defun gnus-article-summary-command-nosave ()
5610 (pop-to-buffer gnus-article-current-summary 'norecord)
5614 (defun gnus-article-check-buffer ()
5615 "Beep if not in an article buffer."
5616 (unless (equal major-mode 'gnus-article-mode)
5617 (error "Command invoked outside of a Gnus article buffer")))
5619 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
5620 "Read a summary buffer key sequence and execute it from the article buffer."
5622 (gnus-article-check-buffer)
5627 (nosave-but-article
5629 (nosave-in-article
5635 (set-buffer gnus-article-current-summary)
5636 (let (gnus-pick-mode)
5645 (member keys nosave-but-article)
5646 (member keys nosave-in-article))
5649 (pop-to-buffer gnus-article-current-summary 'norecord)
5651 (let (gnus-pick-mode)
5656 (unless (member keys nosave-in-article)
5657 (set-buffer gnus-article-current-summary))
5660 (when (member keys nosave-but-article)
5661 (pop-to-buffer gnus-article-buffer 'norecord)))
5668 (pop-to-buffer gnus-article-current-summary 'norecord))
5669 ((setq win (get-buffer-window gnus-article-current-summary))
5672 (switch-to-buffer gnus-article-current-summary 'norecord)))
5675 (if (and (setq func (let (gnus-pick-mode)
5685 (setq selected (gnus-summary-select-article))
5690 (article-goto-body)
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)
5748 the entire article will be yanked."
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
5762 (list (list article contents)) wide)))))
5764 (defun gnus-article-followup-with-original ()
5765 "Compose a followup to the current article.
5767 the entire article will be yanked."
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
5781 (list (list article contents)))))))
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 ()
5795 "Do some article highlighting if article highlighting is requested."
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)
5810 "Get an article and insert it into this buffer."
5815 (gnus-kill-all-overlays)
5816 (setq group (or group gnus-newsgroup-name))
5818 ;; Using `gnus-request-article' directly will insert the article into
5820 ;; copy it from the server buffer into the article buffer.
5822 ;; We only request an article by message-id when we do not have the
5824 (when (stringp article)
5825 (gnus-read-header article))
5827 ;; If the article number is negative, that means that this article
5830 (when (and (numberp 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)))
5837 (when (< article 0)
5839 ((memq article gnus-newsgroup-sparse)
5840 ;; This is a sparse gap article.
5841 (setq do-update-line article)
5842 (setq article (mail-header-id header))
5843 (setq sparse-header (gnus-read-header article))
5844 (setq gnus-newsgroup-sparse
5845 (delq article gnus-newsgroup-sparse)))
5847 ;; It's a real article.
5848 (setq article (mail-header-id header)))
5850 ;; It is an extracted pseudo-article.
5851 (setq article 'pseudo)
5852 (gnus-request-pseudo-article header))))
5854 (let ((method (gnus-find-method-for-group
5855 gnus-newsgroup-name)))
5862 (setq article 'nneething)
5863 (gnus-group-enter-directory dir))))))))
5867 ((and (numberp article)
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)
5878 (numberp article)
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)
5884 'article)
5886 ((and gnus-keep-backlog
5887 (gnus-backlog-request-article group article (current-buffer)))
5888 'article)
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)))
5894 'article)
5896 ((and gnus-use-cache
5897 (numberp article)
5898 (gnus-cache-request-article article group))
5899 'article)
5901 ((gnus-agent-request-article article group)
5902 'article)
5903 ;; Get the article and put into the article buffer.
5904 ((or (stringp article)
5905 (numberp article))
5906 (let ((gnus-override-method gnus-override-method)
5907 (methods (and (stringp article)
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))
5931 (when (numberp article)
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))))
5937 (setq result 'article))
5939 (setq gnus-override-method (pop methods)))
5943 ;; retry; otherwise, assume the article has expired.
5945 (and (eq result 'article) 'article)))
5947 (t article)))
5949 ;; Associate this article with the current summary buffer.
5950 (setq gnus-article-current-summary gnus-summary-buffer)
5952 ;; Take the article from the original article buffer
5954 (when (and (get-buffer gnus-article-buffer)
5956 (buffer-name (get-buffer gnus-article-buffer))))
5958 (if (get-buffer gnus-original-article-buffer)
5959 (set-buffer gnus-original-article-buffer)
5960 (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
5962 (setq major-mode 'gnus-original-article-mode)
5966 (insert-buffer-substring gnus-article-buffer))
5967 (setq gnus-original-article (cons group article)))
5970 (run-hooks 'gnus-article-decode-hook)
5971 ;; Mark article as decoded or not.
5972 (setq gnus-article-decoded-p gnus-article-decode-hook))
5976 (or (numberp article)
5977 (stringp article)))
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
5991 "Hook run in article edit mode buffers."
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."
6101 (set-buffer gnus-article-buffer)
6103 ;; Don't associate the article buffer with a draft file.
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)
6114 "Update the article edits and exit."
6116 (let ((func gnus-article-edit-done-function)
6120 (winconf gnus-prev-winconf))
6125 (when gnus-keep-backlog
6126 (gnus-backlog-remove-article
6127 (car gnus-article-current) (cdr gnus-article-current)))
6128 ;; Flush original article as well.
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)))
6136 ;; We remove all text props from the article buffer.
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 ()
6147 "Exit the article editing without updating."
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)
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)
6584 ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
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))
6690 "*Alist of regexps matching buttons in article bodies.
6703 :group 'gnus-article-buttons
6712 (defcustom gnus-header-button-alist
6714 0 (>= gnus-button-message-level 0) gnus-button-message-id 0)
6716 1 (>= gnus-button-message-level 0) gnus-button-reply 1)
6718 0 (>= gnus-button-message-level 0) gnus-msg-mail 0)
6719 ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp
6720 0 (>= gnus-button-browse-level 0) browse-url 0)
6721 ("^Subject:" gnus-button-url-regexp
6722 0 (>= gnus-button-browse-level 0) browse-url 0)
6723 ("^[^:]+:" gnus-button-url-regexp
6724 0 (>= gnus-button-browse-level 0) browse-url 0)
6726 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
6728 1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
6729 "*Alist of headers and regexps to match buttons in article heads.
6731 This alist is very similar to `gnus-button-alist', except that each
6737 `gnus-button-alist'."
6738 :group 'gnus-article-buttons
6739 :group 'gnus-article-headers
6751 (defun gnus-article-push-button (event)
6753 If the text under the mouse pointer has a `gnus-callback' property,
6754 call it with the value of the `gnus-data' text property."
6758 (data (get-text-property pos 'gnus-data))
6759 (fun (get-text-property pos 'gnus-callback)))
6764 (defun gnus-article-press-button ()
6766 If the text at point has a `gnus-callback' property,
6767 call it with the value of the `gnus-data' text property."
6769 (let ((data (get-text-property (point) 'gnus-data))
6770 (fun (get-text-property (point) 'gnus-callback)))
6774 (defun gnus-article-highlight (&optional force)
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)
6807 entry regexp header-face field-face from hpoints fpoints)
6808 (article-narrow-to-head)
6816 header-face (nth 1 entry)
6817 field-face (nth 2 entry))
6824 (when (and header-face
6827 (gnus-put-text-property from (point) 'face header-face))
6828 (when (and field-face
6834 (gnus-put-text-property from (point) 'face field-face))))))))
6836 (defun gnus-article-highlight-signature ()
6837 "Highlight the signature in an article.
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)
6862 "Find external references in the article and make buttons of them.
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))
6886 (article-goto-body)
6897 (not (gnus-button-in-region-p
6898 start end 'gnus-callback)))
6901 (gnus-article-add-button
6902 start end 'gnus-button-push
6904 gnus-button-marker-list))))))))))
6906 ;; Add buttons to the head of an article.
6907 (defun gnus-article-add-buttons-to-head ()
6908 "Add buttons to the head of the article."
6911 (set-buffer gnus-article-buffer)
6916 (alist gnus-header-button-alist)
6918 (article-narrow-to-head)
6939 (gnus-article-add-button
6947 (defun gnus-article-add-button (from to fun &optional data)
6949 (when gnus-article-button-face
6950 (gnus-overlay-put (gnus-make-overlay from to)
6951 'face gnus-article-button-face))
6952 (gnus-add-text-properties
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)
6973 (if (text-property-any end (point-max) 'article-type 'signature)
6975 (gnus-delete-wash-type 'signature)
6976 (gnus-remove-text-properties-when
6977 'article-type 'signature end (point-max)
6978 (cons 'article-type (cons 'signature
6979 gnus-hidden-properties))))
6980 (gnus-add-wash-type 'signature)
6981 (gnus-add-text-properties-when
6982 'article-type nil end (point-max)
6983 (cons 'article-type (cons 'signature
6984 gnus-hidden-properties)))))
6985 (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
6986 (gnus-set-mode-line 'article))))
6988 (defun gnus-button-entry ()
6989 ;; Return the first entry in `gnus-button-alist' matching this place.
6990 (let ((alist gnus-button-alist)
6999 (defun gnus-button-push (marker)
7003 (let* ((entry (gnus-button-entry))
7008 (gnus-set-text-properties
7019 (gnus-message 1 "You must define `%S' to use this button"
7022 (defun gnus-parse-news-url (url)
7049 (defun gnus-button-handle-news (url)
7052 (gnus-parse-news-url url)
7056 (set-buffer gnus-summary-buffer)
7058 (let ((gnus-refer-article-method
7060 gnus-refer-article-method))
7062 (gnus-message 7 "Fetching %s with %s"
7063 message-id gnus-refer-article-method)
7064 (gnus-summary-refer-article message-id))
7065 (gnus-summary-refer-article message-id))))
7067 (gnus-button-fetch-group url)))))
7069 (defun gnus-button-handle-man (url)
7071 (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
7072 (when (eq gnus-button-man-handler 'woman)
7073 (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
7074 (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
7075 (funcall gnus-button-man-handler url))
7077 (defun gnus-button-handle-info-url (url)
7082 (gnus-info-find-node
7083 (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
7085 ")" (gnus-url-unhex-string (match-string 2 url)))))
7088 (gnus-replace-in-string
7089 (gnus-replace-in-string url "[\n\t ]+" " ") "\"" ""))
7090 (gnus-info-find-node url))
7093 (defun gnus-button-handle-info-url-gnome (url)
7097 (gnus-info-find-node
7099 (gnus-url-unhex-string
7102 (or (gnus-url-unhex-string
7107 (defun gnus-button-handle-info-url-kde (url)
7109 (gnus-info-find-node (gnus-url-unhex-string url)))
7111 (defun gnus-button-handle-info-keystrokes (url)
7113 ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
7118 (defun gnus-button-message-id (message-id)
7121 (set-buffer gnus-summary-buffer)
7122 (gnus-summary-refer-article message-id)))
7124 (defun gnus-button-fetch-group (address)
7128 (gnus-group-read-ephemeral-group address gnus-select-method)
7134 (gnus-group-read-ephemeral-group
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)))
7194 ;;; Next/prev buttons in the article buffer.
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
7225 article-type annotation))
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
7257 article-type annotation))
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)
7327 (article-goto-body-goes-to-point-min-p t)
7331 (let ((list gnus-article-treat-types))
7335 (highlightp (gnus-visual-p 'article-highlight 'highlight))
7337 (gnus-run-hooks 'gnus-part-display-hook)
7341 (when (gnus-buffer-live-p gnus-summary-buffer)
7342 (set-buffer gnus-summary-buffer))
7346 (gnus-treat-predicate val)
7360 (defun gnus-treat-predicate (val)
7368 (apply 'gnus-or (mapcar `(lambda (s)
7369 (string-match s ,(or gnus-newsgroup-name "")))
7375 (apply 'gnus-or (mapcar 'gnus-treat-predicate val)))
7377 (apply 'gnus-and (mapcar 'gnus-treat-predicate val)))
7379 (not (gnus-treat-predicate (car val))))
7395 (defun gnus-article-encrypt-body (protocol &optional n)
7396 "Encrypt the article body."
7399 (or gnus-article-encrypt-protocol
7401 gnus-article-encrypt-protocol-alist
7404 (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
7407 (if (member gnus-newsgroup-name '("nndraft:delayed"
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
7501 "If non-nil, show details in the article buffer.")
7503 (defun gnus-mime-security-verify-or-decrypt (handle)
7505 (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
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
7602 article-type annotation
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