|
98
|
1 ;;; gnus-art.el --- article mode commands for Gnus
|
|
|
2 ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
|
|
5 ;; Keywords: news
|
|
|
6
|
|
|
7 ;; This file is part of GNU Emacs.
|
|
|
8
|
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
|
28 (require 'custom)
|
|
|
29 (require 'gnus)
|
|
|
30 (require 'gnus-sum)
|
|
|
31 (require 'gnus-spec)
|
|
|
32 (require 'gnus-int)
|
|
|
33 (require 'browse-url)
|
|
|
34
|
|
|
35 (defgroup gnus-article nil
|
|
|
36 "Article display."
|
|
|
37 :link '(custom-manual "(gnus)The Article Buffer")
|
|
|
38 :group 'gnus)
|
|
|
39
|
|
|
40 (defgroup gnus-article-hiding nil
|
|
|
41 "Hiding article parts."
|
|
|
42 :link '(custom-manual "(gnus)Article Hiding")
|
|
|
43 :group 'gnus-article)
|
|
|
44
|
|
|
45 (defgroup gnus-article-highlight nil
|
|
|
46 "Article highlighting."
|
|
|
47 :link '(custom-manual "(gnus)Article Highlighting")
|
|
|
48 :group 'gnus-article
|
|
|
49 :group 'gnus-visual)
|
|
|
50
|
|
|
51 (defgroup gnus-article-signature nil
|
|
|
52 "Article signatures."
|
|
|
53 :link '(custom-manual "(gnus)Article Signature")
|
|
|
54 :group 'gnus-article)
|
|
|
55
|
|
|
56 (defgroup gnus-article-headers nil
|
|
|
57 "Article headers."
|
|
|
58 :link '(custom-manual "(gnus)Hiding Headers")
|
|
|
59 :group 'gnus-article)
|
|
|
60
|
|
|
61 (defgroup gnus-article-washing nil
|
|
|
62 "Special commands on articles."
|
|
|
63 :link '(custom-manual "(gnus)Article Washing")
|
|
|
64 :group 'gnus-article)
|
|
|
65
|
|
|
66 (defgroup gnus-article-emphasis nil
|
|
|
67 "Fontisizing articles."
|
|
|
68 :link '(custom-manual "(gnus)Article Fontisizing")
|
|
|
69 :group 'gnus-article)
|
|
|
70
|
|
|
71 (defgroup gnus-article-saving nil
|
|
|
72 "Saving articles."
|
|
|
73 :link '(custom-manual "(gnus)Saving Articles")
|
|
|
74 :group 'gnus-article)
|
|
|
75
|
|
|
76 (defgroup gnus-article-mime nil
|
|
|
77 "Worshiping the MIME wonder."
|
|
|
78 :link '(custom-manual "(gnus)Using MIME")
|
|
|
79 :group 'gnus-article)
|
|
|
80
|
|
|
81 (defgroup gnus-article-buttons nil
|
|
|
82 "Pushable buttons in the article buffer."
|
|
|
83 :link '(custom-manual "(gnus)Article Buttons")
|
|
|
84 :group 'gnus-article)
|
|
|
85
|
|
|
86 (defgroup gnus-article-various nil
|
|
|
87 "Other article options."
|
|
|
88 :link '(custom-manual "(gnus)Misc Article")
|
|
|
89 :group 'gnus-article)
|
|
|
90
|
|
|
91 (defcustom gnus-ignored-headers
|
|
|
92 '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:"
|
|
|
93 "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
|
|
|
94 "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
|
|
108
|
95 "^Approved:" "^Sender:" "^Received:" "^Mail-from:")
|
|
98
|
96 "All headers that match this regexp will be hidden.
|
|
|
97 This variable can also be a list of regexps of headers to be ignored.
|
|
|
98 If `gnus-visible-headers' is non-nil, this variable will be ignored."
|
|
|
99 :type '(choice :custom-show nil
|
|
|
100 regexp
|
|
|
101 (repeat regexp))
|
|
|
102 :group 'gnus-article-hiding)
|
|
|
103
|
|
108
|
104 (defcustom gnus-visible-headers
|
|
98
|
105 "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From"
|
|
|
106 "All headers that do not match this regexp will be hidden.
|
|
|
107 This variable can also be a list of regexp of headers to remain visible.
|
|
|
108 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
|
|
|
109 :type '(repeat :value-to-internal (lambda (widget value)
|
|
|
110 (custom-split-regexp-maybe value))
|
|
|
111 :match (lambda (widget value)
|
|
|
112 (or (stringp value)
|
|
|
113 (widget-editable-list-match widget value)))
|
|
|
114 regexp)
|
|
|
115 :group 'gnus-article-hiding)
|
|
|
116
|
|
|
117 (defcustom gnus-sorted-header-list
|
|
118
|
118 '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
|
|
|
119 "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
|
|
98
|
120 "This variable is a list of regular expressions.
|
|
|
121 If it is non-nil, headers that match the regular expressions will
|
|
|
122 be placed first in the article buffer in the sequence specified by
|
|
|
123 this list."
|
|
|
124 :type '(repeat regexp)
|
|
|
125 :group 'gnus-article-hiding)
|
|
|
126
|
|
|
127 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
|
|
|
128 "Headers that are only to be displayed if they have interesting data.
|
|
|
129 Possible values in this list are `empty', `newsgroups', `followup-to',
|
|
|
130 `reply-to', and `date'."
|
|
|
131 :type '(set (const :tag "Headers with no content." empty)
|
|
|
132 (const :tag "Newsgroups with only one group." newsgroups)
|
|
|
133 (const :tag "Followup-to identical to newsgroups." followup-to)
|
|
|
134 (const :tag "Reply-to identical to from." reply-to)
|
|
|
135 (const :tag "Date less than four days old." date))
|
|
|
136 :group 'gnus-article-hiding)
|
|
|
137
|
|
|
138 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
|
|
|
139 "Regexp matching signature separator.
|
|
|
140 This can also be a list of regexps. In that case, it will be checked
|
|
|
141 from head to tail looking for a separator. Searches will be done from
|
|
|
142 the end of the buffer."
|
|
|
143 :type '(repeat string)
|
|
|
144 :group 'gnus-article-signature)
|
|
|
145
|
|
|
146 (defcustom gnus-signature-limit nil
|
|
|
147 "Provide a limit to what is considered a signature.
|
|
|
148 If it is a number, no signature may not be longer (in characters) than
|
|
|
149 that number. If it is a floating point number, no signature may be
|
|
|
150 longer (in lines) than that number. If it is a function, the function
|
|
|
151 will be called without any parameters, and if it returns nil, there is
|
|
|
152 no signature in the buffer. If it is a string, it will be used as a
|
|
|
153 regexp. If it matches, the text in question is not a signature."
|
|
|
154 :type '(choice integer number function regexp)
|
|
|
155 :group 'gnus-article-signature)
|
|
|
156
|
|
|
157 (defcustom gnus-hidden-properties '(invisible t intangible t)
|
|
|
158 "Property list to use for hiding text."
|
|
108
|
159 :type 'sexp
|
|
98
|
160 :group 'gnus-article-hiding)
|
|
|
161
|
|
|
162 (defcustom gnus-article-x-face-command
|
|
|
163 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
|
|
|
164 "String or function to be executed to display an X-Face header.
|
|
|
165 If it is a string, the command will be executed in a sub-shell
|
|
|
166 asynchronously. The compressed face will be piped to this command."
|
|
|
167 :type 'string ;Leave function case to Lisp.
|
|
|
168 :group 'gnus-article-washing)
|
|
|
169
|
|
|
170 (defcustom gnus-article-x-face-too-ugly nil
|
|
|
171 "Regexp matching posters whose face shouldn't be shown automatically."
|
|
|
172 :type 'regexp
|
|
|
173 :group 'gnus-article-washing)
|
|
|
174
|
|
|
175 (defcustom gnus-emphasis-alist
|
|
|
176 (let ((format
|
|
118
|
177 "\\(\\s-\\|^\\|[-\"]\\|\\s(\\|\\s)\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"]\\|\\s(\\|\\s)\\)")
|
|
98
|
178 (types
|
|
|
179 '(("_" "_" underline)
|
|
|
180 ("/" "/" italic)
|
|
|
181 ("\\*" "\\*" bold)
|
|
100
|
182 ("_/" "/_" underline-italic)
|
|
|
183 ("_\\*" "\\*_" underline-bold)
|
|
98
|
184 ("\\*/" "/\\*" bold-italic)
|
|
100
|
185 ("_\\*/" "/\\*_" underline-bold-italic))))
|
|
98
|
186 `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
|
|
|
187 2 3 gnus-emphasis-underline)
|
|
|
188 ,@(mapcar
|
|
|
189 (lambda (spec)
|
|
|
190 (list
|
|
|
191 (format format (car spec) (cadr spec))
|
|
|
192 2 3 (intern (format "gnus-emphasis-%s" (caddr spec)))))
|
|
|
193 types)))
|
|
|
194 "Alist that says how to fontify certain phrases.
|
|
|
195 Each item looks like this:
|
|
|
196
|
|
|
197 (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
|
|
|
198
|
|
|
199 The first element is a regular expression to be matched. The second
|
|
|
200 is a number that says what regular expression grouping used to find
|
|
|
201 the entire emphasized word. The third is a number that says what
|
|
|
202 regexp grouping should be displayed and highlighted. The fourth
|
|
|
203 is the face used for highlighting."
|
|
|
204 :type '(repeat (list :value ("" 0 0 default)
|
|
|
205 regexp
|
|
|
206 (integer :tag "Match group")
|
|
|
207 (integer :tag "Emphasize group")
|
|
|
208 face))
|
|
|
209 :group 'gnus-article-emphasis)
|
|
|
210
|
|
|
211 (defface gnus-emphasis-bold '((t (:bold t)))
|
|
|
212 "Face used for displaying strong emphasized text (*word*)."
|
|
|
213 :group 'gnus-article-emphasis)
|
|
|
214
|
|
|
215 (defface gnus-emphasis-italic '((t (:italic t)))
|
|
|
216 "Face used for displaying italic emphasized text (/word/)."
|
|
|
217 :group 'gnus-article-emphasis)
|
|
|
218
|
|
|
219 (defface gnus-emphasis-underline '((t (:underline t)))
|
|
|
220 "Face used for displaying underlined emphasized text (_word_)."
|
|
|
221 :group 'gnus-article-emphasis)
|
|
|
222
|
|
|
223 (defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
|
|
|
224 "Face used for displaying underlined bold emphasized text (_*word*_)."
|
|
|
225 :group 'gnus-article-emphasis)
|
|
|
226
|
|
|
227 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
|
|
|
228 "Face used for displaying underlined italic emphasized text (_*word*_)."
|
|
|
229 :group 'gnus-article-emphasis)
|
|
|
230
|
|
|
231 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
|
|
|
232 "Face used for displaying bold italic emphasized text (/*word*/)."
|
|
|
233 :group 'gnus-article-emphasis)
|
|
|
234
|
|
108
|
235 (defface gnus-emphasis-underline-bold-italic
|
|
98
|
236 '((t (:bold t :italic t :underline t)))
|
|
|
237 "Face used for displaying underlined bold italic emphasized text.
|
|
|
238 Esample: (_/*word*/_)."
|
|
|
239 :group 'gnus-article-emphasis)
|
|
|
240
|
|
|
241 (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
|
|
|
242 "Format for display of Date headers in article bodies.
|
|
|
243 See `format-time-zone' for the possible values."
|
|
|
244 :type 'string
|
|
|
245 :link '(custom-manual "(gnus)Article Date")
|
|
|
246 :group 'gnus-article-washing)
|
|
|
247
|
|
|
248 (eval-and-compile
|
|
|
249 (autoload 'hexl-hex-string-to-integer "hexl")
|
|
|
250 (autoload 'timezone-make-date-arpa-standard "timezone")
|
|
|
251 (autoload 'mail-extract-address-components "mail-extr"))
|
|
|
252
|
|
|
253 (defcustom gnus-save-all-headers t
|
|
|
254 "*If non-nil, don't remove any headers before saving."
|
|
|
255 :group 'gnus-article-saving
|
|
|
256 :type 'boolean)
|
|
|
257
|
|
|
258 (defcustom gnus-prompt-before-saving 'always
|
|
|
259 "*This variable says how much prompting is to be done when saving articles.
|
|
|
260 If it is nil, no prompting will be done, and the articles will be
|
|
|
261 saved to the default files. If this variable is `always', each and
|
|
|
262 every article that is saved will be preceded by a prompt, even when
|
|
|
263 saving large batches of articles. If this variable is neither nil not
|
|
|
264 `always', there the user will be prompted once for a file name for
|
|
|
265 each invocation of the saving commands."
|
|
|
266 :group 'gnus-article-saving
|
|
|
267 :type '(choice (item always)
|
|
|
268 (item :tag "never" nil)
|
|
|
269 (sexp :tag "once" :format "%t")))
|
|
|
270
|
|
|
271 (defcustom gnus-saved-headers gnus-visible-headers
|
|
|
272 "Headers to keep if `gnus-save-all-headers' is nil.
|
|
|
273 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
|
|
|
274 If that variable is nil, however, all headers that match this regexp
|
|
|
275 will be kept while the rest will be deleted before saving."
|
|
|
276 :group 'gnus-article-saving
|
|
|
277 :type '(repeat string))
|
|
|
278
|
|
|
279 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
|
|
|
280 "A function to save articles in your favourite format.
|
|
|
281 The function must be interactively callable (in other words, it must
|
|
|
282 be an Emacs command).
|
|
|
283
|
|
|
284 Gnus provides the following functions:
|
|
|
285
|
|
|
286 * gnus-summary-save-in-rmail (Rmail format)
|
|
|
287 * gnus-summary-save-in-mail (Unix mail format)
|
|
|
288 * gnus-summary-save-in-folder (MH folder)
|
|
|
289 * gnus-summary-save-in-file (article format)
|
|
|
290 * gnus-summary-save-in-vm (use VM's folder format)
|
|
|
291 * gnus-summary-write-to-file (article format -- overwrite)."
|
|
|
292 :group 'gnus-article-saving
|
|
|
293 :type '(radio (function-item gnus-summary-save-in-rmail)
|
|
|
294 (function-item gnus-summary-save-in-mail)
|
|
|
295 (function-item gnus-summary-save-in-folder)
|
|
|
296 (function-item gnus-summary-save-in-file)
|
|
|
297 (function-item gnus-summary-save-in-vm)
|
|
|
298 (function-item gnus-summary-write-to-file)))
|
|
|
299
|
|
|
300 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
|
|
|
301 "A function generating a file name to save articles in Rmail format.
|
|
|
302 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
|
|
|
303 :group 'gnus-article-saving
|
|
|
304 :type 'function)
|
|
|
305
|
|
|
306 (defcustom gnus-mail-save-name 'gnus-plain-save-name
|
|
|
307 "A function generating a file name to save articles in Unix mail format.
|
|
|
308 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
|
|
|
309 :group 'gnus-article-saving
|
|
|
310 :type 'function)
|
|
|
311
|
|
|
312 (defcustom gnus-folder-save-name 'gnus-folder-save-name
|
|
|
313 "A function generating a file name to save articles in MH folder.
|
|
|
314 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
|
|
|
315 :group 'gnus-article-saving
|
|
|
316 :type 'function)
|
|
|
317
|
|
|
318 (defcustom gnus-file-save-name 'gnus-numeric-save-name
|
|
|
319 "A function generating a file name to save articles in article format.
|
|
|
320 The function is called with NEWSGROUP, HEADERS, and optional
|
|
|
321 LAST-FILE."
|
|
|
322 :group 'gnus-article-saving
|
|
|
323 :type 'function)
|
|
|
324
|
|
|
325 (defcustom gnus-split-methods
|
|
116
|
326 '((gnus-article-archive-name)
|
|
|
327 (gnus-article-nndoc-name))
|
|
98
|
328 "Variable used to suggest where articles are to be saved.
|
|
|
329 For instance, if you would like to save articles related to Gnus in
|
|
|
330 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
|
|
|
331 you could set this variable to something like:
|
|
|
332
|
|
|
333 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
|
|
|
334 (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
|
|
|
335
|
|
|
336 This variable is an alist where the where the key is the match and the
|
|
|
337 value is a list of possible files to save in if the match is non-nil.
|
|
|
338
|
|
|
339 If the match is a string, it is used as a regexp match on the
|
|
|
340 article. If the match is a symbol, that symbol will be funcalled
|
|
|
341 from the buffer of the article to be saved with the newsgroup as the
|
|
|
342 parameter. If it is a list, it will be evaled in the same buffer.
|
|
|
343
|
|
|
344 If this form or function returns a string, this string will be used as
|
|
|
345 a possible file name; and if it returns a non-nil list, that list will
|
|
|
346 be used as possible file names."
|
|
|
347 :group 'gnus-article-saving
|
|
|
348 :type '(repeat (choice (list function)
|
|
|
349 (cons regexp (repeat string))
|
|
|
350 sexp)))
|
|
|
351
|
|
|
352 (defcustom gnus-strict-mime t
|
|
|
353 "*If nil, MIME-decode even if there is no Mime-Version header."
|
|
|
354 :group 'gnus-article-mime
|
|
|
355 :type 'boolean)
|
|
|
356
|
|
|
357 (defcustom gnus-show-mime-method 'metamail-buffer
|
|
|
358 "Function to process a MIME message.
|
|
|
359 The function is called from the article buffer."
|
|
|
360 :group 'gnus-article-mime
|
|
|
361 :type 'function)
|
|
|
362
|
|
|
363 (defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable
|
|
|
364 "*Function to decode MIME encoded words.
|
|
|
365 The function is called from the article buffer."
|
|
|
366 :group 'gnus-article-mime
|
|
|
367 :type 'function)
|
|
|
368
|
|
|
369 (defcustom gnus-page-delimiter "^\^L"
|
|
|
370 "*Regexp describing what to use as article page delimiters.
|
|
|
371 The default value is \"^\^L\", which is a form linefeed at the
|
|
|
372 beginning of a line."
|
|
|
373 :type 'regexp
|
|
|
374 :group 'gnus-article-various)
|
|
|
375
|
|
|
376 (defcustom gnus-article-mode-line-format "Gnus: %%b %S"
|
|
|
377 "*The format specification for the article mode line.
|
|
|
378 See `gnus-summary-mode-line-format' for a closer description."
|
|
|
379 :type 'string
|
|
|
380 :group 'gnus-article-various)
|
|
|
381
|
|
|
382 (defcustom gnus-article-mode-hook nil
|
|
|
383 "*A hook for Gnus article mode."
|
|
|
384 :type 'hook
|
|
|
385 :group 'gnus-article-various)
|
|
|
386
|
|
|
387 (defcustom gnus-article-menu-hook nil
|
|
|
388 "*Hook run after the creation of the article mode menu."
|
|
|
389 :type 'hook
|
|
|
390 :group 'gnus-article-various)
|
|
|
391
|
|
|
392 (defcustom gnus-article-prepare-hook nil
|
|
|
393 "*A hook called after an article has been prepared in the article buffer.
|
|
|
394 If you want to run a special decoding program like nkf, use this hook."
|
|
|
395 :type 'hook
|
|
|
396 :group 'gnus-article-various)
|
|
|
397
|
|
151
|
398 (defcustom gnus-article-hide-pgp-hook nil
|
|
|
399 "*A hook called after successfully hiding a PGP signature."
|
|
|
400 :type 'hook
|
|
|
401 :group 'gnus-article-various)
|
|
|
402
|
|
98
|
403 (defcustom gnus-article-button-face 'bold
|
|
|
404 "Face used for highlighting buttons in the article buffer.
|
|
|
405
|
|
|
406 An article button is a piece of text that you can activate by pressing
|
|
|
407 `RET' or `mouse-2' above it."
|
|
|
408 :type 'face
|
|
|
409 :group 'gnus-article-buttons)
|
|
|
410
|
|
|
411 (defcustom gnus-article-mouse-face 'highlight
|
|
|
412 "Face used for mouse highlighting in the article buffer.
|
|
|
413
|
|
|
414 Article buttons will be displayed in this face when the cursor is
|
|
|
415 above them."
|
|
|
416 :type 'face
|
|
|
417 :group 'gnus-article-buttons)
|
|
|
418
|
|
136
|
419 (defcustom gnus-signature-face 'gnus-signature-face
|
|
|
420 "Face used for highlighting a signature in the article buffer.
|
|
|
421 Obsolete; use the face `gnus-signature-face' for customizations instead."
|
|
|
422 :type 'face
|
|
|
423 :group 'gnus-article-highlight
|
|
|
424 :group 'gnus-article-signature)
|
|
|
425
|
|
|
426 (defface gnus-signature-face
|
|
|
427 '((((type x))
|
|
|
428 (:italic t)))
|
|
98
|
429 "Face used for highlighting a signature in the article buffer."
|
|
|
430 :group 'gnus-article-highlight
|
|
|
431 :group 'gnus-article-signature)
|
|
|
432
|
|
108
|
433 (defface gnus-header-from-face
|
|
98
|
434 '((((class color)
|
|
|
435 (background dark))
|
|
110
|
436 (:foreground "spring green" :bold t))
|
|
98
|
437 (((class color)
|
|
|
438 (background light))
|
|
110
|
439 (:foreground "red3" :bold t))
|
|
108
|
440 (t
|
|
98
|
441 (:bold t :italic t)))
|
|
|
442 "Face used for displaying from headers."
|
|
|
443 :group 'gnus-article-headers
|
|
|
444 :group 'gnus-article-highlight)
|
|
|
445
|
|
108
|
446 (defface gnus-header-subject-face
|
|
98
|
447 '((((class color)
|
|
|
448 (background dark))
|
|
110
|
449 (:foreground "SeaGreen3" :bold t))
|
|
98
|
450 (((class color)
|
|
|
451 (background light))
|
|
110
|
452 (:foreground "red4" :bold t))
|
|
108
|
453 (t
|
|
98
|
454 (:bold t :italic t)))
|
|
|
455 "Face used for displaying subject headers."
|
|
|
456 :group 'gnus-article-headers
|
|
|
457 :group 'gnus-article-highlight)
|
|
|
458
|
|
108
|
459 (defface gnus-header-newsgroups-face
|
|
98
|
460 '((((class color)
|
|
|
461 (background dark))
|
|
|
462 (:foreground "yellow" :bold t :italic t))
|
|
|
463 (((class color)
|
|
|
464 (background light))
|
|
108
|
465 (:foreground "MidnightBlue" :bold t :italic t))
|
|
|
466 (t
|
|
98
|
467 (:bold t :italic t)))
|
|
|
468 "Face used for displaying newsgroups headers."
|
|
|
469 :group 'gnus-article-headers
|
|
|
470 :group 'gnus-article-highlight)
|
|
|
471
|
|
108
|
472 (defface gnus-header-name-face
|
|
98
|
473 '((((class color)
|
|
|
474 (background dark))
|
|
108
|
475 (:foreground "SeaGreen"))
|
|
98
|
476 (((class color)
|
|
|
477 (background light))
|
|
108
|
478 (:foreground "maroon"))
|
|
|
479 (t
|
|
98
|
480 (:bold t)))
|
|
|
481 "Face used for displaying header names."
|
|
|
482 :group 'gnus-article-headers
|
|
|
483 :group 'gnus-article-highlight)
|
|
|
484
|
|
|
485 (defface gnus-header-content-face
|
|
|
486 '((((class color)
|
|
|
487 (background dark))
|
|
|
488 (:foreground "forest green" :italic t))
|
|
|
489 (((class color)
|
|
|
490 (background light))
|
|
108
|
491 (:foreground "indianred4" :italic t))
|
|
|
492 (t
|
|
98
|
493 (:italic t))) "Face used for displaying header content."
|
|
|
494 :group 'gnus-article-headers
|
|
|
495 :group 'gnus-article-highlight)
|
|
|
496
|
|
|
497 (defcustom gnus-header-face-alist
|
|
|
498 '(("From" nil gnus-header-from-face)
|
|
|
499 ("Subject" nil gnus-header-subject-face)
|
|
|
500 ("Newsgroups:.*," nil gnus-header-newsgroups-face)
|
|
|
501 ("" gnus-header-name-face gnus-header-content-face))
|
|
|
502 "Controls highlighting of article header.
|
|
|
503
|
|
108
|
504 An alist of the form (HEADER NAME CONTENT).
|
|
98
|
505
|
|
|
506 HEADER is a regular expression which should match the name of an
|
|
|
507 header header and NAME and CONTENT are either face names or nil.
|
|
|
508
|
|
|
509 The name of each header field will be displayed using the face
|
|
|
510 specified by the first element in the list where HEADER match the
|
|
|
511 header name and NAME is non-nil. Similarly, the content will be
|
|
|
512 displayed by the first non-nil matching CONTENT face."
|
|
|
513 :group 'gnus-article-headers
|
|
|
514 :group 'gnus-article-highlight
|
|
|
515 :type '(repeat (list (regexp :tag "Header")
|
|
|
516 (choice :tag "Name"
|
|
|
517 (item :tag "skip" nil)
|
|
|
518 (face :value default))
|
|
|
519 (choice :tag "Content"
|
|
|
520 (item :tag "skip" nil)
|
|
|
521 (face :value default)))))
|
|
|
522
|
|
|
523 ;;; Internal variables
|
|
|
524
|
|
|
525 (defvar gnus-article-mode-syntax-table
|
|
|
526 (let ((table (copy-syntax-table text-mode-syntax-table)))
|
|
110
|
527 (modify-syntax-entry ?- "w" table)
|
|
118
|
528 (modify-syntax-entry ?> ")" table)
|
|
|
529 (modify-syntax-entry ?< "(" table)
|
|
98
|
530 table)
|
|
|
531 "Syntax table used in article mode buffers.
|
|
|
532 Initialized from `text-mode-syntax-table.")
|
|
|
533
|
|
|
534 (defvar gnus-save-article-buffer nil)
|
|
|
535
|
|
|
536 (defvar gnus-article-mode-line-format-alist
|
|
|
537 (nconc '((?w (gnus-article-wash-status) ?s))
|
|
|
538 gnus-summary-mode-line-format-alist))
|
|
|
539
|
|
|
540 (defvar gnus-number-of-articles-to-be-saved nil)
|
|
|
541
|
|
|
542 (defvar gnus-inhibit-hiding nil)
|
|
|
543
|
|
|
544 (defsubst gnus-article-hide-text (b e props)
|
|
|
545 "Set text PROPS on the B to E region, extending `intangible' 1 past B."
|
|
|
546 (add-text-properties b e props)
|
|
|
547 (when (memq 'intangible props)
|
|
108
|
548 (put-text-property
|
|
98
|
549 (max (1- b) (point-min))
|
|
|
550 b 'intangible (cddr (memq 'intangible props)))))
|
|
|
551
|
|
|
552 (defsubst gnus-article-unhide-text (b e)
|
|
|
553 "Remove hidden text properties from region between B and E."
|
|
|
554 (remove-text-properties b e gnus-hidden-properties)
|
|
|
555 (when (memq 'intangible gnus-hidden-properties)
|
|
|
556 (put-text-property (max (1- b) (point-min))
|
|
|
557 b 'intangible nil)))
|
|
|
558
|
|
|
559 (defun gnus-article-hide-text-type (b e type)
|
|
|
560 "Hide text of TYPE between B and E."
|
|
|
561 (gnus-article-hide-text
|
|
|
562 b e (cons 'article-type (cons type gnus-hidden-properties))))
|
|
|
563
|
|
|
564 (defun gnus-article-unhide-text-type (b e type)
|
|
|
565 "Hide text of TYPE between B and E."
|
|
|
566 (remove-text-properties
|
|
|
567 b e (cons 'article-type (cons type gnus-hidden-properties)))
|
|
|
568 (when (memq 'intangible gnus-hidden-properties)
|
|
|
569 (put-text-property (max (1- b) (point-min))
|
|
|
570 b 'intangible nil)))
|
|
|
571
|
|
|
572 (defun gnus-article-hide-text-of-type (type)
|
|
|
573 "Hide text of TYPE in the current buffer."
|
|
|
574 (save-excursion
|
|
|
575 (let ((b (point-min))
|
|
|
576 (e (point-max)))
|
|
|
577 (while (setq b (text-property-any b e 'article-type type))
|
|
|
578 (add-text-properties b (incf b) gnus-hidden-properties)))))
|
|
|
579
|
|
|
580 (defun gnus-article-delete-text-of-type (type)
|
|
|
581 "Delete text of TYPE in the current buffer."
|
|
|
582 (save-excursion
|
|
153
|
583 (let ((b (point-min)))
|
|
|
584 (while (setq b (text-property-any b (point-max) 'article-type type))
|
|
|
585 (delete-region
|
|
163
|
586 b (or (text-property-not-all b (point-max) 'article-type type)
|
|
|
587 (point-max)))))))
|
|
98
|
588
|
|
|
589 (defun gnus-article-delete-invisible-text ()
|
|
|
590 "Delete all invisible text in the current buffer."
|
|
|
591 (save-excursion
|
|
153
|
592 (let ((b (point-min)))
|
|
|
593 (while (setq b (text-property-any b (point-max) 'invisible t))
|
|
|
594 (delete-region
|
|
163
|
595 b (or (text-property-not-all b (point-max) 'invisible t)
|
|
|
596 (point-max)))))))
|
|
98
|
597
|
|
|
598 (defun gnus-article-text-type-exists-p (type)
|
|
|
599 "Say whether any text of type TYPE exists in the buffer."
|
|
|
600 (text-property-any (point-min) (point-max) 'article-type type))
|
|
|
601
|
|
|
602 (defsubst gnus-article-header-rank ()
|
|
|
603 "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
|
|
|
604 (let ((list gnus-sorted-header-list)
|
|
|
605 (i 0))
|
|
|
606 (while list
|
|
|
607 (when (looking-at (car list))
|
|
|
608 (setq list nil))
|
|
|
609 (setq list (cdr list))
|
|
|
610 (incf i))
|
|
|
611 i))
|
|
|
612
|
|
|
613 (defun article-hide-headers (&optional arg delete)
|
|
|
614 "Toggle whether to hide unwanted headers and possibly sort them as well.
|
|
|
615 If given a negative prefix, always show; if given a positive prefix,
|
|
|
616 always hide."
|
|
|
617 (interactive (gnus-article-hidden-arg))
|
|
|
618 (if (gnus-article-check-hidden-text 'headers arg)
|
|
|
619 ;; Show boring headers as well.
|
|
|
620 (gnus-article-show-hidden-text 'boring-headers)
|
|
|
621 ;; This function might be inhibited.
|
|
|
622 (unless gnus-inhibit-hiding
|
|
|
623 (save-excursion
|
|
|
624 (save-restriction
|
|
|
625 (let ((buffer-read-only nil)
|
|
|
626 (props (nconc (list 'article-type 'headers)
|
|
|
627 gnus-hidden-properties))
|
|
|
628 (max (1+ (length gnus-sorted-header-list)))
|
|
|
629 (ignored (when (not gnus-visible-headers)
|
|
|
630 (cond ((stringp gnus-ignored-headers)
|
|
|
631 gnus-ignored-headers)
|
|
|
632 ((listp gnus-ignored-headers)
|
|
|
633 (mapconcat 'identity gnus-ignored-headers
|
|
|
634 "\\|")))))
|
|
|
635 (visible
|
|
|
636 (cond ((stringp gnus-visible-headers)
|
|
|
637 gnus-visible-headers)
|
|
|
638 ((and gnus-visible-headers
|
|
|
639 (listp gnus-visible-headers))
|
|
|
640 (mapconcat 'identity gnus-visible-headers "\\|"))))
|
|
|
641 (inhibit-point-motion-hooks t)
|
|
|
642 want-list beg)
|
|
|
643 ;; First we narrow to just the headers.
|
|
|
644 (widen)
|
|
|
645 (goto-char (point-min))
|
|
|
646 ;; Hide any "From " lines at the beginning of (mail) articles.
|
|
|
647 (while (looking-at "From ")
|
|
|
648 (forward-line 1))
|
|
|
649 (unless (bobp)
|
|
|
650 (if delete
|
|
|
651 (delete-region (point-min) (point))
|
|
|
652 (gnus-article-hide-text (point-min) (point) props)))
|
|
|
653 ;; Then treat the rest of the header lines.
|
|
|
654 (narrow-to-region
|
|
|
655 (point)
|
|
|
656 (if (search-forward "\n\n" nil t) ; if there's a body
|
|
|
657 (progn (forward-line -1) (point))
|
|
|
658 (point-max)))
|
|
|
659 ;; Then we use the two regular expressions
|
|
|
660 ;; `gnus-ignored-headers' and `gnus-visible-headers' to
|
|
|
661 ;; select which header lines is to remain visible in the
|
|
|
662 ;; article buffer.
|
|
|
663 (goto-char (point-min))
|
|
|
664 (while (re-search-forward "^[^ \t]*:" nil t)
|
|
|
665 (beginning-of-line)
|
|
|
666 ;; Mark the rank of the header.
|
|
108
|
667 (put-text-property
|
|
98
|
668 (point) (1+ (point)) 'message-rank
|
|
|
669 (if (or (and visible (looking-at visible))
|
|
|
670 (and ignored
|
|
|
671 (not (looking-at ignored))))
|
|
108
|
672 (gnus-article-header-rank)
|
|
98
|
673 (+ 2 max)))
|
|
|
674 (forward-line 1))
|
|
|
675 (message-sort-headers-1)
|
|
108
|
676 (when (setq beg (text-property-any
|
|
98
|
677 (point-min) (point-max) 'message-rank (+ 2 max)))
|
|
|
678 ;; We make the unwanted headers invisible.
|
|
|
679 (if delete
|
|
|
680 (delete-region beg (point-max))
|
|
|
681 ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
|
|
|
682 (gnus-article-hide-text-type beg (point-max) 'headers))
|
|
|
683 ;; Work around XEmacs lossage.
|
|
|
684 (put-text-property (point-min) beg 'invisible nil))))))))
|
|
|
685
|
|
|
686 (defun article-hide-boring-headers (&optional arg)
|
|
|
687 "Toggle hiding of headers that aren't very interesting.
|
|
|
688 If given a negative prefix, always show; if given a positive prefix,
|
|
|
689 always hide."
|
|
|
690 (interactive (gnus-article-hidden-arg))
|
|
|
691 (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
|
|
|
692 (not gnus-show-all-headers))
|
|
|
693 (save-excursion
|
|
|
694 (save-restriction
|
|
|
695 (let ((buffer-read-only nil)
|
|
|
696 (list gnus-boring-article-headers)
|
|
|
697 (inhibit-point-motion-hooks t)
|
|
|
698 elem)
|
|
|
699 (nnheader-narrow-to-headers)
|
|
|
700 (while list
|
|
|
701 (setq elem (pop list))
|
|
|
702 (goto-char (point-min))
|
|
|
703 (cond
|
|
|
704 ;; Hide empty headers.
|
|
|
705 ((eq elem 'empty)
|
|
|
706 (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t)
|
|
|
707 (forward-line -1)
|
|
|
708 (gnus-article-hide-text-type
|
|
|
709 (progn (beginning-of-line) (point))
|
|
108
|
710 (progn
|
|
98
|
711 (end-of-line)
|
|
|
712 (if (re-search-forward "^[^ \t]" nil t)
|
|
|
713 (match-beginning 0)
|
|
|
714 (point-max)))
|
|
|
715 'boring-headers)))
|
|
|
716 ;; Hide boring Newsgroups header.
|
|
|
717 ((eq elem 'newsgroups)
|
|
|
718 (when (equal (gnus-fetch-field "newsgroups")
|
|
|
719 (gnus-group-real-name
|
|
|
720 (if (boundp 'gnus-newsgroup-name)
|
|
|
721 gnus-newsgroup-name
|
|
|
722 "")))
|
|
|
723 (gnus-article-hide-header "newsgroups")))
|
|
|
724 ((eq elem 'followup-to)
|
|
|
725 (when (equal (message-fetch-field "followup-to")
|
|
|
726 (message-fetch-field "newsgroups"))
|
|
|
727 (gnus-article-hide-header "followup-to")))
|
|
|
728 ((eq elem 'reply-to)
|
|
|
729 (let ((from (message-fetch-field "from"))
|
|
|
730 (reply-to (message-fetch-field "reply-to")))
|
|
|
731 (when (and
|
|
|
732 from reply-to
|
|
|
733 (ignore-errors
|
|
108
|
734 (equal
|
|
98
|
735 (nth 1 (mail-extract-address-components from))
|
|
|
736 (nth 1 (mail-extract-address-components reply-to)))))
|
|
|
737 (gnus-article-hide-header "reply-to"))))
|
|
|
738 ((eq elem 'date)
|
|
|
739 (let ((date (message-fetch-field "date")))
|
|
|
740 (when (and date
|
|
|
741 (< (gnus-days-between (current-time-string) date)
|
|
|
742 4))
|
|
|
743 (gnus-article-hide-header "date")))))))))))
|
|
|
744
|
|
|
745 (defun gnus-article-hide-header (header)
|
|
|
746 (save-excursion
|
|
|
747 (goto-char (point-min))
|
|
|
748 (when (re-search-forward (concat "^" header ":") nil t)
|
|
|
749 (gnus-article-hide-text-type
|
|
|
750 (progn (beginning-of-line) (point))
|
|
108
|
751 (progn
|
|
98
|
752 (end-of-line)
|
|
|
753 (if (re-search-forward "^[^ \t]" nil t)
|
|
|
754 (match-beginning 0)
|
|
|
755 (point-max)))
|
|
|
756 'boring-headers))))
|
|
|
757
|
|
|
758 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
|
|
|
759 (defun article-treat-overstrike ()
|
|
|
760 "Translate overstrikes into bold text."
|
|
|
761 (interactive)
|
|
|
762 (save-excursion
|
|
120
|
763 (goto-char (point-min))
|
|
122
|
764 (when (search-forward "\n\n" nil t)
|
|
|
765 (let ((buffer-read-only nil))
|
|
|
766 (while (search-forward "\b" nil t)
|
|
|
767 (let ((next (following-char))
|
|
|
768 (previous (char-after (- (point) 2))))
|
|
|
769 ;; We do the boldification/underlining by hiding the
|
|
|
770 ;; overstrikes and putting the proper text property
|
|
|
771 ;; on the letters.
|
|
|
772 (cond
|
|
|
773 ((eq next previous)
|
|
|
774 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
|
|
|
775 (put-text-property (point) (1+ (point)) 'face 'bold))
|
|
|
776 ((eq next ?_)
|
|
|
777 (gnus-article-hide-text-type
|
|
|
778 (1- (point)) (1+ (point)) 'overstrike)
|
|
|
779 (put-text-property
|
|
|
780 (- (point) 2) (1- (point)) 'face 'underline))
|
|
|
781 ((eq previous ?_)
|
|
|
782 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
|
|
|
783 (put-text-property
|
|
|
784 (point) (1+ (point)) 'face 'underline)))))))))
|
|
98
|
785
|
|
|
786 (defun article-fill ()
|
|
|
787 "Format too long lines."
|
|
|
788 (interactive)
|
|
|
789 (save-excursion
|
|
|
790 (let ((buffer-read-only nil))
|
|
|
791 (widen)
|
|
|
792 (goto-char (point-min))
|
|
|
793 (search-forward "\n\n" nil t)
|
|
|
794 (end-of-line 1)
|
|
|
795 (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
|
|
|
796 (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
|
|
|
797 (adaptive-fill-mode t))
|
|
|
798 (while (not (eobp))
|
|
|
799 (and (>= (current-column) (min fill-column (window-width)))
|
|
|
800 (/= (preceding-char) ?:)
|
|
|
801 (fill-paragraph nil))
|
|
|
802 (end-of-line 2))))))
|
|
|
803
|
|
|
804 (defun article-remove-cr ()
|
|
|
805 "Remove carriage returns from an article."
|
|
|
806 (interactive)
|
|
|
807 (save-excursion
|
|
|
808 (let ((buffer-read-only nil))
|
|
|
809 (goto-char (point-min))
|
|
|
810 (while (search-forward "\r" nil t)
|
|
|
811 (replace-match "" t t)))))
|
|
|
812
|
|
|
813 (defun article-remove-trailing-blank-lines ()
|
|
|
814 "Remove all trailing blank lines from the article."
|
|
|
815 (interactive)
|
|
|
816 (save-excursion
|
|
|
817 (let ((buffer-read-only nil))
|
|
|
818 (goto-char (point-max))
|
|
|
819 (delete-region
|
|
|
820 (point)
|
|
|
821 (progn
|
|
|
822 (while (and (not (bobp))
|
|
|
823 (looking-at "^[ \t]*$"))
|
|
|
824 (forward-line -1))
|
|
|
825 (forward-line 1)
|
|
|
826 (point))))))
|
|
|
827
|
|
|
828 (defun article-display-x-face (&optional force)
|
|
|
829 "Look for an X-Face header and display it if present."
|
|
|
830 (interactive (list 'force))
|
|
|
831 (save-excursion
|
|
|
832 ;; Delete the old process, if any.
|
|
|
833 (when (process-status "article-x-face")
|
|
|
834 (delete-process "article-x-face"))
|
|
|
835 (let ((inhibit-point-motion-hooks t)
|
|
|
836 (case-fold-search nil)
|
|
|
837 from)
|
|
|
838 (save-restriction
|
|
|
839 (nnheader-narrow-to-headers)
|
|
|
840 (setq from (message-fetch-field "from"))
|
|
|
841 (goto-char (point-min))
|
|
136
|
842 (while (and gnus-article-x-face-command
|
|
|
843 (or force
|
|
|
844 ;; Check whether this face is censored.
|
|
|
845 (not gnus-article-x-face-too-ugly)
|
|
|
846 (and gnus-article-x-face-too-ugly from
|
|
|
847 (not (string-match gnus-article-x-face-too-ugly
|
|
|
848 from))))
|
|
|
849 ;; Has to be present.
|
|
|
850 (re-search-forward "^X-Face: " nil t))
|
|
98
|
851 ;; We now have the area of the buffer where the X-Face is stored.
|
|
142
|
852 (save-excursion
|
|
|
853 (let ((beg (point))
|
|
|
854 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
|
|
136
|
855 ;; We display the face.
|
|
|
856 (if (symbolp gnus-article-x-face-command)
|
|
|
857 ;; The command is a lisp function, so we call it.
|
|
|
858 (if (gnus-functionp gnus-article-x-face-command)
|
|
|
859 (funcall gnus-article-x-face-command beg end)
|
|
|
860 (error "%s is not a function" gnus-article-x-face-command))
|
|
|
861 ;; The command is a string, so we interpret the command
|
|
|
862 ;; as a, well, command, and fork it off.
|
|
|
863 (let ((process-connection-type nil))
|
|
|
864 (process-kill-without-query
|
|
|
865 (start-process
|
|
|
866 "article-x-face" nil shell-file-name shell-command-switch
|
|
|
867 gnus-article-x-face-command))
|
|
|
868 (process-send-region "article-x-face" beg end)
|
|
|
869 (process-send-eof "article-x-face"))))))))))
|
|
98
|
870
|
|
155
|
871 (defun gnus-hack-decode-rfc1522 ()
|
|
|
872 "Emergency hack function for avoiding problems when decoding."
|
|
|
873 (let ((buffer-read-only nil))
|
|
|
874 (goto-char (point-min))
|
|
|
875 ;; Remove encoded TABs.
|
|
|
876 (while (search-forward "=09" nil t)
|
|
|
877 (replace-match " " t t))
|
|
|
878 ;; Remove encoded newlines.
|
|
|
879 (goto-char (point-min))
|
|
|
880 (while (search-forward "=10" nil t)
|
|
|
881 (replace-match " " t t))))
|
|
|
882
|
|
98
|
883 (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522)
|
|
|
884 (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522)
|
|
|
885 (defun article-decode-rfc1522 ()
|
|
|
886 "Hack to remove QP encoding from headers."
|
|
|
887 (let ((case-fold-search t)
|
|
|
888 (inhibit-point-motion-hooks t)
|
|
|
889 (buffer-read-only nil)
|
|
|
890 string)
|
|
|
891 (save-restriction
|
|
|
892 (narrow-to-region
|
|
|
893 (goto-char (point-min))
|
|
|
894 (or (search-forward "\n\n" nil t) (point-max)))
|
|
|
895 (goto-char (point-min))
|
|
108
|
896 (while (re-search-forward
|
|
98
|
897 "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
|
|
|
898 (setq string (match-string 1))
|
|
|
899 (save-restriction
|
|
|
900 (narrow-to-region (match-beginning 0) (match-end 0))
|
|
|
901 (delete-region (point-min) (point-max))
|
|
|
902 (insert string)
|
|
108
|
903 (article-mime-decode-quoted-printable
|
|
98
|
904 (goto-char (point-min)) (point-max))
|
|
|
905 (subst-char-in-region (point-min) (point-max) ?_ ? )
|
|
|
906 (goto-char (point-max)))
|
|
|
907 (goto-char (point-min))))))
|
|
|
908
|
|
|
909 (defun article-de-quoted-unreadable (&optional force)
|
|
|
910 "Do a naive translation of a quoted-printable-encoded article.
|
|
|
911 This is in no way, shape or form meant as a replacement for real MIME
|
|
|
912 processing, but is simply a stop-gap measure until MIME support is
|
|
|
913 written.
|
|
|
914 If FORCE, decode the article whether it is marked as quoted-printable
|
|
|
915 or not."
|
|
|
916 (interactive (list 'force))
|
|
|
917 (save-excursion
|
|
|
918 (let ((case-fold-search t)
|
|
|
919 (buffer-read-only nil)
|
|
|
920 (type (gnus-fetch-field "content-transfer-encoding")))
|
|
|
921 (gnus-article-decode-rfc1522)
|
|
|
922 (when (or force
|
|
|
923 (and type (string-match "quoted-printable" (downcase type))))
|
|
|
924 (goto-char (point-min))
|
|
|
925 (search-forward "\n\n" nil 'move)
|
|
|
926 (article-mime-decode-quoted-printable (point) (point-max))))))
|
|
|
927
|
|
|
928 (defun article-mime-decode-quoted-printable-buffer ()
|
|
|
929 "Decode Quoted-Printable in the current buffer."
|
|
|
930 (article-mime-decode-quoted-printable (point-min) (point-max)))
|
|
108
|
931
|
|
98
|
932 (defun article-mime-decode-quoted-printable (from to)
|
|
|
933 "Decode Quoted-Printable in the region between FROM and TO."
|
|
|
934 (interactive "r")
|
|
|
935 (goto-char from)
|
|
|
936 (while (search-forward "=" to t)
|
|
|
937 (cond ((eq (following-char) ?\n)
|
|
|
938 (delete-char -1)
|
|
|
939 (delete-char 1))
|
|
|
940 ((looking-at "[0-9A-F][0-9A-F]")
|
|
|
941 (subst-char-in-region
|
|
|
942 (1- (point)) (point) ?=
|
|
|
943 (hexl-hex-string-to-integer
|
|
|
944 (buffer-substring (point) (+ 2 (point)))))
|
|
|
945 (delete-char 2))
|
|
|
946 ((looking-at "=")
|
|
|
947 (delete-char 1))
|
|
|
948 ((gnus-message 3 "Malformed MIME quoted-printable message")))))
|
|
|
949
|
|
|
950 (defun article-hide-pgp (&optional arg)
|
|
|
951 "Toggle hiding of any PGP headers and signatures in the current article.
|
|
|
952 If given a negative prefix, always show; if given a positive prefix,
|
|
|
953 always hide."
|
|
|
954 (interactive (gnus-article-hidden-arg))
|
|
|
955 (unless (gnus-article-check-hidden-text 'pgp arg)
|
|
|
956 (save-excursion
|
|
|
957 (let ((inhibit-point-motion-hooks t)
|
|
|
958 buffer-read-only beg end)
|
|
|
959 (widen)
|
|
|
960 (goto-char (point-min))
|
|
|
961 ;; Hide the "header".
|
|
|
962 (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
|
|
100
|
963 (gnus-article-hide-text-type (1+ (match-beginning 0))
|
|
163
|
964 (match-end 0) 'pgp)
|
|
|
965 (setq beg (point))
|
|
|
966 ;; Hide the actual signature.
|
|
|
967 (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
|
|
|
968 (setq end (1+ (match-beginning 0)))
|
|
|
969 (gnus-article-hide-text-type
|
|
|
970 end
|
|
|
971 (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
|
|
|
972 (match-end 0)
|
|
|
973 ;; Perhaps we shouldn't hide to the end of the buffer
|
|
|
974 ;; if there is no end to the signature?
|
|
|
975 (point-max))
|
|
|
976 'pgp))
|
|
|
977 ;; Hide "- " PGP quotation markers.
|
|
|
978 (when (and beg end)
|
|
|
979 (narrow-to-region beg end)
|
|
|
980 (goto-char (point-min))
|
|
|
981 (while (re-search-forward "^- " nil t)
|
|
|
982 (gnus-article-hide-text-type
|
|
|
983 (match-beginning 0) (match-end 0) 'pgp))
|
|
|
984 (widen)))
|
|
|
985 (run-hooks 'gnus-article-hide-pgp-hook)))))
|
|
98
|
986
|
|
|
987 (defun article-hide-pem (&optional arg)
|
|
|
988 "Toggle hiding of any PEM headers and signatures in the current article.
|
|
|
989 If given a negative prefix, always show; if given a positive prefix,
|
|
|
990 always hide."
|
|
|
991 (interactive (gnus-article-hidden-arg))
|
|
|
992 (unless (gnus-article-check-hidden-text 'pem arg)
|
|
|
993 (save-excursion
|
|
|
994 (let (buffer-read-only end)
|
|
|
995 (widen)
|
|
|
996 (goto-char (point-min))
|
|
|
997 ;; hide the horrendously ugly "header".
|
|
|
998 (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
|
|
|
999 nil
|
|
|
1000 t)
|
|
|
1001 (setq end (1+ (match-beginning 0)))
|
|
|
1002 (gnus-article-hide-text-type
|
|
|
1003 end
|
|
|
1004 (if (search-forward "\n\n" nil t)
|
|
|
1005 (match-end 0)
|
|
|
1006 (point-max))
|
|
|
1007 'pem))
|
|
|
1008 ;; hide the trailer as well
|
|
|
1009 (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
|
|
|
1010 nil
|
|
|
1011 t)
|
|
|
1012 (gnus-article-hide-text-type
|
|
|
1013 (match-beginning 0) (match-end 0) 'pem))))))
|
|
|
1014
|
|
|
1015 (defun article-hide-signature (&optional arg)
|
|
|
1016 "Hide the signature in the current article.
|
|
|
1017 If given a negative prefix, always show; if given a positive prefix,
|
|
|
1018 always hide."
|
|
|
1019 (interactive (gnus-article-hidden-arg))
|
|
|
1020 (unless (gnus-article-check-hidden-text 'signature arg)
|
|
|
1021 (save-excursion
|
|
|
1022 (save-restriction
|
|
|
1023 (let ((buffer-read-only nil))
|
|
|
1024 (when (gnus-article-narrow-to-signature)
|
|
108
|
1025 (gnus-article-hide-text-type
|
|
98
|
1026 (point-min) (point-max) 'signature)))))))
|
|
|
1027
|
|
|
1028 (defun article-strip-leading-blank-lines ()
|
|
|
1029 "Remove all blank lines from the beginning of the article."
|
|
|
1030 (interactive)
|
|
|
1031 (save-excursion
|
|
|
1032 (let ((inhibit-point-motion-hooks t)
|
|
|
1033 buffer-read-only)
|
|
|
1034 (goto-char (point-min))
|
|
|
1035 (when (search-forward "\n\n" nil t)
|
|
|
1036 (while (and (not (eobp))
|
|
|
1037 (looking-at "[ \t]*$"))
|
|
|
1038 (gnus-delete-line))))))
|
|
|
1039
|
|
|
1040 (defun article-strip-multiple-blank-lines ()
|
|
|
1041 "Replace consecutive blank lines with one empty line."
|
|
|
1042 (interactive)
|
|
|
1043 (save-excursion
|
|
100
|
1044 (let ((inhibit-point-motion-hooks t)
|
|
|
1045 buffer-read-only)
|
|
98
|
1046 ;; First make all blank lines empty.
|
|
|
1047 (goto-char (point-min))
|
|
100
|
1048 (search-forward "\n\n" nil t)
|
|
98
|
1049 (while (re-search-forward "^[ \t]+$" nil t)
|
|
|
1050 (replace-match "" nil t))
|
|
|
1051 ;; Then replace multiple empty lines with a single empty line.
|
|
|
1052 (goto-char (point-min))
|
|
100
|
1053 (search-forward "\n\n" nil t)
|
|
98
|
1054 (while (re-search-forward "\n\n\n+" nil t)
|
|
|
1055 (replace-match "\n\n" t t)))))
|
|
|
1056
|
|
114
|
1057 (defun article-strip-leading-space ()
|
|
|
1058 "Remove all white space from the beginning of the lines in the article."
|
|
|
1059 (interactive)
|
|
|
1060 (save-excursion
|
|
|
1061 (let ((inhibit-point-motion-hooks t)
|
|
|
1062 buffer-read-only)
|
|
|
1063 (goto-char (point-min))
|
|
|
1064 (search-forward "\n\n" nil t)
|
|
|
1065 (while (re-search-forward "^[ \t]+" nil t)
|
|
|
1066 (replace-match "" t t)))))
|
|
|
1067
|
|
98
|
1068 (defun article-strip-blank-lines ()
|
|
|
1069 "Strip leading, trailing and multiple blank lines."
|
|
|
1070 (interactive)
|
|
|
1071 (article-strip-leading-blank-lines)
|
|
|
1072 (article-remove-trailing-blank-lines)
|
|
|
1073 (article-strip-multiple-blank-lines))
|
|
|
1074
|
|
|
1075 (defvar mime::preview/content-list)
|
|
|
1076 (defvar mime::preview-content-info/point-min)
|
|
|
1077 (defun gnus-article-narrow-to-signature ()
|
|
|
1078 "Narrow to the signature; return t if a signature is found, else nil."
|
|
|
1079 (widen)
|
|
|
1080 (when (and (boundp 'mime::preview/content-list)
|
|
|
1081 mime::preview/content-list)
|
|
|
1082 ;; We have a MIMEish article, so we use the MIME data to narrow.
|
|
|
1083 (let ((pcinfo (car (last mime::preview/content-list))))
|
|
|
1084 (ignore-errors
|
|
|
1085 (narrow-to-region
|
|
|
1086 (funcall (intern "mime::preview-content-info/point-min") pcinfo)
|
|
|
1087 (point-max)))))
|
|
108
|
1088
|
|
98
|
1089 (when (gnus-article-search-signature)
|
|
|
1090 (forward-line 1)
|
|
|
1091 ;; Check whether we have some limits to what we consider
|
|
|
1092 ;; to be a signature.
|
|
|
1093 (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
|
|
|
1094 (list gnus-signature-limit)))
|
|
|
1095 limit limited)
|
|
|
1096 (while (setq limit (pop limits))
|
|
|
1097 (if (or (and (integerp limit)
|
|
|
1098 (< (- (point-max) (point)) limit))
|
|
|
1099 (and (floatp limit)
|
|
|
1100 (< (count-lines (point) (point-max)) limit))
|
|
|
1101 (and (gnus-functionp limit)
|
|
|
1102 (funcall limit))
|
|
|
1103 (and (stringp limit)
|
|
|
1104 (not (re-search-forward limit nil t))))
|
|
|
1105 () ; This limit did not succeed.
|
|
|
1106 (setq limited t
|
|
|
1107 limits nil)))
|
|
|
1108 (unless limited
|
|
|
1109 (narrow-to-region (point) (point-max))
|
|
|
1110 t))))
|
|
|
1111
|
|
|
1112 (defun gnus-article-search-signature ()
|
|
|
1113 "Search the current buffer for the signature separator.
|
|
|
1114 Put point at the beginning of the signature separator."
|
|
|
1115 (let ((cur (point)))
|
|
|
1116 (goto-char (point-max))
|
|
|
1117 (if (if (stringp gnus-signature-separator)
|
|
|
1118 (re-search-backward gnus-signature-separator nil t)
|
|
|
1119 (let ((seps gnus-signature-separator))
|
|
|
1120 (while (and seps
|
|
|
1121 (not (re-search-backward (car seps) nil t)))
|
|
|
1122 (pop seps))
|
|
|
1123 seps))
|
|
|
1124 t
|
|
|
1125 (goto-char cur)
|
|
|
1126 nil)))
|
|
|
1127
|
|
104
|
1128 (eval-and-compile
|
|
163
|
1129 (autoload 'w3-parse-buffer "w3-parse")
|
|
|
1130 (autoload 'w3-do-setup "w3" "" t))
|
|
104
|
1131
|
|
|
1132 (defun gnus-article-treat-html ()
|
|
|
1133 "Render HTML."
|
|
|
1134 (interactive)
|
|
|
1135 (let ((cbuf (current-buffer)))
|
|
|
1136 (set-buffer gnus-article-buffer)
|
|
|
1137 (let (buf buffer-read-only b e)
|
|
163
|
1138 (w3-do-setup)
|
|
104
|
1139 (goto-char (point-min))
|
|
|
1140 (narrow-to-region
|
|
|
1141 (if (search-forward "\n\n" nil t)
|
|
|
1142 (setq b (point))
|
|
|
1143 (point-max))
|
|
|
1144 (setq e (point-max)))
|
|
|
1145 (nnheader-temp-write nil
|
|
|
1146 (insert-buffer-substring gnus-article-buffer b e)
|
|
140
|
1147 (require 'url)
|
|
104
|
1148 (save-window-excursion
|
|
140
|
1149 (w3-parse-buffer (current-buffer))
|
|
|
1150 (setq buf (buffer-string))))
|
|
104
|
1151 (when buf
|
|
|
1152 (delete-region (point-min) (point-max))
|
|
151
|
1153 (insert buf))
|
|
104
|
1154 (widen)
|
|
|
1155 (goto-char (point-min))
|
|
|
1156 (set-window-start (get-buffer-window (current-buffer)) (point-min))
|
|
|
1157 (set-buffer cbuf))))
|
|
|
1158
|
|
98
|
1159 (defun gnus-article-hidden-arg ()
|
|
|
1160 "Return the current prefix arg as a number, or 0 if no prefix."
|
|
|
1161 (list (if current-prefix-arg
|
|
|
1162 (prefix-numeric-value current-prefix-arg)
|
|
|
1163 0)))
|
|
|
1164
|
|
|
1165 (defun gnus-article-check-hidden-text (type arg)
|
|
|
1166 "Return nil if hiding is necessary.
|
|
|
1167 Arg can be nil or a number. Nil and positive means hide, negative
|
|
|
1168 means show, 0 means toggle."
|
|
|
1169 (save-excursion
|
|
|
1170 (save-restriction
|
|
|
1171 (widen)
|
|
|
1172 (let ((hide (gnus-article-hidden-text-p type)))
|
|
|
1173 (cond
|
|
|
1174 ((or (null arg)
|
|
|
1175 (> arg 0))
|
|
|
1176 nil)
|
|
|
1177 ((< arg 0)
|
|
|
1178 (gnus-article-show-hidden-text type))
|
|
|
1179 (t
|
|
|
1180 (if (eq hide 'hidden)
|
|
|
1181 (gnus-article-show-hidden-text type)
|
|
|
1182 nil)))))))
|
|
|
1183
|
|
|
1184 (defun gnus-article-hidden-text-p (type)
|
|
|
1185 "Say whether the current buffer contains hidden text of type TYPE."
|
|
120
|
1186 (let ((start (point-min))
|
|
|
1187 (pos (text-property-any (point-min) (point-max) 'article-type type)))
|
|
|
1188 (while (and pos
|
|
|
1189 (not (get-text-property pos 'invisible)))
|
|
|
1190 (setq pos
|
|
|
1191 (text-property-any (1+ pos) (point-max) 'article-type type)))
|
|
|
1192 (if pos
|
|
|
1193 'hidden
|
|
|
1194 'shown)))
|
|
98
|
1195
|
|
|
1196 (defun gnus-article-show-hidden-text (type &optional hide)
|
|
|
1197 "Show all hidden text of type TYPE.
|
|
|
1198 If HIDE, hide the text instead."
|
|
|
1199 (save-excursion
|
|
|
1200 (let ((buffer-read-only nil)
|
|
|
1201 (inhibit-point-motion-hooks t)
|
|
|
1202 (end (point-min))
|
|
|
1203 beg)
|
|
|
1204 (while (setq beg (text-property-any end (point-max) 'article-type type))
|
|
|
1205 (goto-char beg)
|
|
|
1206 (setq end (or
|
|
|
1207 (text-property-not-all beg (point-max) 'article-type type)
|
|
|
1208 (point-max)))
|
|
|
1209 (if hide
|
|
|
1210 (gnus-article-hide-text beg end gnus-hidden-properties)
|
|
|
1211 (gnus-article-unhide-text beg end))
|
|
|
1212 (goto-char end))
|
|
|
1213 t)))
|
|
|
1214
|
|
|
1215 (defconst article-time-units
|
|
|
1216 `((year . ,(* 365.25 24 60 60))
|
|
|
1217 (week . ,(* 7 24 60 60))
|
|
|
1218 (day . ,(* 24 60 60))
|
|
|
1219 (hour . ,(* 60 60))
|
|
|
1220 (minute . 60)
|
|
|
1221 (second . 1))
|
|
|
1222 "Mapping from time units to seconds.")
|
|
|
1223
|
|
|
1224 (defun article-date-ut (&optional type highlight header)
|
|
|
1225 "Convert DATE date to universal time in the current article.
|
|
|
1226 If TYPE is `local', convert to local time; if it is `lapsed', output
|
|
|
1227 how much time has lapsed since DATE."
|
|
|
1228 (interactive (list 'ut t))
|
|
108
|
1229 (let* ((header (or header
|
|
98
|
1230 (mail-header-date gnus-current-headers)
|
|
|
1231 (message-fetch-field "date")
|
|
|
1232 ""))
|
|
|
1233 (date (if (vectorp header) (mail-header-date header)
|
|
|
1234 header))
|
|
|
1235 (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
|
|
|
1236 (inhibit-point-motion-hooks t)
|
|
|
1237 bface eface)
|
|
|
1238 (when (and date (not (string= date "")))
|
|
|
1239 (save-excursion
|
|
|
1240 (save-restriction
|
|
|
1241 (nnheader-narrow-to-headers)
|
|
|
1242 (let ((buffer-read-only nil))
|
|
|
1243 ;; Delete any old Date headers.
|
|
|
1244 (if (re-search-forward date-regexp nil t)
|
|
|
1245 (progn
|
|
|
1246 (setq bface (get-text-property (gnus-point-at-bol) 'face)
|
|
|
1247 eface (get-text-property (1- (gnus-point-at-eol))
|
|
|
1248 'face))
|
|
|
1249 (message-remove-header date-regexp t)
|
|
|
1250 (beginning-of-line))
|
|
|
1251 (goto-char (point-max)))
|
|
|
1252 (insert (article-make-date-line date type))
|
|
|
1253 ;; Do highlighting.
|
|
|
1254 (forward-line -1)
|
|
|
1255 (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
|
|
|
1256 (put-text-property (match-beginning 1) (match-end 1)
|
|
|
1257 'face bface)
|
|
|
1258 (put-text-property (match-beginning 2) (match-end 2)
|
|
|
1259 'face eface))))))))
|
|
|
1260
|
|
|
1261 (defun article-make-date-line (date type)
|
|
|
1262 "Return a DATE line of TYPE."
|
|
|
1263 (cond
|
|
|
1264 ;; Convert to the local timezone. We have to slap a
|
|
|
1265 ;; `condition-case' round the calls to the timezone
|
|
|
1266 ;; functions since they aren't particularly resistant to
|
|
|
1267 ;; buggy dates.
|
|
|
1268 ((eq type 'local)
|
|
|
1269 (concat "Date: " (condition-case ()
|
|
|
1270 (timezone-make-date-arpa-standard date)
|
|
|
1271 (error date))
|
|
|
1272 "\n"))
|
|
|
1273 ;; Convert to Universal Time.
|
|
|
1274 ((eq type 'ut)
|
|
|
1275 (concat "Date: "
|
|
|
1276 (condition-case ()
|
|
|
1277 (timezone-make-date-arpa-standard date nil "UT")
|
|
|
1278 (error date))
|
|
|
1279 "\n"))
|
|
|
1280 ;; Get the original date from the article.
|
|
|
1281 ((eq type 'original)
|
|
|
1282 (concat "Date: " date "\n"))
|
|
|
1283 ;; Let the user define the format.
|
|
|
1284 ((eq type 'user)
|
|
104
|
1285 (concat
|
|
|
1286 "Date: "
|
|
98
|
1287 (format-time-string gnus-article-time-format
|
|
|
1288 (ignore-errors
|
|
|
1289 (gnus-encode-date
|
|
|
1290 (timezone-make-date-arpa-standard
|
|
|
1291 date nil "UT"))))
|
|
|
1292 "\n"))
|
|
|
1293 ;; Do an X-Sent lapsed format.
|
|
|
1294 ((eq type 'lapsed)
|
|
|
1295 ;; If the date is seriously mangled, the timezone functions are
|
|
|
1296 ;; liable to bug out, so we ignore all errors.
|
|
|
1297 (let* ((now (current-time))
|
|
|
1298 (real-time
|
|
|
1299 (ignore-errors
|
|
|
1300 (gnus-time-minus
|
|
|
1301 (gnus-encode-date
|
|
|
1302 (timezone-make-date-arpa-standard
|
|
|
1303 (current-time-string now)
|
|
|
1304 (current-time-zone now) "UT"))
|
|
|
1305 (gnus-encode-date
|
|
|
1306 (timezone-make-date-arpa-standard
|
|
|
1307 date nil "UT")))))
|
|
|
1308 (real-sec (and real-time
|
|
|
1309 (+ (* (float (car real-time)) 65536)
|
|
|
1310 (cadr real-time))))
|
|
|
1311 (sec (and real-time (abs real-sec)))
|
|
|
1312 num prev)
|
|
|
1313 (cond
|
|
|
1314 ((null real-time)
|
|
|
1315 "X-Sent: Unknown\n")
|
|
|
1316 ((zerop sec)
|
|
|
1317 "X-Sent: Now\n")
|
|
|
1318 (t
|
|
|
1319 (concat
|
|
|
1320 "X-Sent: "
|
|
|
1321 ;; This is a bit convoluted, but basically we go
|
|
|
1322 ;; through the time units for years, weeks, etc,
|
|
|
1323 ;; and divide things to see whether that results
|
|
|
1324 ;; in positive answers.
|
|
|
1325 (mapconcat
|
|
|
1326 (lambda (unit)
|
|
|
1327 (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
|
|
|
1328 ;; The (remaining) seconds are too few to
|
|
|
1329 ;; be divided into this time unit.
|
|
|
1330 ""
|
|
|
1331 ;; It's big enough, so we output it.
|
|
|
1332 (setq sec (- sec (* num (cdr unit))))
|
|
|
1333 (prog1
|
|
|
1334 (concat (if prev ", " "") (int-to-string
|
|
|
1335 (floor num))
|
|
108
|
1336 " " (symbol-name (car unit))
|
|
98
|
1337 (if (> num 1) "s" ""))
|
|
|
1338 (setq prev t))))
|
|
|
1339 article-time-units "")
|
|
|
1340 ;; If dates are odd, then it might appear like the
|
|
|
1341 ;; article was sent in the future.
|
|
|
1342 (if (> real-sec 0)
|
|
|
1343 " ago\n"
|
|
|
1344 " in the future\n"))))))
|
|
|
1345 (t
|
|
|
1346 (error "Unknown conversion type: %s" type))))
|
|
|
1347
|
|
|
1348 (defun article-date-local (&optional highlight)
|
|
|
1349 "Convert the current article date to the local timezone."
|
|
|
1350 (interactive (list t))
|
|
|
1351 (article-date-ut 'local highlight))
|
|
|
1352
|
|
|
1353 (defun article-date-original (&optional highlight)
|
|
|
1354 "Convert the current article date to what it was originally.
|
|
|
1355 This is only useful if you have used some other date conversion
|
|
|
1356 function and want to see what the date was before converting."
|
|
|
1357 (interactive (list t))
|
|
|
1358 (article-date-ut 'original highlight))
|
|
|
1359
|
|
|
1360 (defun article-date-lapsed (&optional highlight)
|
|
|
1361 "Convert the current article date to time lapsed since it was sent."
|
|
|
1362 (interactive (list t))
|
|
|
1363 (article-date-ut 'lapsed highlight))
|
|
|
1364
|
|
|
1365 (defun article-date-user (&optional highlight)
|
|
104
|
1366 "Convert the current article date to the user-defined format.
|
|
|
1367 This format is defined by the `gnus-article-time-format' variable."
|
|
98
|
1368 (interactive (list t))
|
|
|
1369 (article-date-ut 'user highlight))
|
|
|
1370
|
|
|
1371 (defun article-show-all ()
|
|
|
1372 "Show all hidden text in the article buffer."
|
|
|
1373 (interactive)
|
|
|
1374 (save-excursion
|
|
|
1375 (let ((buffer-read-only nil))
|
|
|
1376 (gnus-article-unhide-text (point-min) (point-max)))))
|
|
|
1377
|
|
|
1378 (defun article-emphasize (&optional arg)
|
|
|
1379 "Emphasize text according to `gnus-emphasis-alist'."
|
|
|
1380 (interactive (gnus-article-hidden-arg))
|
|
|
1381 (unless (gnus-article-check-hidden-text 'emphasis arg)
|
|
|
1382 (save-excursion
|
|
|
1383 (let ((alist gnus-emphasis-alist)
|
|
|
1384 (buffer-read-only nil)
|
|
|
1385 (props (append '(article-type emphasis)
|
|
|
1386 gnus-hidden-properties))
|
|
|
1387 regexp elem beg invisible visible face)
|
|
|
1388 (goto-char (point-min))
|
|
|
1389 (search-forward "\n\n" nil t)
|
|
|
1390 (setq beg (point))
|
|
|
1391 (while (setq elem (pop alist))
|
|
|
1392 (goto-char beg)
|
|
|
1393 (setq regexp (car elem)
|
|
|
1394 invisible (nth 1 elem)
|
|
|
1395 visible (nth 2 elem)
|
|
|
1396 face (nth 3 elem))
|
|
|
1397 (while (re-search-forward regexp nil t)
|
|
|
1398 (when (and (match-beginning visible) (match-beginning invisible))
|
|
|
1399 (gnus-article-hide-text
|
|
|
1400 (match-beginning invisible) (match-end invisible) props)
|
|
|
1401 (gnus-article-unhide-text-type
|
|
|
1402 (match-beginning visible) (match-end visible) 'emphasis)
|
|
|
1403 (gnus-put-text-property-excluding-newlines
|
|
|
1404 (match-beginning visible) (match-end visible) 'face face)
|
|
|
1405 (goto-char (match-end invisible)))))))))
|
|
|
1406
|
|
|
1407 (defvar gnus-summary-article-menu)
|
|
|
1408 (defvar gnus-summary-post-menu)
|
|
|
1409
|
|
|
1410 ;;; Saving functions.
|
|
|
1411
|
|
|
1412 (defun gnus-article-save (save-buffer file &optional num)
|
|
|
1413 "Save the currently selected article."
|
|
|
1414 (unless gnus-save-all-headers
|
|
|
1415 ;; Remove headers according to `gnus-saved-headers'.
|
|
|
1416 (let ((gnus-visible-headers
|
|
|
1417 (or gnus-saved-headers gnus-visible-headers))
|
|
|
1418 (gnus-article-buffer save-buffer))
|
|
|
1419 (gnus-article-hide-headers 1 t)))
|
|
|
1420 (save-window-excursion
|
|
|
1421 (if (not gnus-default-article-saver)
|
|
|
1422 (error "No default saver is defined.")
|
|
|
1423 ;; !!! Magic! The saving functions all save
|
|
|
1424 ;; `gnus-original-article-buffer' (or so they think), but we
|
|
|
1425 ;; bind that variable to our save-buffer.
|
|
|
1426 (set-buffer gnus-article-buffer)
|
|
|
1427 (let* ((gnus-save-article-buffer save-buffer)
|
|
|
1428 (filename
|
|
|
1429 (cond
|
|
|
1430 ((not gnus-prompt-before-saving) 'default)
|
|
|
1431 ((eq gnus-prompt-before-saving 'always) nil)
|
|
|
1432 (t file)))
|
|
|
1433 (gnus-number-of-articles-to-be-saved
|
|
|
1434 (when (eq gnus-prompt-before-saving t)
|
|
|
1435 num))) ; Magic
|
|
|
1436 (set-buffer gnus-summary-buffer)
|
|
108
|
1437 (funcall gnus-default-article-saver filename)))))
|
|
98
|
1438
|
|
116
|
1439 (defun gnus-read-save-file-name (prompt &optional filename
|
|
|
1440 function group headers variable)
|
|
118
|
1441 (let ((default-name
|
|
|
1442 (funcall function group headers (symbol-value variable)))
|
|
116
|
1443 result)
|
|
|
1444 (setq
|
|
|
1445 result
|
|
|
1446 (cond
|
|
|
1447 ((eq filename 'default)
|
|
|
1448 default-name)
|
|
118
|
1449 ((eq filename t)
|
|
|
1450 default-name)
|
|
116
|
1451 (filename filename)
|
|
|
1452 (t
|
|
|
1453 (let* ((split-name (gnus-get-split-value gnus-split-methods))
|
|
|
1454 (prompt
|
|
|
1455 (format prompt
|
|
|
1456 (if (and gnus-number-of-articles-to-be-saved
|
|
|
1457 (> gnus-number-of-articles-to-be-saved 1))
|
|
|
1458 (format "these %d articles"
|
|
|
1459 gnus-number-of-articles-to-be-saved)
|
|
|
1460 "this article")))
|
|
|
1461 (file
|
|
|
1462 ;; Let the split methods have their say.
|
|
|
1463 (cond
|
|
|
1464 ;; No split name was found.
|
|
|
1465 ((null split-name)
|
|
|
1466 (read-file-name
|
|
|
1467 (concat prompt " (default "
|
|
|
1468 (file-name-nondirectory default-name) ") ")
|
|
|
1469 (file-name-directory default-name)
|
|
|
1470 default-name))
|
|
|
1471 ;; A single group name is returned.
|
|
|
1472 ((stringp split-name)
|
|
|
1473 (setq default-name
|
|
|
1474 (funcall function split-name headers
|
|
|
1475 (symbol-value variable)))
|
|
|
1476 (read-file-name
|
|
|
1477 (concat prompt " (default "
|
|
|
1478 (file-name-nondirectory default-name) ") ")
|
|
|
1479 (file-name-directory default-name)
|
|
|
1480 default-name))
|
|
|
1481 ;; A single split name was found
|
|
|
1482 ((= 1 (length split-name))
|
|
136
|
1483 (let* ((name (expand-file-name
|
|
|
1484 (car split-name) gnus-article-save-directory))
|
|
116
|
1485 (dir (cond ((file-directory-p name)
|
|
|
1486 (file-name-as-directory name))
|
|
|
1487 ((file-exists-p name) name)
|
|
|
1488 (t gnus-article-save-directory))))
|
|
|
1489 (read-file-name
|
|
|
1490 (concat prompt " (default " name ") ")
|
|
|
1491 dir name)))
|
|
|
1492 ;; A list of splits was found.
|
|
|
1493 (t
|
|
|
1494 (setq split-name (nreverse split-name))
|
|
|
1495 (let (result)
|
|
|
1496 (let ((file-name-history
|
|
|
1497 (nconc split-name file-name-history)))
|
|
|
1498 (setq result
|
|
|
1499 (expand-file-name
|
|
|
1500 (read-file-name
|
|
|
1501 (concat prompt " (`M-p' for defaults) ")
|
|
|
1502 gnus-article-save-directory
|
|
|
1503 (car split-name))
|
|
|
1504 gnus-article-save-directory)))
|
|
|
1505 (car (push result file-name-history)))))))
|
|
|
1506 ;; Create the directory.
|
|
|
1507 (gnus-make-directory (file-name-directory file))
|
|
|
1508 ;; If we have read a directory, we append the default file name.
|
|
|
1509 (when (file-directory-p file)
|
|
|
1510 (setq file (concat (file-name-as-directory file)
|
|
|
1511 (file-name-nondirectory default-name))))
|
|
|
1512 ;; Possibly translate some characters.
|
|
|
1513 (nnheader-translate-file-chars file)))))
|
|
|
1514 (gnus-make-directory (file-name-directory result))
|
|
|
1515 (set variable result)))
|
|
98
|
1516
|
|
|
1517 (defun gnus-article-archive-name (group)
|
|
|
1518 "Return the first instance of an \"Archive-name\" in the current buffer."
|
|
|
1519 (let ((case-fold-search t))
|
|
|
1520 (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
|
|
|
1521 (nnheader-concat gnus-article-save-directory
|
|
|
1522 (match-string 1)))))
|
|
|
1523
|
|
116
|
1524 (defun gnus-article-nndoc-name (group)
|
|
|
1525 "If GROUP is an nndoc group, return the name of the parent group."
|
|
|
1526 (when (eq (car (gnus-find-method-for-group group)) 'nndoc)
|
|
|
1527 (gnus-group-get-parameter group 'save-article-group)))
|
|
|
1528
|
|
98
|
1529 (defun gnus-summary-save-in-rmail (&optional filename)
|
|
|
1530 "Append this article to Rmail file.
|
|
|
1531 Optional argument FILENAME specifies file name.
|
|
|
1532 Directory to save to is default to `gnus-article-save-directory'."
|
|
|
1533 (interactive)
|
|
|
1534 (gnus-set-global-variables)
|
|
116
|
1535 (setq filename (gnus-read-save-file-name
|
|
|
1536 "Save %s in rmail file:" filename
|
|
|
1537 gnus-rmail-save-name gnus-newsgroup-name
|
|
|
1538 gnus-current-headers 'gnus-newsgroup-last-rmail))
|
|
|
1539 (gnus-eval-in-buffer-window gnus-save-article-buffer
|
|
|
1540 (save-excursion
|
|
|
1541 (save-restriction
|
|
|
1542 (widen)
|
|
|
1543 (gnus-output-to-rmail filename)))))
|
|
98
|
1544
|
|
|
1545 (defun gnus-summary-save-in-mail (&optional filename)
|
|
|
1546 "Append this article to Unix mail file.
|
|
|
1547 Optional argument FILENAME specifies file name.
|
|
|
1548 Directory to save to is default to `gnus-article-save-directory'."
|
|
|
1549 (interactive)
|
|
|
1550 (gnus-set-global-variables)
|
|
116
|
1551 (setq filename (gnus-read-save-file-name
|
|
|
1552 "Save %s in Unix mail file:" filename
|
|
|
1553 gnus-mail-save-name gnus-newsgroup-name
|
|
|
1554 gnus-current-headers 'gnus-newsgroup-last-mail))
|
|
|
1555 (gnus-eval-in-buffer-window gnus-save-article-buffer
|
|
|
1556 (save-excursion
|
|
|
1557 (save-restriction
|
|
|
1558 (widen)
|
|
|
1559 (if (and (file-readable-p filename)
|
|
|
1560 (mail-file-babyl-p filename))
|
|
|
1561 (gnus-output-to-rmail filename t)
|
|
|
1562 (gnus-output-to-mail filename))))))
|
|
98
|
1563
|
|
|
1564 (defun gnus-summary-save-in-file (&optional filename overwrite)
|
|
|
1565 "Append this article to file.
|
|
|
1566 Optional argument FILENAME specifies file name.
|
|
|
1567 Directory to save to is default to `gnus-article-save-directory'."
|
|
|
1568 (interactive)
|
|
|
1569 (gnus-set-global-variables)
|
|
116
|
1570 (setq filename (gnus-read-save-file-name
|
|
|
1571 "Save %s in file:" filename
|
|
|
1572 gnus-file-save-name gnus-newsgroup-name
|
|
|
1573 gnus-current-headers 'gnus-newsgroup-last-file))
|
|
|
1574 (gnus-eval-in-buffer-window gnus-save-article-buffer
|
|
|
1575 (save-excursion
|
|
|
1576 (save-restriction
|
|
|
1577 (widen)
|
|
|
1578 (when (and overwrite
|
|
|
1579 (file-exists-p filename))
|
|
|
1580 (delete-file filename))
|
|
|
1581 (gnus-output-to-file filename)))))
|
|
98
|
1582
|
|
|
1583 (defun gnus-summary-write-to-file (&optional filename)
|
|
|
1584 "Write this article to a file.
|
|
|
1585 Optional argument FILENAME specifies file name.
|
|
|
1586 The directory to save in defaults to `gnus-article-save-directory'."
|
|
|
1587 (interactive)
|
|
|
1588 (gnus-summary-save-in-file nil t))
|
|
|
1589
|
|
|
1590 (defun gnus-summary-save-body-in-file (&optional filename)
|
|
|
1591 "Append this article body to a file.
|
|
|
1592 Optional argument FILENAME specifies file name.
|
|
|
1593 The directory to save in defaults to `gnus-article-save-directory'."
|
|
|
1594 (interactive)
|
|
|
1595 (gnus-set-global-variables)
|
|
116
|
1596 (setq filename (gnus-read-save-file-name
|
|
|
1597 "Save %s body in file:" filename
|
|
|
1598 gnus-file-save-name gnus-newsgroup-name
|
|
|
1599 gnus-current-headers 'gnus-newsgroup-last-file))
|
|
|
1600 (gnus-eval-in-buffer-window gnus-save-article-buffer
|
|
|
1601 (save-excursion
|
|
|
1602 (save-restriction
|
|
|
1603 (widen)
|
|
|
1604 (goto-char (point-min))
|
|
|
1605 (when (search-forward "\n\n" nil t)
|
|
|
1606 (narrow-to-region (point) (point-max)))
|
|
|
1607 (gnus-output-to-file filename)))))
|
|
98
|
1608
|
|
|
1609 (defun gnus-summary-save-in-pipe (&optional command)
|
|
|
1610 "Pipe this article to subprocess."
|
|
|
1611 (interactive)
|
|
|
1612 (gnus-set-global-variables)
|
|
|
1613 (setq command
|
|
|
1614 (cond ((eq command 'default)
|
|
|
1615 gnus-last-shell-command)
|
|
|
1616 (command command)
|
|
108
|
1617 (t (read-string
|
|
98
|
1618 (format
|
|
|
1619 "Shell command on %s: "
|
|
|
1620 (if (and gnus-number-of-articles-to-be-saved
|
|
|
1621 (> gnus-number-of-articles-to-be-saved 1))
|
|
|
1622 (format "these %d articles"
|
|
|
1623 gnus-number-of-articles-to-be-saved)
|
|
|
1624 "this article"))
|
|
|
1625 gnus-last-shell-command))))
|
|
|
1626 (when (string-equal command "")
|
|
|
1627 (setq command gnus-last-shell-command))
|
|
|
1628 (gnus-eval-in-buffer-window gnus-article-buffer
|
|
|
1629 (save-restriction
|
|
|
1630 (widen)
|
|
|
1631 (shell-command-on-region (point-min) (point-max) command nil)))
|
|
|
1632 (setq gnus-last-shell-command command))
|
|
|
1633
|
|
|
1634 ;;; Article file names when saving.
|
|
|
1635
|
|
|
1636 (defun gnus-capitalize-newsgroup (newsgroup)
|
|
|
1637 "Capitalize NEWSGROUP name."
|
|
|
1638 (when (not (zerop (length newsgroup)))
|
|
|
1639 (concat (char-to-string (upcase (aref newsgroup 0)))
|
|
|
1640 (substring newsgroup 1))))
|
|
|
1641
|
|
|
1642 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
|
|
|
1643 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
|
1644 If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num.
|
|
|
1645 Otherwise, it is like ~/News/news/group/num."
|
|
|
1646 (let ((default
|
|
|
1647 (expand-file-name
|
|
|
1648 (concat (if (gnus-use-long-file-name 'not-save)
|
|
|
1649 (gnus-capitalize-newsgroup newsgroup)
|
|
|
1650 (gnus-newsgroup-directory-form newsgroup))
|
|
|
1651 "/" (int-to-string (mail-header-number headers)))
|
|
|
1652 gnus-article-save-directory)))
|
|
|
1653 (if (and last-file
|
|
|
1654 (string-equal (file-name-directory default)
|
|
|
1655 (file-name-directory last-file))
|
|
|
1656 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
|
|
|
1657 default
|
|
|
1658 (or last-file default))))
|
|
|
1659
|
|
|
1660 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
|
|
|
1661 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
|
1662 If variable `gnus-use-long-file-name' is non-nil, it is
|
|
|
1663 ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num."
|
|
|
1664 (let ((default
|
|
|
1665 (expand-file-name
|
|
|
1666 (concat (if (gnus-use-long-file-name 'not-save)
|
|
|
1667 newsgroup
|
|
|
1668 (gnus-newsgroup-directory-form newsgroup))
|
|
|
1669 "/" (int-to-string (mail-header-number headers)))
|
|
|
1670 gnus-article-save-directory)))
|
|
|
1671 (if (and last-file
|
|
|
1672 (string-equal (file-name-directory default)
|
|
|
1673 (file-name-directory last-file))
|
|
|
1674 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
|
|
|
1675 default
|
|
|
1676 (or last-file default))))
|
|
|
1677
|
|
|
1678 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
|
|
|
1679 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
|
1680 If variable `gnus-use-long-file-name' is non-nil, it is
|
|
|
1681 ~/News/News.group. Otherwise, it is like ~/News/news/group/news."
|
|
|
1682 (or last-file
|
|
|
1683 (expand-file-name
|
|
|
1684 (if (gnus-use-long-file-name 'not-save)
|
|
|
1685 (gnus-capitalize-newsgroup newsgroup)
|
|
|
1686 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
|
|
|
1687 gnus-article-save-directory)))
|
|
|
1688
|
|
|
1689 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
|
|
|
1690 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
|
1691 If variable `gnus-use-long-file-name' is non-nil, it is
|
|
|
1692 ~/News/news.group. Otherwise, it is like ~/News/news/group/news."
|
|
|
1693 (or last-file
|
|
|
1694 (expand-file-name
|
|
|
1695 (if (gnus-use-long-file-name 'not-save)
|
|
|
1696 newsgroup
|
|
|
1697 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
|
|
|
1698 gnus-article-save-directory)))
|
|
|
1699
|
|
|
1700 (eval-and-compile
|
|
|
1701 (mapcar
|
|
|
1702 (lambda (func)
|
|
|
1703 (let (afunc gfunc)
|
|
|
1704 (if (consp func)
|
|
|
1705 (setq afunc (car func)
|
|
|
1706 gfunc (cdr func))
|
|
|
1707 (setq afunc func
|
|
|
1708 gfunc (intern (format "gnus-%s" func))))
|
|
108
|
1709 (fset gfunc
|
|
98
|
1710 (if (not (fboundp afunc))
|
|
|
1711 nil
|
|
|
1712 `(lambda (&optional interactive &rest args)
|
|
|
1713 ,(documentation afunc t)
|
|
|
1714 (interactive (list t))
|
|
|
1715 (save-excursion
|
|
|
1716 (set-buffer gnus-article-buffer)
|
|
|
1717 (if interactive
|
|
|
1718 (call-interactively ',afunc)
|
|
|
1719 (apply ',afunc args))))))))
|
|
|
1720 '(article-hide-headers
|
|
|
1721 article-hide-boring-headers
|
|
|
1722 article-treat-overstrike
|
|
|
1723 (article-fill . gnus-article-word-wrap)
|
|
|
1724 article-remove-cr
|
|
|
1725 article-display-x-face
|
|
|
1726 article-de-quoted-unreadable
|
|
|
1727 article-mime-decode-quoted-printable
|
|
|
1728 article-hide-pgp
|
|
|
1729 article-hide-pem
|
|
|
1730 article-hide-signature
|
|
|
1731 article-remove-trailing-blank-lines
|
|
|
1732 article-strip-leading-blank-lines
|
|
|
1733 article-strip-multiple-blank-lines
|
|
114
|
1734 article-strip-leading-space
|
|
98
|
1735 article-strip-blank-lines
|
|
|
1736 article-date-local
|
|
|
1737 article-date-original
|
|
|
1738 article-date-ut
|
|
|
1739 article-date-user
|
|
|
1740 article-date-lapsed
|
|
|
1741 article-emphasize
|
|
|
1742 (article-show-all . gnus-article-show-all-headers))))
|
|
|
1743
|
|
|
1744 ;;;
|
|
|
1745 ;;; Gnus article mode
|
|
|
1746 ;;;
|
|
|
1747
|
|
|
1748 (put 'gnus-article-mode 'mode-class 'special)
|
|
|
1749
|
|
153
|
1750 (gnus-define-keys gnus-article-mode-map
|
|
|
1751 " " gnus-article-goto-next-page
|
|
|
1752 "\177" gnus-article-goto-prev-page
|
|
163
|
1753 [backspace] gnus-article-goto-prev-page
|
|
153
|
1754 [delete] gnus-article-goto-prev-page
|
|
|
1755 "\C-c^" gnus-article-refer-article
|
|
|
1756 "h" gnus-article-show-summary
|
|
|
1757 "s" gnus-article-show-summary
|
|
|
1758 "\C-c\C-m" gnus-article-mail
|
|
|
1759 "?" gnus-article-describe-briefly
|
|
|
1760 gnus-mouse-2 gnus-article-push-button
|
|
|
1761 "\r" gnus-article-press-button
|
|
|
1762 "\t" gnus-article-next-button
|
|
|
1763 "\M-\t" gnus-article-prev-button
|
|
|
1764 "e" gnus-article-edit
|
|
|
1765 "<" beginning-of-buffer
|
|
|
1766 ">" end-of-buffer
|
|
|
1767 "\C-c\C-i" gnus-info-find-node
|
|
|
1768 "\C-c\C-b" gnus-bug
|
|
98
|
1769
|
|
153
|
1770 "\C-d" gnus-article-read-summary-keys
|
|
|
1771 "\M-*" gnus-article-read-summary-keys
|
|
|
1772 "\M-#" gnus-article-read-summary-keys
|
|
|
1773 "\M-^" gnus-article-read-summary-keys
|
|
|
1774 "\M-g" gnus-article-read-summary-keys)
|
|
98
|
1775
|
|
153
|
1776 (substitute-key-definition
|
|
|
1777 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
|
|
98
|
1778
|
|
|
1779 (defun gnus-article-make-menu-bar ()
|
|
|
1780 (gnus-turn-off-edit-menu 'article)
|
|
|
1781 (unless (boundp 'gnus-article-article-menu)
|
|
|
1782 (easy-menu-define
|
|
|
1783 gnus-article-article-menu gnus-article-mode-map ""
|
|
|
1784 '("Article"
|
|
|
1785 ["Scroll forwards" gnus-article-goto-next-page t]
|
|
|
1786 ["Scroll backwards" gnus-article-goto-prev-page t]
|
|
|
1787 ["Show summary" gnus-article-show-summary t]
|
|
|
1788 ["Fetch Message-ID at point" gnus-article-refer-article t]
|
|
|
1789 ["Mail to address at point" gnus-article-mail t]))
|
|
|
1790
|
|
|
1791 (easy-menu-define
|
|
|
1792 gnus-article-treatment-menu gnus-article-mode-map ""
|
|
|
1793 '("Treatment"
|
|
|
1794 ["Hide headers" gnus-article-hide-headers t]
|
|
|
1795 ["Hide signature" gnus-article-hide-signature t]
|
|
|
1796 ["Hide citation" gnus-article-hide-citation t]
|
|
|
1797 ["Treat overstrike" gnus-article-treat-overstrike t]
|
|
|
1798 ["Remove carriage return" gnus-article-remove-cr t]
|
|
|
1799 ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
|
|
|
1800
|
|
|
1801 (when nil
|
|
|
1802 (when (boundp 'gnus-summary-article-menu)
|
|
|
1803 (define-key gnus-article-mode-map [menu-bar commands]
|
|
|
1804 (cons "Commands" gnus-summary-article-menu))))
|
|
|
1805
|
|
|
1806 (when (boundp 'gnus-summary-post-menu)
|
|
|
1807 (define-key gnus-article-mode-map [menu-bar post]
|
|
|
1808 (cons "Post" gnus-summary-post-menu)))
|
|
|
1809
|
|
|
1810 (run-hooks 'gnus-article-menu-hook)))
|
|
|
1811
|
|
|
1812 (defun gnus-article-mode ()
|
|
|
1813 "Major mode for displaying an article.
|
|
|
1814
|
|
|
1815 All normal editing commands are switched off.
|
|
|
1816
|
|
|
1817 The following commands are available in addition to all summary mode
|
|
|
1818 commands:
|
|
|
1819 \\<gnus-article-mode-map>
|
|
|
1820 \\[gnus-article-next-page]\t Scroll the article one page forwards
|
|
|
1821 \\[gnus-article-prev-page]\t Scroll the article one page backwards
|
|
|
1822 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
|
|
|
1823 \\[gnus-article-show-summary]\t Display the summary buffer
|
|
|
1824 \\[gnus-article-mail]\t Send a reply to the address near point
|
|
|
1825 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
|
|
|
1826 \\[gnus-info-find-node]\t Go to the Gnus info node"
|
|
|
1827 (interactive)
|
|
|
1828 (when (gnus-visual-p 'article-menu 'menu)
|
|
|
1829 (gnus-article-make-menu-bar))
|
|
|
1830 (kill-all-local-variables)
|
|
|
1831 (gnus-simplify-mode-line)
|
|
|
1832 (setq mode-name "Article")
|
|
|
1833 (setq major-mode 'gnus-article-mode)
|
|
|
1834 (make-local-variable 'minor-mode-alist)
|
|
|
1835 (unless (assq 'gnus-show-mime minor-mode-alist)
|
|
|
1836 (push (list 'gnus-show-mime " MIME") minor-mode-alist))
|
|
|
1837 (use-local-map gnus-article-mode-map)
|
|
|
1838 (gnus-update-format-specifications nil 'article-mode)
|
|
|
1839 (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
|
|
120
|
1840 (set (make-local-variable 'gnus-page-broken) nil)
|
|
104
|
1841 (set (make-local-variable 'gnus-button-marker-list) nil)
|
|
98
|
1842 (gnus-set-default-directory)
|
|
|
1843 (buffer-disable-undo (current-buffer))
|
|
|
1844 (setq buffer-read-only t)
|
|
|
1845 (set-syntax-table gnus-article-mode-syntax-table)
|
|
|
1846 (run-hooks 'gnus-article-mode-hook))
|
|
|
1847
|
|
|
1848 (defun gnus-article-setup-buffer ()
|
|
|
1849 "Initialize the article buffer."
|
|
|
1850 (let* ((name (if gnus-single-article-buffer "*Article*"
|
|
|
1851 (concat "*Article " gnus-newsgroup-name "*")))
|
|
|
1852 (original
|
|
|
1853 (progn (string-match "\\*Article" name)
|
|
|
1854 (concat " *Original Article"
|
|
|
1855 (substring name (match-end 0))))))
|
|
|
1856 (setq gnus-article-buffer name)
|
|
|
1857 (setq gnus-original-article-buffer original)
|
|
|
1858 ;; This might be a variable local to the summary buffer.
|
|
|
1859 (unless gnus-single-article-buffer
|
|
|
1860 (save-excursion
|
|
|
1861 (set-buffer gnus-summary-buffer)
|
|
|
1862 (setq gnus-article-buffer name)
|
|
|
1863 (setq gnus-original-article-buffer original)
|
|
|
1864 (gnus-set-global-variables)))
|
|
|
1865 ;; Init original article buffer.
|
|
|
1866 (save-excursion
|
|
|
1867 (set-buffer (get-buffer-create gnus-original-article-buffer))
|
|
|
1868 (buffer-disable-undo (current-buffer))
|
|
|
1869 (setq major-mode 'gnus-original-article-mode)
|
|
|
1870 (gnus-add-current-to-buffer-list)
|
|
|
1871 (make-local-variable 'gnus-original-article))
|
|
|
1872 (if (get-buffer name)
|
|
|
1873 (save-excursion
|
|
|
1874 (set-buffer name)
|
|
|
1875 (buffer-disable-undo (current-buffer))
|
|
|
1876 (setq buffer-read-only t)
|
|
|
1877 (gnus-add-current-to-buffer-list)
|
|
|
1878 (unless (eq major-mode 'gnus-article-mode)
|
|
|
1879 (gnus-article-mode))
|
|
|
1880 (current-buffer))
|
|
|
1881 (save-excursion
|
|
|
1882 (set-buffer (get-buffer-create name))
|
|
|
1883 (gnus-add-current-to-buffer-list)
|
|
|
1884 (gnus-article-mode)
|
|
|
1885 (make-local-variable 'gnus-summary-buffer)
|
|
|
1886 (current-buffer)))))
|
|
|
1887
|
|
|
1888 ;; Set article window start at LINE, where LINE is the number of lines
|
|
|
1889 ;; from the head of the article.
|
|
|
1890 (defun gnus-article-set-window-start (&optional line)
|
|
|
1891 (set-window-start
|
|
|
1892 (get-buffer-window gnus-article-buffer t)
|
|
|
1893 (save-excursion
|
|
|
1894 (set-buffer gnus-article-buffer)
|
|
|
1895 (goto-char (point-min))
|
|
|
1896 (if (not line)
|
|
|
1897 (point-min)
|
|
|
1898 (gnus-message 6 "Moved to bookmark")
|
|
|
1899 (search-forward "\n\n" nil t)
|
|
|
1900 (forward-line line)
|
|
|
1901 (point)))))
|
|
|
1902
|
|
|
1903 (defun gnus-article-prepare (article &optional all-headers header)
|
|
|
1904 "Prepare ARTICLE in article mode buffer.
|
|
|
1905 ARTICLE should either be an article number or a Message-ID.
|
|
|
1906 If ARTICLE is an id, HEADER should be the article headers.
|
|
|
1907 If ALL-HEADERS is non-nil, no headers are hidden."
|
|
|
1908 (save-excursion
|
|
|
1909 ;; Make sure we start in a summary buffer.
|
|
|
1910 (unless (eq major-mode 'gnus-summary-mode)
|
|
|
1911 (set-buffer gnus-summary-buffer))
|
|
|
1912 (setq gnus-summary-buffer (current-buffer))
|
|
|
1913 ;; Make sure the connection to the server is alive.
|
|
|
1914 (unless (gnus-server-opened
|
|
|
1915 (gnus-find-method-for-group gnus-newsgroup-name))
|
|
|
1916 (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
|
|
|
1917 (gnus-request-group gnus-newsgroup-name t))
|
|
|
1918 (let* ((gnus-article (if header (mail-header-number header) article))
|
|
|
1919 (summary-buffer (current-buffer))
|
|
|
1920 (internal-hook gnus-article-internal-prepare-hook)
|
|
|
1921 (group gnus-newsgroup-name)
|
|
|
1922 result)
|
|
|
1923 (save-excursion
|
|
|
1924 (gnus-article-setup-buffer)
|
|
|
1925 (set-buffer gnus-article-buffer)
|
|
|
1926 ;; Deactivate active regions.
|
|
|
1927 (when (and (boundp 'transient-mark-mode)
|
|
|
1928 transient-mark-mode)
|
|
|
1929 (setq mark-active nil))
|
|
|
1930 (if (not (setq result (let ((buffer-read-only nil))
|
|
|
1931 (gnus-request-article-this-buffer
|
|
|
1932 article group))))
|
|
|
1933 ;; There is no such article.
|
|
|
1934 (save-excursion
|
|
|
1935 (when (and (numberp article)
|
|
|
1936 (not (memq article gnus-newsgroup-sparse)))
|
|
|
1937 (setq gnus-article-current
|
|
|
1938 (cons gnus-newsgroup-name article))
|
|
|
1939 (set-buffer gnus-summary-buffer)
|
|
|
1940 (setq gnus-current-article article)
|
|
|
1941 (gnus-summary-mark-article article gnus-canceled-mark))
|
|
|
1942 (unless (memq article gnus-newsgroup-sparse)
|
|
|
1943 (gnus-error
|
|
|
1944 1 "No such article (may have expired or been canceled)")))
|
|
|
1945 (if (or (eq result 'pseudo) (eq result 'nneething))
|
|
|
1946 (progn
|
|
|
1947 (save-excursion
|
|
|
1948 (set-buffer summary-buffer)
|
|
|
1949 (setq gnus-last-article gnus-current-article
|
|
|
1950 gnus-newsgroup-history (cons gnus-current-article
|
|
|
1951 gnus-newsgroup-history)
|
|
|
1952 gnus-current-article 0
|
|
|
1953 gnus-current-headers nil
|
|
|
1954 gnus-article-current nil)
|
|
|
1955 (if (eq result 'nneething)
|
|
|
1956 (gnus-configure-windows 'summary)
|
|
|
1957 (gnus-configure-windows 'article))
|
|
|
1958 (gnus-set-global-variables))
|
|
|
1959 (gnus-set-mode-line 'article))
|
|
|
1960 ;; The result from the `request' was an actual article -
|
|
|
1961 ;; or at least some text that is now displayed in the
|
|
|
1962 ;; article buffer.
|
|
|
1963 (when (and (numberp article)
|
|
|
1964 (not (eq article gnus-current-article)))
|
|
|
1965 ;; Seems like a new article has been selected.
|
|
|
1966 ;; `gnus-current-article' must be an article number.
|
|
|
1967 (save-excursion
|
|
|
1968 (set-buffer summary-buffer)
|
|
|
1969 (setq gnus-last-article gnus-current-article
|
|
|
1970 gnus-newsgroup-history (cons gnus-current-article
|
|
|
1971 gnus-newsgroup-history)
|
|
|
1972 gnus-current-article article
|
|
|
1973 gnus-current-headers
|
|
|
1974 (gnus-summary-article-header gnus-current-article)
|
|
|
1975 gnus-article-current
|
|
|
1976 (cons gnus-newsgroup-name gnus-current-article))
|
|
|
1977 (unless (vectorp gnus-current-headers)
|
|
|
1978 (setq gnus-current-headers nil))
|
|
|
1979 (gnus-summary-show-thread)
|
|
|
1980 (run-hooks 'gnus-mark-article-hook)
|
|
|
1981 (gnus-set-mode-line 'summary)
|
|
|
1982 (when (gnus-visual-p 'article-highlight 'highlight)
|
|
|
1983 (run-hooks 'gnus-visual-mark-article-hook))
|
|
|
1984 ;; Set the global newsgroup variables here.
|
|
|
1985 ;; Suggested by Jim Sisolak
|
|
|
1986 ;; <sisolak@trans4.neep.wisc.edu>.
|
|
|
1987 (gnus-set-global-variables)
|
|
|
1988 (setq gnus-have-all-headers
|
|
|
1989 (or all-headers gnus-show-all-headers))
|
|
|
1990 (and gnus-use-cache
|
|
|
1991 (vectorp (gnus-summary-article-header article))
|
|
|
1992 (gnus-cache-possibly-enter-article
|
|
|
1993 group article
|
|
|
1994 (gnus-summary-article-header article)
|
|
|
1995 (memq article gnus-newsgroup-marked)
|
|
|
1996 (memq article gnus-newsgroup-dormant)
|
|
|
1997 (memq article gnus-newsgroup-unreads)))))
|
|
|
1998 (when (or (numberp article)
|
|
|
1999 (stringp article))
|
|
|
2000 ;; Hooks for getting information from the article.
|
|
|
2001 ;; This hook must be called before being narrowed.
|
|
|
2002 (let (buffer-read-only)
|
|
|
2003 (run-hooks 'internal-hook)
|
|
|
2004 (run-hooks 'gnus-article-prepare-hook)
|
|
|
2005 ;; Decode MIME message.
|
|
|
2006 (when gnus-show-mime
|
|
|
2007 (if (or (not gnus-strict-mime)
|
|
|
2008 (gnus-fetch-field "Mime-Version"))
|
|
|
2009 (funcall gnus-show-mime-method)
|
|
|
2010 (funcall gnus-decode-encoded-word-method)))
|
|
|
2011 ;; Perform the article display hooks.
|
|
|
2012 (run-hooks 'gnus-article-display-hook))
|
|
|
2013 ;; Do page break.
|
|
|
2014 (goto-char (point-min))
|
|
120
|
2015 (setq gnus-page-broken
|
|
|
2016 (when gnus-break-pages
|
|
|
2017 (gnus-narrow-to-page)
|
|
|
2018 t)))
|
|
98
|
2019 (gnus-set-mode-line 'article)
|
|
|
2020 (gnus-configure-windows 'article)
|
|
|
2021 (goto-char (point-min))
|
|
|
2022 t))))))
|
|
|
2023
|
|
|
2024 (defun gnus-article-wash-status ()
|
|
|
2025 "Return a string which display status of article washing."
|
|
|
2026 (save-excursion
|
|
|
2027 (set-buffer gnus-article-buffer)
|
|
|
2028 (let ((cite (gnus-article-hidden-text-p 'cite))
|
|
|
2029 (headers (gnus-article-hidden-text-p 'headers))
|
|
|
2030 (boring (gnus-article-hidden-text-p 'boring-headers))
|
|
|
2031 (pgp (gnus-article-hidden-text-p 'pgp))
|
|
|
2032 (pem (gnus-article-hidden-text-p 'pem))
|
|
|
2033 (signature (gnus-article-hidden-text-p 'signature))
|
|
|
2034 (overstrike (gnus-article-hidden-text-p 'overstrike))
|
|
|
2035 (emphasis (gnus-article-hidden-text-p 'emphasis))
|
|
|
2036 (mime gnus-show-mime))
|
|
|
2037 (format "%c%c%c%c%c%c%c"
|
|
|
2038 (if cite ?c ? )
|
|
|
2039 (if (or headers boring) ?h ? )
|
|
|
2040 (if (or pgp pem) ?p ? )
|
|
|
2041 (if signature ?s ? )
|
|
|
2042 (if overstrike ?o ? )
|
|
|
2043 (if mime ?m ? )
|
|
|
2044 (if emphasis ?e ? )))))
|
|
|
2045
|
|
|
2046 (defun gnus-article-hide-headers-if-wanted ()
|
|
|
2047 "Hide unwanted headers if `gnus-have-all-headers' is nil.
|
|
|
2048 Provided for backwards compatibility."
|
|
|
2049 (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
|
|
|
2050 gnus-inhibit-hiding
|
|
|
2051 (gnus-article-hide-headers)))
|
|
|
2052
|
|
|
2053 ;;; Article savers.
|
|
|
2054
|
|
|
2055 (defun gnus-output-to-file (file-name)
|
|
|
2056 "Append the current article to a file named FILE-NAME."
|
|
|
2057 (let ((artbuf (current-buffer)))
|
|
|
2058 (nnheader-temp-write nil
|
|
|
2059 (insert-buffer-substring artbuf)
|
|
|
2060 ;; Append newline at end of the buffer as separator, and then
|
|
|
2061 ;; save it to file.
|
|
|
2062 (goto-char (point-max))
|
|
|
2063 (insert "\n")
|
|
155
|
2064 (append-to-file (point-min) (point-max) file-name)
|
|
|
2065 t)))
|
|
98
|
2066
|
|
|
2067 (defun gnus-narrow-to-page (&optional arg)
|
|
|
2068 "Narrow the article buffer to a page.
|
|
|
2069 If given a numerical ARG, move forward ARG pages."
|
|
|
2070 (interactive "P")
|
|
|
2071 (setq arg (if arg (prefix-numeric-value arg) 0))
|
|
|
2072 (save-excursion
|
|
|
2073 (set-buffer gnus-article-buffer)
|
|
|
2074 (goto-char (point-min))
|
|
|
2075 (widen)
|
|
|
2076 ;; Remove any old next/prev buttons.
|
|
|
2077 (when (gnus-visual-p 'page-marker)
|
|
|
2078 (let ((buffer-read-only nil))
|
|
|
2079 (gnus-remove-text-with-property 'gnus-prev)
|
|
|
2080 (gnus-remove-text-with-property 'gnus-next)))
|
|
|
2081 (when
|
|
|
2082 (cond ((< arg 0)
|
|
|
2083 (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
|
|
|
2084 ((> arg 0)
|
|
|
2085 (re-search-forward page-delimiter nil 'move arg)))
|
|
|
2086 (goto-char (match-end 0)))
|
|
|
2087 (narrow-to-region
|
|
|
2088 (point)
|
|
|
2089 (if (re-search-forward page-delimiter nil 'move)
|
|
|
2090 (match-beginning 0)
|
|
|
2091 (point)))
|
|
|
2092 (when (and (gnus-visual-p 'page-marker)
|
|
|
2093 (not (= (point-min) 1)))
|
|
|
2094 (save-excursion
|
|
|
2095 (goto-char (point-min))
|
|
|
2096 (gnus-insert-prev-page-button)))
|
|
|
2097 (when (and (gnus-visual-p 'page-marker)
|
|
|
2098 (< (+ (point-max) 2) (buffer-size)))
|
|
|
2099 (save-excursion
|
|
|
2100 (goto-char (point-max))
|
|
|
2101 (gnus-insert-next-page-button)))))
|
|
|
2102
|
|
|
2103 ;; Article mode commands
|
|
|
2104
|
|
|
2105 (defun gnus-article-goto-next-page ()
|
|
|
2106 "Show the next page of the article."
|
|
|
2107 (interactive)
|
|
|
2108 (when (gnus-article-next-page)
|
|
110
|
2109 (goto-char (point-min))
|
|
98
|
2110 (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
|
|
|
2111
|
|
|
2112 (defun gnus-article-goto-prev-page ()
|
|
|
2113 "Show the next page of the article."
|
|
|
2114 (interactive)
|
|
|
2115 (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
|
|
|
2116 (gnus-article-prev-page nil)))
|
|
|
2117
|
|
|
2118 (defun gnus-article-next-page (&optional lines)
|
|
|
2119 "Show the next page of the current article.
|
|
|
2120 If end of article, return non-nil. Otherwise return nil.
|
|
|
2121 Argument LINES specifies lines to be scrolled up."
|
|
|
2122 (interactive "p")
|
|
|
2123 (move-to-window-line -1)
|
|
|
2124 (if (save-excursion
|
|
|
2125 (end-of-line)
|
|
|
2126 (and (pos-visible-in-window-p) ;Not continuation line.
|
|
|
2127 (eobp)))
|
|
|
2128 ;; Nothing in this page.
|
|
120
|
2129 (if (or (not gnus-page-broken)
|
|
98
|
2130 (save-excursion
|
|
|
2131 (save-restriction
|
|
|
2132 (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
|
|
|
2133 t ;Nothing more.
|
|
|
2134 (gnus-narrow-to-page 1) ;Go to next page.
|
|
|
2135 nil)
|
|
|
2136 ;; More in this page.
|
|
|
2137 (let ((scroll-in-place nil))
|
|
|
2138 (condition-case ()
|
|
|
2139 (scroll-up lines)
|
|
|
2140 (end-of-buffer
|
|
|
2141 ;; Long lines may cause an end-of-buffer error.
|
|
|
2142 (goto-char (point-max)))))
|
|
|
2143 (move-to-window-line 0)
|
|
|
2144 nil))
|
|
|
2145
|
|
|
2146 (defun gnus-article-prev-page (&optional lines)
|
|
|
2147 "Show previous page of current article.
|
|
|
2148 Argument LINES specifies lines to be scrolled down."
|
|
|
2149 (interactive "p")
|
|
|
2150 (move-to-window-line 0)
|
|
120
|
2151 (if (and gnus-page-broken
|
|
98
|
2152 (bobp)
|
|
|
2153 (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
|
|
|
2154 (progn
|
|
|
2155 (gnus-narrow-to-page -1) ;Go to previous page.
|
|
|
2156 (goto-char (point-max))
|
|
|
2157 (recenter -1))
|
|
|
2158 (let ((scroll-in-place nil))
|
|
|
2159 (prog1
|
|
110
|
2160 (condition-case ()
|
|
|
2161 (scroll-down lines)
|
|
|
2162 (beginning-of-buffer
|
|
|
2163 (goto-char (point-min))))
|
|
98
|
2164 (move-to-window-line 0)))))
|
|
|
2165
|
|
|
2166 (defun gnus-article-refer-article ()
|
|
|
2167 "Read article specified by message-id around point."
|
|
|
2168 (interactive)
|
|
|
2169 (let ((point (point)))
|
|
|
2170 (search-forward ">" nil t) ;Move point to end of "<....>".
|
|
|
2171 (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
|
|
|
2172 (let ((message-id (match-string 1)))
|
|
|
2173 (goto-char point)
|
|
|
2174 (set-buffer gnus-summary-buffer)
|
|
|
2175 (gnus-summary-refer-article message-id))
|
|
|
2176 (goto-char (point))
|
|
|
2177 (error "No references around point"))))
|
|
|
2178
|
|
|
2179 (defun gnus-article-show-summary ()
|
|
|
2180 "Reconfigure windows to show summary buffer."
|
|
|
2181 (interactive)
|
|
122
|
2182 (if (not (gnus-buffer-live-p gnus-summary-buffer))
|
|
|
2183 (error "There is no summary buffer for this article buffer")
|
|
|
2184 (gnus-configure-windows 'article)
|
|
|
2185 (gnus-summary-goto-subject gnus-current-article)))
|
|
98
|
2186
|
|
|
2187 (defun gnus-article-describe-briefly ()
|
|
|
2188 "Describe article mode commands briefly."
|
|
|
2189 (interactive)
|
|
|
2190 (gnus-message 6
|
|
|
2191 (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")))
|
|
|
2192
|
|
|
2193 (defun gnus-article-summary-command ()
|
|
|
2194 "Execute the last keystroke in the summary buffer."
|
|
|
2195 (interactive)
|
|
|
2196 (let ((obuf (current-buffer))
|
|
|
2197 (owin (current-window-configuration))
|
|
|
2198 func)
|
|
|
2199 (switch-to-buffer gnus-summary-buffer 'norecord)
|
|
|
2200 (setq func (lookup-key (current-local-map) (this-command-keys)))
|
|
|
2201 (call-interactively func)
|
|
|
2202 (set-buffer obuf)
|
|
|
2203 (set-window-configuration owin)
|
|
|
2204 (set-window-point (get-buffer-window (current-buffer)) (point))))
|
|
|
2205
|
|
|
2206 (defun gnus-article-summary-command-nosave ()
|
|
|
2207 "Execute the last keystroke in the summary buffer."
|
|
|
2208 (interactive)
|
|
|
2209 (let (func)
|
|
|
2210 (pop-to-buffer gnus-summary-buffer 'norecord)
|
|
|
2211 (setq func (lookup-key (current-local-map) (this-command-keys)))
|
|
|
2212 (call-interactively func)))
|
|
|
2213
|
|
|
2214 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
|
|
|
2215 "Read a summary buffer key sequence and execute it from the article buffer."
|
|
|
2216 (interactive "P")
|
|
|
2217 (let ((nosaves
|
|
|
2218 '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
|
|
|
2219 "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
|
|
|
2220 "=" "^" "\M-^" "|"))
|
|
|
2221 (nosave-but-article
|
|
|
2222 '("A\r"))
|
|
|
2223 (nosave-in-article
|
|
|
2224 '("\C-d"))
|
|
|
2225 keys)
|
|
|
2226 (save-excursion
|
|
|
2227 (set-buffer gnus-summary-buffer)
|
|
|
2228 (let (gnus-pick-mode)
|
|
|
2229 (push (or key last-command-event) unread-command-events)
|
|
|
2230 (setq keys (read-key-sequence nil))))
|
|
|
2231 (message "")
|
|
|
2232
|
|
|
2233 (if (or (member keys nosaves)
|
|
|
2234 (member keys nosave-but-article)
|
|
|
2235 (member keys nosave-in-article))
|
|
|
2236 (let (func)
|
|
|
2237 (save-window-excursion
|
|
|
2238 (pop-to-buffer gnus-summary-buffer 'norecord)
|
|
|
2239 ;; We disable the pick minor mode commands.
|
|
|
2240 (let (gnus-pick-mode)
|
|
|
2241 (setq func (lookup-key (current-local-map) keys))))
|
|
|
2242 (if (not func)
|
|
|
2243 (ding)
|
|
|
2244 (unless (member keys nosave-in-article)
|
|
|
2245 (set-buffer gnus-summary-buffer))
|
|
|
2246 (call-interactively func))
|
|
|
2247 (when (member keys nosave-but-article)
|
|
|
2248 (pop-to-buffer gnus-article-buffer 'norecord)))
|
|
|
2249 ;; These commands should restore window configuration.
|
|
|
2250 (let ((obuf (current-buffer))
|
|
|
2251 (owin (current-window-configuration))
|
|
|
2252 (opoint (point))
|
|
|
2253 func in-buffer)
|
|
|
2254 (if not-restore-window
|
|
|
2255 (pop-to-buffer gnus-summary-buffer 'norecord)
|
|
|
2256 (switch-to-buffer gnus-summary-buffer 'norecord))
|
|
|
2257 (setq in-buffer (current-buffer))
|
|
|
2258 ;; We disable the pick minor mode commands.
|
|
|
2259 (if (setq func (let (gnus-pick-mode)
|
|
|
2260 (lookup-key (current-local-map) keys)))
|
|
|
2261 (call-interactively func)
|
|
|
2262 (ding))
|
|
|
2263 (when (eq in-buffer (current-buffer))
|
|
|
2264 (set-buffer obuf)
|
|
|
2265 (unless not-restore-window
|
|
|
2266 (set-window-configuration owin))
|
|
|
2267 (set-window-point (get-buffer-window (current-buffer)) opoint))))))
|
|
|
2268
|
|
|
2269 (defun gnus-article-hide (&optional arg force)
|
|
|
2270 "Hide all the gruft in the current article.
|
|
|
2271 This means that PGP stuff, signatures, cited text and (some)
|
|
|
2272 headers will be hidden.
|
|
|
2273 If given a prefix, show the hidden text instead."
|
|
|
2274 (interactive (list current-prefix-arg 'force))
|
|
|
2275 (gnus-article-hide-headers arg)
|
|
|
2276 (gnus-article-hide-pgp arg)
|
|
|
2277 (gnus-article-hide-citation-maybe arg force)
|
|
|
2278 (gnus-article-hide-signature arg))
|
|
|
2279
|
|
|
2280 (defun gnus-article-maybe-highlight ()
|
|
|
2281 "Do some article highlighting if `article-visual' is non-nil."
|
|
|
2282 (when (gnus-visual-p 'article-highlight 'highlight)
|
|
|
2283 (gnus-article-highlight-some)))
|
|
|
2284
|
|
|
2285 (defun gnus-request-article-this-buffer (article group)
|
|
|
2286 "Get an article and insert it into this buffer."
|
|
|
2287 (let (do-update-line)
|
|
|
2288 (prog1
|
|
|
2289 (save-excursion
|
|
|
2290 (erase-buffer)
|
|
|
2291 (gnus-kill-all-overlays)
|
|
|
2292 (setq group (or group gnus-newsgroup-name))
|
|
|
2293
|
|
|
2294 ;; Open server if it has closed.
|
|
|
2295 (gnus-check-server (gnus-find-method-for-group group))
|
|
|
2296
|
|
|
2297 ;; Using `gnus-request-article' directly will insert the article into
|
|
|
2298 ;; `nntp-server-buffer' - so we'll save some time by not having to
|
|
|
2299 ;; copy it from the server buffer into the article buffer.
|
|
|
2300
|
|
|
2301 ;; We only request an article by message-id when we do not have the
|
|
|
2302 ;; headers for it, so we'll have to get those.
|
|
|
2303 (when (stringp article)
|
|
|
2304 (let ((gnus-override-method gnus-refer-article-method))
|
|
|
2305 (gnus-read-header article)))
|
|
|
2306
|
|
|
2307 ;; If the article number is negative, that means that this article
|
|
|
2308 ;; doesn't belong in this newsgroup (possibly), so we find its
|
|
|
2309 ;; message-id and request it by id instead of number.
|
|
|
2310 (when (and (numberp article)
|
|
|
2311 gnus-summary-buffer
|
|
|
2312 (get-buffer gnus-summary-buffer)
|
|
|
2313 (buffer-name (get-buffer gnus-summary-buffer)))
|
|
|
2314 (save-excursion
|
|
|
2315 (set-buffer gnus-summary-buffer)
|
|
|
2316 (let ((header (gnus-summary-article-header article)))
|
|
|
2317 (when (< article 0)
|
|
108
|
2318 (cond
|
|
98
|
2319 ((memq article gnus-newsgroup-sparse)
|
|
|
2320 ;; This is a sparse gap article.
|
|
|
2321 (setq do-update-line article)
|
|
|
2322 (setq article (mail-header-id header))
|
|
|
2323 (let ((gnus-override-method gnus-refer-article-method))
|
|
|
2324 (gnus-read-header article))
|
|
|
2325 (setq gnus-newsgroup-sparse
|
|
|
2326 (delq article gnus-newsgroup-sparse)))
|
|
|
2327 ((vectorp header)
|
|
|
2328 ;; It's a real article.
|
|
|
2329 (setq article (mail-header-id header)))
|
|
|
2330 (t
|
|
|
2331 ;; It is an extracted pseudo-article.
|
|
|
2332 (setq article 'pseudo)
|
|
|
2333 (gnus-request-pseudo-article header))))
|
|
108
|
2334
|
|
|
2335 (let ((method (gnus-find-method-for-group
|
|
98
|
2336 gnus-newsgroup-name)))
|
|
|
2337 (if (not (eq (car method) 'nneething))
|
|
|
2338 ()
|
|
|
2339 (let ((dir (concat (file-name-as-directory (nth 1 method))
|
|
|
2340 (mail-header-subject header))))
|
|
|
2341 (when (file-directory-p dir)
|
|
|
2342 (setq article 'nneething)
|
|
|
2343 (gnus-group-enter-directory dir))))))))
|
|
|
2344
|
|
|
2345 (cond
|
|
|
2346 ;; Refuse to select canceled articles.
|
|
|
2347 ((and (numberp article)
|
|
|
2348 gnus-summary-buffer
|
|
|
2349 (get-buffer gnus-summary-buffer)
|
|
|
2350 (buffer-name (get-buffer gnus-summary-buffer))
|
|
|
2351 (eq (cdr (save-excursion
|
|
|
2352 (set-buffer gnus-summary-buffer)
|
|
|
2353 (assq article gnus-newsgroup-reads)))
|
|
|
2354 gnus-canceled-mark))
|
|
|
2355 nil)
|
|
|
2356 ;; We first check `gnus-original-article-buffer'.
|
|
|
2357 ((and (get-buffer gnus-original-article-buffer)
|
|
|
2358 (numberp article)
|
|
|
2359 (save-excursion
|
|
|
2360 (set-buffer gnus-original-article-buffer)
|
|
|
2361 (and (equal (car gnus-original-article) group)
|
|
|
2362 (eq (cdr gnus-original-article) article))))
|
|
|
2363 (insert-buffer-substring gnus-original-article-buffer)
|
|
|
2364 'article)
|
|
|
2365 ;; Check the backlog.
|
|
|
2366 ((and gnus-keep-backlog
|
|
|
2367 (gnus-backlog-request-article group article (current-buffer)))
|
|
|
2368 'article)
|
|
|
2369 ;; Check asynchronous pre-fetch.
|
|
|
2370 ((gnus-async-request-fetched-article group article (current-buffer))
|
|
|
2371 (gnus-async-prefetch-next group article gnus-summary-buffer)
|
|
|
2372 'article)
|
|
|
2373 ;; Check the cache.
|
|
|
2374 ((and gnus-use-cache
|
|
|
2375 (numberp article)
|
|
|
2376 (gnus-cache-request-article article group))
|
|
|
2377 'article)
|
|
|
2378 ;; Get the article and put into the article buffer.
|
|
|
2379 ((or (stringp article) (numberp article))
|
|
|
2380 (let ((gnus-override-method
|
|
|
2381 (and (stringp article) gnus-refer-article-method))
|
|
|
2382 (buffer-read-only nil))
|
|
|
2383 (erase-buffer)
|
|
|
2384 (gnus-kill-all-overlays)
|
|
|
2385 (when (gnus-request-article article group (current-buffer))
|
|
|
2386 (when (numberp article)
|
|
|
2387 (gnus-async-prefetch-next group article gnus-summary-buffer)
|
|
|
2388 (when gnus-keep-backlog
|
|
108
|
2389 (gnus-backlog-enter-article
|
|
98
|
2390 group article (current-buffer))))
|
|
|
2391 'article)))
|
|
|
2392 ;; It was a pseudo.
|
|
|
2393 (t article)))
|
|
|
2394
|
|
|
2395 ;; Take the article from the original article buffer
|
|
|
2396 ;; and place it in the buffer it's supposed to be in.
|
|
|
2397 (when (and (get-buffer gnus-article-buffer)
|
|
|
2398 ;;(numberp article)
|
|
|
2399 (equal (buffer-name (current-buffer))
|
|
|
2400 (buffer-name (get-buffer gnus-article-buffer))))
|
|
|
2401 (save-excursion
|
|
|
2402 (if (get-buffer gnus-original-article-buffer)
|
|
|
2403 (set-buffer (get-buffer gnus-original-article-buffer))
|
|
|
2404 (set-buffer (get-buffer-create gnus-original-article-buffer))
|
|
|
2405 (buffer-disable-undo (current-buffer))
|
|
|
2406 (setq major-mode 'gnus-original-article-mode)
|
|
|
2407 (setq buffer-read-only t)
|
|
|
2408 (gnus-add-current-to-buffer-list))
|
|
|
2409 (let (buffer-read-only)
|
|
|
2410 (erase-buffer)
|
|
|
2411 (insert-buffer-substring gnus-article-buffer))
|
|
|
2412 (setq gnus-original-article (cons group article))))
|
|
108
|
2413
|
|
98
|
2414 ;; Update sparse articles.
|
|
|
2415 (when (and do-update-line
|
|
|
2416 (or (numberp article)
|
|
|
2417 (stringp article)))
|
|
|
2418 (let ((buf (current-buffer)))
|
|
|
2419 (set-buffer gnus-summary-buffer)
|
|
|
2420 (gnus-summary-update-article do-update-line)
|
|
|
2421 (gnus-summary-goto-subject do-update-line nil t)
|
|
|
2422 (set-window-point (get-buffer-window (current-buffer) t)
|
|
|
2423 (point))
|
|
|
2424 (set-buffer buf))))))
|
|
|
2425
|
|
|
2426 ;;;
|
|
|
2427 ;;; Article editing
|
|
|
2428 ;;;
|
|
|
2429
|
|
|
2430 (defcustom gnus-article-edit-mode-hook nil
|
|
|
2431 "Hook run in article edit mode buffers."
|
|
|
2432 :group 'gnus-article-various
|
|
|
2433 :type 'hook)
|
|
|
2434
|
|
|
2435 (defvar gnus-article-edit-done-function nil)
|
|
|
2436
|
|
|
2437 (defvar gnus-article-edit-mode-map nil)
|
|
|
2438
|
|
108
|
2439 (unless gnus-article-edit-mode-map
|
|
98
|
2440 (setq gnus-article-edit-mode-map (copy-keymap text-mode-map))
|
|
|
2441
|
|
|
2442 (gnus-define-keys gnus-article-edit-mode-map
|
|
|
2443 "\C-c\C-c" gnus-article-edit-done
|
|
|
2444 "\C-c\C-k" gnus-article-edit-exit)
|
|
|
2445
|
|
|
2446 (gnus-define-keys (gnus-article-edit-wash-map
|
|
|
2447 "\C-c\C-w" gnus-article-edit-mode-map)
|
|
|
2448 "f" gnus-article-edit-full-stops))
|
|
|
2449
|
|
|
2450 (defun gnus-article-edit-mode ()
|
|
|
2451 "Major mode for editing articles.
|
|
|
2452 This is an extended text-mode.
|
|
|
2453
|
|
|
2454 \\{gnus-article-edit-mode-map}"
|
|
|
2455 (interactive)
|
|
|
2456 (kill-all-local-variables)
|
|
|
2457 (setq major-mode 'gnus-article-edit-mode)
|
|
|
2458 (setq mode-name "Article Edit")
|
|
|
2459 (use-local-map gnus-article-edit-mode-map)
|
|
|
2460 (make-local-variable 'gnus-article-edit-done-function)
|
|
|
2461 (make-local-variable 'gnus-prev-winconf)
|
|
|
2462 (setq buffer-read-only nil)
|
|
|
2463 (buffer-enable-undo)
|
|
|
2464 (widen)
|
|
|
2465 (run-hooks 'text-mode 'gnus-article-edit-mode-hook))
|
|
|
2466
|
|
|
2467 (defun gnus-article-edit (&optional force)
|
|
|
2468 "Edit the current article.
|
|
|
2469 This will have permanent effect only in mail groups.
|
|
|
2470 If FORCE is non-nil, allow editing of articles even in read-only
|
|
|
2471 groups."
|
|
|
2472 (interactive "P")
|
|
|
2473 (when (and (not force)
|
|
|
2474 (gnus-group-read-only-p))
|
|
|
2475 (error "The current newsgroup does not support article editing."))
|
|
|
2476 (gnus-article-edit-article
|
|
|
2477 `(lambda ()
|
|
|
2478 (gnus-summary-edit-article-done
|
|
|
2479 ,(or (mail-header-references gnus-current-headers) "")
|
|
|
2480 ,(gnus-group-read-only-p) ,gnus-summary-buffer))))
|
|
|
2481
|
|
|
2482 (defun gnus-article-edit-article (exit-func)
|
|
|
2483 "Start editing the contents of the current article buffer."
|
|
|
2484 (let ((winconf (current-window-configuration)))
|
|
|
2485 (set-buffer gnus-article-buffer)
|
|
|
2486 (gnus-article-edit-mode)
|
|
144
|
2487 (gnus-set-text-properties (point-min) (point-max) nil)
|
|
98
|
2488 (gnus-configure-windows 'edit-article)
|
|
|
2489 (setq gnus-article-edit-done-function exit-func)
|
|
|
2490 (setq gnus-prev-winconf winconf)
|
|
|
2491 (gnus-message 6 "C-c C-c to end edits")))
|
|
|
2492
|
|
|
2493 (defun gnus-article-edit-done ()
|
|
|
2494 "Update the article edits and exit."
|
|
|
2495 (interactive)
|
|
|
2496 (let ((func gnus-article-edit-done-function)
|
|
|
2497 (buf (current-buffer))
|
|
|
2498 (start (window-start)))
|
|
|
2499 (gnus-article-edit-exit)
|
|
|
2500 (save-excursion
|
|
|
2501 (set-buffer buf)
|
|
|
2502 (let ((buffer-read-only nil))
|
|
|
2503 (funcall func)))
|
|
|
2504 (set-buffer buf)
|
|
|
2505 (set-window-start (get-buffer-window buf) start)
|
|
|
2506 (set-window-point (get-buffer-window buf) (point))))
|
|
|
2507
|
|
|
2508 (defun gnus-article-edit-exit ()
|
|
|
2509 "Exit the article editing without updating."
|
|
|
2510 (interactive)
|
|
|
2511 ;; We remove all text props from the article buffer.
|
|
|
2512 (let ((buf (format "%s" (buffer-string)))
|
|
|
2513 (curbuf (current-buffer))
|
|
|
2514 (p (point))
|
|
|
2515 (window-start (window-start)))
|
|
|
2516 (erase-buffer)
|
|
|
2517 (insert buf)
|
|
|
2518 (let ((winconf gnus-prev-winconf))
|
|
|
2519 (gnus-article-mode)
|
|
|
2520 ;; The cache and backlog have to be flushed somewhat.
|
|
|
2521 (when gnus-use-cache
|
|
108
|
2522 (gnus-cache-update-article
|
|
98
|
2523 (car gnus-article-current) (cdr gnus-article-current)))
|
|
|
2524 (when gnus-keep-backlog
|
|
108
|
2525 (gnus-backlog-remove-article
|
|
98
|
2526 (car gnus-article-current) (cdr gnus-article-current)))
|
|
|
2527 ;; Flush original article as well.
|
|
|
2528 (save-excursion
|
|
|
2529 (when (get-buffer gnus-original-article-buffer)
|
|
|
2530 (set-buffer gnus-original-article-buffer)
|
|
|
2531 (setq gnus-original-article nil)))
|
|
|
2532 (set-window-configuration winconf)
|
|
|
2533 ;; Tippy-toe some to make sure that point remains where it was.
|
|
|
2534 (let ((buf (current-buffer)))
|
|
|
2535 (set-buffer curbuf)
|
|
|
2536 (set-window-start (get-buffer-window (current-buffer)) window-start)
|
|
|
2537 (goto-char p)
|
|
|
2538 (set-buffer buf)))))
|
|
108
|
2539
|
|
98
|
2540 (defun gnus-article-edit-full-stops ()
|
|
|
2541 "Interactively repair spacing at end of sentences."
|
|
|
2542 (interactive)
|
|
|
2543 (save-excursion
|
|
|
2544 (goto-char (point-min))
|
|
|
2545 (search-forward-regexp "^$" nil t)
|
|
|
2546 (let ((case-fold-search nil))
|
|
|
2547 (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2"))))
|
|
|
2548
|
|
108
|
2549 ;;;
|
|
98
|
2550 ;;; Article highlights
|
|
|
2551 ;;;
|
|
|
2552
|
|
|
2553 ;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
|
|
|
2554
|
|
|
2555 ;;; Internal Variables:
|
|
|
2556
|
|
|
2557 (defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
|
|
|
2558 "Regular expression that matches URLs."
|
|
|
2559 :group 'gnus-article-buttons
|
|
|
2560 :type 'regexp)
|
|
|
2561
|
|
108
|
2562 (defcustom gnus-button-alist
|
|
100
|
2563 `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t
|
|
|
2564 gnus-button-message-id 2)
|
|
153
|
2565 ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1)
|
|
98
|
2566 ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
|
|
|
2567 gnus-button-fetch-group 4)
|
|
|
2568 ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
|
|
108
|
2569 ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
|
|
98
|
2570 t gnus-button-message-id 3)
|
|
|
2571 ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 1)
|
|
|
2572 ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2)
|
|
|
2573 ;; This is how URLs _should_ be embedded in text...
|
|
|
2574 ("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
|
|
|
2575 ;; Raw URLs.
|
|
|
2576 (,gnus-button-url-regexp 0 t gnus-button-url 0))
|
|
|
2577 "Alist of regexps matching buttons in article bodies.
|
|
|
2578
|
|
|
2579 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
|
|
|
2580 REGEXP: is the string matching text around the button,
|
|
|
2581 BUTTON: is the number of the regexp grouping actually matching the button,
|
|
|
2582 FORM: is a lisp expression which must eval to true for the button to
|
|
108
|
2583 be added,
|
|
98
|
2584 CALLBACK: is the function to call when the user push this button, and each
|
|
|
2585 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
|
|
|
2586
|
|
|
2587 CALLBACK can also be a variable, in that case the value of that
|
|
|
2588 variable it the real callback function."
|
|
|
2589 :group 'gnus-article-buttons
|
|
108
|
2590 :type '(repeat (list regexp
|
|
98
|
2591 (integer :tag "Button")
|
|
|
2592 (sexp :tag "Form")
|
|
|
2593 (function :tag "Callback")
|
|
|
2594 (repeat :tag "Par"
|
|
|
2595 :inline t
|
|
|
2596 (integer :tag "Regexp group")))))
|
|
|
2597
|
|
108
|
2598 (defcustom gnus-header-button-alist
|
|
98
|
2599 `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
|
|
|
2600 0 t gnus-button-message-id 0)
|
|
|
2601 ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
|
|
108
|
2602 ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
|
|
98
|
2603 0 t gnus-button-mailto 0)
|
|
|
2604 ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
|
|
155
|
2605 ("^Subject:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
|
|
98
|
2606 ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
|
|
|
2607 ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
|
|
|
2608 gnus-button-message-id 3))
|
|
|
2609 "Alist of headers and regexps to match buttons in article heads.
|
|
|
2610
|
|
|
2611 This alist is very similar to `gnus-button-alist', except that each
|
|
|
2612 alist has an additional HEADER element first in each entry:
|
|
|
2613
|
|
|
2614 \(HEADER REGEXP BUTTON FORM CALLBACK PAR)
|
|
|
2615
|
|
|
2616 HEADER is a regexp to match a header. For a fuller explanation, see
|
|
|
2617 `gnus-button-alist'."
|
|
|
2618 :group 'gnus-article-buttons
|
|
|
2619 :group 'gnus-article-headers
|
|
|
2620 :type '(repeat (list (regexp :tag "Header")
|
|
108
|
2621 regexp
|
|
98
|
2622 (integer :tag "Button")
|
|
|
2623 (sexp :tag "Form")
|
|
|
2624 (function :tag "Callback")
|
|
|
2625 (repeat :tag "Par"
|
|
|
2626 :inline t
|
|
|
2627 (integer :tag "Regexp group")))))
|
|
|
2628
|
|
|
2629 (defvar gnus-button-regexp nil)
|
|
|
2630 (defvar gnus-button-marker-list nil)
|
|
|
2631 ;; Regexp matching any of the regexps from `gnus-button-alist'.
|
|
|
2632
|
|
|
2633 (defvar gnus-button-last nil)
|
|
|
2634 ;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
|
|
|
2635
|
|
|
2636 ;;; Commands:
|
|
|
2637
|
|
|
2638 (defun gnus-article-push-button (event)
|
|
|
2639 "Check text under the mouse pointer for a callback function.
|
|
|
2640 If the text under the mouse pointer has a `gnus-callback' property,
|
|
|
2641 call it with the value of the `gnus-data' text property."
|
|
|
2642 (interactive "e")
|
|
|
2643 (set-buffer (window-buffer (posn-window (event-start event))))
|
|
|
2644 (let* ((pos (posn-point (event-start event)))
|
|
|
2645 (data (get-text-property pos 'gnus-data))
|
|
|
2646 (fun (get-text-property pos 'gnus-callback)))
|
|
|
2647 (when fun
|
|
|
2648 (funcall fun data))))
|
|
|
2649
|
|
|
2650 (defun gnus-article-press-button ()
|
|
|
2651 "Check text at point for a callback function.
|
|
|
2652 If the text at point has a `gnus-callback' property,
|
|
|
2653 call it with the value of the `gnus-data' text property."
|
|
|
2654 (interactive)
|
|
|
2655 (let* ((data (get-text-property (point) 'gnus-data))
|
|
|
2656 (fun (get-text-property (point) 'gnus-callback)))
|
|
|
2657 (when fun
|
|
|
2658 (funcall fun data))))
|
|
|
2659
|
|
|
2660 (defun gnus-article-prev-button (n)
|
|
|
2661 "Move point to N buttons backward.
|
|
|
2662 If N is negative, move forward instead."
|
|
|
2663 (interactive "p")
|
|
|
2664 (gnus-article-next-button (- n)))
|
|
|
2665
|
|
|
2666 (defun gnus-article-next-button (n)
|
|
|
2667 "Move point to N buttons forward.
|
|
|
2668 If N is negative, move backward instead."
|
|
|
2669 (interactive "p")
|
|
|
2670 (let ((function (if (< n 0) 'previous-single-property-change
|
|
|
2671 'next-single-property-change))
|
|
|
2672 (inhibit-point-motion-hooks t)
|
|
|
2673 (backward (< n 0))
|
|
|
2674 (limit (if (< n 0) (point-min) (point-max))))
|
|
|
2675 (setq n (abs n))
|
|
|
2676 (while (and (not (= limit (point)))
|
|
|
2677 (> n 0))
|
|
|
2678 ;; Skip past the current button.
|
|
|
2679 (when (get-text-property (point) 'gnus-callback)
|
|
|
2680 (goto-char (funcall function (point) 'gnus-callback nil limit)))
|
|
|
2681 ;; Go to the next (or previous) button.
|
|
|
2682 (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
|
|
|
2683 ;; Put point at the start of the button.
|
|
|
2684 (when (and backward (not (get-text-property (point) 'gnus-callback)))
|
|
|
2685 (goto-char (funcall function (point) 'gnus-callback nil limit)))
|
|
|
2686 ;; Skip past intangible buttons.
|
|
|
2687 (when (get-text-property (point) 'intangible)
|
|
|
2688 (incf n))
|
|
|
2689 (decf n))
|
|
|
2690 (unless (zerop n)
|
|
|
2691 (gnus-message 5 "No more buttons"))
|
|
|
2692 n))
|
|
|
2693
|
|
|
2694 (defun gnus-article-highlight (&optional force)
|
|
|
2695 "Highlight current article.
|
|
|
2696 This function calls `gnus-article-highlight-headers',
|
|
108
|
2697 `gnus-article-highlight-citation',
|
|
98
|
2698 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
|
|
|
2699 do the highlighting. See the documentation for those functions."
|
|
|
2700 (interactive (list 'force))
|
|
|
2701 (gnus-article-highlight-headers)
|
|
|
2702 (gnus-article-highlight-citation force)
|
|
|
2703 (gnus-article-highlight-signature)
|
|
|
2704 (gnus-article-add-buttons force)
|
|
|
2705 (gnus-article-add-buttons-to-head))
|
|
|
2706
|
|
|
2707 (defun gnus-article-highlight-some (&optional force)
|
|
|
2708 "Highlight current article.
|
|
|
2709 This function calls `gnus-article-highlight-headers',
|
|
|
2710 `gnus-article-highlight-signature', and `gnus-article-add-buttons' to
|
|
|
2711 do the highlighting. See the documentation for those functions."
|
|
|
2712 (interactive (list 'force))
|
|
|
2713 (gnus-article-highlight-headers)
|
|
|
2714 (gnus-article-highlight-signature)
|
|
|
2715 (gnus-article-add-buttons))
|
|
|
2716
|
|
|
2717 (defun gnus-article-highlight-headers ()
|
|
|
2718 "Highlight article headers as specified by `gnus-header-face-alist'."
|
|
|
2719 (interactive)
|
|
|
2720 (save-excursion
|
|
|
2721 (set-buffer gnus-article-buffer)
|
|
|
2722 (save-restriction
|
|
|
2723 (let ((alist gnus-header-face-alist)
|
|
|
2724 (buffer-read-only nil)
|
|
|
2725 (case-fold-search t)
|
|
|
2726 (inhibit-point-motion-hooks t)
|
|
|
2727 entry regexp header-face field-face from hpoints fpoints)
|
|
108
|
2728 (message-narrow-to-head)
|
|
|
2729 (while (setq entry (pop alist))
|
|
|
2730 (goto-char (point-min))
|
|
|
2731 (setq regexp (concat "^\\("
|
|
|
2732 (if (string-equal "" (nth 0 entry))
|
|
|
2733 "[^\t ]"
|
|
|
2734 (nth 0 entry))
|
|
|
2735 "\\)")
|
|
|
2736 header-face (nth 1 entry)
|
|
|
2737 field-face (nth 2 entry))
|
|
|
2738 (while (and (re-search-forward regexp nil t)
|
|
|
2739 (not (eobp)))
|
|
|
2740 (beginning-of-line)
|
|
|
2741 (setq from (point))
|
|
|
2742 (unless (search-forward ":" nil t)
|
|
|
2743 (forward-char 1))
|
|
|
2744 (when (and header-face
|
|
|
2745 (not (memq (point) hpoints)))
|
|
|
2746 (push (point) hpoints)
|
|
|
2747 (gnus-put-text-property from (point) 'face header-face))
|
|
|
2748 (when (and field-face
|
|
|
2749 (not (memq (setq from (point)) fpoints)))
|
|
|
2750 (push from fpoints)
|
|
|
2751 (if (re-search-forward "^[^ \t]" nil t)
|
|
|
2752 (forward-char -2)
|
|
|
2753 (goto-char (point-max)))
|
|
|
2754 (gnus-put-text-property from (point) 'face field-face))))))))
|
|
98
|
2755
|
|
|
2756 (defun gnus-article-highlight-signature ()
|
|
|
2757 "Highlight the signature in an article.
|
|
|
2758 It does this by highlighting everything after
|
|
108
|
2759 `gnus-signature-separator' using `gnus-signature-face'."
|
|
98
|
2760 (interactive)
|
|
|
2761 (save-excursion
|
|
|
2762 (set-buffer gnus-article-buffer)
|
|
|
2763 (let ((buffer-read-only nil)
|
|
|
2764 (inhibit-point-motion-hooks t))
|
|
|
2765 (save-restriction
|
|
|
2766 (when (and gnus-signature-face
|
|
|
2767 (gnus-article-narrow-to-signature))
|
|
|
2768 (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
|
|
|
2769 'face gnus-signature-face)
|
|
|
2770 (widen)
|
|
|
2771 (gnus-article-search-signature)
|
|
|
2772 (let ((start (match-beginning 0))
|
|
|
2773 (end (set-marker (make-marker) (1+ (match-end 0)))))
|
|
|
2774 (gnus-article-add-button start (1- end) 'gnus-signature-toggle
|
|
|
2775 end)))))))
|
|
|
2776
|
|
100
|
2777 (defun gnus-button-in-region-p (b e prop)
|
|
|
2778 "Say whether PROP exists in the region."
|
|
|
2779 (text-property-not-all b e prop nil))
|
|
|
2780
|
|
98
|
2781 (defun gnus-article-add-buttons (&optional force)
|
|
|
2782 "Find external references in the article and make buttons of them.
|
|
|
2783 \"External references\" are things like Message-IDs and URLs, as
|
|
|
2784 specified by `gnus-button-alist'."
|
|
|
2785 (interactive (list 'force))
|
|
|
2786 (save-excursion
|
|
|
2787 (set-buffer gnus-article-buffer)
|
|
|
2788 (let ((buffer-read-only nil)
|
|
|
2789 (inhibit-point-motion-hooks t)
|
|
|
2790 (case-fold-search t)
|
|
|
2791 (alist gnus-button-alist)
|
|
|
2792 beg entry regexp)
|
|
108
|
2793 ;; Remove all old markers.
|
|
|
2794 (let (marker entry)
|
|
|
2795 (while (setq marker (pop gnus-button-marker-list))
|
|
|
2796 (goto-char marker)
|
|
|
2797 (when (setq entry (gnus-button-entry))
|
|
|
2798 (put-text-property (match-beginning (nth 1 entry))
|
|
|
2799 (match-end (nth 1 entry))
|
|
|
2800 'gnus-callback nil))
|
|
|
2801 (set-marker marker nil)))
|
|
|
2802 ;; We skip the headers.
|
|
98
|
2803 (goto-char (point-min))
|
|
|
2804 (unless (search-forward "\n\n" nil t)
|
|
|
2805 (goto-char (point-max)))
|
|
|
2806 (setq beg (point))
|
|
|
2807 (while (setq entry (pop alist))
|
|
|
2808 (setq regexp (car entry))
|
|
|
2809 (goto-char beg)
|
|
|
2810 (while (re-search-forward regexp nil t)
|
|
|
2811 (let* ((start (and entry (match-beginning (nth 1 entry))))
|
|
|
2812 (end (and entry (match-end (nth 1 entry))))
|
|
|
2813 (from (match-beginning 0)))
|
|
118
|
2814 (when (and (or (eq t (nth 2 entry))
|
|
|
2815 (eval (nth 2 entry)))
|
|
104
|
2816 (not (gnus-button-in-region-p
|
|
|
2817 start end 'gnus-callback)))
|
|
98
|
2818 ;; That optional form returned non-nil, so we add the
|
|
104
|
2819 ;; button.
|
|
108
|
2820 (gnus-article-add-button
|
|
|
2821 start end 'gnus-button-push
|
|
98
|
2822 (car (push (set-marker (make-marker) from)
|
|
|
2823 gnus-button-marker-list))))))))))
|
|
|
2824
|
|
|
2825 ;; Add buttons to the head of an article.
|
|
|
2826 (defun gnus-article-add-buttons-to-head ()
|
|
|
2827 "Add buttons to the head of the article."
|
|
|
2828 (interactive)
|
|
|
2829 (save-excursion
|
|
|
2830 (set-buffer gnus-article-buffer)
|
|
|
2831 (let ((buffer-read-only nil)
|
|
|
2832 (inhibit-point-motion-hooks t)
|
|
|
2833 (case-fold-search t)
|
|
|
2834 (alist gnus-header-button-alist)
|
|
|
2835 entry beg end)
|
|
|
2836 (nnheader-narrow-to-headers)
|
|
|
2837 (while alist
|
|
|
2838 ;; Each alist entry.
|
|
|
2839 (setq entry (car alist)
|
|
|
2840 alist (cdr alist))
|
|
|
2841 (goto-char (point-min))
|
|
|
2842 (while (re-search-forward (car entry) nil t)
|
|
|
2843 ;; Each header matching the entry.
|
|
|
2844 (setq beg (match-beginning 0))
|
|
|
2845 (setq end (or (and (re-search-forward "^[^ \t]" nil t)
|
|
|
2846 (match-beginning 0))
|
|
|
2847 (point-max)))
|
|
|
2848 (goto-char beg)
|
|
|
2849 (while (re-search-forward (nth 1 entry) end t)
|
|
|
2850 ;; Each match within a header.
|
|
|
2851 (let* ((entry (cdr entry))
|
|
|
2852 (start (match-beginning (nth 1 entry)))
|
|
|
2853 (end (match-end (nth 1 entry)))
|
|
|
2854 (form (nth 2 entry)))
|
|
|
2855 (goto-char (match-end 0))
|
|
|
2856 (when (eval form)
|
|
108
|
2857 (gnus-article-add-button
|
|
98
|
2858 start end (nth 3 entry)
|
|
|
2859 (buffer-substring (match-beginning (nth 4 entry))
|
|
|
2860 (match-end (nth 4 entry)))))))
|
|
|
2861 (goto-char end))))
|
|
|
2862 (widen)))
|
|
|
2863
|
|
|
2864 ;;; External functions:
|
|
|
2865
|
|
|
2866 (defun gnus-article-add-button (from to fun &optional data)
|
|
|
2867 "Create a button between FROM and TO with callback FUN and data DATA."
|
|
|
2868 (when gnus-article-button-face
|
|
|
2869 (gnus-overlay-put (gnus-make-overlay from to)
|
|
|
2870 'face gnus-article-button-face))
|
|
108
|
2871 (gnus-add-text-properties
|
|
98
|
2872 from to
|
|
|
2873 (nconc (and gnus-article-mouse-face
|
|
|
2874 (list gnus-mouse-face-prop gnus-article-mouse-face))
|
|
|
2875 (list 'gnus-callback fun)
|
|
|
2876 (and data (list 'gnus-data data)))))
|
|
|
2877
|
|
|
2878 ;;; Internal functions:
|
|
|
2879
|
|
|
2880 (defun gnus-signature-toggle (end)
|
|
|
2881 (save-excursion
|
|
|
2882 (set-buffer gnus-article-buffer)
|
|
|
2883 (let ((buffer-read-only nil)
|
|
|
2884 (inhibit-point-motion-hooks t))
|
|
|
2885 (if (get-text-property end 'invisible)
|
|
|
2886 (gnus-article-unhide-text end (point-max))
|
|
|
2887 (gnus-article-hide-text end (point-max) gnus-hidden-properties)))))
|
|
|
2888
|
|
|
2889 (defun gnus-button-entry ()
|
|
|
2890 ;; Return the first entry in `gnus-button-alist' matching this place.
|
|
|
2891 (let ((alist gnus-button-alist)
|
|
|
2892 (entry nil))
|
|
|
2893 (while alist
|
|
|
2894 (setq entry (pop alist))
|
|
|
2895 (if (looking-at (car entry))
|
|
|
2896 (setq alist nil)
|
|
|
2897 (setq entry nil)))
|
|
|
2898 entry))
|
|
|
2899
|
|
|
2900 (defun gnus-button-push (marker)
|
|
|
2901 ;; Push button starting at MARKER.
|
|
|
2902 (save-excursion
|
|
|
2903 (set-buffer gnus-article-buffer)
|
|
|
2904 (goto-char marker)
|
|
|
2905 (let* ((entry (gnus-button-entry))
|
|
|
2906 (inhibit-point-motion-hooks t)
|
|
|
2907 (fun (nth 3 entry))
|
|
|
2908 (args (mapcar (lambda (group)
|
|
|
2909 (let ((string (match-string group)))
|
|
|
2910 (gnus-set-text-properties
|
|
|
2911 0 (length string) nil string)
|
|
|
2912 string))
|
|
|
2913 (nthcdr 4 entry))))
|
|
|
2914 (cond
|
|
|
2915 ((fboundp fun)
|
|
|
2916 (apply fun args))
|
|
|
2917 ((and (boundp fun)
|
|
|
2918 (fboundp (symbol-value fun)))
|
|
|
2919 (apply (symbol-value fun) args))
|
|
|
2920 (t
|
|
|
2921 (gnus-message 1 "You must define `%S' to use this button"
|
|
|
2922 (cons fun args)))))))
|
|
|
2923
|
|
|
2924 (defun gnus-button-message-id (message-id)
|
|
|
2925 "Fetch MESSAGE-ID."
|
|
|
2926 (save-excursion
|
|
|
2927 (set-buffer gnus-summary-buffer)
|
|
|
2928 (gnus-summary-refer-article message-id)))
|
|
|
2929
|
|
|
2930 (defun gnus-button-fetch-group (address)
|
|
|
2931 "Fetch GROUP specified by ADDRESS."
|
|
100
|
2932 (if (not (string-match "[:/]" address))
|
|
|
2933 ;; This is just a simple group url.
|
|
|
2934 (gnus-group-read-ephemeral-group address gnus-select-method)
|
|
|
2935 (if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$"
|
|
|
2936 address))
|
|
|
2937 (error "Can't parse %s" address)
|
|
|
2938 (gnus-group-read-ephemeral-group
|
|
|
2939 (match-string 4 address)
|
|
|
2940 `(nntp ,(match-string 1 address)
|
|
|
2941 (nntp-address ,(match-string 1 address))
|
|
|
2942 (nntp-port-number ,(if (match-end 3)
|
|
|
2943 (match-string 3 address)
|
|
|
2944 "nntp")))))))
|
|
98
|
2945
|
|
|
2946 (defun gnus-split-string (string pattern)
|
|
|
2947 "Return a list of substrings of STRING which are separated by PATTERN."
|
|
|
2948 (let (parts (start 0))
|
|
|
2949 (while (string-match pattern string start)
|
|
|
2950 (setq parts (cons (substring string start (match-beginning 0)) parts)
|
|
|
2951 start (match-end 0)))
|
|
|
2952 (nreverse (cons (substring string start) parts))))
|
|
108
|
2953
|
|
98
|
2954 (defun gnus-url-parse-query-string (query &optional downcase)
|
|
|
2955 (let (retval pairs cur key val)
|
|
|
2956 (setq pairs (gnus-split-string query "&"))
|
|
|
2957 (while pairs
|
|
|
2958 (setq cur (car pairs)
|
|
|
2959 pairs (cdr pairs))
|
|
|
2960 (if (not (string-match "=" cur))
|
|
|
2961 nil ; Grace
|
|
|
2962 (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
|
|
|
2963 val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
|
|
|
2964 (if downcase
|
|
|
2965 (setq key (downcase key)))
|
|
|
2966 (setq cur (assoc key retval))
|
|
|
2967 (if cur
|
|
|
2968 (setcdr cur (cons val (cdr cur)))
|
|
|
2969 (setq retval (cons (list key val) retval)))))
|
|
|
2970 retval))
|
|
108
|
2971
|
|
98
|
2972 (defun gnus-url-unhex (x)
|
|
|
2973 (if (> x ?9)
|
|
|
2974 (if (>= x ?a)
|
|
|
2975 (+ 10 (- x ?a))
|
|
|
2976 (+ 10 (- x ?A)))
|
|
|
2977 (- x ?0)))
|
|
108
|
2978
|
|
98
|
2979 (defun gnus-url-unhex-string (str &optional allow-newlines)
|
|
|
2980 "Remove %XXX embedded spaces, etc in a url.
|
|
|
2981 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
|
|
|
2982 decoding of carriage returns and line feeds in the string, which is normally
|
|
|
2983 forbidden in URL encoding."
|
|
|
2984 (setq str (or str ""))
|
|
|
2985 (let ((tmp "")
|
|
|
2986 (case-fold-search t))
|
|
|
2987 (while (string-match "%[0-9a-f][0-9a-f]" str)
|
|
|
2988 (let* ((start (match-beginning 0))
|
|
|
2989 (ch1 (gnus-url-unhex (elt str (+ start 1))))
|
|
|
2990 (code (+ (* 16 ch1)
|
|
|
2991 (gnus-url-unhex (elt str (+ start 2))))))
|
|
108
|
2992 (setq tmp (concat
|
|
98
|
2993 tmp (substring str 0 start)
|
|
|
2994 (cond
|
|
|
2995 (allow-newlines
|
|
|
2996 (char-to-string code))
|
|
|
2997 ((or (= code ?\n) (= code ?\r))
|
|
|
2998 " ")
|
|
|
2999 (t (char-to-string code))))
|
|
|
3000 str (substring str (match-end 0)))))
|
|
|
3001 (setq tmp (concat tmp str))
|
|
|
3002 tmp))
|
|
108
|
3003
|
|
98
|
3004 (defun gnus-url-mailto (url)
|
|
|
3005 ;; Send mail to someone
|
|
|
3006 (when (string-match "mailto:/*\\(.*\\)" url)
|
|
|
3007 (setq url (substring url (match-beginning 1) nil)))
|
|
|
3008 (let (to args source-url subject func)
|
|
|
3009 (if (string-match (regexp-quote "?") url)
|
|
|
3010 (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
|
|
|
3011 args (gnus-url-parse-query-string
|
|
|
3012 (substring url (match-end 0) nil) t))
|
|
|
3013 (setq to (gnus-url-unhex-string url)))
|
|
|
3014 (setq args (cons (list "to" to) args)
|
|
|
3015 subject (cdr-safe (assoc "subject" args)))
|
|
|
3016 (message-mail)
|
|
|
3017 (while args
|
|
|
3018 (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
|
|
|
3019 (if (fboundp func)
|
|
|
3020 (funcall func)
|
|
|
3021 (message-position-on-field (caar args)))
|
|
|
3022 (insert (mapconcat 'identity (cdar args) ", "))
|
|
|
3023 (setq args (cdr args)))
|
|
|
3024 (if subject
|
|
|
3025 (message-goto-body)
|
|
|
3026 (message-goto-subject))))
|
|
|
3027
|
|
|
3028 (defun gnus-button-mailto (address)
|
|
|
3029 ;; Mail to ADDRESS.
|
|
|
3030 (set-buffer (gnus-copy-article-buffer))
|
|
|
3031 (message-reply address))
|
|
|
3032
|
|
|
3033 (defun gnus-button-reply (address)
|
|
|
3034 ;; Reply to ADDRESS.
|
|
|
3035 (message-reply address))
|
|
|
3036
|
|
|
3037 (defun gnus-button-url (address)
|
|
|
3038 "Browse ADDRESS."
|
|
|
3039 (funcall browse-url-browser-function address))
|
|
|
3040
|
|
|
3041 (defun gnus-button-embedded-url (address)
|
|
|
3042 "Browse ADDRESS."
|
|
|
3043 (funcall browse-url-browser-function (gnus-strip-whitespace address)))
|
|
|
3044
|
|
|
3045 ;;; Next/prev buttons in the article buffer.
|
|
|
3046
|
|
|
3047 (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
|
|
|
3048 (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
|
|
|
3049
|
|
|
3050 (defvar gnus-prev-page-map nil)
|
|
|
3051 (unless gnus-prev-page-map
|
|
|
3052 (setq gnus-prev-page-map (make-sparse-keymap))
|
|
|
3053 (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
|
|
|
3054 (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
|
|
|
3055
|
|
|
3056 (defun gnus-insert-prev-page-button ()
|
|
|
3057 (let ((buffer-read-only nil))
|
|
108
|
3058 (gnus-eval-format
|
|
98
|
3059 gnus-prev-page-line-format nil
|
|
|
3060 `(gnus-prev t local-map ,gnus-prev-page-map
|
|
|
3061 gnus-callback gnus-article-button-prev-page))))
|
|
|
3062
|
|
|
3063 (defvar gnus-next-page-map nil)
|
|
|
3064 (unless gnus-next-page-map
|
|
|
3065 (setq gnus-next-page-map (make-keymap))
|
|
|
3066 (suppress-keymap gnus-prev-page-map)
|
|
|
3067 (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
|
|
|
3068 (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
|
|
|
3069
|
|
|
3070 (defun gnus-button-next-page ()
|
|
|
3071 "Go to the next page."
|
|
|
3072 (interactive)
|
|
|
3073 (let ((win (selected-window)))
|
|
|
3074 (select-window (get-buffer-window gnus-article-buffer t))
|
|
|
3075 (gnus-article-next-page)
|
|
|
3076 (select-window win)))
|
|
|
3077
|
|
|
3078 (defun gnus-button-prev-page ()
|
|
|
3079 "Go to the prev page."
|
|
|
3080 (interactive)
|
|
|
3081 (let ((win (selected-window)))
|
|
|
3082 (select-window (get-buffer-window gnus-article-buffer t))
|
|
|
3083 (gnus-article-prev-page)
|
|
|
3084 (select-window win)))
|
|
|
3085
|
|
|
3086 (defun gnus-insert-next-page-button ()
|
|
|
3087 (let ((buffer-read-only nil))
|
|
|
3088 (gnus-eval-format gnus-next-page-line-format nil
|
|
|
3089 `(gnus-next t local-map ,gnus-next-page-map
|
|
108
|
3090 gnus-callback
|
|
98
|
3091 gnus-article-button-next-page))))
|
|
|
3092
|
|
|
3093 (defun gnus-article-button-next-page (arg)
|
|
|
3094 "Go to the next page."
|
|
|
3095 (interactive "P")
|
|
|
3096 (let ((win (selected-window)))
|
|
|
3097 (select-window (get-buffer-window gnus-article-buffer t))
|
|
|
3098 (gnus-article-next-page)
|
|
|
3099 (select-window win)))
|
|
|
3100
|
|
|
3101 (defun gnus-article-button-prev-page (arg)
|
|
|
3102 "Go to the prev page."
|
|
|
3103 (interactive "P")
|
|
|
3104 (let ((win (selected-window)))
|
|
|
3105 (select-window (get-buffer-window gnus-article-buffer t))
|
|
|
3106 (gnus-article-prev-page)
|
|
108
|
3107 (select-window win)))
|
|
98
|
3108
|
|
|
3109 (gnus-ems-redefine)
|
|
|
3110
|
|
|
3111 (provide 'gnus-art)
|
|
|
3112
|
|
|
3113 (run-hooks 'gnus-art-load-hook)
|
|
|
3114
|
|
|
3115 ;;; gnus-art.el ends here
|
