lisp/gnus/gnus-art.el

0 ;;; gnus-art.el --- article mode commands for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
9 ;; This file is part of GNU Emacs.
12 ;; it under the terms of the GNU General Public License as published by
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; You should have received a copy of the GNU General Public License
35 (require 'gnus)
36 (require 'gnus-sum)
37 (require 'gnus-spec)
38 (require 'gnus-int)
39 (require 'gnus-win)
48 (autoload 'gnus-msg-mail "gnus-msg" nil t)
49 (autoload 'gnus-button-mailto "gnus-msg")
50 (autoload 'gnus-button-reply "gnus-msg" nil t)
54 (defgroup gnus-article nil
56   :link '(custom-manual "(gnus)Article Buffer")
57   :group 'gnus)
59 (defgroup gnus-article-treat nil
61   :link '(custom-manual "(gnus)Article Hiding")
62   :group 'gnus-article)
64 (defgroup gnus-article-hiding nil
66   :link '(custom-manual "(gnus)Article Hiding")
67   :group 'gnus-article)
69 (defgroup gnus-article-highlight nil
71   :link '(custom-manual "(gnus)Article Highlighting")
72   :group 'gnus-article
73   :group 'gnus-visual)
75 (defgroup gnus-article-signature nil
77   :link '(custom-manual "(gnus)Article Signature")
78   :group 'gnus-article)
80 (defgroup gnus-article-headers nil
82   :link '(custom-manual "(gnus)Hiding Headers")
83   :group 'gnus-article)
85 (defgroup gnus-article-washing nil
86   "Special commands on articles."
87   :link '(custom-manual "(gnus)Article Washing")
88   :group 'gnus-article)
90 (defgroup gnus-article-emphasis nil
91   "Fontisizing articles."
92   :link '(custom-manual "(gnus)Article Fontisizing")
93   :group 'gnus-article)
95 (defgroup gnus-article-saving nil
96   "Saving articles."
97   :link '(custom-manual "(gnus)Saving Articles")
98   :group 'gnus-article)
100 (defgroup gnus-article-mime nil
102   :link '(custom-manual "(gnus)Using MIME")
103   :group 'gnus-article)
105 (defgroup gnus-article-buttons nil
107   :link '(custom-manual "(gnus)Article Buttons")
108   :group 'gnus-article)
110 (defgroup gnus-article-various nil
112   :link '(custom-manual "(gnus)Misc Article")
113   :group 'gnus-article)
115 (defcustom gnus-ignored-headers
158 This variable can also be a list of regexps of headers to be ignored.
159 If `gnus-visible-headers' is non-nil, this variable will be ignored."
163   :group 'gnus-article-hiding)
165 (defcustom gnus-visible-headers
168 This variable can also be a list of regexp of headers to remain visible.
169 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
174 			      (widget-editable-list-match widget value)))
176   :group 'gnus-article-hiding)
178 (defcustom gnus-sorted-header-list
181   "*This variable is a list of regular expressions.
184 this list."
186   :group 'gnus-article-hiding)
188 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
190 Possible values in this list are:
195   'to-list     To identical to To-list.
196   'cc-list     CC identical to To-list.
205 	      (const :tag "To identical to To-list." to-list)
206 	      (const :tag "CC identical to To-list." cc-list)
212   :group 'gnus-article-hiding)
214 (defcustom gnus-article-skip-boring nil
218 only of boring text.  Boring text is controlled by
219 `gnus-article-boring-faces'."
222   :group 'gnus-article-hiding)
224 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
226 This can also be a list of regexps.  In that case, it will be checked
228 the end of the buffer."
231 		 (repeat :tag "List of regexp" regexp))
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)
250   "Property list to use for hiding text."
252   :group 'gnus-article-hiding)
256 (defcustom gnus-article-x-face-command
258       (if (or (gnus-image-type-available-p 'xface)
259 	      (gnus-image-type-available-p 'pbm))
260 	  'gnus-display-x-face-in-from
262     (if (gnus-image-type-available-p 'pbm)
263 	'gnus-display-x-face-in-from
270 		 (function-item gnus-display-x-face-in-from)
273   :group 'gnus-picon
274   :group 'gnus-article-washing)
276 (defcustom gnus-article-x-face-too-ugly nil
279   :group 'gnus-article-washing)
281 (defcustom gnus-article-banner-alist nil
287   :group 'gnus-article-washing)
289 (gnus-define-group-parameter
292  "Alist of regexps (to match group names) and banner."
293  :variable-group gnus-article-washing
298 	  (symbol :tag "Item in `gnus-article-banner-alist'" none)
302  "If non-nil, specify how to remove `banners' from articles.
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
311   "Alist of mail addresses and banners.
313 to match a mail address in the From: header, BANNER is one of a symbol
314 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
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
340        (list (format format (car (car value)) (cdr (car value)))
346 (defun gnus-emphasis-custom-value-to-internal (value)
347   (gnus-emphasis-custom-with-format
354 	 (list (cons (match-string 1 pattern) (match-string 2 pattern))
359 (defcustom gnus-emphasis-alist
369      (gnus-emphasis-custom-with-format
371 		(list (format format (car spec) (cadr spec))
374 		      (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
381        ;; 2 3 gnus-emphasis-strikethru)
383 	2 3 gnus-emphasis-underline))))
411 		     (gnus-emphasis-custom-value-to-external value))))
426 	 (mapcar 'gnus-emphasis-custom-value-to-internal
429 	 (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
431   :group 'gnus-article-emphasis)
433 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
436 The former avoids underlining of leading and trailing whitespace,
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
496 This will be overridden by the `:headers' property that the symbol of
497 the saver function, which is specified by `gnus-default-article-saver',
499   :group 'gnus-article-saving
502 (defcustom gnus-prompt-before-saving 'always
503   "*This variable says how much prompting is to be done when saving articles.
504 If it is nil, no prompting will be done, and the articles will be
507 saving large batches of articles.  If this variable is neither nil not
509 each invocation of the saving commands."
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
521 that the symbol of the saver function, which is specified by
522 `gnus-default-article-saver', might have."
523   :group 'gnus-article-saving
526 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
527   "A function to save articles in your favourite format.
528 The function will be called by way of the `gnus-summary-save-article'
529 command, and friends such as `gnus-summary-save-article-rmail'.
533 * gnus-summary-save-in-rmail (Rmail format)
534 * gnus-summary-save-in-mail (Unix mail format)
535 * gnus-summary-save-in-folder (MH folder)
536 * gnus-summary-save-in-file (article format)
537 * gnus-summary-save-body-in-file (article body)
538 * gnus-summary-save-in-vm (use VM's folder format)
539 * gnus-summary-write-to-file (article format -- overwrite)
540 * gnus-summary-write-body-to-file (article body -- overwrite)
542 The symbol of each function may have the following properties:
545 The value non-nil means save decoded articles.  This is meaningful
546 only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
547 `gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'.
551 overwrites, articles to a file.  This implies that when saving many
552 articles at a time, `gnus-prompt-before-saving' is bound to t and all
553 articles are saved in a single file.  This is meaningful only with
554 `gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'.
557 The value specifies the symbol of a variable of which the value
559 `gnus-save-all-headers' and `gnus-saved-headers' control what
561   :group 'gnus-article-saving
562   :type '(radio (function-item gnus-summary-save-in-rmail)
563 		(function-item gnus-summary-save-in-mail)
564 		(function-item gnus-summary-save-in-folder)
565 		(function-item gnus-summary-save-in-file)
566 		(function-item gnus-summary-save-body-in-file)
567 		(function-item gnus-summary-save-in-vm)
568 		(function-item gnus-summary-write-to-file)
569 		(function-item gnus-summary-write-body-to-file)
572 (defcustom gnus-article-save-coding-system
577   "Coding system used to save decoded articles to a file.
583 * gnus-summary-save-article-file
584 * gnus-summary-save-article-body-file
585 * gnus-summary-write-article-file
586 * gnus-summary-write-article-body-file
588 and the functions to which you may set `gnus-default-article-saver':
590 * gnus-summary-save-in-file
591 * gnus-summary-save-body-in-file
592 * gnus-summary-write-to-file
593 * gnus-summary-write-body-to-file
596 buffer to a file if the value of this variable is non-nil.  Note that
598 Otherwise, raw articles will be saved."
599   :group 'gnus-article-saving
602 	  (const :tag "Save raw articles" nil)
612 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
613   "A function generating a file name to save articles in Rmail format.
615   :group 'gnus-article-saving
618 (defcustom gnus-mail-save-name 'gnus-plain-save-name
619   "A function generating a file name to save articles in Unix mail format.
621   :group 'gnus-article-saving
624 (defcustom gnus-folder-save-name 'gnus-folder-save-name
625   "A function generating a file name to save articles in MH folder.
627   :group 'gnus-article-saving
630 (defcustom gnus-file-save-name 'gnus-numeric-save-name
631   "A function generating a file name to save articles in article format.
634   :group 'gnus-article-saving
637 (defcustom gnus-split-methods
638   '((gnus-article-archive-name)
639     (gnus-article-nndoc-name))
640   "*Variable used to suggest where articles are to be saved.
641 For instance, if you would like to save articles related to Gnus in
642 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
645  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
649 value is a list of possible files to save in if the match is non-nil.
653 from the buffer of the article to be saved with the newsgroup as the
654 parameter.  If it is a list, it will be evaled in the same buffer.
657 a possible file name; and if it returns a non-nil list, that list will
659   :group 'gnus-article-saving
660   :type '(repeat (choice (list :value (fun) function)
664 (defcustom gnus-page-delimiter "^\^L"
667 beginning of a line."
669   :group 'gnus-article-various)
671 (defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
673 See `gnus-summary-mode-line-format' for a closer description.
678 %m  The number of MIME parts in the article."
680   :group 'gnus-article-various)
682 (defcustom gnus-article-mode-hook nil
685   :group 'gnus-article-various)
688   ;; Extracted from gnus-xmas-define in order to preserve user settings
690     (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
691   ;; Extracted from gnus-xmas-redefine in order to preserve user settings
692   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
694 (defcustom gnus-article-menu-hook nil
695   "*Hook run after the creation of the article mode menu."
697   :group 'gnus-article-various)
699 (defcustom gnus-article-prepare-hook nil
702   :group 'gnus-article-various)
704 (make-obsolete-variable 'gnus-article-hide-pgp-hook
707 (defcustom gnus-article-button-face 'bold
710 An article button is a piece of text that you can activate by pressing
713   :group 'gnus-article-buttons)
715 (defcustom gnus-article-mouse-face 'highlight
721   :group 'gnus-article-buttons)
723 (defcustom gnus-signature-face 'gnus-signature
725 Obsolete; use the face `gnus-signature' for customizations instead."
727   :group 'gnus-article-highlight
728   :group 'gnus-article-signature)
730 (defface gnus-signature
734   :group 'gnus-article-highlight
735   :group 'gnus-article-signature)
737 (put 'gnus-signature-face 'face-alias 'gnus-signature)
739 (defface gnus-header-from
749   :group 'gnus-article-headers
750   :group 'gnus-article-highlight)
752 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
754 (defface gnus-header-subject
764   :group 'gnus-article-headers
765   :group 'gnus-article-highlight)
767 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
769 (defface gnus-header-newsgroups
780 articles."
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.
822 An alist of the form (HEADER NAME CONTENT).
824 HEADER is a regular expression which should match the name of a
827 The name of each header field will be displayed using the face
828 specified by the first element in the list where HEADER matches
831   :group 'gnus-article-headers
832   :group 'gnus-article-highlight
833   :type '(repeat (list (regexp :tag "Header")
841 (defcustom gnus-article-decode-hook
844   "*Hook run to decode charsets in articles."
845   :group 'gnus-article-headers
848 (defcustom gnus-display-mime-function 'gnus-display-mime
849   "Function to display MIME articles."
850   :group 'gnus-article-mime
853 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
856 (defvar gnus-decode-address-function 'mail-decode-encoded-address-region
859 (defvar gnus-article-dumbquotes-map
881 (defcustom gnus-ignored-mime-types nil
882   "List of MIME types that should be ignored by Gnus."
884   :group 'gnus-article-mime
887 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
888   "List of MIME types that should not be given buttons when rendered inline.
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
896   "List of MIME types that should be given buttons when rendered inline.
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"
927   "Defines the location of the faces database.
928 For information on obtaining this database of pretty pictures, please
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))
997   "An alist of actions that run on the MIME attachment."
998   :group 'gnus-article-mime
1006 (defvar gnus-part-display-hook nil
1009 (defvar gnus-article-treat-custom
1018 (defvar gnus-article-treat-head-custom
1022 (defvar gnus-article-treat-types '("text/plain")
1025 (defvar gnus-inhibit-treatment nil
1028 (defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
1031 See Info node `(gnus)Customizing Articles'."
1032   :group 'gnus-article-treat
1033   :link '(custom-manual "(gnus)Customizing Articles")
1034   :type gnus-article-treat-custom)
1035 (put 'gnus-treat-highlight-signature 'highlight t)
1037 (defcustom gnus-treat-buttonize 100000
1040 See Info node `(gnus)Customizing Articles'."
1041   :group 'gnus-article-treat
1042   :link '(custom-manual "(gnus)Customizing Articles")
1043   :type gnus-article-treat-custom)
1044 (put 'gnus-treat-buttonize 'highlight t)
1046 (defcustom gnus-treat-buttonize-head 'head
1049 See Info node `(gnus)Customizing Articles' for details."
1050   :group 'gnus-article-treat
1051   :link '(custom-manual "(gnus)Customizing Articles")
1052   :type gnus-article-treat-head-custom)
1053 (put 'gnus-treat-buttonize-head 'highlight t)
1055 (defcustom gnus-treat-emphasize
1062 See Info node `(gnus)Customizing Articles' for details."
1063   :group 'gnus-article-treat
1064   :link '(custom-manual "(gnus)Customizing Articles")
1065   :type gnus-article-treat-custom)
1066 (put 'gnus-treat-emphasize 'highlight t)
1068 (defcustom gnus-treat-strip-cr nil
1071 See Info node `(gnus)Customizing Articles' for details."
1073   :group 'gnus-article-treat
1074   :link '(custom-manual "(gnus)Customizing Articles")
1075   :type gnus-article-treat-custom)
1077 (defcustom gnus-treat-unsplit-urls nil
1080 See Info node `(gnus)Customizing Articles' for details."
1082   :group 'gnus-article-treat
1083   :link '(custom-manual "(gnus)Customizing Articles")
1084   :type gnus-article-treat-custom)
1086 (defcustom gnus-treat-leading-whitespace nil
1089 See Info node `(gnus)Customizing Articles' for details."
1091   :group 'gnus-article-treat
1092   :link '(custom-manual "(gnus)Customizing Articles")
1093   :type gnus-article-treat-custom)
1095 (defcustom gnus-treat-hide-headers 'head
1098 See Info node `(gnus)Customizing Articles' for details."
1099   :group 'gnus-article-treat
1100   :link '(custom-manual "(gnus)Customizing Articles")
1101   :type gnus-article-treat-head-custom)
1103 (defcustom gnus-treat-hide-boring-headers nil
1106 See Info node `(gnus)Customizing Articles' for details."
1107   :group 'gnus-article-treat
1108   :link '(custom-manual "(gnus)Customizing Articles")
1109   :type gnus-article-treat-head-custom)
1111 (defcustom gnus-treat-hide-signature nil
1114 See Info node `(gnus)Customizing Articles' for details."
1115   :group 'gnus-article-treat
1116   :link '(custom-manual "(gnus)Customizing Articles")
1117   :type gnus-article-treat-custom)
1119 (defcustom gnus-treat-fill-article nil
1122 See Info node `(gnus)Customizing Articles' for details."
1123   :group 'gnus-article-treat
1124   :link '(custom-manual "(gnus)Customizing Articles")
1125   :type gnus-article-treat-custom)
1127 (defcustom gnus-treat-hide-citation nil
1130 See Info node `(gnus)Customizing Articles' for details."
1131   :group 'gnus-article-treat
1132   :link '(custom-manual "(gnus)Customizing Articles")
1133   :type gnus-article-treat-custom)
1135 (defcustom gnus-treat-hide-citation-maybe nil
1138 See Info node `(gnus)Customizing Articles' for details."
1139   :group 'gnus-article-treat
1140   :link '(custom-manual "(gnus)Customizing Articles")
1141   :type gnus-article-treat-custom)
1143 (defcustom gnus-treat-strip-list-identifiers 'head
1144   "Strip list identifiers from `gnus-list-identifiers`.
1146 See Info node `(gnus)Customizing Articles' for details."
1148   :group 'gnus-article-treat
1149   :link '(custom-manual "(gnus)Customizing Articles")
1150   :type gnus-article-treat-custom)
1152 (make-obsolete-variable 'gnus-treat-strip-pgp
1155 (defcustom gnus-treat-strip-pem nil
1158 See Info node `(gnus)Customizing Articles' for details."
1159   :group 'gnus-article-treat
1160   :link '(custom-manual "(gnus)Customizing Articles")
1161   :type gnus-article-treat-custom)
1163 (defcustom gnus-treat-strip-banner t
1164   "Strip banners from articles.
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
1207   "Display the Date in a format that can be read aloud in English.
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
1250   "Strip the X-No-Archive header line from the beginning of the body.
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)
1442   "Draw a boundary at the end of the headers.
1444 See Info node `(gnus)Customizing Articles' for details."
1446   :group 'gnus-article-treat
1447   :link '(custom-manual "(gnus)Customizing Articles")
1448   :type gnus-article-treat-head-custom)
1450 (defcustom gnus-treat-capitalize-sentences nil
1453 See Info node `(gnus)Customizing Articles' for details."
1455   :group 'gnus-article-treat
1456   :link '(custom-manual "(gnus)Customizing Articles")
1457   :type gnus-article-treat-custom)
1459 (defcustom gnus-treat-wash-html nil
1462 See Info node `(gnus)Customizing Articles' for details."
1464   :group 'gnus-article-treat
1465   :link '(custom-manual "(gnus)Customizing Articles")
1466   :type gnus-article-treat-custom)
1468 (defcustom gnus-treat-fill-long-lines nil
1471 See Info node `(gnus)Customizing Articles' for details."
1472   :group 'gnus-article-treat
1473   :link '(custom-manual "(gnus)Customizing Articles")
1474   :type gnus-article-treat-custom)
1476 (defcustom gnus-treat-play-sounds nil
1479 See Info node `(gnus)Customizing Articles' for details."
1481   :group 'gnus-article-treat
1482   :link '(custom-manual "(gnus)Customizing Articles")
1483   :type gnus-article-treat-custom)
1485 (defcustom gnus-treat-translate nil
1486   "Translate articles from one language to another.
1488 See Info node `(gnus)Customizing Articles' for details."
1490   :group 'gnus-article-treat
1491   :link '(custom-manual "(gnus)Customizing Articles")
1492   :type gnus-article-treat-custom)
1494 (defcustom gnus-treat-x-pgp-sig nil
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"
1511   "The protocol used for encrypt articles.
1517 (defvar gnus-article-wash-function nil
1520 (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
1523   "Whether IDNA decoding of headers is used when viewing messages.
1526   :group 'gnus-article-headers
1529 (defcustom gnus-article-over-scroll nil
1532   :group 'gnus-article
1537 (defvar gnus-english-month-names
1542 (defvar gnus-article-wash-types nil)
1543 (defvar gnus-article-emphasis-alist nil)
1544 (defvar gnus-article-image-alist nil)
1546 (defvar gnus-article-mime-handle-alist-1 nil)
1547 (defvar gnus-treatment-function-alist
1548   '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
1549     (gnus-treat-strip-banner gnus-article-strip-banner)
1550     (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
1551     (gnus-treat-highlight-signature gnus-article-highlight-signature)
1552     (gnus-treat-buttonize gnus-article-add-buttons)
1553     (gnus-treat-fill-article gnus-article-fill-cited-article)
1554     (gnus-treat-fill-long-lines gnus-article-fill-long-lines)
1555     (gnus-treat-strip-cr gnus-article-remove-cr)
1556     (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1557     (gnus-treat-date-ut gnus-article-date-ut)
1558     (gnus-treat-date-local gnus-article-date-local)
1559     (gnus-treat-date-english gnus-article-date-english)
1560     (gnus-treat-date-original gnus-article-date-original)
1561     (gnus-treat-date-user-defined gnus-article-date-user)
1562     (gnus-treat-date-iso8601 gnus-article-date-iso8601)
1563     (gnus-treat-date-lapsed gnus-article-date-lapsed)
1564     (gnus-treat-display-x-face gnus-article-display-x-face)
1565     (gnus-treat-display-face gnus-article-display-face)
1566     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
1567     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
1568     (gnus-treat-hide-signature gnus-article-hide-signature)
1569     (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
1570     (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
1571     (gnus-treat-strip-pem gnus-article-hide-pem)
1572     (gnus-treat-from-picon gnus-treat-from-picon)
1573     (gnus-treat-mail-picon gnus-treat-mail-picon)
1574     (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
1575     (gnus-treat-highlight-headers gnus-article-highlight-headers)
1576     (gnus-treat-highlight-signature gnus-article-highlight-signature)
1577     (gnus-treat-strip-trailing-blank-lines
1578      gnus-article-remove-trailing-blank-lines)
1579     (gnus-treat-strip-leading-blank-lines
1580      gnus-article-strip-leading-blank-lines)
1581     (gnus-treat-strip-multiple-blank-lines
1582      gnus-article-strip-multiple-blank-lines)
1583     (gnus-treat-overstrike gnus-article-treat-overstrike)
1584     (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
1585     (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1586     (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
1587     (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
1588     (gnus-treat-display-smileys gnus-treat-smiley)
1589     (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
1590     (gnus-treat-wash-html gnus-article-wash-html)
1591     (gnus-treat-emphasize gnus-article-emphasize)
1592     (gnus-treat-hide-citation gnus-article-hide-citation)
1593     (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
1594     (gnus-treat-highlight-citation gnus-article-highlight-citation)
1595     (gnus-treat-body-boundary gnus-article-treat-body-boundary)
1596     (gnus-treat-play-sounds gnus-earcon-display)))
1598 (defvar gnus-article-mime-handle-alist nil)
1600 (defvar gnus-article-current-summary nil)
1602 (defvar gnus-article-mode-syntax-table
1615 (defvar gnus-save-article-buffer nil)
1617 (defvar gnus-article-mode-line-format-alist
1618   (nconc '((?w (gnus-article-wash-status) ?s)
1619 	   (?m (gnus-article-mime-part-status) ?s))
1620 	 gnus-summary-mode-line-format-alist))
1622 (defvar gnus-number-of-articles-to-be-saved nil)
1624 (defvar gnus-inhibit-hiding nil)
1626 (defvar gnus-article-edit-mode nil)
1630 (defmacro gnus-with-article-headers (&rest forms)
1632      (set-buffer gnus-article-buffer)
1634        (let ((inhibit-read-only t)
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)
1646      (let ((inhibit-read-only t))
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)
1672   "Hide text of TYPE between B and E."
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)
1678   "Unhide text of TYPE between B and E."
1679   (gnus-delete-wash-type type)
1681    b e (cons 'article-type (cons type gnus-hidden-properties)))
1682   (when (memq 'intangible gnus-hidden-properties)
1686 (defun gnus-article-hide-text-of-type (type)
1687   "Hide text of TYPE in the current buffer."
1692 	(add-text-properties b (incf b) gnus-hidden-properties)))))
1694 (defun gnus-article-delete-text-of-type (type)
1695   "Delete text of TYPE in the current buffer."
1702 	    (while (if (get-text-property (point) 'gnus-part)
1705 								'gnus-part))
1708 	      (end-of-line)
1717 (defun gnus-article-delete-invisible-text ()
1726 (defun gnus-article-text-type-exists-p (type)
1727   "Say whether any text of type TYPE exists in the buffer."
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)
1734     (while list
1735       (if (looking-at (car list))
1736 	  (setq list nil)
1737 	(setq list (cdr list))
1745   (unless gnus-inhibit-hiding
1746     (let ((inhibit-read-only nil)
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
1777 	  ;; Hide any "From " lines at the beginning of (mail) articles.
1782 	  ;; Then treat the rest of the header lines.
1784 	  ;; `gnus-ignored-headers' and `gnus-visible-headers' to
1788 	    (beginning-of-line)
1789 	    ;; Mark the rank of the header.
1795 		 (gnus-article-header-rank)
1802 	    (gnus-add-wash-type 'headers)
1808   "Toggle hiding of headers that aren't very interesting.
1811   (interactive (gnus-article-hidden-arg))
1812   (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
1813 	     (not gnus-show-all-headers))
1816 	(let ((inhibit-read-only t)
1817 	      (list gnus-boring-article-headers)
1821 	  (while list
1822 	    (setq elem (pop list))
1829 		(gnus-article-hide-text-type
1830 		 (gnus-point-at-bol)
1832 		   (end-of-line)
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"))))
1859 	     ((eq elem 'to-list)
1861 		    (to-list
1862 		     (gnus-parameter-to-list
1863 		      (if (boundp 'gnus-newsgroup-name)
1864 			  gnus-newsgroup-name ""))))
1865 		(when (and to to-list
1867 			     (gnus-string-equal
1870 			      to-list)))
1871 		  (gnus-article-hide-header "to"))))
1872 	     ((eq elem 'cc-list)
1874 		    (to-list
1875 		     (gnus-parameter-to-list
1876 		      (if (boundp 'gnus-newsgroup-name)
1877 			  gnus-newsgroup-name ""))))
1878 		(when (and cc to-list
1880 			     (gnus-string-equal
1883 			      to-list)))
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)
1962 	 (end-of-line)
1968 (defvar gnus-article-normalized-header-length 40
1969   "Length of normalized headers.")
1974   (let ((inhibit-read-only t)
1981 	   ((< (setq column (- (gnus-point-at-eol) (point)))
1982 	       gnus-article-normalized-header-length)
1983 	    (end-of-line)
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)
2007 you're expecting some kind of apostrophe or quotation mark, then
2010   (article-translate-strings gnus-article-dumbquotes-map))
2013   "Translate all characters in the body of the article according to FROM and TO.
2014 FROM is a string of characters to translate from; to is a string of
2018       (let ((inhibit-read-only t)
2030   "Translate all string in the body of the article according to MAP.
2034       (let ((inhibit-read-only t)
2046       (let ((inhibit-read-only t))
2055 	      (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2058 	      (gnus-article-hide-text-type
2063 	      (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2067 (defun gnus-article-treat-unfold-headers ()
2072   (gnus-with-article-headers
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)
2108 	  (gnus-add-wash-type 'smiley)
2110 	    (gnus-add-image 'smiley image)))))))
2112 (defun gnus-article-remove-images ()
2115   (gnus-with-article-buffer
2116     (dolist (elem gnus-article-image-alist)
2117       (gnus-delete-images (car elem)))))
2119 (defun gnus-article-treat-fold-newsgroups ()
2124   (gnus-with-article-headers
2125     (while (gnus-article-goto-header "newsgroups\\|followup-to")
2133 (defun gnus-article-treat-body-boundary ()
2134   "Place a boundary line at the end of the headers."
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)))))
2154     (let ((inhibit-read-only t)
2160 	    (end-of-line)
2163 				(gnus-point-at-bol))
2174     (let ((inhibit-read-only t)
2185     (let ((inhibit-read-only t))
2197     (let ((inhibit-read-only t))
2204 		     (not (gnus-annotation-in-region-p
2205 			   (point) (gnus-point-at-eol))))
2213   (let ((wash-face-p buffer-read-only))
2214     (gnus-with-article-headers
2219       ;; read-only.
2220       (if (and wash-face-p (memq 'face gnus-article-wash-types))
2221 	  (gnus-delete-images 'face)
2225 		       (gnus-buffer-live-p gnus-original-article-buffer)
2227 	      (set-buffer gnus-original-article-buffer))
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))))))))))
2250   (interactive (list 'force))
2251   (let ((wash-face-p buffer-read-only))	;; When type `W f'
2252     (gnus-with-article-headers
2257       (if (and wash-face-p (memq 'xface gnus-article-wash-types))
2260 	  (gnus-delete-images 'xface)
2265 		       (gnus-buffer-live-p gnus-original-article-buffer)
2267 	      ;; If type `W f', use gnus-original-article-buffer,
2270 	      (set-buffer gnus-original-article-buffer))
2273 	      (while (gnus-article-goto-header "X-Face")
2278 	  (when (stringp gnus-article-x-face-command)
2279 	    (setq x-faces (list (car x-faces))))
2281 		     gnus-article-x-face-command
2284 			 (not gnus-article-x-face-too-ugly)
2286 			      (not (string-match gnus-article-x-face-too-ugly
2290 	      (cond ((stringp gnus-article-x-face-command)
2294 		       (gnus-set-process-query-on-exit-flag
2297 			 shell-command-switch gnus-article-x-face-command)
2304 		    ((functionp gnus-article-x-face-command)
2306 		     (funcall gnus-article-x-face-command face))
2309 			    gnus-article-x-face-command))))))))))
2315     (set-buffer gnus-article-buffer)
2317 	  (inhibit-read-only t)
2318 	  (mail-parse-charset gnus-newsgroup-charset)
2320 	   (save-excursion (set-buffer gnus-summary-buffer)
2321 			   gnus-newsgroup-ignored-charsets)))
2329 	(inhibit-read-only t)
2330 	(mail-parse-charset gnus-newsgroup-charset)
2333 			     (set-buffer gnus-summary-buffer)
2335 			 gnus-newsgroup-ignored-charsets))
2345 			(mm-read-coding-system "Charset to decode: "))
2357 	(when (and (eq mail-parse-charset 'gnus-decoded)
2366 				     (gnus-strip-whitespace cte))))
2372 	(mail-parse-charset gnus-newsgroup-charset)
2375 			     (set-buffer gnus-summary-buffer)
2377 			 gnus-newsgroup-ignored-charsets))
2378 	(inhibit-read-only t)
2393 	  (funcall gnus-decode-address-function start end)
2394 	(funcall gnus-decode-header-function start end))
2400 	(inhibit-read-only t)
2401 	(method (gnus-find-method-for-group gnus-newsgroup-name)))
2402     (when (and (or gnus-group-name-charset-method-alist
2403 		   gnus-group-name-charset-group-alist)
2404 	       (gnus-buffer-live-p gnus-original-article-buffer))
2407 	(with-current-buffer gnus-original-article-buffer
2412 			   (gnus-decode-newsgroups
2414 			    (with-current-buffer gnus-original-article-buffer
2419 			    gnus-newsgroup-name method))
2422 	(with-current-buffer gnus-original-article-buffer
2427 			   (gnus-decode-newsgroups
2429 			    (with-current-buffer gnus-original-article-buffer
2434 			    gnus-newsgroup-name method))
2443   (when gnus-use-idna
2446 	    (inhibit-read-only t))
2460 (defun article-de-quoted-unreadable (&optional force read-charset)
2465   (interactive (list 'force current-prefix-arg))
2467     (let ((inhibit-read-only t) type charset)
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"))
2478       (if read-charset
2479 	  (setq charset (mm-read-coding-system "Charset: " charset)))
2481 	(setq charset gnus-newsgroup-charset))
2489 (defun article-de-base64-unreadable (&optional force read-charset)
2493   (interactive (list 'force current-prefix-arg))
2495     (let ((inhibit-read-only t) type charset)
2496       (if (gnus-buffer-live-p gnus-original-article-buffer)
2497 	  (with-current-buffer gnus-original-article-buffer
2499 		  (gnus-fetch-field "content-transfer-encoding"))
2500 	    (let* ((ct (gnus-fetch-field "content-type"))
2506       (if read-charset
2507 	  (setq charset (mm-read-coding-system "Charset: " charset)))
2509 	(setq charset gnus-newsgroup-charset))
2528     (let ((inhibit-read-only t))
2535     (let ((inhibit-read-only t))
2541       (gnus-treat-article nil))))
2544 (defun article-wash-html (&optional read-charset)
2547 charset defined in `gnus-summary-show-article-charset-alist' is used."
2550     (let ((inhibit-read-only t)
2552       (if read-charset
2553 	  (if (or (and (numberp read-charset)
2556 			      (assq read-charset
2557 				    gnus-summary-show-article-charset-alist))))
2558 		  (setq charset (mm-read-coding-system "Charset: ")))
2559 	      (let ((gnus-summary-show-article-charset-alist
2560 		     (list (cons 1 charset))))
2561 		(with-current-buffer gnus-summary-buffer
2562 		  (gnus-summary-show-article 1)))
2564 	(when (gnus-buffer-live-p gnus-original-article-buffer)
2565 	  (with-current-buffer gnus-original-article-buffer
2566 	    (let* ((ct (gnus-fetch-field "content-type"))
2573 	  (setq charset gnus-newsgroup-charset)))
2578 	  (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
2588 (defun gnus-article-wash-html-with-w3 ()
2599 (defun gnus-article-wash-html-with-w3m ()
2610      (list 'keymap w3m-minor-mode-map
2616 (defun gnus-article-wash-html-with-w3m-standalone ()
2624 	      (coding-system-for-read charset))
2631 (defun article-hide-list-identifiers ()
2632   "Remove list identifies from the Subject header.
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))
2639 	(inhibit-read-only t))
2649 	    (beginning-of-line))
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)
2661       (let ((inhibit-read-only t) end)
2668 	  (gnus-add-wash-type 'pem)
2669 	  (gnus-article-hide-text-type
2678 	    (gnus-article-hide-text-type
2683 `gnus-article-address-banner-alist'."
2688 	(when (gnus-parameter-banner gnus-newsgroup-name)
2690 	   (gnus-parameter-banner gnus-newsgroup-name)))
2691 	(when gnus-article-address-banner-alist
2701 			     (cadr (funcall gnus-extract-address-components
2704 		(dolist (pair gnus-article-address-banner-alist)
2714 	    (gnus-signature-limit nil)
2715 	    (inhibit-read-only t))
2719 	  (when (gnus-article-narrow-to-signature)
2724 	  (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
2736     (set-buffer gnus-article-buffer)
2738       (let* ((inhibit-read-only t)
2752   (interactive (gnus-article-hidden-arg))
2753   (unless (gnus-article-check-hidden-text 'signature arg)
2756 	(let ((inhibit-read-only t))
2757 	  (when (gnus-article-narrow-to-signature)
2758 	    (gnus-article-hide-text-type
2760   (gnus-set-mode-line 'article))
2769 	(gnus-delete-line)))))
2772   "Remove all blank lines from the beginning of the article."
2776 	  (inhibit-read-only t))
2780 	  (gnus-delete-line))))))
2783   "Narrow the buffer to the head of the message.
2784 Point is left at the beginning of the narrowed-to region."
2793   "Place point at the start of the body."
2811 	  (inhibit-read-only t))
2815 	(unless (gnus-annotation-in-region-p
2821 	(unless (gnus-annotation-in-region-p
2826   "Remove all white space from the beginning of the lines in the article."
2830 	  (inhibit-read-only t))
2836   "Remove all white space from the end of the lines in the article."
2840 	  (inhibit-read-only t))
2857 	  (inhibit-read-only t))
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 ()
2890 Put point at the beginning of the signature separator."
2893     (if (if (stringp gnus-signature-separator)
2894 	    (re-search-backward gnus-signature-separator nil t)
2895 	  (let ((seps gnus-signature-separator))
2904 (defun gnus-article-hidden-arg ()
2906   (list (if current-prefix-arg
2910 (defun gnus-article-check-hidden-text (type arg)
2916       (let ((hide (gnus-article-hidden-text-p type)))
2922 	  (gnus-article-show-hidden-text type)
2927 		(gnus-article-show-hidden-text type)
2931 (defun gnus-article-hidden-text-p (type)
2932   "Say whether the current buffer contains hidden text of type TYPE."
2943 (defun gnus-article-show-hidden-text (type &optional dummy)
2944   "Show all hidden text of type TYPE.
2945 Originally it is hide instead of DUMMY."
2946   (let ((inhibit-read-only t)
2948     (gnus-remove-text-properties-when
2952 			       gnus-hidden-properties)))
2953     (gnus-delete-wash-type type)))
2964 (defun gnus-article-forward-header ()
2965   "Move point to the start of the next header.
2978 how much time has lapsed since DATE.  For `lapsed', the value of
2979 `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
2981   (interactive (list 'ut t))
2983 	 (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
2992 	 (inhibit-read-only t)
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)
3036 	  (beginning-of-line)
3047   "Return a DATE line of TYPE."
3067 		     (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
3068 			   ((> ls 65535) (list (1+ ms) (- ls 65536)))
3069 			   (t (list ms ls)))))
3079 				(with-current-buffer gnus-summary-buffer
3080 				  gnus-article-time-format)
3082 			    gnus-article-time-format)))
3151 	     " of "
3152 	     (nth (1- (nth 4 dtime)) gnus-english-month-names)
3164   (interactive (list t))
3169   (interactive (list t))
3176   (interactive (list t))
3181   (interactive (list t))
3193 	    (when (eq major-mode 'gnus-article-mode)
3202 (defun gnus-start-date-timer (&optional n)
3209   (gnus-stop-date-timer)
3213 (defun gnus-stop-date-timer ()
3222 This format is defined by the `gnus-article-time-format' variable."
3223   (interactive (list t))
3228   (interactive (list t))
3231 (defmacro gnus-article-save-original-date (&rest forms)
3256 ;;     (let ((inhibit-read-only t))
3257 ;;       (gnus-article-unhide-text (point-min) (point-max)))))
3264       (let ((inhibit-read-only t))
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))
3281 	    (inhibit-read-only t)
3283 			   gnus-hidden-properties))
3295 	      (gnus-article-hide-text
3297 	      (gnus-article-unhide-text-type
3299 	      (gnus-put-overlay-excluding-newlines
3301 	      (gnus-add-wash-type 'emphasis)
3304 (defun gnus-article-setup-highlight-words (&optional highlight-words)
3306   (unless gnus-article-emphasis-alist
3307     (let ((name (and gnus-newsgroup-name
3308 		     (gnus-group-real-name gnus-newsgroup-name))))
3309       (make-local-variable 'gnus-article-emphasis-alist)
3310       (setq gnus-article-emphasis-alist
3312 	     (let ((alist gnus-group-highlight-words-alist) elem highlight)
3319 	     (if gnus-newsgroup-name
3320 		 (copy-sequence (gnus-group-find-parameter
3321 				 gnus-newsgroup-name 'highlight-words t)))
3322 	     gnus-emphasis-alist)))))
3325   (defvar gnus-summary-article-menu)
3326   (defvar gnus-summary-post-menu))
3330 (defun gnus-article-save (save-buffer file &optional num)
3332   (when (or (get gnus-default-article-saver :headers)
3333 	    (not gnus-save-all-headers))
3334     ;; Remove headers according to `gnus-saved-headers' or the value
3335     ;; of the `:headers' property that the saver function might have.
3336     (let ((gnus-visible-headers
3337 	   (or (symbol-value (get gnus-default-article-saver :headers))
3338 	       gnus-saved-headers gnus-visible-headers))
3339 	  (gnus-article-buffer save-buffer))
3344     (if (not gnus-default-article-saver)
3347       ;; `gnus-save-article-buffer' (or so they think), but we
3349       (set-buffer gnus-article-buffer)
3350       (let* ((gnus-save-article-buffer save-buffer)
3353 	       ((not gnus-prompt-before-saving) 'default)
3354 	       ((eq gnus-prompt-before-saving 'always) nil)
3356 	     (gnus-number-of-articles-to-be-saved
3357 	      (when (eq gnus-prompt-before-saving t)
3359 	(set-buffer gnus-article-current-summary)
3360 	(funcall gnus-default-article-saver filename)))))
3362 (defun gnus-read-save-file-name (prompt &optional filename
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))
3386 				 (format "these %d articles"
3387 					 gnus-number-of-articles-to-be-saved)
3394 		       (read-file-name
3404 		       (read-file-name
3413 				     gnus-article-save-directory))
3417 					 (t gnus-article-save-directory))))
3418 			 (read-file-name
3421 		      ;; A list of splits was found.
3429 				  (read-file-name
3431 				   gnus-article-save-directory
3433 				  gnus-article-save-directory)))
3436 	       (gnus-make-directory (file-name-directory file))
3437 	       ;; If we have read a directory, we append the default file name.
3444     (gnus-make-directory (file-name-directory result))
3451 (defun gnus-article-archive-name (group)
3452   "Return the first instance of an \"Archive-name\" in the current buffer."
3455       (nnheader-concat gnus-article-save-directory
3458 (defun gnus-article-nndoc-name (group)
3459   "If GROUP is an nndoc group, return the name of the parent group."
3460   (when (eq (car (gnus-find-method-for-group group)) 'nndoc)
3461     (gnus-group-get-parameter group 'save-article-group)))
3463 (defun gnus-summary-save-in-rmail (&optional filename)
3466 Directory to save to is default to `gnus-article-save-directory'."
3467   (setq filename (gnus-read-save-file-name
3469 		  gnus-rmail-save-name gnus-newsgroup-name
3470 		  gnus-current-headers 'gnus-newsgroup-last-rmail))
3471   (gnus-eval-in-buffer-window gnus-save-article-buffer
3475 	(gnus-output-to-rmail filename))))
3478 (defun gnus-summary-save-in-mail (&optional filename)
3481 Directory to save to is default to `gnus-article-save-directory'."
3482   (setq filename (gnus-read-save-file-name
3484 		  gnus-mail-save-name gnus-newsgroup-name
3485 		  gnus-current-headers 'gnus-newsgroup-last-mail))
3486   (gnus-eval-in-buffer-window gnus-save-article-buffer
3494 	  (gnus-output-to-mail filename)))))
3497 (put 'gnus-summary-save-in-file :decode t)
3498 (put 'gnus-summary-save-in-file :headers 'gnus-saved-headers)
3499 (defun gnus-summary-save-in-file (&optional filename overwrite)
3502 Directory to save to is default to `gnus-article-save-directory'."
3503   (setq filename (gnus-read-save-file-name
3505 		  gnus-file-save-name gnus-newsgroup-name
3506 		  gnus-current-headers 'gnus-newsgroup-last-file))
3507   (gnus-eval-in-buffer-window gnus-save-article-buffer
3514 	(gnus-output-to-file filename))))
3517 (put 'gnus-summary-write-to-file :decode t)
3518 (put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file)
3519 (put 'gnus-summary-write-to-file :headers 'gnus-saved-headers)
3520 (defun gnus-summary-write-to-file (&optional filename)
3523 The directory to save in defaults to `gnus-article-save-directory'."
3524   (setq filename (gnus-read-save-file-name
3526 		  gnus-file-save-name gnus-newsgroup-name
3527 		  gnus-current-headers nil 'gnus-newsgroup-last-directory))
3528   (gnus-summary-save-in-file filename t))
3530 (put 'gnus-summary-save-body-in-file :decode t)
3531 (defun gnus-summary-save-body-in-file (&optional filename overwrite)
3534 The directory to save in defaults to `gnus-article-save-directory'."
3535   (setq filename (gnus-read-save-file-name
3537 		  gnus-file-save-name gnus-newsgroup-name
3538 		  gnus-current-headers 'gnus-newsgroup-last-file))
3539   (gnus-eval-in-buffer-window gnus-save-article-buffer
3548 	(gnus-output-to-file filename))))
3551 (put 'gnus-summary-write-body-to-file :decode t)
3552 (put 'gnus-summary-write-body-to-file
3553      :function 'gnus-summary-save-body-in-file)
3554 (defun gnus-summary-write-body-to-file (&optional filename)
3557 The directory to save in defaults to `gnus-article-save-directory'."
3558   (setq filename (gnus-read-save-file-name
3560 		  gnus-file-save-name gnus-newsgroup-name
3561 		  gnus-current-headers nil 'gnus-newsgroup-last-directory))
3562   (gnus-summary-save-body-in-file filename t))
3564 (defun gnus-summary-save-in-pipe (&optional command)
3568 		    gnus-last-shell-command)
3569 	       gnus-last-shell-command)
3572 	      (t (read-string
3575 		   (if (and gnus-number-of-articles-to-be-saved
3576 			    (> gnus-number-of-articles-to-be-saved 1))
3577 		       (format "these %d articles"
3578 			       gnus-number-of-articles-to-be-saved)
3580 		  gnus-last-shell-command))))
3582     (if gnus-last-shell-command
3583 	(setq command gnus-last-shell-command)
3585   (gnus-eval-in-buffer-window gnus-article-buffer
3589   (setq gnus-last-shell-command command))
3591 (defmacro gnus-read-string (prompt &optional initial-contents history
3593   "Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
3596       `(read-string ,prompt ,initial-contents ,history)
3597     `(read-string ,prompt ,initial-contents ,history ,default-value)))
3599 (defun gnus-summary-pipe-to-muttprint (&optional command)
3601   (setq command (gnus-read-string
3602 		 "Print using command: " gnus-summary-muttprint-program
3603 		 nil gnus-summary-muttprint-program))
3604   (gnus-summary-save-in-pipe command))
3608 (defun gnus-capitalize-newsgroup (newsgroup)
3614 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
3616 If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num.
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)))
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)
3708 	    (let ((mm-security-handle (list (format "multipart/signed"))))
3710 	      (let ((coding-system-for-write (or gnus-newsgroup-charset
3715 			 mm-security-handle 'gnus-details)
3717 			 mm-security-handle 'gnus-info)))))
3719 	    (let ((inhibit-read-only t) bface eface)
3724 		(setq bface (get-text-property (gnus-point-at-bol) 'face)
3725 		      eface (get-text-property (1- (gnus-point-at-eol)) 'face))
3749   (if (gnus-buffer-live-p gnus-original-article-buffer)
3750       (canlock-verify gnus-original-article-buffer)))
3760 	       gfunc (intern (format "gnus-%s" func))))
3765 	      (interactive (list t))
3767 		(set-buffer gnus-article-buffer)
3787      article-hide-list-identifiers
3813 ;;     (article-show-all . gnus-article-show-all-headers)
3821 (put 'gnus-article-mode 'mode-class 'special)
3823 (set-keymap-parent gnus-article-mode-map widget-keymap)
3825 (gnus-define-keys gnus-article-mode-map
3826   " " gnus-article-goto-next-page
3827   "\177" gnus-article-goto-prev-page
3828   [delete] gnus-article-goto-prev-page
3829   [backspace] gnus-article-goto-prev-page
3830   "\C-c^" gnus-article-refer-article
3831   "h" gnus-article-show-summary
3832   "s" gnus-article-show-summary
3833   "\C-c\C-m" gnus-article-mail
3834   "?" gnus-article-describe-briefly
3835   "e" gnus-summary-edit-article
3836   "<" beginning-of-buffer
3837   ">" end-of-buffer
3838   "\C-c\C-i" gnus-info-find-node
3839   "\C-c\C-b" gnus-bug
3840   "R" gnus-article-reply-with-original
3841   "F" gnus-article-followup-with-original
3842   "\C-hk" gnus-article-describe-key
3843   "\C-hc" gnus-article-describe-key-briefly
3845   "\C-d" gnus-article-read-summary-keys
3846   "\M-*" gnus-article-read-summary-keys
3847   "\M-#" gnus-article-read-summary-keys
3848   "\M-^" gnus-article-read-summary-keys
3849   "\M-g" gnus-article-read-summary-keys)
3852  'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
3854 (defun gnus-article-make-menu-bar ()
3855   (unless (boundp 'gnus-article-commands-menu)
3856     (gnus-summary-make-menu-bar))
3857   (gnus-turn-off-edit-menu 'article)
3858   (unless (boundp 'gnus-article-article-menu)
3860      gnus-article-article-menu gnus-article-mode-map ""
3862        ["Scroll forwards" gnus-article-goto-next-page t]
3863        ["Scroll backwards" gnus-article-goto-prev-page t]
3864        ["Show summary" gnus-article-show-summary t]
3865        ["Fetch Message-ID at point" gnus-article-refer-article t]
3866        ["Mail to address at point" gnus-article-mail t]
3867        ["Send a bug report" gnus-bug t]))
3870      gnus-article-treatment-menu gnus-article-mode-map ""
3873        ["Hide headers" gnus-article-hide-headers t]
3874        ["Hide signature" gnus-article-hide-signature t]
3875        ["Hide citation" gnus-article-hide-citation t]
3876        ["Treat overstrike" gnus-article-treat-overstrike t]
3877        ["Remove carriage return" gnus-article-remove-cr t]
3878        ["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
3879        ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
3880        ["Remove base64" gnus-article-de-base64-unreadable t]
3881        ["Treat html" gnus-article-wash-html t]
3882        ["Remove newlines from within URLs" gnus-article-unsplit-urls t]
3883        ["Decode HZ" gnus-article-decode-HZ t]))
3885     ;; Note "Commands" menu is defined in gnus-sum.el for consistency
3887     ;; Note "Post" menu is defined in gnus-sum.el for consistency
3889     (gnus-run-hooks 'gnus-article-menu-hook)))
3891 (defun gnus-article-mode ()
3898 \\<gnus-article-mode-map>
3899 \\[gnus-article-next-page]\t Scroll the article one page forwards
3900 \\[gnus-article-prev-page]\t Scroll the article one page backwards
3901 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
3902 \\[gnus-article-show-summary]\t Display the summary buffer
3903 \\[gnus-article-mail]\t Send a reply to the address near point
3904 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
3905 \\[gnus-info-find-node]\t Go to the Gnus info node"
3908   (gnus-simplify-mode-line)
3910   (setq major-mode 'gnus-article-mode)
3912   (use-local-map gnus-article-mode-map)
3913   (when (gnus-visual-p 'article-menu 'menu)
3914     (gnus-article-make-menu-bar)
3915     (when gnus-summary-tool-bar-map
3916       (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
3917   (gnus-update-format-specifications nil 'article-mode)
3918   (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
3919   (set (make-local-variable 'gnus-page-broken) nil)
3920   (make-local-variable 'gnus-button-marker-list)
3921   (make-local-variable 'gnus-article-current-summary)
3922   (make-local-variable 'gnus-article-mime-handles)
3923   (make-local-variable 'gnus-article-decoded-p)
3924   (make-local-variable 'gnus-article-mime-handle-alist)
3925   (make-local-variable 'gnus-article-wash-types)
3926   (make-local-variable 'gnus-article-image-alist)
3927   (make-local-variable 'gnus-article-charset)
3928   (make-local-variable 'gnus-article-ignored-charsets)
3932   (gnus-set-default-directory)
3934   (setq buffer-read-only t)
3935   (set-syntax-table gnus-article-mode-syntax-table)
3937   (gnus-run-mode-hooks 'gnus-article-mode-hook))
3939 ;; Internal variables.  Are `gnus-button-regexp' and `gnus-button-last' used
3941 (defvar gnus-button-regexp nil)
3942 (defvar gnus-button-marker-list nil
3943   "Regexp matching any of the regexps from `gnus-button-alist'.")
3944 (defvar gnus-button-last nil
3945   "The value of `gnus-button-alist' when `gnus-button-regexp' was build.")
3947 (defun gnus-article-setup-buffer ()
3949   (let* ((name (if gnus-single-article-buffer "*Article*"
3950 		 (concat "*Article " gnus-newsgroup-name "*")))
3955     (setq gnus-article-buffer name)
3956     (setq gnus-original-article-buffer original)
3957     (setq gnus-article-mime-handle-alist nil)
3959     (unless gnus-single-article-buffer
3961 	(set-buffer gnus-summary-buffer)
3962 	(setq gnus-article-buffer name)
3963 	(setq gnus-original-article-buffer original)
3964 	(gnus-set-global-variables)))
3965     (gnus-article-setup-highlight-words)
3968       (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
3970       (setq major-mode 'gnus-original-article-mode)
3971       (make-local-variable 'gnus-original-article))
3974 	       (if gnus-article-edit-mode
3978 			 (gnus-kill-buffer name)
3985 	  (set (make-local-variable 'gnus-article-edit-mode) nil)
3986 	  (when gnus-article-mime-handles
3987 	    (mm-destroy-parts gnus-article-mime-handles)
3988 	    (setq gnus-article-mime-handles nil))
3990 	  (setq gnus-article-mime-handle-alist nil)
3992 	  (setq buffer-read-only t)
3993 	  ;; This list just keeps growing if we don't reset it.
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)
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)
4042 	(if (not (setq result (let ((inhibit-read-only t))
4043 				(gnus-request-article-this-buffer
4048 			 (not (memq article gnus-newsgroup-sparse)))
4049 		(setq gnus-article-current
4050 		      (cons gnus-newsgroup-name article))
4051 		(set-buffer gnus-summary-buffer)
4052 		(setq gnus-current-article article)
4053 		(if (and (memq article gnus-newsgroup-undownloaded)
4054 			 (not (gnus-online (gnus-find-method-for-group
4055 					    gnus-newsgroup-name))))
4057 		      (gnus-summary-set-agent-mark article)
4059 		  (gnus-summary-mark-article article gnus-canceled-mark)
4060 		  (unless (memq article gnus-newsgroup-sparse)
4061 		    (gnus-error 1 "No such article (may have expired or been canceled)")))))
4067 		  (push article gnus-newsgroup-history)
4068 		  (setq gnus-last-article gnus-current-article
4069 			gnus-current-article 0
4070 			gnus-current-headers nil
4071 			gnus-article-current nil)
4073 		      (gnus-configure-windows 'summary)
4074 		    (gnus-configure-windows 'article))
4075 		  (gnus-set-global-variables))
4076 		(let ((gnus-article-mime-handle-alist-1
4077 		       gnus-article-mime-handle-alist))
4078 		  (gnus-set-mode-line 'article)))
4083 		       (not (eq article gnus-current-article)))
4085 	      ;; `gnus-current-article' must be an article number.
4088 		(push article gnus-newsgroup-history)
4089 		(setq gnus-last-article gnus-current-article
4090 		      gnus-current-article article
4091 		      gnus-current-headers
4092 		      (gnus-summary-article-header gnus-current-article)
4093 		      gnus-article-current
4094 		      (cons gnus-newsgroup-name gnus-current-article))
4095 		(unless (vectorp gnus-current-headers)
4096 		  (setq gnus-current-headers nil))
4097 		(gnus-summary-goto-subject gnus-current-article)
4098 		(when (gnus-summary-show-thread)
4103 		  (gnus-summary-goto-subject gnus-current-article))
4104 		(gnus-run-hooks 'gnus-mark-article-hook)
4105 		(gnus-set-mode-line 'summary)
4106 		(when (gnus-visual-p 'article-highlight 'highlight)
4107 		  (gnus-run-hooks 'gnus-visual-mark-article-hook))
4109 		(gnus-set-global-variables)
4110 		(setq gnus-have-all-headers
4111 		      (or all-headers gnus-show-all-headers))))
4113 	      (gnus-configure-windows 'article))
4116 	      (gnus-article-prepare-display)
4119 	      (when gnus-break-pages
4120 		(gnus-narrow-to-page)))
4121 	    (let ((gnus-article-mime-handle-alist-1
4122 		   gnus-article-mime-handle-alist))
4123 	      (gnus-set-mode-line 'article))
4128 	    (gnus-configure-windows 'article)
4132 (defun gnus-article-prepare-display ()
4136   (let ((gnus-article-buffer (current-buffer))
4137 	buffer-read-only
4138 	(inhibit-read-only t))
4139     (unless (eq major-mode 'gnus-article-mode)
4140       (gnus-article-mode))
4141     (setq buffer-read-only nil
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"
4154   "Format of the MIME buttons.
4161 %l  The length of the encoded part
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)))
4227 			 t (list (car menu)
4234 (defun gnus-mime-button-menu (event prefix)
4235  "Construct a context-sensitive menu of MIME commands."
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)))
4258 	(let ((inhibit-read-only t))
4262 (defun gnus-mime-save-part-and-strip ()
4265   (gnus-article-check-buffer)
4266   (when (gnus-group-read-only-p)
4267     (error "The current group does not support deleting of parts"))
4268   (when (mm-complicated-handles gnus-article-mime-handles)
4271   (when (gnus-yes-or-no-p "\
4273     (let* ((data (get-text-property (point) 'gnus-data))
4275 	   (handles gnus-article-mime-handles))
4283 	  ;; Add a filename for the sake of saving the part again.
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))
4304 		  (mbl mml-buffer-list))
4305 	      (setq mml-buffer-list nil)
4306 	      (insert-buffer-substring gnus-original-article-buffer)
4308 	      (setq gnus-article-mime-handles nil)
4309 	      (let ((mbl1 mml-buffer-list))
4310 		(setq mml-buffer-list mbl)
4311 		(set (make-local-variable 'mml-buffer-list) mbl1))
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)))
4326 	      (kill-local-variable 'mml-buffer-list))
4327 	    (gnus-summary-edit-article-done
4328 	     ,(or (mail-header-references gnus-current-headers) "")
4329 	     ,(gnus-group-read-only-p)
4330 	     ,gnus-summary-buffer no-highlight)))))))
4332 (defun gnus-mime-delete-part ()
4336   (gnus-article-check-buffer)
4337   (when (gnus-group-read-only-p)
4338     (error "The current group does not support deleting of parts"))
4339   (when (mm-complicated-handles gnus-article-mime-handles)
4342   (when (gnus-yes-or-no-p "\
4344     (let* ((data (get-text-property (point) 'gnus-data))
4345 	   (handles gnus-article-mime-handles)
4372 			(list "attachment")
4374       (set-buffer gnus-summary-buffer)
4375       ;; FIXME: maybe some of the following code (borrowed from
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))
4385 		(mbl mml-buffer-list))
4386 	    (setq mml-buffer-list nil)
4387 	    (insert-buffer-substring gnus-original-article-buffer)
4389 	    (setq gnus-article-mime-handles nil)
4390 	    (let ((mbl1 mml-buffer-list))
4391 	      (setq mml-buffer-list mbl)
4392 	      (set (make-local-variable 'mml-buffer-list) mbl1))
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)))
4407 	    (kill-local-variable 'mml-buffer-list))
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)))
4463 	    (completing-read
4466 	     (mapcar #'list (mailcap-mime-types))
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 ()
4513                                    t (list t err-file) nil
4515                             jka-compr-acceptable-retval-list)
4519 (defun gnus-mime-copy-part (&optional handle)
4524   (gnus-article-check-buffer)
4525   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4542 	    (gnus-mime-jka-compr-maybe-uncompress)
4547 (defun gnus-mime-print-part (&optional handle filename)
4549   (interactive (list nil (ps-print-preprint current-prefix-arg)))
4550   (gnus-article-check-buffer)
4551   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4569 	    (gnus-print-buffer))
4572 (defun gnus-mime-inline-part (&optional handle arg)
4574   (interactive (list nil current-prefix-arg))
4575   (gnus-article-check-buffer)
4576   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4579 	 (inhibit-read-only t))
4588 			    gnus-newsgroup-charset)))
4594 			       gnus-summary-show-article-charset-alist))
4595 		    (mm-read-coding-system "Charset: "))))
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)
4628   (interactive (list nil current-prefix-arg))
4629   (gnus-article-check-buffer)
4630   (let ((handle (or handle (get-text-property (point) 'gnus-data)))
4631 	(fun (get-text-property (point) 'gnus-callback))
4632 	(gnus-newsgroup-ignored-charsets 'gnus-all)
4633 	gnus-newsgroup-charset form preferred parts)
4638 	(setq gnus-newsgroup-charset
4639 	      (or (cdr (assq arg gnus-summary-show-article-charset-alist))
4640 		  (mm-read-coding-system "Charset: ")))
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)))
4657 		  (list 'quote (or (cadr (member preferred parts))
4661 (defun gnus-mime-view-part-externally (&optional handle)
4664   (gnus-article-check-buffer)
4665   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4668 	 (mail-parse-charset gnus-newsgroup-charset)
4670           (with-current-buffer gnus-summary-buffer
4671             gnus-newsgroup-ignored-charsets))
4676 	(gnus-mime-view-part-as-type
4683 (defun gnus-mime-view-part-internally (&optional handle)
4687   (gnus-article-check-buffer)
4688   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
4691 	 (mail-parse-charset gnus-newsgroup-charset)
4693 	  (with-current-buffer gnus-summary-buffer
4694 	    gnus-newsgroup-ignored-charsets))
4695 	 (inhibit-read-only t))
4697         (gnus-mime-view-part-as-type
4704 (defun gnus-mime-action-on-part (&optional action)
4707    (list (completing-read "Action: " gnus-mime-action-alist nil t)))
4708   (gnus-article-check-buffer)
4709   (let ((action-pair (assoc action gnus-mime-action-alist)))
4713 (defun gnus-article-part-wrapper (n function)
4714   (let ((window (get-buffer-window gnus-article-buffer 'visible))
4718       ;; `gnus-article-goto-part' may really move the point.
4720       (gnus-select-frame-set-input-focus (window-frame window))
4724 	    (when (> n (length gnus-article-mime-handle-alist))
4726 	    (gnus-article-goto-part n)
4727 	    (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
4729 	(gnus-select-frame-set-input-focus frame)))))
4731 (defun gnus-article-pipe-part (n)
4734   (gnus-article-part-wrapper n 'mm-pipe-part))
4736 (defun gnus-article-save-part (n)
4739   (gnus-article-part-wrapper n 'mm-save-part))
4741 (defun gnus-article-interactively-view-part (n)
4744   (gnus-article-part-wrapper n 'mm-interactively-view-part))
4746 (defun gnus-article-copy-part (n)
4749   (gnus-article-part-wrapper n 'gnus-mime-copy-part))
4751 (defun gnus-article-view-part-as-charset (n)
4755   (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
4757 (defun gnus-article-view-part-externally (n)
4760   (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
4762 (defun gnus-article-inline-part (n)
4765   (gnus-article-part-wrapper n 'gnus-mime-inline-part))
4767 (defun gnus-article-mime-match-handle-first (condition)
4769       (let ((alist gnus-article-mime-handle-alist) ihandle n)
4781 		   (gnus-article-goto-part (car ihandle))
4787 (defun gnus-article-view-part (&optional n)
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))
4812 	(inhibit-read-only t))
4816 	      (mail-parse-charset gnus-newsgroup-charset)
4818 	       (if (gnus-buffer-live-p gnus-summary-buffer)
4820 		     (set-buffer gnus-summary-buffer)
4821 		     gnus-newsgroup-ignored-charsets)
4825 		(let ((win (gnus-get-buffer-window (current-buffer) t))
4843 		      (gnus-treat-article
4845 		       (gnus-article-mime-total-parts)
4850       (gnus-delete-line)
4851       (gnus-insert-mime-button
4852        handle id (list (mm-handle-displayed-p handle)))
4855 (defun gnus-article-goto-part (n)
4857   (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
4859 (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
4860   (let ((gnus-tmp-name
4865 	(gnus-tmp-type (mm-handle-media-type handle))
4866 	(gnus-tmp-description
4869 	(gnus-tmp-dots
4873 	(gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
4875 	gnus-tmp-type-long b e)
4876     (when (string-match ".*/" gnus-tmp-name)
4877       (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
4878     (setq gnus-tmp-type-long (concat gnus-tmp-type
4879 				     (and (not (equal gnus-tmp-name ""))
4880 					  (concat "; " gnus-tmp-name))))
4881     (unless (equal gnus-tmp-description "")
4882       (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
4886     (gnus-eval-format
4887      gnus-mime-button-line-format gnus-mime-button-line-format-alist
4888      `(,@(gnus-local-map-property gnus-mime-button-map)
4889 	 gnus-callback gnus-mm-display-part
4890 	 gnus-part ,gnus-tmp-id
4892 	 gnus-data ,handle))
4900      :action 'gnus-widget-press-button
4901      :button-keymap gnus-mime-button-map
4910 	(aref gnus-mouse-2 0)
4915 		 (with-current-buffer (gnus-overlay-buffer overlay)
4916 		   (widget-get (widget-at (gnus-overlay-start overlay))
4920 	(aref gnus-down-mouse-3 0))))))
4922 (defun gnus-widget-press-button (elems el)
4924   (gnus-article-press-button))
4926 (defvar gnus-displaying-mime nil)
4928 (defun gnus-display-mime (&optional ihandles)
4932       (let ((window (get-buffer-window gnus-article-buffer))
4940 	    (inhibit-read-only t)
4943 	      ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
4944 	       (when gnus-article-emulate-mime
4946 	      (gnus-article-emulate-mime
4949 		   (not gnus-displaying-mime))
4951 	  (when gnus-article-mime-handles
4952 	    (mm-destroy-parts gnus-article-mime-handles)
4953 	    (setq gnus-article-mime-handle-alist nil));; A trick.
4954 	  (setq gnus-article-mime-handles handles)
4956 	  (when gnus-article-mime-part-function
4957 	    (gnus-mime-part-function handles)))
4963 			 (not gnus-displaying-mime))
4967 	      (let ((gnus-displaying-mime t))
4968 		(gnus-mime-display-part handles)))
4972 	    (gnus-treat-article nil 1 1)
4980 	      (gnus-article-save-original-date
4981 	       (gnus-treat-article 'head)))))))
4987 (defcustom gnus-mime-display-multipart-as-mixed nil
4990 If t, it overrides nil values of
4991 `gnus-mime-display-multipart-alternative-as-mixed' and
4992 `gnus-mime-display-multipart-related-as-mixed'."
4993   :group 'gnus-article-mime
4996 (defcustom gnus-mime-display-multipart-alternative-as-mixed nil
4999   :group 'gnus-article-mime
5002 (defcustom gnus-mime-display-multipart-related-as-mixed nil
5009   :group 'gnus-article-mime
5012 (defun gnus-mime-display-part (handle)
5018     (gnus-mime-display-single handle))
5020    ((cdr (assoc (car handle) gnus-mime-multipart-functions))
5021     (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
5025 	 (not (or gnus-mime-display-multipart-as-mixed
5026 		  gnus-mime-display-multipart-alternative-as-mixed)))
5027     (let ((id (1+ (length gnus-article-mime-handle-alist))))
5028       (push (cons id handle) gnus-article-mime-handle-alist)
5029       (gnus-mime-display-alternative (cdr handle) nil nil id)))
5032 	 (not (or gnus-mime-display-multipart-as-mixed
5033 		  gnus-mime-display-multipart-related-as-mixed)))
5036     ;;(gnus-mime-display-part (cadr handle))
5040     ;;(gnus-mime-display-mixed (cdr handle))
5042     (gnus-mime-display-part (cadr handle)))
5044     (gnus-add-wash-type 'signed)
5045     (gnus-mime-display-security handle))
5047     (gnus-add-wash-type 'encrypted)
5048     (gnus-mime-display-security handle))
5051     (gnus-mime-display-mixed (cdr handle)))))
5053 (defun gnus-mime-part-function (handles)
5055       (mapcar 'gnus-mime-part-function (cdr handles))
5056     (funcall gnus-article-mime-part-function handles)))
5058 (defun gnus-mime-display-mixed (handles)
5059   (mapcar 'gnus-mime-display-part handles))
5061 (defun gnus-mime-display-single (handle)
5063 	(ignored gnus-ignored-mime-types)
5086 	(let ((id (1+ (length gnus-article-mime-handle-alist)))
5088 	  (push (cons id handle) gnus-article-mime-handle-alist)
5097 		    (not (gnus-unbuttonized-mime-type-p type)))
5098 	    (gnus-insert-mime-button
5099 	     handle id (list (or display (and not-attachment text))))
5100 	    (gnus-article-insert-newline)
5101 	    ;; Remember modify the number of forward lines.
5109 	    (let ((mail-parse-charset gnus-newsgroup-charset)
5112 				       (set-buffer gnus-summary-buffer)
5114 				   gnus-newsgroup-ignored-charsets)))
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)
5166 	 handle (inhibit-read-only t) from props begend not-pref)
5178 	(setq begend (list (point-marker)))
5184 		  (not (gnus-unbuttonized-mime-type-p
5186 	  (gnus-add-text-properties
5191 	   `(gnus-callback
5194 		 (setq gnus-article-mime-handle-alist
5195 		       ',gnus-article-mime-handle-alist))
5196 	       (gnus-mime-display-alternative
5198 	     ,@(gnus-local-map-property gnus-mime-button-map)
5199 	     ,gnus-mouse-face-prop ,gnus-article-mouse-face
5200 	     face ,gnus-article-button-face
5201 	     gnus-part ,id
5204 				 :action 'gnus-widget-press-button
5205 				 :button-keymap gnus-widget-button-keymap)
5208 	    (gnus-add-text-properties
5215 	     `(gnus-callback
5218 		   (setq gnus-article-mime-handle-alist
5219 			 ',gnus-article-mime-handle-alist))
5220 		 (gnus-mime-display-alternative
5222 	       ,@(gnus-local-map-property gnus-mime-button-map)
5223 	       ,gnus-mouse-face-prop ,gnus-article-mouse-face
5224 	       face ,gnus-article-button-face
5225 	       gnus-part ,id
5226 	       gnus-data ,handle))
5228 				   :action 'gnus-widget-press-button
5229 				   :button-keymap gnus-widget-button-keymap)
5234 	      (gnus-display-mime preferred)
5235 	    (let ((mail-parse-charset gnus-newsgroup-charset)
5237 		   (save-excursion (set-buffer gnus-summary-buffer)
5238 				   gnus-newsgroup-ignored-charsets)))
5244 		  (gnus-treat-article
5245 		   nil (length gnus-article-mime-handle-alist)
5246 		   (gnus-article-mime-total-parts)
5253 (defconst gnus-article-wash-status-strings
5275 	(push (list key on off) result))))
5276   "Alist of strings describing wash status in the mode line.
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)
5309   "Add a washing of TYPE to the current status."
5310   (add-to-list 'gnus-article-wash-types type))
5312 (defun gnus-delete-wash-type (type)
5313   "Add a washing of TYPE to the current status."
5314   (setq gnus-article-wash-types (delq type gnus-article-wash-types)))
5316 (defun gnus-add-image (category image)
5317   "Add IMAGE of CATEGORY to the list of displayed images."
5318   (let ((entry (assq category gnus-article-image-alist)))
5320       (setq entry (list category))
5321       (push entry gnus-article-image-alist))
5322     (nconc entry (list image))))
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)
5347 If `gnus-article-save-coding-system' is non-nil, it is used to encode
5348 text and used as the value of the coding cookie which is added to the
5349 top of a file.  Otherwise, this function saves a raw article without
5353 	 (coding gnus-article-save-coding-system)
5354 	 (coding-system-for-read (if coding
5370       ;; Append newline at end of the buffer as separator, and then
5396 (defun gnus-narrow-to-page (&optional arg)
5402     (set-buffer gnus-article-buffer)
5406     (when (gnus-visual-p 'page-marker)
5407       (let ((inhibit-read-only t))
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.
5475 	(end-of-line)
5479       (if (or (not gnus-page-broken)
5484 		  (eobp)))) ;Real end-of-buffer?
5486 	    (when gnus-article-over-scroll
5487 	      (gnus-article-next-page-1 lines))
5489 	(gnus-narrow-to-page 1)		;Go to next page.
5492     (gnus-article-next-page-1 lines)
5495 (defmacro gnus-article-beginning-of-window ()
5496   "Move point to the beginning of the window.
5509 (defun gnus-article-next-page-1 (lines)
5516     ;; too many number of lines if `scroll-margin' is set as two or greater.
5523     (end-of-buffer
5524      ;; Long lines may cause an end-of-buffer error.
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
5535 	   (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
5537 	(gnus-narrow-to-page -1)	;Go to previous page.
5544 	  (beginning-of-buffer
5546       (gnus-article-beginning-of-window))))
5548 (defun gnus-article-only-boring-p ()
5550 Something \"interesting\" is a word of at least two letters that does
5551 not have a face in `gnus-article-boring-faces'."
5552   (when (and gnus-article-skip-boring
5553 	     (boundp 'gnus-article-boring-faces)
5554 	     (symbol-value 'gnus-article-boring-faces))
5560 	    (when (not (gnus-intersection
5561 			(gnus-faces-at (point))
5562 			(symbol-value 'gnus-article-boring-faces)))
5566 (defun gnus-article-refer-article ()
5570     (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
5571     (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
5572     (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
5574 	  (set-buffer gnus-summary-buffer)
5575 	  (gnus-summary-refer-article msg-id))
5578 (defun gnus-article-show-summary ()
5581   (if (not (gnus-buffer-live-p gnus-summary-buffer))
5583     (gnus-article-set-globals)
5584     (gnus-configure-windows 'article)
5585     (gnus-summary-goto-subject gnus-current-article)
5586     (gnus-summary-position-point)))
5588 (defun gnus-article-describe-briefly ()
5591   (gnus-message 6 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page	 \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
5593 (defun gnus-article-summary-command ()
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 ()
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)
5622   (gnus-article-check-buffer)
5635       (set-buffer gnus-article-current-summary)
5636       (let (gnus-pick-mode)
5639 		       (events-to-keys (read-key-sequence nil))
5640 		     (read-key-sequence nil)))))
5649 	    (pop-to-buffer gnus-article-current-summary 'norecord)
5651 	    (let (gnus-pick-mode)
5657 	      (set-buffer gnus-article-current-summary))
5661 	    (pop-to-buffer gnus-article-buffer 'norecord)))
5668 	       (pop-to-buffer gnus-article-current-summary 'norecord))
5669 	      ((setq win (get-buffer-window gnus-article-current-summary))
5672 	       (switch-to-buffer gnus-article-current-summary 'norecord)))
5675 	(if (and (setq func (let (gnus-pick-mode)
5685 		(setq selected (gnus-summary-select-article))
5703 (defun gnus-article-describe-key (key)
5704   "Display documentation of the function invoked by KEY.  KEY is a string."
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)
5715 			   (read-key-sequence "Describe key: "))))
5718 		   (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
5719 		   (string-to-list key)))
5720 	    (setq key (read-key-sequence "Describe key: "))))
5724 (defun gnus-article-describe-key-briefly (key &optional insert)
5725   "Display documentation of the function invoked by KEY.  KEY is a string."
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)
5736 			   (read-key-sequence "Describe key: "))))
5739 		   (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
5740 		   (string-to-list key)))
5741 	    (setq key (read-key-sequence "Describe key: "))))
5745 (defun gnus-article-reply-with-original (&optional wide)
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 ()
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)
5788   (interactive (append (gnus-article-hidden-arg) (list 'force)))
5789   (gnus-article-hide-headers arg)
5790   (gnus-article-hide-list-identifiers arg)
5791   (gnus-article-hide-citation-maybe arg force)
5792   (gnus-article-hide-signature arg))
5794 (defun gnus-article-maybe-highlight ()
5796   (when (gnus-visual-p 'article-highlight 'highlight)
5797     (gnus-article-highlight-some)))
5799 (defun gnus-check-group-server ()
5801   (unless (gnus-server-opened
5802 	   (gnus-find-method-for-group gnus-newsgroup-name))
5803     (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
5804     (gnus-request-group gnus-newsgroup-name t)))
5809 (defun gnus-request-article-this-buffer (article group)
5815 	  (gnus-kill-all-overlays)
5816 	  (setq group (or group gnus-newsgroup-name))
5818 	  ;; Using `gnus-request-article' directly will insert the article into
5825 	    (gnus-read-header article))
5829 	  ;; message-id and request it by id instead of number.
5831 		     gnus-summary-buffer
5832 		     (get-buffer gnus-summary-buffer)
5833 		     (gnus-buffer-exists-p gnus-summary-buffer))
5835 	      (set-buffer gnus-summary-buffer)
5836 	      (let ((header (gnus-summary-article-header article)))
5839 		   ((memq article gnus-newsgroup-sparse)
5843 		    (setq sparse-header (gnus-read-header article))
5844 		    (setq gnus-newsgroup-sparse
5845 			  (delq article gnus-newsgroup-sparse)))
5852 		    (gnus-request-pseudo-article header))))
5854 		(let ((method (gnus-find-method-for-group
5855 			       gnus-newsgroup-name)))
5863 			(gnus-group-enter-directory dir))))))))
5866 	   ;; Refuse to select canceled articles.
5868 		 gnus-summary-buffer
5869 		 (get-buffer gnus-summary-buffer)
5870 		 (gnus-buffer-exists-p gnus-summary-buffer)
5872 			    (set-buffer gnus-summary-buffer)
5873 			    (assq article gnus-newsgroup-reads)))
5874 		     gnus-canceled-mark))
5876 	   ;; We first check `gnus-original-article-buffer'.
5877 	   ((and (get-buffer gnus-original-article-buffer)
5880 		   (set-buffer gnus-original-article-buffer)
5881 		   (and (equal (car gnus-original-article) group)
5882 			(eq (cdr gnus-original-article) article))))
5883 	    (insert-buffer-substring gnus-original-article-buffer)
5886 	   ((and gnus-keep-backlog
5887 		 (gnus-backlog-request-article group article (current-buffer)))
5890 	   ((gnus-async-request-fetched-article group article (current-buffer))
5891 	    (gnus-async-prefetch-next group article gnus-summary-buffer)
5892 	    (when (and (numberp article) gnus-keep-backlog)
5893 	      (gnus-backlog-enter-article group article (current-buffer)))
5896 	   ((and gnus-use-cache
5898 		 (gnus-cache-request-article article group))
5901 	   ((gnus-agent-request-article article group)
5906 	    (let ((gnus-override-method gnus-override-method)
5908 				gnus-refer-article-method))
5909 		  (backend (car (gnus-find-method-for-group
5910 				 gnus-newsgroup-name)))
5912 		  (inhibit-read-only t))
5916 		  (setq methods (list methods)))
5917 	      (when (and (null gnus-override-method)
5919 		(setq gnus-override-method (pop methods)))
5921 		(when (eq gnus-override-method 'current)
5922 		  (setq gnus-override-method
5923 			(with-current-buffer gnus-summary-buffer
5924 			  gnus-current-select-method)))
5926 		(gnus-kill-all-overlays)
5927 		(let ((gnus-newsgroup-name group))
5928 		  (gnus-check-group-server))
5930 		 ((gnus-request-article article group (current-buffer))
5932 		    (gnus-async-prefetch-next group article
5933 					      gnus-summary-buffer)
5934 		    (when gnus-keep-backlog
5935 		      (gnus-backlog-enter-article
5939 		  (setq gnus-override-method (pop methods)))
5950       (setq gnus-article-current-summary gnus-summary-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)
5963 	    (setq buffer-read-only t))
5964 	  (let ((inhibit-read-only t))
5966 	    (insert-buffer-substring gnus-article-buffer))
5967 	  (setq gnus-original-article (cons group article)))
5970 	(run-hooks 'gnus-article-decode-hook)
5972 	(setq gnus-article-decoded-p gnus-article-decode-hook))
5974       ;; Update sparse articles.
5979 	  (set-buffer gnus-summary-buffer)
5980 	  (gnus-summary-update-article do-update-line sparse-header)
5981 	  (gnus-summary-goto-subject do-update-line nil t)
5982 	  (set-window-point (gnus-get-buffer-window (current-buffer) t)
5990 (defcustom gnus-article-edit-mode-hook nil
5992   :group 'gnus-article-various
5995 (defvar gnus-article-edit-done-function nil)
5997 (defvar gnus-article-edit-mode-map nil)
5998 (defvar gnus-article-edit-mode nil)
6001 (unless gnus-article-edit-mode-map
6002   (setq gnus-article-edit-mode-map (make-keymap))
6003   (set-keymap-parent gnus-article-edit-mode-map text-mode-map)
6005   (gnus-define-keys gnus-article-edit-mode-map
6007     "\C-c\C-c" gnus-article-edit-done
6008     "\C-c\C-k" gnus-article-edit-exit
6035     "\C-a" message-beginning-of-line
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"
6064   "Major mode for editing articles.
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)
6076   (setq buffer-read-only nil)
6080 (defun gnus-article-edit (&optional force)
6083 If FORCE is non-nil, allow editing of articles even in read-only
6087 	     (gnus-group-read-only-p))
6089   (gnus-article-date-original)
6090   (gnus-article-edit-article
6094       (gnus-summary-edit-article-done
6095        ,(or (mail-header-references gnus-current-headers) "")
6096        ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
6098 (defun gnus-article-edit-article (start-func exit-func)
6099   "Start editing the contents of the current article buffer."
6101     (set-buffer gnus-article-buffer)
6105       (gnus-article-edit-mode))
6108     (gnus-configure-windows 'edit-article)
6109     (setq gnus-article-edit-done-function exit-func)
6110     (setq gnus-prev-winconf winconf)
6111     (gnus-message 6 "C-c C-c to end edits")))
6113 (defun gnus-article-edit-done (&optional arg)
6116   (let ((func gnus-article-edit-done-function)
6120 	(winconf gnus-prev-winconf))
6125     (when gnus-keep-backlog
6126       (gnus-backlog-remove-article
6127        (car gnus-article-current) (cdr gnus-article-current)))
6130       (when (get-buffer gnus-original-article-buffer)
6131 	(set-buffer gnus-original-article-buffer)
6132 	(setq gnus-original-article nil)))
6133     (when gnus-use-cache
6134       (gnus-cache-update-article
6135        (car gnus-article-current) (cdr gnus-article-current)))
6138     (gnus-set-text-properties (point-min) (point-max) nil)
6139     (gnus-article-mode)
6144   (gnus-summary-show-article))
6146 (defun gnus-article-edit-exit ()
6155       (if (gnus-buffer-live-p gnus-original-article-buffer)
6156 	  (insert-buffer-substring gnus-original-article-buffer))
6157       (let ((winconf gnus-prev-winconf))
6159 	(gnus-article-mode)
6166     (gnus-summary-show-article)))
6168 (defun gnus-article-edit-full-stops ()
6169   "Interactively repair spacing at end of sentences."
6185 (defcustom gnus-button-url-regexp
6190   :group 'gnus-article-buttons
6193 (defcustom gnus-button-valid-fqdn-regexp
6197   :group 'gnus-article-buttons
6201 (defcustom gnus-button-valid-localpart-regexp
6203   "Regular expression that matches a localpart of mail addresses or MIDs."
6205   :group 'gnus-article-buttons
6208 (defcustom gnus-button-man-handler 'manual-entry
6216   :group 'gnus-article-buttons)
6218 (defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
6219   "Top directory of a CTAN \(Comprehensive TeX Archive Network\) 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
6248    (list "archive-tools" "biblio" "bibliography" "digests" "documentation"
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
6270 of the symbols `mid' or `mail', Gnus will always assume that the string is a
6276   :group 'gnus-article-buttons
6278 				gnus-button-mid-or-mail-heuristic)
6283 (defcustom gnus-button-mid-or-mail-heuristic-alist
6326     ;;      ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part
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)
6368       (while list
6369 	(setq elem (car list)
6372 	      list (cdr list))
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)
6421 	    ;; get rid of surrounding angles...
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>?\\)")
6446 ;; FIXME: Maybe we should merge some of the functions that do quite similar
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)
6507       (find-file-read-only file))))
6509 (defun gnus-button-handle-ctan (url)
6512    gnus-button-ctan-handler
6514     gnus-ctan-url
6515     (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp ""))))
6517 (defcustom gnus-button-tex-level 5
6522 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
6525   :group 'gnus-article-buttons
6526   :link '(custom-manual "(gnus)Group Parameters")
6529 (defcustom gnus-button-man-level 5
6534 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
6537   :group 'gnus-article-buttons
6538   :link '(custom-manual "(gnus)Group Parameters")
6541 (defcustom gnus-button-emacs-level 5
6546 probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
6547 `gnus-parameters' on how to set variables in specific groups."
6549   :group 'gnus-article-buttons
6550   :link '(custom-manual "(gnus)Group Parameters")
6553 (defcustom gnus-button-message-level 5
6559   :group 'gnus-article-buttons
6562 (defcustom gnus-button-browse-level 5
6566   ;; stuff handled by `browse-url' or `gnus-button-embedded-url'
6568   :group 'gnus-article-buttons
6571 (defcustom gnus-button-alist
6573      0 (>= gnus-button-message-level 0) gnus-button-handle-news 3)
6575 	     gnus-button-valid-localpart-regexp "@[a-z0-9.-]+[a-z]\\)")
6576      0 t gnus-button-handle-news 2)
6578      1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
6580      0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
6583      0 (>= gnus-button-message-level 0) gnus-button-message-id 2)
6585      2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
6587      0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
6590      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
6592      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
6595 	     gnus-button-ctan-directory-regexp
6597      0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
6599 	     gnus-button-ctan-directory-regexp
6601      1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1)
6604       gnus-button-ctan-directory-regexp
6606      1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
6609      0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
6612      0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1)
6615      1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2)
6617      (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
6620      0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
6623      0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2)
6625      (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1)
6629      0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1)
6631      0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1)
6633      0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
6635      0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
6640      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
6642      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
6643     ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
6644      0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
6646      0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
6648      1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
6650      1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1)
6652      0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
6654      0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
6658      1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
6661      1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6664      1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6667      1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
6669     (gnus-button-url-regexp
6670      0 (>= gnus-button-browse-level 0) browse-url 0)
6673      0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
6674      gnus-button-handle-man 1)
6677      0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
6678      gnus-button-handle-man 1)
6682      0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
6684     ;; all kind of allowed MIDs or mail addresses.  Domain part must contain
6686     ;; (info|name|...).  Put this entry near the _end_ of `gnus-button-alist'
6688     (gnus-button-mid-or-mail-regexp
6689      0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1))
6690   "*Alist of regexps matching buttons in article bodies.
6695 BUTTON: is the number of the regexp grouping actually matching the button,
6699 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
6701 CALLBACK can also be a variable, in that case the value of that
6703   :group 'gnus-article-buttons
6704   :type '(repeat (list (choice regexp variable sexp)
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
6740   :type '(repeat (list (regexp :tag "Header")
6751 (defun gnus-article-push-button (event)
6753 If the text under the mouse pointer has a `gnus-callback' property,
6754 call it with the value of the `gnus-data' text property."
6758 	 (data (get-text-property pos 'gnus-data))
6759 	 (fun (get-text-property pos 'gnus-callback)))
6764 (defun gnus-article-press-button ()
6766 If the text at point has a `gnus-callback' property,
6767 call it with the value of the `gnus-data' text property."
6769   (let ((data (get-text-property (point) 'gnus-data))
6770 	(fun (get-text-property (point) 'gnus-callback)))
6774 (defun gnus-article-highlight (&optional force)
6776 This function calls `gnus-article-highlight-headers',
6777 `gnus-article-highlight-citation',
6778 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
6780   (interactive (list 'force))
6781   (gnus-article-highlight-headers)
6782   (gnus-article-highlight-citation force)
6783   (gnus-article-highlight-signature)
6784   (gnus-article-add-buttons force)
6785   (gnus-article-add-buttons-to-head))
6787 (defun gnus-article-highlight-some (&optional force)
6789 This function calls `gnus-article-highlight-headers',
6790 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
6792   (interactive (list 'force))
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)
6804 	    (inhibit-read-only t)
6820 	    (beginning-of-line)
6827 	      (gnus-put-text-property from (point) 'face header-face))
6834 	      (gnus-put-text-property from (point) 'face field-face))))))))
6836 (defun gnus-article-highlight-signature ()
6839 `gnus-signature-separator' using the face `gnus-signature'."
6842     (set-buffer gnus-article-buffer)
6843     (let ((inhibit-read-only t)
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'."
6865   (interactive (list 'force))
6867     (set-buffer gnus-article-buffer)
6868     (let ((inhibit-read-only t)
6871 	  (alist gnus-button-alist)
6874       (let (marker entry new-list)
6875 	(while (setq marker (pop gnus-button-marker-list))
6877 	      (push marker new-list)
6879 	    (when (setq entry (gnus-button-entry))
6882 				 'gnus-callback nil))
6884 	(setq gnus-button-marker-list new-list))
6897 		       (not (gnus-button-in-region-p
6898 			     start end 'gnus-callback)))
6901 	      (gnus-article-add-button
6902 	       start end 'gnus-button-push
6904 			  gnus-button-marker-list))))))))))
6906 ;; Add buttons to the head of an article.
6907 (defun gnus-article-add-buttons-to-head ()
6908   "Add buttons to the head of the article."
6911     (set-buffer gnus-article-buffer)
6913       (let ((inhibit-read-only t)
6916 	    (alist gnus-header-button-alist)
6939 		  (gnus-article-add-button
6947 (defun gnus-article-add-button (from to fun &optional data)
6949   (when gnus-article-button-face
6950     (gnus-overlay-put (gnus-make-overlay from to)
6951 		      'face gnus-article-button-face))
6952   (gnus-add-text-properties
6954    (nconc (and gnus-article-mouse-face
6955 	       (list gnus-mouse-face-prop gnus-article-mouse-face))
6956 	  (list 'gnus-callback fun)
6957 	  (and data (list 'gnus-data data))))
6958   (widget-convert-button 'link from to :action 'gnus-widget-press-button
6959 			 :button-keymap gnus-widget-button-keymap))
6963 (defun gnus-article-set-globals ()
6965     (set-buffer gnus-summary-buffer)
6966     (gnus-set-global-variables)))
6968 (defun gnus-signature-toggle (end)
6970     (set-buffer gnus-article-buffer)
6971     (let ((inhibit-read-only t)
6975 	    (gnus-delete-wash-type 'signature)
6976 	    (gnus-remove-text-properties-when
6979 				       gnus-hidden-properties))))
6980 	(gnus-add-wash-type 'signature)
6981 	(gnus-add-text-properties-when
6984 				   gnus-hidden-properties)))))
6985     (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
6986       (gnus-set-mode-line 'article))))
6988 (defun gnus-button-entry ()
6989   ;; Return the first entry in `gnus-button-alist' matching this place.
6990   (let ((alist gnus-button-alist)
6999 (defun gnus-button-push (marker)
7003     (let* ((entry (gnus-button-entry))
7008 			     (gnus-set-text-properties
7019 	(gnus-message 1 "You must define `%S' to use this button"
7022 (defun gnus-parse-news-url (url)
7023   (let (scheme server port group message-id articles)
7042 	      articles (split-string (match-string 2) "-")))
7047     (list scheme server port group message-id articles)))
7049 (defun gnus-button-handle-news (url)
7051   (destructuring-bind (scheme server port group message-id articles)
7052       (gnus-parse-news-url url)
7056 	(set-buffer gnus-summary-buffer)
7058 	    (let ((gnus-refer-article-method
7059 		   (nconc (list (list 'nntp server))
7060 			  gnus-refer-article-method))
7062 	      (gnus-message 7 "Fetching %s with %s"
7063 			    message-id gnus-refer-article-method)
7064 	      (gnus-summary-refer-article message-id))
7065 	  (gnus-summary-refer-article message-id))))
7067       (gnus-button-fetch-group url)))))
7069 (defun gnus-button-handle-man (url)
7071   (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
7072   (when (eq gnus-button-man-handler 'woman)
7073     (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
7074   (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
7075   (funcall gnus-button-man-handler url))
7077 (defun gnus-button-handle-info-url (url)
7082     (gnus-info-find-node
7083      (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
7085 	     ")" (gnus-url-unhex-string (match-string 2 url)))))
7088 	  (gnus-replace-in-string
7089 	   (gnus-replace-in-string url "[\n\t ]+" " ") "\"" ""))
7090     (gnus-info-find-node url))
7093 (defun gnus-button-handle-info-url-gnome (url)
7097       (gnus-info-find-node
7099 	       (gnus-url-unhex-string
7102 	       (or (gnus-url-unhex-string
7107 (defun gnus-button-handle-info-url-kde (url)
7109   (gnus-info-find-node (gnus-url-unhex-string url)))
7111 (defun gnus-button-handle-info-keystrokes (url)
7113   ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
7118 (defun gnus-button-message-id (message-id)
7121     (set-buffer gnus-summary-buffer)
7122     (gnus-summary-refer-article message-id)))
7124 (defun gnus-button-fetch-group (address)
7128       (gnus-group-read-ephemeral-group address gnus-select-method)
7134       (gnus-group-read-ephemeral-group
7142        (and (match-end 6) (list (string-to-number (match-string 6 address))))))))
7144 (defun gnus-url-parse-query-string (query &optional downcase)
7152 	(setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
7153 	      val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
7159 	  (setq retval (cons (list key val) retval)))))
7162 (defun gnus-url-mailto (url)
7167     (setq args (gnus-url-parse-query-string
7176     (gnus-msg-mail)
7182       (insert (gnus-replace-in-string
7190 (defun gnus-button-embedded-url (address)
7192   (browse-url (gnus-strip-whitespace address)))
7196 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
7197 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
7199 (defvar gnus-prev-page-map
7203       (set-keymap-parent map gnus-article-mode-map))
7204     (define-key map gnus-mouse-2 'gnus-button-prev-page)
7205     (define-key map "\r" 'gnus-button-prev-page)
7208 (defvar gnus-next-page-map
7212       (set-keymap-parent map gnus-article-mode-map))
7213     (define-key map gnus-mouse-2 'gnus-button-next-page)
7214     (define-key map "\r" 'gnus-button-next-page)
7217 (defun gnus-insert-prev-page-button ()
7219 	(inhibit-read-only t))
7220     (gnus-eval-format
7221      gnus-prev-page-line-format nil
7222      `(,@(gnus-local-map-property gnus-prev-page-map)
7223 	 gnus-prev t
7224 	 gnus-callback gnus-article-button-prev-page
7231      :action 'gnus-button-prev-page
7232      :button-keymap gnus-prev-page-map)))
7234 (defun gnus-button-next-page (&optional args more-args)
7238     (select-window (gnus-get-buffer-window gnus-article-buffer t))
7239     (gnus-article-next-page)
7242 (defun gnus-button-prev-page (&optional args more-args)
7246     (select-window (gnus-get-buffer-window gnus-article-buffer t))
7247     (gnus-article-prev-page)
7250 (defun gnus-insert-next-page-button ()
7252 	(inhibit-read-only t))
7253     (gnus-eval-format gnus-next-page-line-format nil
7254 		      `(,@(gnus-local-map-property gnus-next-page-map)
7255 			  gnus-next t
7256 			  gnus-callback gnus-article-button-next-page
7263      :action 'gnus-button-next-page
7264      :button-keymap gnus-next-page-map)))
7266 (defun gnus-article-button-next-page (arg)
7270     (select-window (gnus-get-buffer-window gnus-article-buffer t))
7271     (gnus-article-next-page)
7274 (defun gnus-article-button-prev-page (arg)
7278     (select-window (gnus-get-buffer-window gnus-article-buffer t))
7279     (gnus-article-prev-page)
7282 (defvar gnus-decode-header-methods
7284   "List of methods used to decode headers.
7286 This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
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
7311 			   (list (cdr x))))))
7312 	  gnus-decode-header-methods))
7313   (let ((xlist gnus-decode-header-methods-cache))
7324 (defun gnus-treat-article (condition &optional part-number total-parts type)
7326 	(alist gnus-treatment-function-alist)
7331 	       (let ((list gnus-article-treat-types))
7332 		 (while list
7333 		   (when (string-match (pop list) type)
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)
7398    (list
7399     (or gnus-article-encrypt-protocol
7400 	(completing-read "Encrypt protocol: "
7401 			 gnus-article-encrypt-protocol-alist
7404   (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
7407     (if (member gnus-newsgroup-name '("nndraft:delayed"
7411 	       gnus-newsgroup-name))
7412     (gnus-summary-iterate n
7414 	(set-buffer gnus-summary-buffer)
7415 	(let ((mail-parse-charset gnus-newsgroup-charset)
7416 	      (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
7417 	      (summary-buffer gnus-summary-buffer)
7419 	  (gnus-set-global-variables)
7420 	  (when (gnus-group-read-only-p)
7422 	  (gnus-summary-show-article t)
7424 	      (or (mail-header-references gnus-current-headers) ""))
7425 	  (set-buffer gnus-article-buffer)
7426 	  (let* ((inhibit-read-only t)
7455 	    (gnus-summary-edit-article-done
7457 	  (when gnus-keep-backlog
7458 	    (gnus-backlog-remove-article
7459 	     (car gnus-article-current) (cdr gnus-article-current)))
7461 	    (when (get-buffer gnus-original-article-buffer)
7462 	      (set-buffer gnus-original-article-buffer)
7463 	      (setq gnus-original-article nil)))
7464 	  (when gnus-use-cache
7465 	    (gnus-cache-update-article
7466 	     (car gnus-article-current) (cdr gnus-article-current))))))))
7468 (defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n"
7475 (defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n"
7482 (defvar gnus-mime-security-button-line-format-alist
7483   '((?t gnus-tmp-type ?s)
7484     (?i gnus-tmp-info ?s)
7485     (?d gnus-tmp-details ?s)
7486     (?D gnus-tmp-pressed-details ?s)))
7488 (defvar gnus-mime-security-button-map
7491       (set-keymap-parent map gnus-article-mode-map))
7492     (define-key map gnus-mouse-2 'gnus-article-push-button)
7493     (define-key map "\r" 'gnus-article-press-button)
7496 (defvar gnus-mime-security-details-buffer nil)
7498 (defvar gnus-mime-security-button-pressed nil)
7500 (defvar gnus-mime-security-show-details-inline t
7503 (defun gnus-mime-security-verify-or-decrypt (handle)
7505   (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
7506 	point (inhibit-read-only t))
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))
7536 		(inhibit-read-only t))
7538 	    (while (eq (get-text-property (point) 'gnus-line-format)
7539 		       gnus-mime-security-button-line-format)
7544 	      (gnus-insert-mime-security-button handle))
7548 				'gnus-line-format
7549 				gnus-mime-security-button-line-format)
7552 	(if (gnus-buffer-live-p gnus-mime-security-details-buffer)
7553 	    (with-current-buffer gnus-mime-security-details-buffer
7556 	  (setq gnus-mime-security-details-buffer
7557 		(gnus-get-buffer-create "*MIME Security Details*")))
7558 	(with-current-buffer gnus-mime-security-details-buffer
7561 	(pop-to-buffer gnus-mime-security-details-buffer)))))
7563 (defun gnus-mime-security-press-button (handle)
7565     (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
7566 	(gnus-mime-security-show-details handle)
7567       (gnus-mime-security-verify-or-decrypt handle))))
7569 (defun gnus-insert-mime-security-button (handle &optional displayed)
7571 	 (gnus-tmp-type
7579 	 (gnus-tmp-info
7580 	  (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
7582 	 (gnus-tmp-details
7583 	  (mm-handle-multipart-ctl-parameter handle 'gnus-details))
7584 	 gnus-tmp-pressed-details
7586     (setq gnus-tmp-details
7587 	  (if gnus-tmp-details
7588 	      (concat "\n" gnus-tmp-details)
7590     (setq gnus-tmp-pressed-details
7591 	  (if gnus-mime-security-button-pressed gnus-tmp-details ""))
7595     (gnus-eval-format
7596      gnus-mime-security-button-line-format
7597      gnus-mime-security-button-line-format-alist
7598      `(,@(gnus-local-map-property gnus-mime-security-button-map)
7599 	 gnus-callback gnus-mime-security-press-button
7600 	 gnus-line-format ,gnus-mime-security-button-line-format
7601 	 gnus-mime-details ,gnus-mime-security-button-pressed
7603 	 gnus-data ,handle))
7611      :action 'gnus-widget-press-button
7612      :button-keymap gnus-mime-security-button-map
7621 	(aref gnus-mouse-2 0))))))
7623 (defun gnus-mime-display-security (handle)
7626     (unless (gnus-unbuttonized-mime-type-p (car handle))
7627       (gnus-insert-mime-security-button handle))
7628     (gnus-mime-display-mixed (cdr handle))
7631     (unless (gnus-unbuttonized-mime-type-p (car handle))
7632       (let ((gnus-mime-security-button-line-format
7633 	     gnus-mime-security-button-end-line-format))
7634 	(gnus-insert-mime-security-button handle)))
7636      handle 'gnus-region
7640 (gnus-ems-redefine)
7642 (provide 'gnus-art)
7644 (run-hooks 'gnus-art-load-hook)
7647 ;;; gnus-art.el ends here