257
|
1 ;;; GNUS: an NNTP-based News Reader for GNU Emacs
|
|
2 ;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD.
|
|
3 ;; Copyright (C) 1987, 1988, 1989, 1990 Masanobu UMEDA
|
|
4 ;; $Header: gnus.el,v 3.13 90/03/23 13:24:27 umerin Locked $
|
|
5
|
|
6 ;; This file is part of GNU Emacs.
|
|
7
|
|
8 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
9 ;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
10 ;; accepts responsibility to anyone for the consequences of using it
|
|
11 ;; or for whether it serves any particular purpose or works at all,
|
|
12 ;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
13 ;; License for full details.
|
|
14
|
|
15 ;; Everyone is granted permission to copy, modify and redistribute
|
|
16 ;; GNU Emacs, but only under the conditions described in the
|
|
17 ;; GNU Emacs General Public License. A copy of this license is
|
|
18 ;; supposed to have been given to you along with GNU Emacs so you
|
|
19 ;; can know your rights and responsibilities. It should be in a
|
|
20 ;; file named COPYING. Among other things, the copyright notice
|
|
21 ;; and this notice must be preserved on all copies.
|
|
22
|
|
23 ;; GNUS Mailing List:
|
|
24 ;; There are two mailing lists for GNUS lovers in the world:
|
|
25 ;;
|
|
26 ;; info-gnus@flab.fujitsu.co.jp, and
|
|
27 ;; info-gnus-english@tut.cis.ohio-state.edu.
|
|
28 ;;
|
|
29 ;; They are intended to exchange useful information about GNUS, such
|
|
30 ;; as bug fixes, useful hooks, and extensions. The major difference
|
|
31 ;; between the lists is what the official language is. Both Japanese
|
|
32 ;; and English are available in info-gnus, while English is only
|
|
33 ;; available in info-gnus-english. There is no need to subscribe to
|
|
34 ;; info-gnus if you cannot read Japanese messages, because most of the
|
|
35 ;; discussion and important announcements will be sent to
|
|
36 ;; info-gnus-english. Moreover, if you can read gnu.emacs.gnus
|
|
37 ;; newsgroup of USENET, you need not, either. info-gnus-english and
|
|
38 ;; gnu.emacs.gnus are linked each other.
|
|
39 ;;
|
|
40 ;; Please send subscription request to:
|
|
41 ;;
|
|
42 ;; info-gnus-request@flab.fujitsu.co.jp, or
|
|
43 ;; info-gnus-english-request@cis.ohio-state.edu
|
|
44
|
|
45 ;; TO DO:
|
|
46 ;; (1) Incremental update of active info.
|
|
47 ;; (2) GNUS own poster.
|
|
48 ;; (3) Multi-GNUS (Talking to many hosts same time).
|
|
49 ;; (4) Asynchronous transmission of large messages.
|
|
50
|
|
51 (provide 'gnus)
|
|
52 (require 'nntp)
|
|
53 (require 'mail-utils)
|
|
54
|
|
55 (defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server)
|
|
56 "The name of the host running NNTP server.
|
|
57 If it is a string such as `:DIRECTORY', the user's private DIRECTORY
|
|
58 is used as a news spool.
|
|
59 Initialized from the NNTPSERVER environment variable.")
|
|
60
|
|
61 (defvar gnus-signature-file "~/.signature"
|
|
62 "*Your .signature file. Use `.signature-DISTRIBUTION' instead if exists.")
|
|
63
|
|
64 (defvar gnus-use-cross-reference t
|
|
65 "Specifies what to do with cross references (Xref: field).
|
|
66 If nil, ignore cross references. If t, mark articles as read in subscribed
|
|
67 newsgroups. Otherwise, mark articles as read in all newsgroups.")
|
|
68
|
|
69 (defvar gnus-use-followup-to t
|
|
70 "*Specifies what to do with Followup-To: field.
|
|
71 If nil, ignore followup-to: field. If t, use its value execpt for
|
|
72 `poster'. Otherewise, if not nil nor t, always use its value.")
|
|
73
|
|
74 (defvar gnus-large-newsgroup 50
|
|
75 "*The number of articles which indicates a large newsgroup.
|
|
76 If the number of articles in a newsgroup is greater than the value,
|
|
77 confirmation is required for selecting the newsgroup.")
|
|
78
|
|
79 (defvar gnus-author-copy (getenv "AUTHORCOPY")
|
|
80 "*Filename for saving a copy of an article posted using FCC: field.
|
|
81 Initialized from the AUTHORCOPY environment variable.
|
|
82
|
|
83 Articles are saved using a function specified by the the variable
|
|
84 `gnus-author-copy-saver' (`rmail-output' is the default) if a file name
|
|
85 is given. Instead, if the first character of the name is `|', the
|
|
86 contents of the article is piped out to the named program. It is
|
|
87 possible to save an article in an MH folder as follows:
|
|
88
|
|
89 (setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
|
|
90
|
|
91 (defvar gnus-author-copy-saver (function rmail-output)
|
|
92 "*A function called with a file name to save an author copy to.
|
|
93 The default function is `rmail-output' which saves in Unix mailbox format.")
|
|
94
|
|
95 (defvar gnus-use-long-file-name
|
|
96 (not (memq system-type '(usg-unix-v xenix)))
|
|
97 "Non-nil means that a newsgroup name is used as a default file name
|
|
98 to save articles to. If nil, the directory form of a newsgroup is
|
|
99 used instead.")
|
|
100
|
|
101 (defvar gnus-article-save-directory (getenv "SAVEDIR")
|
|
102 "*The directory in which to save articles; defaults to ~/News.
|
|
103 Initialized from the SAVEDIR environment variable.")
|
|
104
|
|
105 (defvar gnus-default-article-saver (function gnus-Subject-save-in-rmail)
|
|
106 "A function used to save articles in your favorite format.
|
|
107 The function must be interactively callable (in other words, it must
|
|
108 be an Emacs command).
|
|
109
|
|
110 GNUS provides the following functions:
|
|
111 gnus-Subject-save-in-rmail (in Rmail format)
|
|
112 gnus-Subject-save-in-mail (in Unix mail format)
|
|
113 gnus-Subject-save-in-folder (in an MH folder)
|
|
114 gnus-Subject-save-in-file (in article format).")
|
|
115
|
|
116 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
|
|
117 "A function generating a file name to save articles in Rmail format.
|
|
118 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
|
|
119
|
|
120 (defvar gnus-mail-save-name (function gnus-plain-save-name)
|
|
121 "A function generating a file name to save articles in Unix mail format.
|
|
122 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
|
|
123
|
|
124 (defvar gnus-folder-save-name (function gnus-folder-save-name)
|
|
125 "A function generating a file name to save articles in MH folder.
|
|
126 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
|
|
127
|
|
128 (defvar gnus-file-save-name (function gnus-numeric-save-name)
|
|
129 "A function generating a file name to save articles in article format.
|
|
130 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
|
|
131
|
|
132 (defvar gnus-kill-file-name "KILL"
|
|
133 "File name of a KILL file.")
|
|
134
|
|
135 (defvar gnus-default-distribution "local"
|
|
136 "*Use this value as distribution if no distribution is specified.")
|
|
137
|
|
138 (defvar gnus-novice-user t
|
|
139 "*Non-nil means that you are a novice to USENET.
|
|
140 If non-nil, verbose messages may be displayed or your confirmation
|
|
141 may be required.")
|
|
142
|
|
143 (defvar gnus-interactive-post t
|
|
144 "*Newsgroup, subject, and distribution will be asked for if non-nil.")
|
|
145
|
|
146 (defvar gnus-user-login-name nil
|
|
147 "*The login name of the user.
|
|
148 Uses USER and LOGNAME environment variables if undefined.")
|
|
149
|
|
150 (defvar gnus-user-full-name nil
|
|
151 "*The full name of the user.
|
|
152 Uses from the NAME environment variable if undefined.")
|
|
153
|
|
154 (defvar gnus-show-threads t
|
|
155 "*Show conversation threads in Subject Mode if non-nil.")
|
|
156
|
|
157 (defvar gnus-thread-hide-subject t
|
|
158 "*Non-nil means hide subjects for thread subtrees.")
|
|
159
|
|
160 (defvar gnus-thread-hide-subtree nil
|
|
161 "*Non-nil means hide thread subtrees initially.
|
|
162 If non-nil, you have to run the command `gnus-Subject-show-thread' by
|
|
163 hand or by using `gnus-Select-article-hook' to show hidden threads.")
|
|
164
|
|
165 (defvar gnus-thread-hide-killed t
|
|
166 "*Non-nil means hide killed thread subtrees automatically.")
|
|
167
|
|
168 (defvar gnus-thread-ignore-subject nil
|
|
169 "*Don't take care of subject differences, but only references if non-nil.
|
|
170 If it is non-nil, some commands work with subjects do not work properly.")
|
|
171
|
|
172 (defvar gnus-thread-indent-level 4
|
|
173 "Indentation of thread subtrees.")
|
|
174
|
|
175 (defvar gnus-ignored-headers
|
|
176 "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^In-Reply-To:"
|
|
177 "Regexp matching headers not to display in messages.")
|
|
178
|
|
179 (defvar gnus-show-all-headers nil
|
|
180 "*Show all headers of an article if non-nil.")
|
|
181
|
|
182 (defvar gnus-save-all-headers nil
|
|
183 "*Save all headers of an article if non-nil.")
|
|
184
|
|
185 (defvar gnus-optional-headers (function gnus-optional-lines-and-from)
|
|
186 "A function generating a optional string displayed in GNUS Subject
|
|
187 mode buffer. The function is called with an article HEADER. The
|
|
188 result must be a string excluding `[' and `]'.")
|
|
189
|
|
190 (defvar gnus-auto-extend-newsgroup t
|
|
191 "*Extend visible articles to forward and backward if non-nil.")
|
|
192
|
|
193 (defvar gnus-auto-select-first t
|
|
194 "*Select the first unread article automagically if non-nil.
|
|
195 If you want to prevent automatic selection of the first unread article
|
|
196 in some newsgroups, set the variable to nil in `gnus-Select-group-hook'
|
|
197 or `gnus-Apply-kill-hook'.")
|
|
198
|
|
199 (defvar gnus-auto-select-next t
|
|
200 "*Select the next newsgroup automagically if non-nil.
|
|
201 If the value is t and the next newsgroup is empty, GNUS will exit
|
|
202 Subject mode and go back to Group mode. If the value is neither nil
|
|
203 nor t, GNUS will select the following unread newsgroup. Especially, if
|
|
204 the value is the symbol `quietly', the next unread newsgroup will be
|
|
205 selected without any confirmations.")
|
|
206
|
|
207 (defvar gnus-auto-select-same nil
|
|
208 "*Select the next article with the same subject automagically if non-nil.")
|
|
209
|
|
210 (defvar gnus-auto-center-subject t
|
|
211 "*Always center the current subject in GNUS Subject mode window if non-nil.")
|
|
212
|
|
213 (defvar gnus-break-pages t
|
|
214 "*Break an article into pages if non-nil.
|
|
215 Page delimiter is specified by the variable `gnus-page-delimiter'.")
|
|
216
|
|
217 (defvar gnus-page-delimiter "^\^L"
|
|
218 "*Regexp describing line-beginnings that separate pages of news article.")
|
|
219
|
|
220 (defvar gnus-digest-show-summary t
|
|
221 "*Show a summary of undigestified messages if non-nil.")
|
|
222
|
|
223 (defvar gnus-digest-separator "^Subject:[ \t]"
|
|
224 "*Regexp that separates messages in a digest article.")
|
|
225
|
|
226 (defvar gnus-use-full-window t
|
|
227 "*Non-nil means to take up the entire screen of Emacs.")
|
|
228
|
|
229 (defvar gnus-window-configuration
|
|
230 '((SelectNewsgroup (0 1 0))
|
|
231 (ExitNewsgroup (1 0 0))
|
|
232 (SelectArticle (0 3 10))
|
|
233 (ExpandSubject (0 1 0)))
|
|
234 "Specify window configurations for each action.
|
|
235 The format of the variable is a list of (ACTION (G S A)), where
|
|
236 G, S, and A are the relative height of Group, Subject, and Article
|
|
237 windows, respectively. ACTION is `SelectNewsgroup', `ExitNewsgroup',
|
|
238 `SelectArticle', or `ExpandSubject'.")
|
|
239
|
|
240 (defvar gnus-mail-reply-method
|
|
241 (function gnus-mail-reply-using-mail)
|
|
242 "A function to compose reply mail.
|
|
243 The function `gnus-mail-reply-using-mail' uses usual the sendmail mail
|
|
244 program. The function `gnus-mail-reply-using-mhe' uses the mh-e mail
|
|
245 program. You can use yet another program by customizing this variable.")
|
|
246
|
|
247 (defvar gnus-mail-other-window-method
|
|
248 (function gnus-mail-other-window-using-mail)
|
|
249 "A function to compose mail in other window.
|
|
250 The function `gnus-mail-other-window-using-mail' uses usual sendmail
|
|
251 mail program. The function `gnus-mail-other-window-using-mhe' uses mh-e
|
|
252 mail program. You can use yet another program by customizing this variable.")
|
|
253
|
|
254 (defvar gnus-subscribe-newsgroup-method
|
|
255 (function
|
|
256 (lambda (newsgroup)
|
|
257 (gnus-subscribe-newsgroup newsgroup
|
|
258 (car (car gnus-newsrc-assoc)))))
|
|
259 "A function called with a newsgroup name when it is created.")
|
|
260
|
|
261 (defvar gnus-Group-mode-hook nil
|
|
262 "A hook for GNUS Group Mode.")
|
|
263
|
|
264 (defvar gnus-Subject-mode-hook nil
|
|
265 "A hook for GNUS Subject Mode.")
|
|
266
|
|
267 (defvar gnus-Article-mode-hook nil
|
|
268 "A hook for GNUS Article Mode.")
|
|
269
|
|
270 (defvar gnus-Kill-file-mode-hook nil
|
|
271 "A hook for GNUS KILL File Mode.")
|
|
272
|
|
273 (defvar gnus-Open-server-hook nil
|
|
274 "A hook called just before opening connection to news server.")
|
|
275
|
|
276 (defvar gnus-Startup-hook nil
|
|
277 "A hook called at start up time.
|
|
278 This hook is called after GNUS is connected to the NNTP server.
|
|
279 So, it is possible to change the behavior of GNUS according to the
|
|
280 selected NNTP server.")
|
|
281
|
|
282 (defvar gnus-Group-prepare-hook nil
|
|
283 "A hook called after newsgroup list is created in the Newsgroup buffer.
|
|
284 If you want to modify the Newsgroup buffer, you can use this hook.")
|
|
285
|
|
286 (defvar gnus-Subject-prepare-hook nil
|
|
287 "A hook called after subject list is created in the Subject buffer.
|
|
288 If you want to modify the Subject buffer, you can use this hook.")
|
|
289
|
|
290 (defvar gnus-Article-prepare-hook nil
|
|
291 "A hook called after an article is prepared in the Article buffer.
|
|
292 If you want to run a special decoding program like nkf, use this hook.")
|
|
293
|
|
294 (defvar gnus-Select-group-hook nil
|
|
295 "A hook called when a newsgroup is selected.
|
|
296 If you want to sort Subject buffer by date and then by subject, you
|
|
297 can use the following hook:
|
|
298
|
|
299 (setq gnus-Select-group-hook
|
|
300 '(lambda ()
|
|
301 ;; First of all, sort by date.
|
|
302 (gnus-sort-headers
|
|
303 '(lambda (a b)
|
|
304 (gnus-date-lessp (gnus-header-date a)
|
|
305 (gnus-header-date b))))
|
|
306 ;; Then sort by subject string ignoring `Re:'.
|
|
307 ;; If case-fold-search is non-nil, case of letters is ignored.
|
|
308 (gnus-sort-headers
|
|
309 '(lambda (a b)
|
|
310 (gnus-string-lessp
|
|
311 (gnus-simplify-subject (gnus-header-subject a) 're)
|
|
312 (gnus-simplify-subject (gnus-header-subject b) 're)
|
|
313 )))))
|
|
314
|
|
315 If you'd like to simplify subjects like the `gnus-Subject-next-same-subject'
|
|
316 command does, you can use the following hook:
|
|
317
|
|
318 (setq gnus-Select-group-hook
|
|
319 '(lambda ()
|
|
320 (mapcar (function
|
|
321 (lambda (header)
|
|
322 (nntp-set-header-subject
|
|
323 header
|
|
324 (gnus-simplify-subject
|
|
325 (gnus-header-subject header) 're-only))))
|
|
326 gnus-newsgroup-headers)))
|
|
327
|
|
328 In some newsgroups author name is meaningless. It is possible to
|
|
329 prevent listing author names in the GNUS Subject buffer as follows:
|
|
330
|
|
331 (setq gnus-Select-group-hook
|
|
332 '(lambda ()
|
|
333 (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name)
|
|
334 (setq gnus-optional-headers
|
|
335 (function gnus-optional-lines)))
|
|
336 (t
|
|
337 (setq gnus-optional-headers
|
|
338 (function gnus-optional-lines-and-from))))))")
|
|
339
|
|
340 (defvar gnus-Select-article-hook
|
|
341 (function (lambda () (gnus-Subject-show-thread)))
|
|
342 "Hook called when an article is selected.
|
|
343 The default hook automatically shows conversation thread subtrees
|
|
344 of the selected article as follows:
|
|
345
|
|
346 (setq gnus-Select-article-hook
|
|
347 '(lambda ()
|
|
348 (gnus-Subject-show-thread)))
|
|
349
|
|
350 If you'd like to run RMAIL on a digest article automagically, you can
|
|
351 use the following hook:
|
|
352
|
|
353 (setq gnus-Select-article-hook
|
|
354 '(lambda ()
|
|
355 (gnus-Subject-show-thread)
|
|
356 (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
|
|
357 (gnus-Subject-rmail-digest))
|
|
358 ((and (string-equal \"comp.text\" gnus-newsgroup-name)
|
|
359 (string-match \"^TeXhax Digest\"
|
|
360 (gnus-header-subject gnus-current-headers)))
|
|
361 (gnus-Subject-rmail-digest)
|
|
362 ))))")
|
|
363
|
|
364 (defvar gnus-Select-digest-hook
|
|
365 (function
|
|
366 (lambda ()
|
|
367 ;; Reply-To: is required by `undigestify-rmail-message'.
|
|
368 (or (mail-position-on-field "Reply-to" t)
|
|
369 (progn
|
|
370 (mail-position-on-field "Reply-to")
|
|
371 (insert (gnus-fetch-field "From"))))))
|
|
372 "A hook called when reading digest messages using Rmail.
|
|
373 This hook can be used to modify incomplete digest articles as follows
|
|
374 (this is the default):
|
|
375
|
|
376 (setq gnus-Select-digest-hook
|
|
377 '(lambda ()
|
|
378 ;; Reply-To: is required by `undigestify-rmail-message'.
|
|
379 (or (mail-position-on-field \"Reply-to\" t)
|
|
380 (progn
|
|
381 (mail-position-on-field \"Reply-to\")
|
|
382 (insert (gnus-fetch-field \"From\"))))))")
|
|
383
|
|
384 (defvar gnus-Rmail-digest-hook nil
|
|
385 "A hook called when reading digest messages using Rmail.
|
|
386 This hook is intended to customize Rmail mode for reading digest articles.")
|
|
387
|
|
388 (defvar gnus-Apply-kill-hook (function gnus-apply-kill-file)
|
|
389 "A hook called when a newsgroup is selected and subject list is prepared.
|
|
390 This hook is intended to apply a KILL file to the selected newsgroup.
|
|
391 The function `gnus-apply-kill-file' is called defaultly.
|
|
392
|
|
393 Since a general KILL file is too heavy to use for only a few
|
|
394 newsgroups, we recommend you use a lighter hook function. For
|
|
395 example, if you'd like to apply a KILL file to articles which contains
|
|
396 a string `rmgroup' in subject in newsgroup `control', you can use the
|
|
397 following hook:
|
|
398
|
|
399 (setq gnus-Apply-kill-hook
|
|
400 '(lambda ()
|
|
401 (cond ((string-match \"control\" gnus-newsgroup-name)
|
|
402 (gnus-kill \"Subject\" \"rmgroup\")
|
|
403 (gnus-expunge \"X\")))))")
|
|
404
|
|
405 (defvar gnus-Mark-article-hook
|
|
406 (function
|
|
407 (lambda ()
|
|
408 (or (memq gnus-current-article gnus-newsgroup-marked)
|
|
409 (gnus-Subject-mark-as-read gnus-current-article))
|
|
410 (gnus-Subject-set-current-mark "+")))
|
|
411 "A hook called when an article is selected for the first time.
|
|
412 The hook is intended to mark an article as read when it is selected.
|
|
413 If you'd like to mark as unread (-) instead, use the following hook:
|
|
414
|
|
415 (setq gnus-Mark-article-hook
|
|
416 '(lambda ()
|
|
417 (gnus-Subject-mark-as-unread gnus-current-article)
|
|
418 (gnus-Subject-set-current-mark \"+\")))")
|
|
419
|
|
420 (defvar gnus-Inews-article-hook nil
|
|
421 "A hook called before posting an article.
|
|
422 If you'd like to run a special encoding program, use this hook.")
|
|
423
|
|
424 (defvar gnus-Exit-group-hook nil
|
|
425 "A hook called when exiting (not quitting) Subject mode.
|
|
426 If your machine is so slow that exiting from Subject mode takes a
|
|
427 long time, set the variable `gnus-newsgroup-headers' to nil. This
|
|
428 inhibits marking articles as read using cross-reference information.")
|
|
429
|
|
430 (defvar gnus-Suspend-gnus-hook nil
|
|
431 "A hook called when suspending (not exiting) GNUS.")
|
|
432
|
|
433 (defvar gnus-Exit-gnus-hook nil
|
|
434 "A hook called when exiting (not suspending) GNUS.")
|
|
435
|
|
436 (defvar gnus-Save-newsrc-hook nil
|
|
437 "A hook called when saving the newsrc file.
|
|
438 This hook is called before saving .newsrc file.")
|
|
439
|
|
440 (defvar gnus-your-domain nil
|
|
441 "*Your domain name without your host name like: \"stars.flab.Fujitsu.CO.JP\"
|
|
442 The environment variable DOMAINNAME is used instead if defined. If
|
|
443 the function `system-name' returns the full internet name, there is no
|
|
444 need to define this variable.")
|
|
445
|
|
446 (defvar gnus-your-organization nil
|
|
447 "*Your organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\"
|
|
448 The `ORGANIZATION' environment variable is used instead if defined.")
|
|
449
|
|
450 (defvar gnus-use-generic-from nil
|
|
451 "*If nil, prepend local host name to the defined domain in the From:
|
|
452 field; if stringp, use this; if non-nil, strip of the local host name.")
|
|
453
|
|
454 (defvar gnus-use-generic-path nil
|
|
455 "*If nil, use the NNTP server name in the Path: field; if stringp,
|
|
456 use this; if non-nil, use no host name (user name only)")
|
|
457
|
|
458 ;; Internal variables.
|
|
459
|
|
460 (defconst gnus-version "GNUS 3.13"
|
|
461 "Version numbers of this version of GNUS.")
|
|
462
|
|
463 (defvar gnus-Info-nodes
|
|
464 '((gnus-Group-mode . "(gnus)Newsgroup Commands")
|
|
465 (gnus-Subject-mode . "(gnus)Subject Commands")
|
|
466 (gnus-Article-mode . "(gnus)Article Commands")
|
|
467 (gnus-Kill-file-mode . "(gnus)KILL File")
|
|
468 (gnus-Browse-killed-mode . "(gnus)Maintenance"))
|
|
469 "Assoc list of major modes and related Info nodes.")
|
|
470
|
|
471 (defvar gnus-access-methods
|
|
472 '((nntp
|
|
473 (gnus-retrieve-headers . nntp-retrieve-headers)
|
|
474 (gnus-open-server . nntp-open-server)
|
|
475 (gnus-close-server . nntp-close-server)
|
|
476 (gnus-server-opened . nntp-server-opened)
|
|
477 (gnus-status-message . nntp-status-message)
|
|
478 (gnus-request-article . nntp-request-article)
|
|
479 (gnus-request-group . nntp-request-group)
|
|
480 (gnus-request-list . nntp-request-list)
|
|
481 (gnus-request-post . nntp-request-post))
|
|
482 (nnspool
|
|
483 (gnus-retrieve-headers . nnspool-retrieve-headers)
|
|
484 (gnus-open-server . nnspool-open-server)
|
|
485 (gnus-close-server . nnspool-close-server)
|
|
486 (gnus-server-opened . nnspool-server-opened)
|
|
487 (gnus-status-message . nnspool-status-message)
|
|
488 (gnus-request-article . nnspool-request-article)
|
|
489 (gnus-request-group . nnspool-request-group)
|
|
490 (gnus-request-list . nnspool-request-list)
|
|
491 (gnus-request-post . nnspool-request-post))
|
|
492 (mhspool
|
|
493 (gnus-retrieve-headers . mhspool-retrieve-headers)
|
|
494 (gnus-open-server . mhspool-open-server)
|
|
495 (gnus-close-server . mhspool-close-server)
|
|
496 (gnus-server-opened . mhspool-server-opened)
|
|
497 (gnus-status-message . mhspool-status-message)
|
|
498 (gnus-request-article . mhspool-request-article)
|
|
499 (gnus-request-group . mhspool-request-group)
|
|
500 (gnus-request-list . mhspool-request-list)
|
|
501 (gnus-request-post . mhspool-request-post)))
|
|
502 "Access method for NNTP, nnspool, and mhspool.")
|
|
503
|
|
504 (defvar gnus-Group-buffer "*Newsgroup*")
|
|
505 (defvar gnus-Subject-buffer "*Subject*")
|
|
506 (defvar gnus-Article-buffer "*Article*")
|
|
507 (defvar gnus-Digest-buffer "GNUS Digest")
|
|
508 (defvar gnus-Digest-summary-buffer "GNUS Digest-summary")
|
|
509
|
|
510 (defvar gnus-buffer-list
|
|
511 (list gnus-Group-buffer gnus-Subject-buffer gnus-Article-buffer
|
|
512 gnus-Digest-buffer gnus-Digest-summary-buffer)
|
|
513 "GNUS buffer names which should be killed when exiting.")
|
|
514
|
|
515 (defvar gnus-variable-list
|
|
516 '(gnus-newsrc-options
|
|
517 gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
|
|
518 gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)
|
|
519 "GNUS variables saved in the quick startup file.")
|
|
520
|
|
521 (defvar gnus-overload-functions
|
|
522 '((news-inews gnus-inews-news "rnewspost")
|
|
523 (caesar-region gnus-caesar-region "rnews"))
|
|
524 "Functions overloaded by gnus.
|
|
525 It is a list of `(original overload &optional file)'.")
|
|
526
|
|
527 (defvar gnus-newsrc-options nil
|
|
528 "Options line in the .newsrc file.")
|
|
529
|
|
530 (defvar gnus-newsrc-options-n-yes nil
|
|
531 "Regexp representing subscribed newsgroups.")
|
|
532
|
|
533 (defvar gnus-newsrc-options-n-no nil
|
|
534 "Regexp representing unsubscribed newsgroups.")
|
|
535
|
|
536 (defvar gnus-newsrc-assoc nil
|
|
537 "Assoc list of read articles.")
|
|
538
|
|
539 (defvar gnus-killed-assoc nil
|
|
540 "Assoc list of newsgroups removed from `gnus-newsrc-assoc'.")
|
|
541
|
|
542 (defvar gnus-marked-assoc nil
|
|
543 "Assoc list of articles marked as unread.")
|
|
544
|
|
545 (defvar gnus-unread-hashtb nil
|
|
546 "Hashtable of unread articles.")
|
|
547
|
|
548 (defvar gnus-active-hashtb nil
|
|
549 "Hashtable of active articles.")
|
|
550
|
|
551 (defvar gnus-octive-hashtb nil
|
|
552 "Hashtable of OLD active articles.")
|
|
553
|
|
554 (defvar gnus-current-startup-file nil
|
|
555 "Startup file for the current host.")
|
|
556
|
|
557 (defvar gnus-last-search-regexp nil
|
|
558 "Default regexp for article search command.")
|
|
559
|
|
560 (defvar gnus-last-shell-command nil
|
|
561 "Default shell command on article.")
|
|
562
|
|
563 (defvar gnus-have-all-newsgroups nil)
|
|
564
|
|
565 (defvar gnus-newsgroup-name nil)
|
|
566 (defvar gnus-newsgroup-begin nil)
|
|
567 (defvar gnus-newsgroup-end nil)
|
|
568 (defvar gnus-newsgroup-last-rmail nil)
|
|
569 (defvar gnus-newsgroup-last-mail nil)
|
|
570 (defvar gnus-newsgroup-last-folder nil)
|
|
571 (defvar gnus-newsgroup-last-file nil)
|
|
572
|
|
573 (defvar gnus-newsgroup-unreads nil
|
|
574 "List of unread articles in the current newsgroup.")
|
|
575
|
|
576 (defvar gnus-newsgroup-unselected nil
|
|
577 "List of unselected unread articles in the current newsgroup.")
|
|
578
|
|
579 (defvar gnus-newsgroup-marked nil
|
|
580 "List of marked articles in the current newsgroup (a subset of unread art).")
|
|
581
|
|
582 (defvar gnus-newsgroup-headers nil
|
|
583 "List of article headers in the current newsgroup.")
|
|
584
|
|
585 (defvar gnus-current-article nil)
|
|
586 (defvar gnus-current-headers nil)
|
|
587 (defvar gnus-current-history nil)
|
|
588 (defvar gnus-have-all-headers nil)
|
|
589 (defvar gnus-last-article nil)
|
|
590 (defvar gnus-current-kill-article nil)
|
|
591
|
|
592 ;; Save window configuration.
|
|
593 (defvar gnus-winconf-kill-file nil)
|
|
594
|
|
595 (defvar gnus-Group-mode-map nil)
|
|
596 (defvar gnus-Subject-mode-map nil)
|
|
597 (defvar gnus-Article-mode-map nil)
|
|
598 (defvar gnus-Kill-file-mode-map nil)
|
|
599
|
|
600 (defvar rmail-last-file (expand-file-name "~/XMBOX"))
|
|
601 (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
|
|
602
|
|
603 ;; Define GNUS Subsystems.
|
|
604 (autoload 'gnus-Group-post-news "gnuspost"
|
|
605 "Post an article." t)
|
|
606 (autoload 'gnus-Subject-post-news "gnuspost"
|
|
607 "Post an article." t)
|
|
608 (autoload 'gnus-Subject-post-reply "gnuspost"
|
|
609 "Post a reply article." t)
|
|
610 (autoload 'gnus-Subject-post-reply-with-original "gnuspost"
|
|
611 "Post a reply article with original article." t)
|
|
612 (autoload 'gnus-Subject-cancel-article "gnuspost"
|
|
613 "Cancel an article you posted." t)
|
|
614
|
|
615 (autoload 'gnus-Subject-mail-reply "gnusmail"
|
|
616 "Reply mail to news author." t)
|
|
617 (autoload 'gnus-Subject-mail-reply-with-original "gnusmail"
|
|
618 "Reply mail to news author with original article." t)
|
|
619 (autoload 'gnus-Subject-mail-other-window "gnusmail"
|
|
620 "Compose mail in other window." t)
|
|
621
|
|
622 (autoload 'gnus-Group-kill-group "gnusmisc"
|
|
623 "Kill newsgroup on current line." t)
|
|
624 (autoload 'gnus-Group-yank-group "gnusmisc"
|
|
625 "Yank the last killed newsgroup on current line." t)
|
|
626 (autoload 'gnus-Browse-killed-groups "gnusmisc"
|
|
627 "Browse the killed newsgroups." t)
|
|
628
|
|
629 (autoload 'rmail-output "rmailout"
|
|
630 "Append this message to Unix mail file named FILE-NAME." t)
|
|
631 (autoload 'mail-position-on-field "sendmail")
|
|
632 (autoload 'mh-find-path "mh-e")
|
|
633 (autoload 'mh-prompt-for-folder "mh-e")
|
|
634
|
|
635 (put 'gnus-Group-mode 'mode-class 'special)
|
|
636 (put 'gnus-Subject-mode 'mode-class 'special)
|
|
637 (put 'gnus-Article-mode 'mode-class 'special)
|
|
638
|
|
639
|
|
640 ;;(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
|
|
641
|
|
642 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
|
|
643 "Pop to BUFFER, evaluate FORMS, and then returns to original window."
|
|
644 (` (let ((GNUSStartBufferWindow (selected-window)))
|
|
645 (unwind-protect
|
|
646 (progn
|
|
647 (pop-to-buffer (, buffer))
|
|
648 (,@ forms))
|
|
649 (select-window GNUSStartBufferWindow)))))
|
|
650
|
|
651 (defmacro gnus-make-hashtable ()
|
|
652 '(make-abbrev-table))
|
|
653
|
|
654 (defmacro gnus-gethash (string hashtable)
|
|
655 "Get hash value of STRING in HASHTABLE."
|
|
656 ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
|
|
657 (` (abbrev-expansion (, string) (, hashtable))))
|
|
658
|
|
659 (defmacro gnus-sethash (string value hashtable)
|
|
660 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
|
|
661 ;; We cannot use define-abbrev since it only accepts string as value.
|
|
662 (` (set (intern (, string) (, hashtable)) (, value))))
|
|
663
|
|
664 ;; Note: Macros defined here are also defined in nntp.el. I don't like
|
|
665 ;; to put them here, but many users got troubled with the old
|
|
666 ;; definitions in nntp.elc. These codes are NNTP 3.10 version.
|
|
667
|
|
668 (defmacro nntp-header-number (header)
|
|
669 "Return article number in HEADER."
|
|
670 (` (aref (, header) 0)))
|
|
671
|
|
672 (defmacro nntp-set-header-number (header number)
|
|
673 "Set article number of HEADER to NUMBER."
|
|
674 (` (aset (, header) 0 (, number))))
|
|
675
|
|
676 (defmacro nntp-header-subject (header)
|
|
677 "Return subject string in HEADER."
|
|
678 (` (aref (, header) 1)))
|
|
679
|
|
680 (defmacro nntp-set-header-subject (header subject)
|
|
681 "Set article subject of HEADER to SUBJECT."
|
|
682 (` (aset (, header) 1 (, subject))))
|
|
683
|
|
684 (defmacro nntp-header-from (header)
|
|
685 "Return author string in HEADER."
|
|
686 (` (aref (, header) 2)))
|
|
687
|
|
688 (defmacro nntp-set-header-from (header from)
|
|
689 "Set article author of HEADER to FROM."
|
|
690 (` (aset (, header) 2 (, from))))
|
|
691
|
|
692 (defmacro nntp-header-xref (header)
|
|
693 "Return xref string in HEADER."
|
|
694 (` (aref (, header) 3)))
|
|
695
|
|
696 (defmacro nntp-set-header-xref (header xref)
|
|
697 "Set article xref of HEADER to xref."
|
|
698 (` (aset (, header) 3 (, xref))))
|
|
699
|
|
700 (defmacro nntp-header-lines (header)
|
|
701 "Return lines in HEADER."
|
|
702 (` (aref (, header) 4)))
|
|
703
|
|
704 (defmacro nntp-set-header-lines (header lines)
|
|
705 "Set article lines of HEADER to LINES."
|
|
706 (` (aset (, header) 4 (, lines))))
|
|
707
|
|
708 (defmacro nntp-header-date (header)
|
|
709 "Return date in HEADER."
|
|
710 (` (aref (, header) 5)))
|
|
711
|
|
712 (defmacro nntp-set-header-date (header date)
|
|
713 "Set article date of HEADER to DATE."
|
|
714 (` (aset (, header) 5 (, date))))
|
|
715
|
|
716 (defmacro nntp-header-id (header)
|
|
717 "Return Id in HEADER."
|
|
718 (` (aref (, header) 6)))
|
|
719
|
|
720 (defmacro nntp-set-header-id (header id)
|
|
721 "Set article Id of HEADER to ID."
|
|
722 (` (aset (, header) 6 (, id))))
|
|
723
|
|
724 (defmacro nntp-header-references (header)
|
|
725 "Return references in HEADER."
|
|
726 (` (aref (, header) 7)))
|
|
727
|
|
728 (defmacro nntp-set-header-references (header ref)
|
|
729 "Set article references of HEADER to REF."
|
|
730 (` (aset (, header) 7 (, ref))))
|
|
731
|
|
732
|
|
733 ;;;
|
|
734 ;;; GNUS Group Mode
|
|
735 ;;;
|
|
736
|
|
737 (if gnus-Group-mode-map
|
|
738 nil
|
|
739 (setq gnus-Group-mode-map (make-keymap))
|
|
740 (suppress-keymap gnus-Group-mode-map)
|
|
741 (define-key gnus-Group-mode-map " " 'gnus-Group-read-group)
|
|
742 (define-key gnus-Group-mode-map "=" 'gnus-Group-select-group)
|
|
743 (define-key gnus-Group-mode-map "j" 'gnus-Group-jump-to-group)
|
|
744 (define-key gnus-Group-mode-map "n" 'gnus-Group-next-unread-group)
|
|
745 (define-key gnus-Group-mode-map "p" 'gnus-Group-prev-unread-group)
|
|
746 (define-key gnus-Group-mode-map "\177" 'gnus-Group-prev-unread-group)
|
|
747 (define-key gnus-Group-mode-map "N" 'gnus-Group-next-group)
|
|
748 (define-key gnus-Group-mode-map "P" 'gnus-Group-prev-group)
|
|
749 (define-key gnus-Group-mode-map "\C-n" 'gnus-Group-next-group)
|
|
750 (define-key gnus-Group-mode-map "\C-p" 'gnus-Group-prev-group)
|
|
751 (define-key gnus-Group-mode-map "\r" 'next-line)
|
|
752 (define-key gnus-Group-mode-map "/" 'isearch-forward)
|
|
753 (define-key gnus-Group-mode-map "<" 'beginning-of-buffer)
|
|
754 (define-key gnus-Group-mode-map ">" 'end-of-buffer)
|
|
755 (define-key gnus-Group-mode-map "u" 'gnus-Group-unsubscribe-current-group)
|
|
756 (define-key gnus-Group-mode-map "U" 'gnus-Group-unsubscribe-group)
|
|
757 (define-key gnus-Group-mode-map "c" 'gnus-Group-catch-up)
|
|
758 (define-key gnus-Group-mode-map "C" 'gnus-Group-catch-up-all)
|
|
759 (define-key gnus-Group-mode-map "l" 'gnus-Group-list-groups)
|
|
760 (define-key gnus-Group-mode-map "L" 'gnus-Group-list-all-groups)
|
|
761 (define-key gnus-Group-mode-map "g" 'gnus-Group-get-new-news)
|
|
762 (define-key gnus-Group-mode-map "R" 'gnus-Group-restart)
|
|
763 (define-key gnus-Group-mode-map "b" 'gnus-Group-check-bogus-groups)
|
|
764 (define-key gnus-Group-mode-map "r" 'gnus-Group-restrict-groups)
|
|
765 (define-key gnus-Group-mode-map "a" 'gnus-Group-post-news)
|
|
766 (define-key gnus-Group-mode-map "\ek" 'gnus-Group-edit-local-kill)
|
|
767 (define-key gnus-Group-mode-map "\eK" 'gnus-Group-edit-global-kill)
|
|
768 (define-key gnus-Group-mode-map "\C-k" 'gnus-Group-kill-group)
|
|
769 (define-key gnus-Group-mode-map "\C-y" 'gnus-Group-yank-group)
|
|
770 (define-key gnus-Group-mode-map "\C-c\C-y" 'gnus-Browse-killed-groups)
|
|
771 (define-key gnus-Group-mode-map "V" 'gnus-version)
|
|
772 (define-key gnus-Group-mode-map "x" 'gnus-Group-force-update)
|
|
773 (define-key gnus-Group-mode-map "s" 'gnus-Group-force-update)
|
|
774 (define-key gnus-Group-mode-map "z" 'gnus-Group-suspend)
|
|
775 (define-key gnus-Group-mode-map "q" 'gnus-Group-exit)
|
|
776 (define-key gnus-Group-mode-map "Q" 'gnus-Group-quit)
|
|
777 (define-key gnus-Group-mode-map "?" 'gnus-Group-describe-briefly)
|
|
778 (define-key gnus-Group-mode-map "\C-c\C-i" 'gnus-Info-find-node))
|
|
779
|
|
780 (defun gnus-Group-mode ()
|
|
781 "Major mode for reading network news.
|
|
782 All normal editing commands are turned off.
|
|
783 Instead, these commands are available:
|
|
784 \\{gnus-Group-mode-map}
|
|
785
|
|
786 The name of the host running NNTP server is asked for if no default
|
|
787 host is specified. It is also possible to choose another NNTP server
|
|
788 even when the default server is defined by giving a prefix argument to
|
|
789 the command `\\[gnus]'.
|
|
790
|
|
791 If an NNTP server is preceded by a colon such as `:Mail', the user's
|
|
792 private directory `~/Mail' is used as a news spool. This makes it
|
|
793 possible to read mail stored in MH folders or articles saved by GNUS.
|
|
794 File names of mail or articles must consist of only numeric
|
|
795 characters. Otherwise, they are ignored.
|
|
796
|
|
797 If there is a file named `~/.newsrc-SERVER', it is used as the
|
|
798 startup file instead of standard one when talking to SERVER. It is
|
|
799 possible to talk to many hosts by using different startup files for
|
|
800 each.
|
|
801
|
|
802 Option `-n' of the options line in the startup file is recognized
|
|
803 properly the same as the Bnews system. For example, if the options
|
|
804 line is `options -n !talk talk.rumors', newsgroups under the `talk'
|
|
805 hierarchy except for `talk.rumors' are ignored while checking new
|
|
806 newsgroups.
|
|
807
|
|
808 If there is a file named `~/.signature-DISTRIBUTION', it is used as
|
|
809 signature file instead of standard one when posting a news in
|
|
810 DISTRIBUTION.
|
|
811
|
|
812 If an Info file generated from `gnus.texinfo' is installed, you can
|
|
813 read an appropriate Info node of the Info file according to the
|
|
814 current major mode of GNUS by \\[gnus-Info-find-node].
|
|
815
|
|
816 The variable `gnus-version', `nntp-version', `nnspool-version', and
|
|
817 `mhspool-version' have the version numbers of this version of gnus.el,
|
|
818 nntp.el, nnspool.el, and mhspoo.el, respectively.
|
|
819
|
|
820 User customizable variables:
|
|
821 gnus-nntp-server
|
|
822 Specifies the name of the host running the NNTP server. If its
|
|
823 value is a string such as `:DIRECTORY', the user's private
|
|
824 DIRECTORY is used as a news spool. The variable is initialized
|
|
825 from the NNTPSERVER environment variable.
|
|
826
|
|
827 gnus-nntp-service
|
|
828 Specifies a NNTP service name. It is usually \"nntp\" or 119. Nil
|
|
829 forces GNUS to use a local news spool if the variable
|
|
830 `gnus-nntp-server' is set to the local host name.
|
|
831
|
|
832 gnus-startup-file
|
|
833 Specifies a startup file (.newsrc). If there is a file named
|
|
834 `.newsrc-SERVER', it's used instead when talking to SERVER. I
|
|
835 recommend you to use the server specific file, if you'd like to
|
|
836 talk to many servers. Especially if you'd like to read your
|
|
837 private directory, the name of the file must be
|
|
838 `.newsrc-:DIRECTORY'.
|
|
839
|
|
840 gnus-signature-file
|
|
841 Specifies a signature file (.signature). If there is a file named
|
|
842 `.signature-DISTRIBUTION', it's used instead when posting an
|
|
843 article in DISTRIBUTION. Set the variable to nil to prevent
|
|
844 appending the file automatically. If you use an NNTP inews which
|
|
845 comes with the NNTP package, you may have to set the variable to
|
|
846 nil.
|
|
847
|
|
848 gnus-use-cross-reference
|
|
849 Specifies what to do with cross references (Xref: field). If it
|
|
850 is nil, cross references are ignored. If it is t, articles in
|
|
851 subscribed newsgroups are only marked as read. Otherwise, if it
|
|
852 is not nil nor t, articles in all newsgroups are marked as read.
|
|
853
|
|
854 gnus-use-followup-to
|
|
855 Specifies what to do with followup-to: field. If it is nil, its
|
|
856 value is ignored. If it is non-nil, its value is used as followup
|
|
857 newsgroups. Especially, if it is t and field value is `poster',
|
|
858 your confirmation is required.
|
|
859
|
|
860 gnus-author-copy
|
|
861 Specifies a file name to save a copy of article you posted using
|
|
862 FCC: field. If the first character of the value is `|', the
|
|
863 contents of the article is piped out to a program specified by the
|
|
864 rest of the value. The variable is initialized from the
|
|
865 AUTHORCOPY environment variable.
|
|
866
|
|
867 gnus-author-copy-saver
|
|
868 Specifies a function to save an author copy. The function is
|
|
869 called with a file name. The default function `rmail-output'
|
|
870 saves in Unix mail format.
|
|
871
|
|
872 gnus-kill-file-name
|
|
873 Use specified file name as a KILL file (default to `KILL').
|
|
874
|
|
875 gnus-novice-user
|
|
876 Non-nil means that you are a novice to USENET. If non-nil,
|
|
877 verbose messages may be displayed or your confirmations may be
|
|
878 required.
|
|
879
|
|
880 gnus-interactive-post
|
|
881 Non-nil means that newsgroup, subject and distribution are asked
|
|
882 for interactively when posting a new article.
|
|
883
|
|
884 gnus-use-full-window
|
|
885 Non-nil means to take up the entire screen of Emacs.
|
|
886
|
|
887 gnus-window-configuration
|
|
888 Specifies the configuration of Group, Subject, and Article
|
|
889 windows. It is a list of (ACTION (G S A)), where G, S, and A are
|
|
890 the relative height of Group, Subject, and Article windows,
|
|
891 respectively. ACTION is `SelectNewsgroup', `ExitNewsgroup',
|
|
892 `SelectArticle', or `ExpandSubject'.
|
|
893
|
|
894 gnus-subscribe-newsgroup-method
|
|
895 Specifies a function called with a newsgroup name when new
|
|
896 newsgroup is found. The default definition adds new newsgroup at
|
|
897 the beginning of other newsgroups.
|
|
898
|
|
899 Various hooks for customization:
|
|
900 gnus-Group-mode-hook
|
|
901 Entry to this mode calls the value with no arguments, if that
|
|
902 value is non-nil. This hook is called before GNUS is connected to
|
|
903 the NNTP server. So, you can change or define the NNTP server in
|
|
904 this hook.
|
|
905
|
|
906 gnus-Startup-hook
|
|
907 Called with no arguments after the NNTP server is selected. It is
|
|
908 possible to change the behavior of GNUS or initialize the
|
|
909 variables according to the selected NNTP server.
|
|
910
|
|
911 gnus-Group-prepare-hook
|
|
912 Called with no arguments after a newsgroup list is created in the
|
|
913 Newsgroup buffer, if that value is non-nil.
|
|
914
|
|
915 gnus-Save-newsrc-hook
|
|
916 Called with no arguments when saving newsrc file if that value is
|
|
917 non-nil.
|
|
918
|
|
919 gnus-Inews-article-hook
|
|
920 Called with no arguments when posting an article if that value is
|
|
921 non-nil. This hook is called just before posting an article, while
|
|
922 `news-inews-hook' is called before preparing article headers. If
|
|
923 you'd like to convert kanji code of the article, this hook is recommended.
|
|
924
|
|
925 gnus-Suspend-gnus-hook
|
|
926 Called with no arguments when suspending (not exiting) GNUS, if
|
|
927 that value is non-nil.
|
|
928
|
|
929 gnus-Exit-gnus-hook
|
|
930 Called with no arguments when exiting (not suspending) GNUS, if
|
|
931 that value is non-nil."
|
|
932 (interactive)
|
|
933 (kill-all-local-variables)
|
|
934 ;; Gee. Why don't you upgrade?
|
|
935 (cond ((boundp 'mode-line-modified)
|
|
936 (setq mode-line-modified "--- "))
|
|
937 ((listp (default-value 'mode-line-format))
|
|
938 (setq mode-line-format
|
|
939 (cons "--- " (cdr (default-value 'mode-line-format)))))
|
|
940 (t
|
|
941 (setq mode-line-format
|
|
942 "--- GNUS: List of Newsgroups %[(%m)%]----%3p-%-")))
|
|
943 (setq major-mode 'gnus-Group-mode)
|
|
944 (setq mode-name "Newsgroup")
|
|
945 (setq mode-line-buffer-identification "GNUS: List of Newsgroups")
|
|
946 (setq mode-line-process nil)
|
|
947 (use-local-map gnus-Group-mode-map)
|
|
948 (buffer-flush-undo (current-buffer))
|
|
949 (setq buffer-read-only t) ;Disable modification
|
|
950 (run-hooks 'gnus-Group-mode-hook))
|
|
951
|
|
952 ;;;###autoload
|
|
953 (defun gnus (&optional confirm)
|
|
954 "Read network news.
|
|
955 If optional argument CONFIRM is non-nil, ask NNTP server."
|
|
956 (interactive "P")
|
|
957 (unwind-protect
|
|
958 (progn
|
|
959 (switch-to-buffer (get-buffer-create gnus-Group-buffer))
|
|
960 (gnus-Group-mode)
|
|
961 (gnus-start-news-server confirm))
|
|
962 (if (not (gnus-server-opened))
|
|
963 (gnus-Group-quit)
|
|
964 ;; NNTP server is successfully open.
|
|
965 (setq mode-line-process (format " {%s}" gnus-nntp-server))
|
|
966 (let ((buffer-read-only nil))
|
|
967 (erase-buffer)
|
|
968 (gnus-Group-startup-message)
|
|
969 (sit-for 0))
|
|
970 (run-hooks 'gnus-Startup-hook)
|
|
971 (gnus-setup-news-info)
|
|
972 (if gnus-novice-user
|
|
973 (gnus-Group-describe-briefly)) ;Show brief help message.
|
|
974 (gnus-Group-list-groups nil)
|
|
975 )))
|
|
976
|
|
977 (defun gnus-Group-startup-message ()
|
|
978 "Insert startup message in current buffer."
|
|
979 ;; Insert the message.
|
|
980 (insert "
|
|
981 GNUS Version 3.13
|
|
982
|
|
983 NNTP-based News Reader for GNU Emacs
|
|
984
|
|
985
|
|
986 If you have any trouble with this software, please let me
|
|
987 know. I will fix your problems in the next release.
|
|
988
|
|
989 Comments, suggestions, and bug fixes are welcome.
|
|
990
|
|
991 Masanobu UMEDA
|
|
992 umerin@tc.Nagasaki.GO.JP")
|
|
993 ;; And then hack it.
|
|
994 ;; 57 is the longest line.
|
|
995 (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2))
|
|
996 (goto-char (point-min))
|
|
997 ;; +4 is fuzzy factor.
|
|
998 (insert-char ?\n (/ (max (- (window-height) 18) 0) 2)))
|
|
999
|
|
1000 (defun gnus-Group-list-groups (show-all)
|
|
1001 "List newsgroups in the Newsgroup buffer.
|
|
1002 If argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
|
|
1003 (interactive "P")
|
|
1004 (let ((last-group ;Current newsgroup.
|
|
1005 (gnus-Group-group-name))
|
|
1006 (next-group ;Next possible newsgroup.
|
|
1007 (progn
|
|
1008 (gnus-Group-search-forward nil nil)
|
|
1009 (gnus-Group-group-name)))
|
|
1010 (prev-group ;Previous possible newsgroup.
|
|
1011 (progn
|
|
1012 (gnus-Group-search-forward t nil)
|
|
1013 (gnus-Group-group-name))))
|
|
1014 (gnus-Group-prepare show-all)
|
|
1015 (if (zerop (buffer-size))
|
|
1016 (message "No news is good news")
|
|
1017 ;; Go to last newsgroup if possible. If cannot, try next and
|
|
1018 ;; previous. If all fail, go to first unread newsgroup.
|
|
1019 (goto-char (point-min))
|
|
1020 (or (and last-group
|
|
1021 (re-search-forward
|
|
1022 (concat "^.+: " (regexp-quote last-group) "$") nil t))
|
|
1023 (and next-group
|
|
1024 (re-search-forward
|
|
1025 (concat "^.+: " (regexp-quote next-group) "$") nil t))
|
|
1026 (and prev-group
|
|
1027 (re-search-forward
|
|
1028 (concat "^.+: " (regexp-quote prev-group) "$") nil t))
|
|
1029 (re-search-forward "^[ \t]+[1-9][0-9]*:" nil t))
|
|
1030 ;; Adjust cursor point.
|
|
1031 (beginning-of-line)
|
|
1032 (search-forward ":" nil t)
|
|
1033 )))
|
|
1034
|
|
1035 (defun gnus-Group-prepare (&optional all)
|
|
1036 "Prepare list of newsgroups in current buffer.
|
|
1037 If optional argument ALL is non-nil, unsubscribed groups are also listed."
|
|
1038 (let ((buffer-read-only nil)
|
|
1039 (newsrc gnus-newsrc-assoc)
|
|
1040 (group-info nil)
|
|
1041 (group-name nil)
|
|
1042 (unread-count 0)
|
|
1043 ;; This specifies the format of Group buffer.
|
|
1044 (cntl "%s%s%5d: %s\n"))
|
|
1045 (erase-buffer)
|
|
1046 ;; List newsgroups.
|
|
1047 (while newsrc
|
|
1048 (setq group-info (car newsrc))
|
|
1049 (setq group-name (car group-info))
|
|
1050 (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
|
|
1051 (if (or all
|
|
1052 (and (nth 1 group-info) ;Subscribed.
|
|
1053 (> unread-count 0))) ;There are unread articles.
|
|
1054 ;; Yes, I can use gnus-Group-prepare-line, but this is faster.
|
|
1055 (insert
|
|
1056 (format cntl
|
|
1057 ;; Subscribed or not.
|
|
1058 (if (nth 1 group-info) " " "U")
|
|
1059 ;; Has new news?
|
|
1060 (if (and (> unread-count 0)
|
|
1061 (>= 0
|
|
1062 (- unread-count
|
|
1063 (length
|
|
1064 (cdr (assoc group-name
|
|
1065 gnus-marked-assoc))))))
|
|
1066 "*" " ")
|
|
1067 ;; Number of unread articles.
|
|
1068 unread-count
|
|
1069 ;; Newsgroup name.
|
|
1070 group-name))
|
|
1071 )
|
|
1072 (setq newsrc (cdr newsrc))
|
|
1073 )
|
|
1074 (setq gnus-have-all-newsgroups all)
|
|
1075 (goto-char (point-min))
|
|
1076 (run-hooks 'gnus-Group-prepare-hook)
|
|
1077 ))
|
|
1078
|
|
1079 (defun gnus-Group-prepare-line (info)
|
|
1080 "Return a string for the Newsgroup buffer from INFO.
|
|
1081 INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."
|
|
1082 (let* ((group-name (car info))
|
|
1083 (unread-count
|
|
1084 (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
|
|
1085 ;; Not in hash table, so compute it now.
|
|
1086 (gnus-number-of-articles
|
|
1087 (gnus-difference-of-range
|
|
1088 (nth 2 (gnus-gethash group-name gnus-active-hashtb))
|
|
1089 (nthcdr 2 info)))))
|
|
1090 ;; This specifies the format of Group buffer.
|
|
1091 (cntl "%s%s%5d: %s\n"))
|
|
1092 (format cntl
|
|
1093 ;; Subscribed or not.
|
|
1094 (if (nth 1 info) " " "U")
|
|
1095 ;; Has new news?
|
|
1096 (if (and (> unread-count 0)
|
|
1097 (>= 0
|
|
1098 (- unread-count
|
|
1099 (length
|
|
1100 (cdr (assoc group-name gnus-marked-assoc))))))
|
|
1101 "*" " ")
|
|
1102 ;; Number of unread articles.
|
|
1103 unread-count
|
|
1104 ;; Newsgroup name.
|
|
1105 group-name
|
|
1106 )))
|
|
1107
|
|
1108 (defun gnus-Group-update-group (group &optional visible-only)
|
|
1109 "Update newsgroup info of GROUP.
|
|
1110 If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
|
|
1111 (let ((buffer-read-only nil)
|
|
1112 (visible nil))
|
|
1113 ;; Buffer may be narrowed.
|
|
1114 (save-restriction
|
|
1115 (widen)
|
|
1116 ;; Search point to modify.
|
|
1117 (goto-char (point-min))
|
|
1118 (if (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
|
|
1119 ;; GROUP is listed in current buffer. So, delete old line.
|
|
1120 (progn
|
|
1121 (setq visible t)
|
|
1122 (beginning-of-line)
|
|
1123 (delete-region (point) (progn (forward-line 1) (point)))
|
|
1124 ))
|
|
1125 (if (or visible (not visible-only))
|
|
1126 (progn
|
|
1127 (insert (gnus-Group-prepare-line (assoc group gnus-newsrc-assoc)))
|
|
1128 (forward-line -1) ;Move point on that line.
|
|
1129 ))
|
|
1130 )))
|
|
1131
|
|
1132 ;; GNUS Group mode command
|
|
1133
|
|
1134 (defun gnus-Group-group-name ()
|
|
1135 "Get newsgroup name around point."
|
|
1136 (save-excursion
|
|
1137 (beginning-of-line)
|
|
1138 (if (looking-at ".[* \t]*[0-9]+:[ \t]+\\([^ \t\n]+\\)$")
|
|
1139 (buffer-substring (match-beginning 1) (match-end 1))
|
|
1140 )))
|
|
1141
|
|
1142 (defun gnus-Group-read-group (all &optional no-article)
|
|
1143 "Read news in this newsgroup.
|
|
1144 If argument ALL is non-nil, already read articles become readable.
|
|
1145 If optional argument NO-ARTICLE is non-nil, no article body is displayed."
|
|
1146 (interactive "P")
|
|
1147 (let ((group (gnus-Group-group-name))) ;Newsgroup name to read.
|
|
1148 (if group
|
|
1149 (gnus-Subject-read-group
|
|
1150 group
|
|
1151 (or all
|
|
1152 ;;(not (nth 1 (assoc group gnus-newsrc-assoc))) ;Unsubscribed
|
|
1153 (zerop
|
|
1154 (nth 1 (gnus-gethash group gnus-unread-hashtb)))) ;No unread
|
|
1155 no-article
|
|
1156 ))
|
|
1157 ))
|
|
1158
|
|
1159 (defun gnus-Group-select-group (all)
|
|
1160 "Select this newsgroup.
|
|
1161 No article is selected automatically.
|
|
1162 If argument ALL is non-nil, already read articles become readable."
|
|
1163 (interactive "P")
|
|
1164 (gnus-Group-read-group all t))
|
|
1165
|
|
1166 (defun gnus-Group-jump-to-group (group)
|
|
1167 "Jump to newsgroup GROUP."
|
|
1168 (interactive
|
|
1169 (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
|
|
1170 (goto-char (point-min))
|
|
1171 (or (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
|
|
1172 (if (assoc group gnus-newsrc-assoc)
|
|
1173 ;; Add GROUP entry, then seach again.
|
|
1174 (gnus-Group-update-group group)))
|
|
1175 ;; Adjust cursor point.
|
|
1176 (beginning-of-line)
|
|
1177 (search-forward ":" nil t))
|
|
1178
|
|
1179 (defun gnus-Group-search-forward (backward any-group)
|
|
1180 "Search for newsgroup forward.
|
|
1181 If first argument BACKWARD is non-nil, search backward instead.
|
|
1182 If second argument ANY-GROUP is non-nil, unsubscribed or empty
|
|
1183 group may be selected."
|
|
1184 (let ((func (if backward 're-search-backward 're-search-forward))
|
|
1185 (regexp
|
|
1186 (format "^%s[ \t]*\\(%s\\):"
|
|
1187 (if any-group ".." " [ \t]")
|
|
1188 (if any-group "[0-9]+" "[1-9][0-9]*")))
|
|
1189 (found nil))
|
|
1190 (if backward
|
|
1191 (beginning-of-line)
|
|
1192 (end-of-line))
|
|
1193 (setq found (funcall func regexp nil t))
|
|
1194 ;; Adjust cursor point.
|
|
1195 (beginning-of-line)
|
|
1196 (search-forward ":" nil t)
|
|
1197 ;; Return T if found.
|
|
1198 found
|
|
1199 ))
|
|
1200
|
|
1201 (defun gnus-Group-next-group (n)
|
|
1202 "Go to next N'th newsgroup."
|
|
1203 (interactive "p")
|
|
1204 (while (and (> n 1)
|
|
1205 (gnus-Group-search-forward nil t))
|
|
1206 (setq n (1- n)))
|
|
1207 (or (gnus-Group-search-forward nil t)
|
|
1208 (message "No more newsgroups")))
|
|
1209
|
|
1210 (defun gnus-Group-next-unread-group (n)
|
|
1211 "Go to next N'th unread newsgroup."
|
|
1212 (interactive "p")
|
|
1213 (while (and (> n 1)
|
|
1214 (gnus-Group-search-forward nil nil))
|
|
1215 (setq n (1- n)))
|
|
1216 (or (gnus-Group-search-forward nil nil)
|
|
1217 (message "No more unread newsgroups")))
|
|
1218
|
|
1219 (defun gnus-Group-prev-group (n)
|
|
1220 "Go to previous N'th newsgroup."
|
|
1221 (interactive "p")
|
|
1222 (while (and (> n 1)
|
|
1223 (gnus-Group-search-forward t t))
|
|
1224 (setq n (1- n)))
|
|
1225 (or (gnus-Group-search-forward t t)
|
|
1226 (message "No more newsgroups")))
|
|
1227
|
|
1228 (defun gnus-Group-prev-unread-group (n)
|
|
1229 "Go to previous N'th unread newsgroup."
|
|
1230 (interactive "p")
|
|
1231 (while (and (> n 1)
|
|
1232 (gnus-Group-search-forward t nil))
|
|
1233 (setq n (1- n)))
|
|
1234 (or (gnus-Group-search-forward t nil)
|
|
1235 (message "No more unread newsgroups")))
|
|
1236
|
|
1237 (defun gnus-Group-catch-up (all &optional quietly)
|
|
1238 "Mark all articles not marked as unread in current newsgroup as read.
|
|
1239 If prefix argument ALL is non-nil, all articles are marked as read.
|
|
1240 Cross references (Xref: field) of articles are ignored."
|
|
1241 (interactive "P")
|
|
1242 (let* ((group (gnus-Group-group-name))
|
|
1243 (marked (if (not all)
|
|
1244 (cdr (assoc group gnus-marked-assoc)))))
|
|
1245 (and group
|
|
1246 (or quietly
|
|
1247 (y-or-n-p
|
|
1248 (if all
|
|
1249 "Do you really want to mark everything as read? "
|
|
1250 "Delete all articles not marked as read? ")))
|
|
1251 (progn
|
|
1252 (message "") ;Erase "Yes or No" question.
|
|
1253 ;; Any marked articles will be preserved.
|
|
1254 (gnus-update-unread-articles group marked marked)
|
|
1255 (gnus-Group-update-group group)
|
|
1256 (gnus-Group-next-group 1)))
|
|
1257 ))
|
|
1258
|
|
1259 (defun gnus-Group-catch-up-all (&optional quietly)
|
|
1260 "Mark all articles in current newsgroup as read.
|
|
1261 Cross references (Xref: field) of articles are ignored."
|
|
1262 (interactive)
|
|
1263 (gnus-Group-catch-up t quietly))
|
|
1264
|
|
1265 (defun gnus-Group-unsubscribe-current-group ()
|
|
1266 "Toggle subscribe from/to unsubscribe current group."
|
|
1267 (interactive)
|
|
1268 (gnus-Group-unsubscribe-group (gnus-Group-group-name))
|
|
1269 (gnus-Group-next-group 1))
|
|
1270
|
|
1271 (defun gnus-Group-unsubscribe-group (group)
|
|
1272 "Toggle subscribe from/to unsubscribe GROUP.
|
|
1273 New newsgroup is added to .newsrc automatically."
|
|
1274 (interactive
|
|
1275 (list (completing-read "Newsgroup: "
|
|
1276 gnus-active-hashtb nil 'require-match)))
|
|
1277 (let ((newsrc (assoc group gnus-newsrc-assoc)))
|
|
1278 (cond ((not (null newsrc))
|
|
1279 ;; Toggle subscription flag.
|
|
1280 (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
|
|
1281 (gnus-update-newsrc-buffer group)
|
|
1282 (gnus-Group-update-group group)
|
|
1283 ;; Adjust cursor point.
|
|
1284 (beginning-of-line)
|
|
1285 (search-forward ":" nil t))
|
|
1286 ((and (stringp group)
|
|
1287 (gnus-gethash group gnus-active-hashtb))
|
|
1288 ;; Add new newsgroup.
|
|
1289 (gnus-add-newsgroup group)
|
|
1290 (gnus-Group-update-group group)
|
|
1291 ;; Adjust cursor point.
|
|
1292 (beginning-of-line)
|
|
1293 (search-forward ":" nil t))
|
|
1294 (t (error "No such newsgroup: %s" group)))
|
|
1295 ))
|
|
1296
|
|
1297 (defun gnus-Group-list-all-groups ()
|
|
1298 "List all of newsgroups in the Newsgroup buffer."
|
|
1299 (interactive)
|
|
1300 (gnus-Group-list-groups t))
|
|
1301
|
|
1302 (defun gnus-Group-get-new-news ()
|
|
1303 "Get newly arrived articles. In fact, read the active file again."
|
|
1304 (interactive)
|
|
1305 (gnus-setup-news-info)
|
|
1306 (gnus-Group-list-groups gnus-have-all-newsgroups))
|
|
1307
|
|
1308 (defun gnus-Group-restart ()
|
|
1309 "Force GNUS to read the raw startup file."
|
|
1310 (interactive)
|
|
1311 (gnus-save-newsrc-file)
|
|
1312 (gnus-setup-news-info t) ;Force to read the raw startup file.
|
|
1313 (gnus-Group-list-groups gnus-have-all-newsgroups))
|
|
1314
|
|
1315 (defun gnus-Group-check-bogus-groups ()
|
|
1316 "Check bogus newsgroups."
|
|
1317 (interactive)
|
|
1318 (gnus-check-bogus-newsgroups t) ;Require confirmation.
|
|
1319 (gnus-Group-list-groups gnus-have-all-newsgroups))
|
|
1320
|
|
1321 (defun gnus-Group-restrict-groups (start end)
|
|
1322 "Restrict visible newsgroups to the current region (START and END).
|
|
1323 Type \\[widen] to remove restriction."
|
|
1324 (interactive "r")
|
|
1325 (save-excursion
|
|
1326 (narrow-to-region (progn
|
|
1327 (goto-char start)
|
|
1328 (beginning-of-line)
|
|
1329 (point))
|
|
1330 (progn
|
|
1331 (goto-char end)
|
|
1332 (forward-line 1)
|
|
1333 (point))))
|
|
1334 (message (substitute-command-keys "Type \\[widen] to remove restriction")))
|
|
1335
|
|
1336 (defun gnus-Group-edit-global-kill ()
|
|
1337 "Edit a global KILL file."
|
|
1338 (interactive)
|
|
1339 (setq gnus-current-kill-article nil) ;No articles selected.
|
|
1340 (gnus-Kill-file-edit-file nil) ;Nil stands for global KILL file.
|
|
1341 (message
|
|
1342 (substitute-command-keys
|
|
1343 "Editing a global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
|
|
1344
|
|
1345 (defun gnus-Group-edit-local-kill ()
|
|
1346 "Edit a local KILL file."
|
|
1347 (interactive)
|
|
1348 (setq gnus-current-kill-article nil) ;No articles selected.
|
|
1349 (gnus-Kill-file-edit-file (gnus-Group-group-name))
|
|
1350 (message
|
|
1351 (substitute-command-keys
|
|
1352 "Editing a local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
|
|
1353
|
|
1354 (defun gnus-Group-force-update ()
|
|
1355 "Update .newsrc file."
|
|
1356 (interactive)
|
|
1357 (gnus-save-newsrc-file))
|
|
1358
|
|
1359 (defun gnus-Group-suspend ()
|
|
1360 "Suspend the current GNUS session.
|
|
1361 In fact, cleanup buffers except for Group Mode buffer.
|
|
1362 The hook `gnus-Suspend-gnus-hook' is called before actually suspending."
|
|
1363 (interactive)
|
|
1364 (run-hooks 'gnus-Suspend-gnus-hook)
|
|
1365 ;; Kill GNUS buffers except for Group Mode buffer.
|
|
1366 (let ((buffers gnus-buffer-list))
|
|
1367 (while buffers
|
|
1368 (and (not (eq (car buffers) gnus-Group-buffer))
|
|
1369 (get-buffer (car buffers))
|
|
1370 (kill-buffer (car buffers)))
|
|
1371 (setq buffers (cdr buffers))
|
|
1372 ))
|
|
1373 (bury-buffer))
|
|
1374
|
|
1375 (defun gnus-Group-exit ()
|
|
1376 "Quit reading news after updating .newsrc.
|
|
1377 The hook `gnus-Exit-gnus-hook' is called before actually quitting."
|
|
1378 (interactive)
|
|
1379 (if (or noninteractive ;For gnus-batch-kill
|
|
1380 (zerop (buffer-size)) ;No news is good news.
|
|
1381 (not (gnus-server-opened)) ;NNTP connection closed.
|
|
1382 (y-or-n-p "Are you sure you want to quit reading news? "))
|
|
1383 (progn
|
|
1384 (message "") ;Erase "Yes or No" question.
|
|
1385 (run-hooks 'gnus-Exit-gnus-hook)
|
|
1386 (gnus-save-newsrc-file)
|
|
1387 (gnus-clear-system)
|
|
1388 (gnus-close-server))
|
|
1389 ))
|
|
1390
|
|
1391 (defun gnus-Group-quit ()
|
|
1392 "Quit reading news without updating .newsrc.
|
|
1393 The hook `gnus-Exit-gnus-hook' is called before actually quitting."
|
|
1394 (interactive)
|
|
1395 (if (or (zerop (buffer-size))
|
|
1396 (not (gnus-server-opened))
|
|
1397 (yes-or-no-p
|
|
1398 (format "Quit reading news without saving %s? "
|
|
1399 (file-name-nondirectory gnus-current-startup-file))))
|
|
1400 (progn
|
|
1401 (message "") ;Erase "Yes or No" question.
|
|
1402 (run-hooks 'gnus-Exit-gnus-hook)
|
|
1403 (gnus-clear-system)
|
|
1404 (gnus-close-server))
|
|
1405 ))
|
|
1406
|
|
1407 (defun gnus-Group-describe-briefly ()
|
|
1408 "Describe Group mode commands briefly."
|
|
1409 (interactive)
|
|
1410 (message
|
|
1411 (concat
|
|
1412 (substitute-command-keys "\\[gnus-Group-read-group]:Select ")
|
|
1413 (substitute-command-keys "\\[gnus-Group-next-unread-group]:Forward ")
|
|
1414 (substitute-command-keys "\\[gnus-Group-prev-unread-group]:Backward ")
|
|
1415 (substitute-command-keys "\\[gnus-Group-exit]:Exit ")
|
|
1416 (substitute-command-keys "\\[gnus-Info-find-node]:Run Info ")
|
|
1417 (substitute-command-keys "\\[gnus-Group-describe-briefly]:This help")
|
|
1418 )))
|
|
1419
|
|
1420
|
|
1421 ;;;
|
|
1422 ;;; GNUS Subject Mode
|
|
1423 ;;;
|
|
1424
|
|
1425 (if gnus-Subject-mode-map
|
|
1426 nil
|
|
1427 (setq gnus-Subject-mode-map (make-keymap))
|
|
1428 (suppress-keymap gnus-Subject-mode-map)
|
|
1429 (define-key gnus-Subject-mode-map " " 'gnus-Subject-next-page)
|
|
1430 (define-key gnus-Subject-mode-map "\177" 'gnus-Subject-prev-page)
|
|
1431 (define-key gnus-Subject-mode-map "\r" 'gnus-Subject-scroll-up)
|
|
1432 (define-key gnus-Subject-mode-map "n" 'gnus-Subject-next-unread-article)
|
|
1433 (define-key gnus-Subject-mode-map "p" 'gnus-Subject-prev-unread-article)
|
|
1434 (define-key gnus-Subject-mode-map "N" 'gnus-Subject-next-article)
|
|
1435 (define-key gnus-Subject-mode-map "P" 'gnus-Subject-prev-article)
|
|
1436 (define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-same-subject)
|
|
1437 (define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-same-subject)
|
|
1438 ;;(define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-unread-same-subject)
|
|
1439 ;;(define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-unread-same-subject)
|
|
1440 (define-key gnus-Subject-mode-map "\C-c\C-n" 'gnus-Subject-next-digest)
|
|
1441 (define-key gnus-Subject-mode-map "\C-c\C-p" 'gnus-Subject-prev-digest)
|
|
1442 (define-key gnus-Subject-mode-map "\C-n" 'gnus-Subject-next-subject)
|
|
1443 (define-key gnus-Subject-mode-map "\C-p" 'gnus-Subject-prev-subject)
|
|
1444 (define-key gnus-Subject-mode-map "\en" 'gnus-Subject-next-unread-subject)
|
|
1445 (define-key gnus-Subject-mode-map "\ep" 'gnus-Subject-prev-unread-subject)
|
|
1446 ;;(define-key gnus-Subject-mode-map "\C-cn" 'gnus-Subject-next-group)
|
|
1447 ;;(define-key gnus-Subject-mode-map "\C-cp" 'gnus-Subject-prev-group)
|
|
1448 (define-key gnus-Subject-mode-map "." 'gnus-Subject-first-unread-article)
|
|
1449 (define-key gnus-Subject-mode-map "/" 'isearch-forward)
|
|
1450 (define-key gnus-Subject-mode-map "s" 'gnus-Subject-isearch-article)
|
|
1451 (define-key gnus-Subject-mode-map "\es" 'gnus-Subject-search-article-forward)
|
|
1452 (define-key gnus-Subject-mode-map "\eS" 'gnus-Subject-search-article-backward)
|
|
1453 (define-key gnus-Subject-mode-map "<" 'gnus-Subject-beginning-of-article)
|
|
1454 (define-key gnus-Subject-mode-map ">" 'gnus-Subject-end-of-article)
|
|
1455 (define-key gnus-Subject-mode-map "j" 'gnus-Subject-goto-subject)
|
|
1456 (define-key gnus-Subject-mode-map "J" 'gnus-Subject-goto-article)
|
|
1457 (define-key gnus-Subject-mode-map "l" 'gnus-Subject-goto-last-article)
|
|
1458 (define-key gnus-Subject-mode-map "^" 'gnus-Subject-refer-parent-article)
|
|
1459 (define-key gnus-Subject-mode-map "\er" 'gnus-Subject-refer-article)
|
|
1460 (define-key gnus-Subject-mode-map "u" 'gnus-Subject-mark-as-unread-forward)
|
|
1461 (define-key gnus-Subject-mode-map "U" 'gnus-Subject-mark-as-unread-backward)
|
|
1462 (define-key gnus-Subject-mode-map "d" 'gnus-Subject-mark-as-read-forward)
|
|
1463 (define-key gnus-Subject-mode-map "D" 'gnus-Subject-mark-as-read-backward)
|
|
1464 (define-key gnus-Subject-mode-map "\eu" 'gnus-Subject-clear-mark-forward)
|
|
1465 (define-key gnus-Subject-mode-map "\eU" 'gnus-Subject-clear-mark-backward)
|
|
1466 (define-key gnus-Subject-mode-map "k" 'gnus-Subject-kill-same-subject-and-select)
|
|
1467 (define-key gnus-Subject-mode-map "\C-k" 'gnus-Subject-kill-same-subject)
|
|
1468 (define-key gnus-Subject-mode-map "\e\C-t" 'gnus-Subject-toggle-threads)
|
|
1469 (define-key gnus-Subject-mode-map "\e\C-s" 'gnus-Subject-show-thread)
|
|
1470 (define-key gnus-Subject-mode-map "\e\C-h" 'gnus-Subject-hide-thread)
|
|
1471 (define-key gnus-Subject-mode-map "\e\C-f" 'gnus-Subject-next-thread)
|
|
1472 (define-key gnus-Subject-mode-map "\e\C-b" 'gnus-Subject-prev-thread)
|
|
1473 (define-key gnus-Subject-mode-map "\e\C-u" 'gnus-Subject-up-thread)
|
|
1474 (define-key gnus-Subject-mode-map "\e\C-d" 'gnus-Subject-down-thread)
|
|
1475 (define-key gnus-Subject-mode-map "\e\C-k" 'gnus-Subject-kill-thread)
|
|
1476 (define-key gnus-Subject-mode-map "&" 'gnus-Subject-execute-command)
|
|
1477 ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up)
|
|
1478 ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-all)
|
|
1479 (define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-and-exit)
|
|
1480 ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-all-and-exit)
|
|
1481 (define-key gnus-Subject-mode-map "\C-t" 'gnus-Subject-toggle-truncation)
|
|
1482 (define-key gnus-Subject-mode-map "x" 'gnus-Subject-delete-marked-as-read)
|
|
1483 (define-key gnus-Subject-mode-map "X" 'gnus-Subject-delete-marked-with)
|
|
1484 (define-key gnus-Subject-mode-map "\C-c\C-sn" 'gnus-Subject-sort-by-number)
|
|
1485 (define-key gnus-Subject-mode-map "\C-c\C-sa" 'gnus-Subject-sort-by-author)
|
|
1486 (define-key gnus-Subject-mode-map "\C-c\C-ss" 'gnus-Subject-sort-by-subject)
|
|
1487 (define-key gnus-Subject-mode-map "\C-c\C-sd" 'gnus-Subject-sort-by-date)
|
|
1488 (define-key gnus-Subject-mode-map "\C-c\C-s\C-n" 'gnus-Subject-sort-by-number)
|
|
1489 (define-key gnus-Subject-mode-map "\C-c\C-s\C-a" 'gnus-Subject-sort-by-author)
|
|
1490 (define-key gnus-Subject-mode-map "\C-c\C-s\C-s" 'gnus-Subject-sort-by-subject)
|
|
1491 (define-key gnus-Subject-mode-map "\C-c\C-s\C-d" 'gnus-Subject-sort-by-date)
|
|
1492 (define-key gnus-Subject-mode-map "=" 'gnus-Subject-expand-window)
|
|
1493 (define-key gnus-Subject-mode-map "G" 'gnus-Subject-reselect-current-group)
|
|
1494 (define-key gnus-Subject-mode-map "w" 'gnus-Subject-stop-page-breaking)
|
|
1495 (define-key gnus-Subject-mode-map "\C-c\C-r" 'gnus-Subject-caesar-message)
|
|
1496 (define-key gnus-Subject-mode-map "g" 'gnus-Subject-show-article)
|
|
1497 (define-key gnus-Subject-mode-map "t" 'gnus-Subject-toggle-header)
|
|
1498 (define-key gnus-Subject-mode-map "v" 'gnus-Subject-show-all-headers)
|
|
1499 (define-key gnus-Subject-mode-map "\C-d" 'gnus-Subject-rmail-digest)
|
|
1500 (define-key gnus-Subject-mode-map "a" 'gnus-Subject-post-news)
|
|
1501 (define-key gnus-Subject-mode-map "f" 'gnus-Subject-post-reply)
|
|
1502 (define-key gnus-Subject-mode-map "F" 'gnus-Subject-post-reply-with-original)
|
|
1503 (define-key gnus-Subject-mode-map "C" 'gnus-Subject-cancel-article)
|
|
1504 (define-key gnus-Subject-mode-map "r" 'gnus-Subject-mail-reply)
|
|
1505 (define-key gnus-Subject-mode-map "R" 'gnus-Subject-mail-reply-with-original)
|
|
1506 (define-key gnus-Subject-mode-map "m" 'gnus-Subject-mail-other-window)
|
|
1507 (define-key gnus-Subject-mode-map "o" 'gnus-Subject-save-article)
|
|
1508 (define-key gnus-Subject-mode-map "\C-o" 'gnus-Subject-save-in-mail)
|
|
1509 (define-key gnus-Subject-mode-map "|" 'gnus-Subject-pipe-output)
|
|
1510 (define-key gnus-Subject-mode-map "\ek" 'gnus-Subject-edit-local-kill)
|
|
1511 (define-key gnus-Subject-mode-map "\eK" 'gnus-Subject-edit-global-kill)
|
|
1512 (define-key gnus-Subject-mode-map "V" 'gnus-version)
|
|
1513 (define-key gnus-Subject-mode-map "q" 'gnus-Subject-exit)
|
|
1514 (define-key gnus-Subject-mode-map "Q" 'gnus-Subject-quit)
|
|
1515 (define-key gnus-Subject-mode-map "?" 'gnus-Subject-describe-briefly)
|
|
1516 (define-key gnus-Subject-mode-map "\C-c\C-i" 'gnus-Info-find-node))
|
|
1517
|
|
1518 (defun gnus-Subject-mode ()
|
|
1519 "Major mode for reading articles in this newsgroup.
|
|
1520 All normal editing commands are turned off.
|
|
1521 Instead, these commands are available:
|
|
1522 \\{gnus-Subject-mode-map}
|
|
1523
|
|
1524 User customizable variables:
|
|
1525 gnus-large-newsgroup
|
|
1526 The number of articles which indicates a large newsgroup. If the
|
|
1527 number of articles in a newsgroup is greater than the value, the
|
|
1528 number of articles to be selected is asked for. If the given value
|
|
1529 N is positive, the last N articles is selected. If N is negative,
|
|
1530 the first N articles are selected. An empty string means to select
|
|
1531 all articles.
|
|
1532
|
|
1533 gnus-use-long-file-name
|
|
1534 Non-nil means that a newsgroup name is used as a default file name
|
|
1535 to save articles to. If it's nil, the directory form of a
|
|
1536 newsgroup is used instead.
|
|
1537
|
|
1538 gnus-default-article-saver
|
|
1539 Specifies your favorite article saver which is interactively
|
|
1540 funcallable. Following functions are available:
|
|
1541
|
|
1542 gnus-Subject-save-in-rmail (in Rmail format)
|
|
1543 gnus-Subject-save-in-mail (in Unix mail format)
|
|
1544 gnus-Subject-save-in-folder (in MH folder)
|
|
1545 gnus-Subject-save-in-file (in article format).
|
|
1546
|
|
1547 gnus-rmail-save-name
|
|
1548 gnus-mail-save-name
|
|
1549 gnus-folder-save-name
|
|
1550 gnus-file-save-name
|
|
1551 Specifies a function generating a file name to save articles in
|
|
1552 specified format. The function is called with NEWSGROUP, HEADERS,
|
|
1553 and optional LAST-FILE. Access macros to the headers are defined
|
|
1554 as nntp-header-FIELD, and functions are defined as `gnus-header-FIELD'.
|
|
1555
|
|
1556 gnus-article-save-directory
|
|
1557 Specifies a directory name to save articles to using the commands
|
|
1558 `gnus-Subject-save-in-rmail', `gnus-Subject-save-in-mail' and
|
|
1559 `gnus-Subject-save-in-file'. The variable is initialized from the
|
|
1560 SAVEDIR environment variable.
|
|
1561
|
|
1562 gnus-show-all-headers
|
|
1563 Non-nil means that all headers of an article are shown.
|
|
1564
|
|
1565 gnus-save-all-headers
|
|
1566 Non-nil means that all headers of an article are saved in a file.
|
|
1567
|
|
1568 gnus-show-threads
|
|
1569 Non-nil means that conversation threads are shown in tree structure.
|
|
1570
|
|
1571 gnus-thread-hide-subject
|
|
1572 Non-nil means that subjects for thread subtrees are hidden.
|
|
1573
|
|
1574 gnus-thread-hide-subtree
|
|
1575 Non-nil means that thread subtrees are hidden initially.
|
|
1576
|
|
1577 gnus-thread-hide-killed
|
|
1578 Non-nil means that killed thread subtrees are hidden automatically.
|
|
1579
|
|
1580 gnus-thread-ignore-subject
|
|
1581 Non-nil means that subject differences are ignored in constructing
|
|
1582 thread trees.
|
|
1583
|
|
1584 gnus-thread-indent-level
|
|
1585 Indentation of thread subtrees.
|
|
1586
|
|
1587 gnus-optional-headers
|
|
1588 Specifies a function which generates an optional string displayed
|
|
1589 in the Subject buffer. The function is called with an article
|
|
1590 HEADERS. The result must be a string excluding `[' and `]'. The
|
|
1591 default function returns a string like NNN:AUTHOR, where NNN is
|
|
1592 the number of lines in an article and AUTHOR is the name of the
|
|
1593 author.
|
|
1594
|
|
1595 gnus-auto-extend-newsgroup
|
|
1596 Non-nil means visible articles are extended to forward and
|
|
1597 backward automatically if possible.
|
|
1598
|
|
1599 gnus-auto-select-first
|
|
1600 Non-nil means the first unread article is selected automagically
|
|
1601 when a newsgroup is selected normally (by gnus-Group-read-group).
|
|
1602 If you'd like to prevent automatic selection of the first unread
|
|
1603 article in some newsgroups, set the variable to nil in
|
|
1604 gnus-Select-group-hook or gnus-Apply-kill-hook.
|
|
1605
|
|
1606 gnus-auto-select-next
|
|
1607 Non-nil means the next newsgroup is selected automagically at the
|
|
1608 end of the newsgroup. If the value is t and the next newsgroup is
|
|
1609 empty (no unread articles), GNUS will exit Subject mode and go
|
|
1610 back to Group mode. If the value is neither nil nor t, GNUS won't
|
|
1611 exit Subject mode but select the following unread newsgroup.
|
|
1612 Especially, if the value is the symbol `quietly', the next unread
|
|
1613 newsgroup will be selected without any confirmations.
|
|
1614
|
|
1615 gnus-auto-select-same
|
|
1616 Non-nil means an article with the same subject as the current
|
|
1617 article is selected automagically like `rn -S'.
|
|
1618
|
|
1619 gnus-auto-center-subject
|
|
1620 Non-nil means the point of Subject Mode window is always kept
|
|
1621 centered.
|
|
1622
|
|
1623 gnus-break-pages
|
|
1624 Non-nil means an article is broken into pages at page delimiters.
|
|
1625 This may not work with some versions of GNU Emacs earlier than
|
|
1626 version 18.50.
|
|
1627
|
|
1628 gnus-page-delimiter
|
|
1629 Specifies a regexp describing line-beginnings that separate pages
|
|
1630 of news article.
|
|
1631
|
|
1632 [gnus-more-message is obsolete. overlay-arrow-string interfares
|
|
1633 with other subsystems, such as dbx mode.]
|
|
1634
|
|
1635 gnus-digest-show-summary
|
|
1636 Non-nil means that a summary of digest messages is shown when
|
|
1637 reading a digest article using `gnus-Subject-rmail-digest' command.
|
|
1638
|
|
1639 gnus-digest-separator
|
|
1640 Specifies a regexp separating messages in a digest article.
|
|
1641
|
|
1642 gnus-mail-reply-method
|
|
1643 gnus-mail-other-window-method
|
|
1644 Specifies a function to begin composing mail message using
|
|
1645 commands gnus-Subject-mail-reply and
|
|
1646 gnus-Subject-mail-other-window. Functions
|
|
1647 gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe are
|
|
1648 available for the value of gnus-mail-reply-method. And functions
|
|
1649 gnus-mail-other-window-using-mail and
|
|
1650 gnus-mail-other-window-using-mhe are available for the value of
|
|
1651 gnus-mail-other-window-method.
|
|
1652
|
|
1653 Various hooks for customization:
|
|
1654 gnus-Subject-mode-hook
|
|
1655 Entry to this mode calls the value with no arguments, if that
|
|
1656 value is non-nil.
|
|
1657
|
|
1658 gnus-Select-group-hook
|
|
1659 Called with no arguments when newsgroup is selected, if that value
|
|
1660 is non-nil. It is possible to sort subjects in this hook. See the
|
|
1661 documentation of this variable for more information.
|
|
1662
|
|
1663 gnus-Subject-prepare-hook
|
|
1664 Called with no arguments after a subject list is created in the
|
|
1665 Subject buffer, if that value is non-nil. If you'd like to modify
|
|
1666 the buffer, you can use this hook.
|
|
1667
|
|
1668 gnus-Select-article-hook
|
|
1669 Called with no arguments when an article is selected, if that
|
|
1670 value is non-nil. See the documentation of this variable for
|
|
1671 more information.
|
|
1672
|
|
1673 gnus-Select-digest-hook
|
|
1674 Called with no arguments when reading digest messages using Rmail,
|
|
1675 if that value is non-nil. This hook can be used to modify an
|
|
1676 article so that Rmail can work with it. See the documentation of
|
|
1677 the variable for more information.
|
|
1678
|
|
1679 gnus-Rmail-digest-hook
|
|
1680 Called with no arguments when reading digest messages using Rmail,
|
|
1681 if that value is non-nil. This hook is intended to customize Rmail
|
|
1682 mode.
|
|
1683
|
|
1684 gnus-Apply-kill-hook
|
|
1685 Called with no arguments when a newsgroup is selected and the
|
|
1686 Subject buffer is prepared. This hook is intended to apply a KILL
|
|
1687 file to the selected newsgroup. The format of KILL file is
|
|
1688 completely different from that of version 3.8. You have to rewrite
|
|
1689 them in the new format. See the documentation of Kill file mode
|
|
1690 for more information.
|
|
1691
|
|
1692 gnus-Mark-article-hook
|
|
1693 Called with no arguments when an article is selected at the first
|
|
1694 time. The hook is intended to mark an article as read (or unread)
|
|
1695 automatically when it is selected. See the documentation of the
|
|
1696 variable for more information.
|
|
1697
|
|
1698 gnus-Exit-group-hook
|
|
1699 Called with no arguments when exiting the current newsgroup, if
|
|
1700 that value is non-nil. If your machine is so slow that exiting
|
|
1701 from Subject mode takes very long time, inhibit marking articles
|
|
1702 as read using cross-references by setting the variable
|
|
1703 `gnus-newsgroup-headers' to nil in this hook."
|
|
1704 (interactive)
|
|
1705 (kill-all-local-variables)
|
|
1706 ;; Gee. Why don't you upgrade?
|
|
1707 (cond ((boundp 'mode-line-modified)
|
|
1708 (setq mode-line-modified "--- "))
|
|
1709 ((listp (default-value 'mode-line-format))
|
|
1710 (setq mode-line-format
|
|
1711 (cons "--- " (cdr (default-value 'mode-line-format))))))
|
|
1712 (make-local-variable 'global-mode-string)
|
|
1713 (setq global-mode-string nil)
|
|
1714 (setq major-mode 'gnus-Subject-mode)
|
|
1715 (setq mode-name "Subject")
|
|
1716 ;;(setq mode-line-process '(" " gnus-newsgroup-name))
|
|
1717 (make-local-variable 'minor-mode-alist)
|
|
1718 (or (assq 'gnus-show-threads minor-mode-alist)
|
|
1719 (setq minor-mode-alist
|
|
1720 (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
|
|
1721 (gnus-Subject-set-mode-line)
|
|
1722 (use-local-map gnus-Subject-mode-map)
|
|
1723 (buffer-flush-undo (current-buffer))
|
|
1724 (setq buffer-read-only t) ;Disable modification
|
|
1725 (setq truncate-lines t) ;Stop line folding
|
|
1726 (setq selective-display t)
|
|
1727 (setq selective-display-ellipses t) ;Display `...'
|
|
1728 ;;(setq case-fold-search t)
|
|
1729 (run-hooks 'gnus-Subject-mode-hook))
|
|
1730
|
|
1731 (defun gnus-Subject-setup-buffer ()
|
|
1732 "Initialize subject display buffer."
|
|
1733 (if (get-buffer gnus-Subject-buffer)
|
|
1734 (set-buffer gnus-Subject-buffer)
|
|
1735 (set-buffer (get-buffer-create gnus-Subject-buffer))
|
|
1736 (gnus-Subject-mode)
|
|
1737 ))
|
|
1738
|
|
1739 (defun gnus-Subject-read-group (group &optional show-all no-article)
|
|
1740 "Start reading news in newsgroup GROUP.
|
|
1741 If optional first argument SHOW-ALL is non-nil, already read articles are
|
|
1742 also listed.
|
|
1743 If optional second argument NO-ARTICLE is non-nil, no article is selected
|
|
1744 initially."
|
|
1745 (message "Retrieving newsgroup: %s..." group)
|
|
1746 (if (gnus-select-newsgroup group show-all)
|
|
1747 (progn
|
|
1748 ;; Don't switch-to-buffer to prevent displaying old contents
|
|
1749 ;; of the buffer until new subjects list is created.
|
|
1750 ;; Suggested by Juha Heinanen <jh@tut.fi>
|
|
1751 (gnus-Subject-setup-buffer)
|
|
1752 ;; You can change the order of subjects in this hook.
|
|
1753 (run-hooks 'gnus-Select-group-hook)
|
|
1754 (gnus-Subject-prepare)
|
|
1755 ;; Function `gnus-apply-kill-file' must be called in this hook.
|
|
1756 (run-hooks 'gnus-Apply-kill-hook)
|
|
1757 (if (zerop (buffer-size))
|
|
1758 ;; This newsgroup is empty.
|
|
1759 (progn
|
|
1760 (gnus-Subject-catch-up-and-exit nil t) ;Without confirmations.
|
|
1761 (message "No unread news"))
|
|
1762 ;; Hide conversation thread subtrees. We cannot do this in
|
|
1763 ;; gnus-Subject-prepare-hook since kill processing may not
|
|
1764 ;; work with hidden articles.
|
|
1765 (and gnus-show-threads
|
|
1766 gnus-thread-hide-subtree
|
|
1767 (gnus-Subject-hide-all-threads))
|
|
1768 ;; Show first unread article if requested.
|
|
1769 (goto-char (point-min))
|
|
1770 (if (and (not no-article)
|
|
1771 gnus-auto-select-first
|
|
1772 (gnus-Subject-first-unread-article))
|
|
1773 ;; Window is configured automatically.
|
|
1774 ;; Current buffer may be changed as a result of hook
|
|
1775 ;; evaluation, especially by gnus-Subject-rmail-digest
|
|
1776 ;; command, so we should adjust cursor point carefully.
|
|
1777 (if (eq (current-buffer) (get-buffer gnus-Subject-buffer))
|
|
1778 (progn
|
|
1779 ;; Adjust cursor point.
|
|
1780 (beginning-of-line)
|
|
1781 (search-forward ":" nil t)))
|
|
1782 (gnus-configure-windows 'SelectNewsgroup)
|
|
1783 (pop-to-buffer gnus-Subject-buffer)
|
|
1784 (gnus-Subject-set-mode-line)
|
|
1785 ;; I sometime get confused with the old Article buffer.
|
|
1786 (if (get-buffer gnus-Article-buffer)
|
|
1787 (if (get-buffer-window gnus-Article-buffer)
|
|
1788 (save-excursion
|
|
1789 (set-buffer gnus-Article-buffer)
|
|
1790 (let ((buffer-read-only nil))
|
|
1791 (erase-buffer)))
|
|
1792 (kill-buffer gnus-Article-buffer)))
|
|
1793 ;; Adjust cursor point.
|
|
1794 (beginning-of-line)
|
|
1795 (search-forward ":" nil t))
|
|
1796 ))
|
|
1797 ;; Cannot select newsgroup GROUP.
|
|
1798 (if (gnus-gethash group gnus-active-hashtb)
|
|
1799 (progn
|
|
1800 ;; If NNTP is used, nntp_access file may not be installed
|
|
1801 ;; properly. Otherwise, may be active file problem.
|
|
1802 (ding)
|
|
1803 (message "Cannot select %s. May be security or active file problem." group)
|
|
1804 (sit-for 0))
|
|
1805 ;; Check bogus newsgroups.
|
|
1806 ;; We must be in Group Mode buffer.
|
|
1807 (gnus-Group-check-bogus-groups))
|
|
1808 ))
|
|
1809
|
|
1810 (defun gnus-Subject-prepare ()
|
|
1811 "Prepare subject list of current newsgroup in Subject mode buffer."
|
|
1812 (let ((buffer-read-only nil))
|
|
1813 ;; Note: The next codes are not actually used because the user who
|
|
1814 ;; want it can define them in gnus-Select-group-hook.
|
|
1815 ;; Print verbose messages if too many articles are selected.
|
|
1816 ;; (and (numberp gnus-large-newsgroup)
|
|
1817 ;; (> (length gnus-newsgroup-headers) gnus-large-newsgroup)
|
|
1818 ;; (message "Preparing headers..."))
|
|
1819 (erase-buffer)
|
|
1820 (gnus-Subject-prepare-threads
|
|
1821 (if gnus-show-threads
|
|
1822 (gnus-make-threads gnus-newsgroup-headers)
|
|
1823 gnus-newsgroup-headers) 0)
|
|
1824 ;; Erase header retrieval message.
|
|
1825 (message "")
|
|
1826 ;; Call hooks for modifying Subject mode buffer.
|
|
1827 ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
|
|
1828 (goto-char (point-min))
|
|
1829 (run-hooks 'gnus-Subject-prepare-hook)
|
|
1830 ))
|
|
1831
|
|
1832 ;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>
|
|
1833
|
|
1834 (defun gnus-Subject-prepare-threads (threads level)
|
|
1835 "Prepare Subject buffer from THREADS and indentation LEVEL.
|
|
1836 THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).'"
|
|
1837 (let ((thread nil)
|
|
1838 (header nil)
|
|
1839 (number nil)
|
|
1840 ;; `M Indent NUM: [OPT] SUBJECT'
|
|
1841 (cntl (format "%%s %%s%%%dd: [%%s] %%s\n"
|
|
1842 (length (prin1-to-string gnus-newsgroup-end)))))
|
|
1843 (while threads
|
|
1844 (setq thread (car threads))
|
|
1845 (setq threads (cdr threads))
|
|
1846 ;; If thread is a cons, hierarchical threads is given.
|
|
1847 ;; Otherwise, thread itself is header.
|
|
1848 (if (consp thread)
|
|
1849 (setq header (car thread))
|
|
1850 (setq header thread))
|
|
1851 ;; Print valid header only.
|
|
1852 (if (vectorp header) ;Depends on nntp.el.
|
|
1853 (progn
|
|
1854 (setq number (nntp-header-number header))
|
|
1855 (insert
|
|
1856 (format cntl
|
|
1857 ;; Read or not.
|
|
1858 (cond ((memq number gnus-newsgroup-marked) "-")
|
|
1859 ((memq number gnus-newsgroup-unreads) " ")
|
|
1860 (t "D"))
|
|
1861 ;; Thread level.
|
|
1862 (make-string (* level gnus-thread-indent-level) ? )
|
|
1863 ;; Article number.
|
|
1864 number
|
|
1865 ;; Optional headers.
|
|
1866 (or (and gnus-optional-headers
|
|
1867 (funcall gnus-optional-headers header)) "")
|
|
1868 ;; Its subject string.
|
|
1869 (concat (if (or (zerop level)
|
|
1870 (not gnus-thread-hide-subject))
|
|
1871 nil
|
|
1872 (make-string (window-width) ? ))
|
|
1873 (nntp-header-subject header))
|
|
1874 ))
|
|
1875 ))
|
|
1876 ;; Print subthreads.
|
|
1877 (and (consp thread)
|
|
1878 (cdr thread)
|
|
1879 (gnus-Subject-prepare-threads (cdr thread) (1+ level)))
|
|
1880 )))
|
|
1881
|
|
1882 (defun gnus-Subject-set-mode-line ()
|
|
1883 "Set Subject mode line string."
|
|
1884 ;; The value must be a string to escape %-constructs.
|
|
1885 (let ((subject
|
|
1886 (if gnus-current-headers
|
|
1887 (nntp-header-subject gnus-current-headers) gnus-newsgroup-name)))
|
|
1888 (setq mode-line-buffer-identification
|
|
1889 (concat "GNUS: "
|
|
1890 subject
|
|
1891 ;; Enough spaces to pad subject to 17 positions.
|
|
1892 (make-string (max 0 (- 17 (length subject))) ? ))))
|
|
1893 (set-buffer-modified-p t))
|
|
1894
|
|
1895 ;; GNUS Subject mode command.
|
|
1896
|
|
1897 (defun gnus-Subject-search-group (&optional backward)
|
|
1898 "Search for next unread newsgroup.
|
|
1899 If optional argument BACKWARD is non-nil, search backward instead."
|
|
1900 (save-excursion
|
|
1901 (set-buffer gnus-Group-buffer)
|
|
1902 (save-excursion
|
|
1903 ;; We don't want to alter current point of Group mode buffer.
|
|
1904 (if (gnus-Group-search-forward backward nil)
|
|
1905 (gnus-Group-group-name))
|
|
1906 )))
|
|
1907
|
|
1908 (defun gnus-Subject-search-subject (backward unread subject)
|
|
1909 "Search for article forward.
|
|
1910 If first argument BACKWARD is non-nil, search backward.
|
|
1911 If second argument UNREAD is non-nil, only unread article is selected.
|
|
1912 If third argument SUBJECT is non-nil, the article which has
|
|
1913 the same subject will be searched for."
|
|
1914 (let ((func (if backward 're-search-backward 're-search-forward))
|
|
1915 (article nil)
|
|
1916 ;; We have to take care of hidden lines.
|
|
1917 (regexp
|
|
1918 (format "^%s[ \t]+\\([0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s"
|
|
1919 ;;(if unread " " ".")
|
|
1920 (cond ((eq unread t) " ") (unread "[ ---]") (t "."))
|
|
1921 (if subject
|
|
1922 (concat "\\([Rr][Ee]:[ \t]+\\)*"
|
|
1923 (regexp-quote (gnus-simplify-subject subject))
|
|
1924 ;; Ignore words in parentheses.
|
|
1925 "\\([ \t]*([^\r\n]*)\\)*[ \t]*\\(\r\\|$\\)")
|
|
1926 "")
|
|
1927 )))
|
|
1928 (if backward
|
|
1929 (beginning-of-line)
|
|
1930 (end-of-line))
|
|
1931 (if (funcall func regexp nil t)
|
|
1932 (setq article
|
|
1933 (string-to-int
|
|
1934 (buffer-substring (match-beginning 1) (match-end 1)))))
|
|
1935 ;; Adjust cursor point.
|
|
1936 (beginning-of-line)
|
|
1937 (search-forward ":" nil t)
|
|
1938 ;; This is the result.
|
|
1939 article
|
|
1940 ))
|
|
1941
|
|
1942 (defun gnus-Subject-search-forward (&optional unread subject)
|
|
1943 "Search for article forward.
|
|
1944 If first optional argument UNREAD is non-nil, only unread article is selected.
|
|
1945 If second optional argument SUBJECT is non-nil, the article which has
|
|
1946 the same subject will be searched for."
|
|
1947 (gnus-Subject-search-subject nil unread subject))
|
|
1948
|
|
1949 (defun gnus-Subject-search-backward (&optional unread subject)
|
|
1950 "Search for article backward.
|
|
1951 If first optional argument UNREAD is non-nil, only unread article is selected.
|
|
1952 If second optional argument SUBJECT is non-nil, the article which has
|
|
1953 the same subject will be searched for."
|
|
1954 (gnus-Subject-search-subject t unread subject))
|
|
1955
|
|
1956 (defun gnus-Subject-article-number ()
|
|
1957 "Article number around point. If nothing, return current number."
|
|
1958 (save-excursion
|
|
1959 (beginning-of-line)
|
|
1960 (if (looking-at ".[ \t]+\\([0-9]+\\):")
|
|
1961 (string-to-int
|
|
1962 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
1963 ;; If search fail, return current article number.
|
|
1964 gnus-current-article
|
|
1965 )))
|
|
1966
|
|
1967 (defun gnus-Subject-subject-string ()
|
|
1968 "Return current subject string or nil if nothing."
|
|
1969 (save-excursion
|
|
1970 ;; It is possible to implement this function using
|
|
1971 ;; `gnus-Subject-article-number' and `gnus-newsgroup-headers'.
|
|
1972 (beginning-of-line)
|
|
1973 ;; We have to take care of hidden lines.
|
|
1974 (if (looking-at ".[ \t]+[0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]")
|
|
1975 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
1976 ))
|
|
1977
|
|
1978 (defun gnus-Subject-goto-subject (article)
|
|
1979 "Move point to ARTICLE's subject."
|
|
1980 (interactive
|
|
1981 (list
|
|
1982 (string-to-int
|
|
1983 (completing-read "Article number: "
|
|
1984 (mapcar
|
|
1985 (function
|
|
1986 (lambda (headers)
|
|
1987 (list
|
|
1988 (int-to-string (nntp-header-number headers)))))
|
|
1989 gnus-newsgroup-headers)
|
|
1990 nil 'require-match))))
|
|
1991 (let ((current (point)))
|
|
1992 (goto-char (point-min))
|
|
1993 (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t))
|
|
1994 (progn (goto-char current) nil))
|
|
1995 ))
|
|
1996
|
|
1997 (defun gnus-Subject-recenter ()
|
|
1998 "Center point in Subject mode window."
|
|
1999 ;; Scroll window so as to cursor comes center of Subject mode window
|
|
2000 ;; only when article is displayed.
|
|
2001 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
|
|
2002 ;; Recenter only when requested.
|
|
2003 ;; Suggested by popovich@park.cs.columbia.edu
|
|
2004 (and gnus-auto-center-subject
|
|
2005 (get-buffer-window gnus-Article-buffer)
|
|
2006 (< (/ (- (window-height) 1) 2)
|
|
2007 (count-lines (point) (point-max)))
|
|
2008 (recenter (/ (- (window-height) 2) 2))))
|
|
2009
|
|
2010 ;; Walking around Group mode buffer.
|
|
2011
|
|
2012 (defun gnus-Subject-jump-to-group (newsgroup)
|
|
2013 "Move point to NEWSGROUP in Group mode buffer."
|
|
2014 ;; Keep update point of Group mode buffer if visible.
|
|
2015 (if (eq (current-buffer)
|
|
2016 (get-buffer gnus-Group-buffer))
|
|
2017 (save-window-excursion
|
|
2018 ;; Take care of tree window mode.
|
|
2019 (if (get-buffer-window gnus-Group-buffer)
|
|
2020 (pop-to-buffer gnus-Group-buffer))
|
|
2021 (gnus-Group-jump-to-group newsgroup))
|
|
2022 (save-excursion
|
|
2023 ;; Take care of tree window mode.
|
|
2024 (if (get-buffer-window gnus-Group-buffer)
|
|
2025 (pop-to-buffer gnus-Group-buffer)
|
|
2026 (set-buffer gnus-Group-buffer))
|
|
2027 (gnus-Group-jump-to-group newsgroup))))
|
|
2028
|
|
2029 (defun gnus-Subject-next-group (no-article)
|
|
2030 "Exit current newsgroup and then select next unread newsgroup.
|
|
2031 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
|
|
2032 (interactive "P")
|
|
2033 ;; Make sure Group mode buffer point is on current newsgroup.
|
|
2034 (gnus-Subject-jump-to-group gnus-newsgroup-name)
|
|
2035 (let ((group (gnus-Subject-search-group)))
|
|
2036 (if (null group)
|
|
2037 (progn
|
|
2038 (message "Exiting %s..." gnus-newsgroup-name)
|
|
2039 (gnus-Subject-exit)
|
|
2040 (message ""))
|
|
2041 (message "Selecting %s..." group)
|
|
2042 (gnus-Subject-exit t) ;Exit Subject mode temporary.
|
|
2043 ;; We are now in Group mode buffer.
|
|
2044 ;; Make sure Group mode buffer point is on GROUP.
|
|
2045 (gnus-Subject-jump-to-group group)
|
|
2046 (gnus-Subject-read-group group nil no-article)
|
|
2047 (or (eq (current-buffer)
|
|
2048 (get-buffer gnus-Subject-buffer))
|
|
2049 (eq gnus-auto-select-next t)
|
|
2050 ;; Expected newsgroup has nothing to read since the articles
|
|
2051 ;; are marked as read by cross-referencing. So, try next
|
|
2052 ;; newsgroup. (Make sure we are in Group mode buffer now.)
|
|
2053 (and (eq (current-buffer)
|
|
2054 (get-buffer gnus-Group-buffer))
|
|
2055 (gnus-Group-group-name)
|
|
2056 (gnus-Subject-read-group
|
|
2057 (gnus-Group-group-name) nil no-article))
|
|
2058 )
|
|
2059 )))
|
|
2060
|
|
2061 (defun gnus-Subject-prev-group (no-article)
|
|
2062 "Exit current newsgroup and then select previous unread newsgroup.
|
|
2063 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
|
|
2064 (interactive "P")
|
|
2065 ;; Make sure Group mode buffer point is on current newsgroup.
|
|
2066 (gnus-Subject-jump-to-group gnus-newsgroup-name)
|
|
2067 (let ((group (gnus-Subject-search-group t)))
|
|
2068 (if (null group)
|
|
2069 (progn
|
|
2070 (message "Exiting %s..." gnus-newsgroup-name)
|
|
2071 (gnus-Subject-exit)
|
|
2072 (message ""))
|
|
2073 (message "Selecting %s..." group)
|
|
2074 (gnus-Subject-exit t) ;Exit Subject mode temporary.
|
|
2075 ;; We are now in Group mode buffer.
|
|
2076 ;; We have to adjust point of Group mode buffer because current
|
|
2077 ;; point is moved to next unread newsgroup by exiting.
|
|
2078 (gnus-Subject-jump-to-group group)
|
|
2079 (gnus-Subject-read-group group nil no-article)
|
|
2080 (or (eq (current-buffer)
|
|
2081 (get-buffer gnus-Subject-buffer))
|
|
2082 (eq gnus-auto-select-next t)
|
|
2083 ;; Expected newsgroup has nothing to read since the articles
|
|
2084 ;; are marked as read by cross-referencing. So, try next
|
|
2085 ;; newsgroup. (Make sure we are in Group mode buffer now.)
|
|
2086 (and (eq (current-buffer)
|
|
2087 (get-buffer gnus-Group-buffer))
|
|
2088 (gnus-Subject-search-group t)
|
|
2089 (gnus-Subject-read-group
|
|
2090 (gnus-Subject-search-group t) nil no-article))
|
|
2091 )
|
|
2092 )))
|
|
2093
|
|
2094 ;; Walking around subject lines.
|
|
2095
|
|
2096 (defun gnus-Subject-next-subject (n &optional unread)
|
|
2097 "Go to next N'th subject line.
|
|
2098 If optional argument UNREAD is non-nil, only unread article is selected."
|
|
2099 (interactive "p")
|
|
2100 (while (and (> n 1)
|
|
2101 (gnus-Subject-search-forward unread))
|
|
2102 (setq n (1- n)))
|
|
2103 (cond ((gnus-Subject-search-forward unread)
|
|
2104 (gnus-Subject-recenter))
|
|
2105 (unread
|
|
2106 (message "No more unread articles"))
|
|
2107 (t
|
|
2108 (message "No more articles"))
|
|
2109 ))
|
|
2110
|
|
2111 (defun gnus-Subject-next-unread-subject (n)
|
|
2112 "Go to next N'th unread subject line."
|
|
2113 (interactive "p")
|
|
2114 (gnus-Subject-next-subject n t))
|
|
2115
|
|
2116 (defun gnus-Subject-prev-subject (n &optional unread)
|
|
2117 "Go to previous N'th subject line.
|
|
2118 If optional argument UNREAD is non-nil, only unread article is selected."
|
|
2119 (interactive "p")
|
|
2120 (while (and (> n 1)
|
|
2121 (gnus-Subject-search-backward unread))
|
|
2122 (setq n (1- n)))
|
|
2123 (cond ((gnus-Subject-search-backward unread)
|
|
2124 (gnus-Subject-recenter))
|
|
2125 (unread
|
|
2126 (message "No more unread articles"))
|
|
2127 (t
|
|
2128 (message "No more articles"))
|
|
2129 ))
|
|
2130
|
|
2131 (defun gnus-Subject-prev-unread-subject (n)
|
|
2132 "Go to previous N'th unread subject line."
|
|
2133 (interactive "p")
|
|
2134 (gnus-Subject-prev-subject n t))
|
|
2135
|
|
2136 ;; Walking around subject lines with displaying articles.
|
|
2137
|
|
2138 (defun gnus-Subject-expand-window ()
|
|
2139 "Expand Subject window to show headers full window."
|
|
2140 (interactive)
|
|
2141 (gnus-configure-windows 'ExpandSubject)
|
|
2142 (pop-to-buffer gnus-Subject-buffer))
|
|
2143
|
|
2144 (defun gnus-Subject-display-article (article &optional all-header)
|
|
2145 "Display ARTICLE in Article buffer."
|
|
2146 (if (null article)
|
|
2147 nil
|
|
2148 (gnus-configure-windows 'SelectArticle)
|
|
2149 (pop-to-buffer gnus-Subject-buffer)
|
|
2150 (gnus-Article-prepare article all-header)
|
|
2151 (gnus-Subject-recenter)
|
|
2152 (gnus-Subject-set-mode-line)
|
|
2153 (run-hooks 'gnus-Select-article-hook)
|
|
2154 ;; Successfully display article.
|
|
2155 t
|
|
2156 ))
|
|
2157
|
|
2158 (defun gnus-Subject-select-article (&optional all-headers force)
|
|
2159 "Select the current article.
|
|
2160 Optional argument ALL-HEADERS is non-nil, show all headers."
|
|
2161 (let ((article (gnus-Subject-article-number)))
|
|
2162 (if (or (null gnus-current-article)
|
|
2163 (/= article gnus-current-article)
|
|
2164 (and force (not (eq all-headers gnus-have-all-headers))))
|
|
2165 ;; The selected subject is different from that of the current article.
|
|
2166 (gnus-Subject-display-article article all-headers)
|
|
2167 (gnus-configure-windows 'SelectArticle)
|
|
2168 (pop-to-buffer gnus-Subject-buffer))
|
|
2169 ))
|
|
2170
|
|
2171 (defun gnus-Subject-set-current-mark (&optional current-mark)
|
|
2172 "Put `+' at the current article.
|
|
2173 Optional argument specifies CURRENT-MARK instead of `+'."
|
|
2174 (save-excursion
|
|
2175 (set-buffer gnus-Subject-buffer)
|
|
2176 (let ((buffer-read-only nil))
|
|
2177 (goto-char (point-min))
|
|
2178 ;; First of all clear mark at last article.
|
|
2179 (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t)
|
|
2180 (progn
|
|
2181 (delete-char -1)
|
|
2182 (insert " ")
|
|
2183 (goto-char (point-min))))
|
|
2184 (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t)
|
|
2185 (progn
|
|
2186 (delete-char 1)
|
|
2187 (insert (or current-mark "+"))))
|
|
2188 )))
|
|
2189
|
|
2190 (defun gnus-Subject-next-article (unread &optional subject)
|
|
2191 "Select article after current one.
|
|
2192 If argument UNREAD is non-nil, only unread article is selected."
|
|
2193 (interactive "P")
|
|
2194 (let ((header nil))
|
|
2195 (cond ((gnus-Subject-display-article
|
|
2196 (gnus-Subject-search-forward unread subject)))
|
|
2197 ((and subject
|
|
2198 gnus-auto-select-same
|
|
2199 (gnus-set-difference gnus-newsgroup-unreads
|
|
2200 gnus-newsgroup-marked)
|
|
2201 (memq this-command
|
|
2202 '(gnus-Subject-next-unread-article
|
|
2203 gnus-Subject-next-page
|
|
2204 gnus-Subject-kill-same-subject-and-select
|
|
2205 ;;gnus-Subject-next-article
|
|
2206 ;;gnus-Subject-next-same-subject
|
|
2207 ;;gnus-Subject-next-unread-same-subject
|
|
2208 )))
|
|
2209 ;; Wrap article pointer if there are unread articles.
|
|
2210 ;; Hook function, such as gnus-Subject-rmail-digest, may
|
|
2211 ;; change current buffer, so need check.
|
|
2212 (let ((buffer (current-buffer))
|
|
2213 (last-point (point)))
|
|
2214 ;; No more articles with same subject, so jump to the first
|
|
2215 ;; unread article.
|
|
2216 (gnus-Subject-first-unread-article)
|
|
2217 ;;(and (eq buffer (current-buffer))
|
|
2218 ;; (= (point) last-point)
|
|
2219 ;; ;; Ignore given SUBJECT, and try again.
|
|
2220 ;; (gnus-Subject-next-article unread nil))
|
|
2221 (and (eq buffer (current-buffer))
|
|
2222 (< (point) last-point)
|
|
2223 (message "Wrapped"))
|
|
2224 ))
|
|
2225 ((and (not unread)
|
|
2226 gnus-auto-extend-newsgroup
|
|
2227 (setq header (gnus-more-header-forward)))
|
|
2228 ;; Extend to next article if possible.
|
|
2229 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
|
|
2230 (gnus-extend-newsgroup header nil)
|
|
2231 ;; Threads feature must be turned off.
|
|
2232 (let ((buffer-read-only nil))
|
|
2233 (goto-char (point-max))
|
|
2234 (gnus-Subject-prepare-threads (list header) 0))
|
|
2235 (gnus-Subject-goto-article gnus-newsgroup-end))
|
|
2236 (t
|
|
2237 ;; Select next newsgroup automatically if requested.
|
|
2238 (let ((cmd (string-to-char (this-command-keys)))
|
|
2239 (group (gnus-Subject-search-group))
|
|
2240 (auto-select
|
|
2241 (and gnus-auto-select-next
|
|
2242 ;;(null (gnus-set-difference gnus-newsgroup-unreads
|
|
2243 ;; gnus-newsgroup-marked))
|
|
2244 (memq this-command
|
|
2245 '(gnus-Subject-next-unread-article
|
|
2246 gnus-Subject-next-article
|
|
2247 gnus-Subject-next-page
|
|
2248 gnus-Subject-next-same-subject
|
|
2249 gnus-Subject-next-unread-same-subject
|
|
2250 gnus-Subject-kill-same-subject
|
|
2251 gnus-Subject-kill-same-subject-and-select
|
|
2252 ))
|
|
2253 ;; Ignore characters typed ahead.
|
|
2254 (not (input-pending-p))
|
|
2255 )))
|
|
2256 (message "No more%s articles%s"
|
|
2257 (if unread " unread" "")
|
|
2258 (if (and auto-select
|
|
2259 (not (eq gnus-auto-select-next 'quietly)))
|
|
2260 (if group
|
|
2261 (format " (Type %s to %s [%d])"
|
|
2262 (key-description (char-to-string cmd))
|
|
2263 group
|
|
2264 (nth 1 (gnus-gethash group
|
|
2265 gnus-unread-hashtb)))
|
|
2266 (format " (Type %s to exit %s)"
|
|
2267 (key-description (char-to-string cmd))
|
|
2268 gnus-newsgroup-name
|
|
2269 ))
|
|
2270 ""))
|
|
2271 ;; Select next unread newsgroup automagically.
|
|
2272 (cond ((and auto-select
|
|
2273 (eq gnus-auto-select-next 'quietly))
|
|
2274 ;; Select quietly.
|
|
2275 (gnus-Subject-next-group nil))
|
|
2276 (auto-select
|
|
2277 ;; Confirm auto selection.
|
|
2278 (let ((char (read-char)))
|
|
2279 (if (= char cmd)
|
|
2280 (gnus-Subject-next-group nil)
|
|
2281 (setq unread-command-char char))))
|
|
2282 )
|
|
2283 ))
|
|
2284 )))
|
|
2285
|
|
2286 (defun gnus-Subject-next-unread-article ()
|
|
2287 "Select unread article after current one."
|
|
2288 (interactive)
|
|
2289 (gnus-Subject-next-article t (and gnus-auto-select-same
|
|
2290 (gnus-Subject-subject-string))))
|
|
2291
|
|
2292 (defun gnus-Subject-prev-article (unread &optional subject)
|
|
2293 "Select article before current one.
|
|
2294 If argument UNREAD is non-nil, only unread article is selected."
|
|
2295 (interactive "P")
|
|
2296 (let ((header nil))
|
|
2297 (cond ((gnus-Subject-display-article
|
|
2298 (gnus-Subject-search-backward unread subject)))
|
|
2299 ((and subject
|
|
2300 gnus-auto-select-same
|
|
2301 (gnus-set-difference gnus-newsgroup-unreads
|
|
2302 gnus-newsgroup-marked)
|
|
2303 (memq this-command
|
|
2304 '(gnus-Subject-prev-unread-article
|
|
2305 ;;gnus-Subject-prev-page
|
|
2306 ;;gnus-Subject-prev-article
|
|
2307 ;;gnus-Subject-prev-same-subject
|
|
2308 ;;gnus-Subject-prev-unread-same-subject
|
|
2309 )))
|
|
2310 ;; Ignore given SUBJECT, and try again.
|
|
2311 (gnus-Subject-prev-article unread nil))
|
|
2312 (unread
|
|
2313 (message "No more unread articles"))
|
|
2314 ((and gnus-auto-extend-newsgroup
|
|
2315 (setq header (gnus-more-header-backward)))
|
|
2316 ;; Extend to previous article if possible.
|
|
2317 ;; Basic ideas by himacdonald@watdragon.waterloo.edu
|
|
2318 (gnus-extend-newsgroup header t)
|
|
2319 (let ((buffer-read-only nil))
|
|
2320 (goto-char (point-min))
|
|
2321 (gnus-Subject-prepare-threads (list header) 0))
|
|
2322 (gnus-Subject-goto-article gnus-newsgroup-begin))
|
|
2323 (t
|
|
2324 (message "No more articles"))
|
|
2325 )))
|
|
2326
|
|
2327 (defun gnus-Subject-prev-unread-article ()
|
|
2328 "Select unred article before current one."
|
|
2329 (interactive)
|
|
2330 (gnus-Subject-prev-article t (and gnus-auto-select-same
|
|
2331 (gnus-Subject-subject-string))))
|
|
2332
|
|
2333 (defun gnus-Subject-next-page (lines)
|
|
2334 "Show next page of selected article.
|
|
2335 If end of artile, select next article.
|
|
2336 Argument LINES specifies lines to be scrolled up."
|
|
2337 (interactive "P")
|
|
2338 (let ((article (gnus-Subject-article-number))
|
|
2339 (endp nil))
|
|
2340 (if (or (null gnus-current-article)
|
|
2341 (/= article gnus-current-article))
|
|
2342 ;; Selected subject is different from current article's.
|
|
2343 (gnus-Subject-display-article article)
|
|
2344 (gnus-configure-windows 'SelectArticle)
|
|
2345 (pop-to-buffer gnus-Subject-buffer)
|
|
2346 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2347 (setq endp (gnus-Article-next-page lines)))
|
|
2348 (cond ((and endp lines)
|
|
2349 (message "End of message"))
|
|
2350 ((and endp (null lines))
|
|
2351 (gnus-Subject-next-unread-article)))
|
|
2352 )))
|
|
2353
|
|
2354 (defun gnus-Subject-prev-page (lines)
|
|
2355 "Show previous page of selected article.
|
|
2356 Argument LINES specifies lines to be scrolled down."
|
|
2357 (interactive "P")
|
|
2358 (let ((article (gnus-Subject-article-number)))
|
|
2359 (if (or (null gnus-current-article)
|
|
2360 (/= article gnus-current-article))
|
|
2361 ;; Selected subject is different from current article's.
|
|
2362 (gnus-Subject-display-article article)
|
|
2363 (gnus-configure-windows 'SelectArticle)
|
|
2364 (pop-to-buffer gnus-Subject-buffer)
|
|
2365 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2366 (gnus-Article-prev-page lines))
|
|
2367 )))
|
|
2368
|
|
2369 (defun gnus-Subject-scroll-up (lines)
|
|
2370 "Scroll up (or down) one line current article.
|
|
2371 Argument LINES specifies lines to be scrolled up (or down if negative)."
|
|
2372 (interactive "p")
|
|
2373 (gnus-Subject-select-article)
|
|
2374 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2375 (cond ((> lines 0)
|
|
2376 (if (gnus-Article-next-page lines)
|
|
2377 (message "End of message")))
|
|
2378 ((< lines 0)
|
|
2379 (gnus-Article-prev-page (- 0 lines))))
|
|
2380 ))
|
|
2381
|
|
2382 (defun gnus-Subject-next-same-subject ()
|
|
2383 "Select next article which has the same subject as current one."
|
|
2384 (interactive)
|
|
2385 (gnus-Subject-next-article nil (gnus-Subject-subject-string)))
|
|
2386
|
|
2387 (defun gnus-Subject-prev-same-subject ()
|
|
2388 "Select previous article which has the same subject as current one."
|
|
2389 (interactive)
|
|
2390 (gnus-Subject-prev-article nil (gnus-Subject-subject-string)))
|
|
2391
|
|
2392 (defun gnus-Subject-next-unread-same-subject ()
|
|
2393 "Select next unread article which has the same subject as current one."
|
|
2394 (interactive)
|
|
2395 (gnus-Subject-next-article t (gnus-Subject-subject-string)))
|
|
2396
|
|
2397 (defun gnus-Subject-prev-unread-same-subject ()
|
|
2398 "Select previous unread article which has the same subject as current one."
|
|
2399 (interactive)
|
|
2400 (gnus-Subject-prev-article t (gnus-Subject-subject-string)))
|
|
2401
|
|
2402 (defun gnus-Subject-refer-parent-article (child)
|
|
2403 "Refer parent article of current article.
|
|
2404 If a prefix argument CHILD is non-nil, go back to the child article
|
|
2405 using internally maintained articles history.
|
|
2406 NOTE: This command may not work with nnspool.el."
|
|
2407 (interactive "P")
|
|
2408 (gnus-Subject-select-article t t) ;Request all headers.
|
|
2409 (let ((referenced-id nil)) ;Message-id of parent or child article.
|
|
2410 (if child
|
|
2411 ;; Go back to child article using history.
|
|
2412 (gnus-Subject-refer-article nil)
|
|
2413 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2414 ;; Look for parent Message-ID.
|
|
2415 ;; We cannot use gnus-current-headers to get references
|
|
2416 ;; because we may be looking at parent or refered article.
|
|
2417 (let ((references (gnus-fetch-field "References")))
|
|
2418 ;; Get the last message-id in the references.
|
|
2419 (and references
|
|
2420 (string-match "\\(<[^<>]+>\\)[^>]*\\'" references)
|
|
2421 (setq referenced-id
|
|
2422 (substring references
|
|
2423 (match-beginning 1) (match-end 1))))
|
|
2424 ))
|
|
2425 (if (stringp referenced-id)
|
|
2426 (gnus-Subject-refer-article referenced-id)
|
|
2427 (error "No more parents"))
|
|
2428 )))
|
|
2429
|
|
2430 (defun gnus-Subject-refer-article (message-id)
|
|
2431 "Refer article specified by MESSAGE-ID.
|
|
2432 If MESSAGE-ID is nil or an empty string, it is popped from an
|
|
2433 internally maintained articles history.
|
|
2434 NOTE: This command may not work with nnspool.el."
|
|
2435 (interactive "sMessage-ID: ")
|
|
2436 ;; Make sure that this command depends on the fact that article
|
|
2437 ;; related information is not updated when an article is retrieved
|
|
2438 ;; by Message-ID.
|
|
2439 (gnus-Subject-select-article t t) ;Request all headers.
|
|
2440 (if (and (stringp message-id)
|
|
2441 (> (length message-id) 0))
|
|
2442 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2443 ;; Construct the correct Message-ID if necessary.
|
|
2444 ;; Suggested by tale@pawl.rpi.edu.
|
|
2445 (or (string-match "^<" message-id)
|
|
2446 (setq message-id (concat "<" message-id)))
|
|
2447 (or (string-match ">$" message-id)
|
|
2448 (setq message-id (concat message-id ">")))
|
|
2449 ;; Push current message-id on history.
|
|
2450 ;; We cannot use gnus-current-headers to get current
|
|
2451 ;; message-id because we may be looking at parent or refered
|
|
2452 ;; article.
|
|
2453 (let ((current (gnus-fetch-field "Message-ID")))
|
|
2454 (or (equal current message-id) ;Nothing to do.
|
|
2455 (equal current (car gnus-current-history))
|
|
2456 (setq gnus-current-history
|
|
2457 (cons current gnus-current-history)))
|
|
2458 ))
|
|
2459 ;; Pop message-id from history.
|
|
2460 (setq message-id (car gnus-current-history))
|
|
2461 (setq gnus-current-history (cdr gnus-current-history)))
|
|
2462 (if (stringp message-id)
|
|
2463 ;; Retrieve article by message-id. This may not work with nnspool.
|
|
2464 (gnus-Article-prepare message-id t)
|
|
2465 (error "No such references"))
|
|
2466 )
|
|
2467
|
|
2468 (defun gnus-Subject-next-digest (nth)
|
|
2469 "Move to head of NTH next digested message."
|
|
2470 (interactive "p")
|
|
2471 (gnus-Subject-select-article)
|
|
2472 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2473 (gnus-Article-next-digest (or nth 1))
|
|
2474 ))
|
|
2475
|
|
2476 (defun gnus-Subject-prev-digest (nth)
|
|
2477 "Move to head of NTH previous digested message."
|
|
2478 (interactive "p")
|
|
2479 (gnus-Subject-select-article)
|
|
2480 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2481 (gnus-Article-prev-digest (or nth 1))
|
|
2482 ))
|
|
2483
|
|
2484 (defun gnus-Subject-first-unread-article ()
|
|
2485 "Select first unread article. Return non-nil if successfully selected."
|
|
2486 (interactive)
|
|
2487 (let ((begin (point)))
|
|
2488 (goto-char (point-min))
|
|
2489 (if (re-search-forward "^ [ \t]+[0-9]+:" nil t)
|
|
2490 (gnus-Subject-display-article (gnus-Subject-article-number))
|
|
2491 ;; If there is no unread articles, stay there.
|
|
2492 (goto-char begin)
|
|
2493 ;;(gnus-Subject-display-article (gnus-Subject-article-number))
|
|
2494 (message "No more unread articles")
|
|
2495 nil
|
|
2496 )
|
|
2497 ))
|
|
2498
|
|
2499 (defun gnus-Subject-isearch-article ()
|
|
2500 "Do incremental search forward on current article."
|
|
2501 (interactive)
|
|
2502 (gnus-Subject-select-article)
|
|
2503 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2504 (call-interactively 'isearch-forward)
|
|
2505 ))
|
|
2506
|
|
2507 (defun gnus-Subject-search-article-forward (regexp)
|
|
2508 "Search for an article containing REGEXP forward.
|
|
2509 `gnus-Select-article-hook' is not called during the search."
|
|
2510 (interactive
|
|
2511 (list (read-string
|
|
2512 (concat "Search forward (regexp): "
|
|
2513 (if gnus-last-search-regexp
|
|
2514 (concat "(default " gnus-last-search-regexp ") "))))))
|
|
2515 (if (string-equal regexp "")
|
|
2516 (setq regexp (or gnus-last-search-regexp ""))
|
|
2517 (setq gnus-last-search-regexp regexp))
|
|
2518 (if (gnus-Subject-search-article regexp nil)
|
|
2519 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2520 (recenter 0)
|
|
2521 ;;(sit-for 1)
|
|
2522 )
|
|
2523 (error "Search failed: \"%s\"" regexp)
|
|
2524 ))
|
|
2525
|
|
2526 (defun gnus-Subject-search-article-backward (regexp)
|
|
2527 "Search for an article containing REGEXP backward.
|
|
2528 `gnus-Select-article-hook' is not called during the search."
|
|
2529 (interactive
|
|
2530 (list (read-string
|
|
2531 (concat "Search backward (regexp): "
|
|
2532 (if gnus-last-search-regexp
|
|
2533 (concat "(default " gnus-last-search-regexp ") "))))))
|
|
2534 (if (string-equal regexp "")
|
|
2535 (setq regexp (or gnus-last-search-regexp ""))
|
|
2536 (setq gnus-last-search-regexp regexp))
|
|
2537 (if (gnus-Subject-search-article regexp t)
|
|
2538 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2539 (recenter 0)
|
|
2540 ;;(sit-for 1)
|
|
2541 )
|
|
2542 (error "Search failed: \"%s\"" regexp)
|
|
2543 ))
|
|
2544
|
|
2545 (defun gnus-Subject-search-article (regexp &optional backward)
|
|
2546 "Search for an article containing REGEXP.
|
|
2547 Optional argument BACKWARD means do search for backward.
|
|
2548 `gnus-Select-article-hook' is not called during the search."
|
|
2549 (let ((gnus-Select-article-hook nil) ;Disable hook.
|
|
2550 (gnus-Mark-article-hook nil) ;Inhibit marking as read.
|
|
2551 (re-search
|
|
2552 (if backward
|
|
2553 (function re-search-backward) (function re-search-forward)))
|
|
2554 (found nil)
|
|
2555 (last nil))
|
|
2556 ;; Hidden thread subtrees must be searched for ,too.
|
|
2557 (gnus-Subject-show-all-threads)
|
|
2558 ;; First of all, search current article.
|
|
2559 ;; We don't want to read article again from NNTP server nor reset
|
|
2560 ;; current point.
|
|
2561 (gnus-Subject-select-article)
|
|
2562 (message "Searching article: %d..." gnus-current-article)
|
|
2563 (setq last gnus-current-article)
|
|
2564 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2565 (save-restriction
|
|
2566 (widen)
|
|
2567 ;; Begin search from current point.
|
|
2568 (setq found (funcall re-search regexp nil t))))
|
|
2569 ;; Then search next articles.
|
|
2570 (while (and (not found)
|
|
2571 (gnus-Subject-display-article
|
|
2572 (gnus-Subject-search-subject backward nil nil)))
|
|
2573 (message "Searching article: %d..." gnus-current-article)
|
|
2574 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2575 (save-restriction
|
|
2576 (widen)
|
|
2577 (goto-char (if backward (point-max) (point-min)))
|
|
2578 (setq found (funcall re-search regexp nil t)))
|
|
2579 ))
|
|
2580 (message "")
|
|
2581 ;; Adjust article pointer.
|
|
2582 (or (eq last gnus-current-article)
|
|
2583 (setq gnus-last-article last))
|
|
2584 ;; Return T if found such article.
|
|
2585 found
|
|
2586 ))
|
|
2587
|
|
2588 (defun gnus-Subject-execute-command (field regexp command &optional backward)
|
|
2589 "If FIELD of article header matches REGEXP, execute COMMAND string.
|
|
2590 If FIELD is an empty string (or nil), entire article body is searched for.
|
|
2591 If optional (prefix) argument BACKWARD is non-nil, do backward instead."
|
|
2592 (interactive
|
|
2593 (list (let ((completion-ignore-case t))
|
|
2594 (completing-read "Field name: "
|
|
2595 '(("Number")("Subject")("From")
|
|
2596 ("Lines")("Date")("Id")
|
|
2597 ("Xref")("References"))
|
|
2598 nil 'require-match))
|
|
2599 (read-string "Regexp: ")
|
|
2600 (read-key-sequence "Command: ")
|
|
2601 current-prefix-arg))
|
|
2602 ;; Hidden thread subtrees must be searched for ,too.
|
|
2603 (gnus-Subject-show-all-threads)
|
|
2604 ;; We don't want to change current point nor window configuration.
|
|
2605 (save-excursion
|
|
2606 (save-window-excursion
|
|
2607 (message "Executing %s..." (key-description command))
|
|
2608 ;; We'd like to execute COMMAND interactively so as to give arguments.
|
|
2609 (gnus-execute field regexp
|
|
2610 (` (lambda ()
|
|
2611 (call-interactively '(, (key-binding command)))))
|
|
2612 backward)
|
|
2613 (message "Executing %s... done" (key-description command)))))
|
|
2614
|
|
2615 (defun gnus-Subject-beginning-of-article ()
|
|
2616 "Go to beginning of article body"
|
|
2617 (interactive)
|
|
2618 (gnus-Subject-select-article)
|
|
2619 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2620 (widen)
|
|
2621 (beginning-of-buffer)
|
|
2622 (if gnus-break-pages
|
|
2623 (gnus-narrow-to-page))
|
|
2624 ))
|
|
2625
|
|
2626 (defun gnus-Subject-end-of-article ()
|
|
2627 "Go to end of article body"
|
|
2628 (interactive)
|
|
2629 (gnus-Subject-select-article)
|
|
2630 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2631 (widen)
|
|
2632 (end-of-buffer)
|
|
2633 (if gnus-break-pages
|
|
2634 (gnus-narrow-to-page))
|
|
2635 ))
|
|
2636
|
|
2637 (defun gnus-Subject-goto-article (article &optional all-headers)
|
|
2638 "Read ARTICLE if exists.
|
|
2639 Optional argument ALL-HEADERS means all headers are shown."
|
|
2640 (interactive
|
|
2641 (list
|
|
2642 (string-to-int
|
|
2643 (completing-read "Article number: "
|
|
2644 (mapcar
|
|
2645 (function
|
|
2646 (lambda (headers)
|
|
2647 (list
|
|
2648 (int-to-string (nntp-header-number headers)))))
|
|
2649 gnus-newsgroup-headers)
|
|
2650 nil 'require-match))))
|
|
2651 (if (gnus-Subject-goto-subject article)
|
|
2652 (gnus-Subject-display-article article all-headers)))
|
|
2653
|
|
2654 (defun gnus-Subject-goto-last-article ()
|
|
2655 "Go to last subject line."
|
|
2656 (interactive)
|
|
2657 (if gnus-last-article
|
|
2658 (gnus-Subject-goto-article gnus-last-article)))
|
|
2659
|
|
2660 (defun gnus-Subject-show-article ()
|
|
2661 "Force to show current article."
|
|
2662 (interactive)
|
|
2663 ;; The following is a trick to force to read the current article again.
|
|
2664 (setq gnus-have-all-headers (not gnus-have-all-headers))
|
|
2665 (gnus-Subject-select-article (not gnus-have-all-headers) t))
|
|
2666
|
|
2667 (defun gnus-Subject-toggle-header (arg)
|
|
2668 "Show original header if pruned header currently shown, or vice versa.
|
|
2669 With arg, show original header iff arg is positive."
|
|
2670 (interactive "P")
|
|
2671 ;; Variable gnus-show-all-headers must be NIL to toggle really.
|
|
2672 (let ((gnus-show-all-headers nil)
|
|
2673 (all-headers
|
|
2674 (if (null arg) (not gnus-have-all-headers)
|
|
2675 (> (prefix-numeric-value arg) 0))))
|
|
2676 (gnus-Subject-select-article all-headers t)))
|
|
2677
|
|
2678 (defun gnus-Subject-show-all-headers ()
|
|
2679 "Show original article header."
|
|
2680 (interactive)
|
|
2681 (gnus-Subject-select-article t t))
|
|
2682
|
|
2683 (defun gnus-Subject-stop-page-breaking ()
|
|
2684 "Stop page breaking by linefeed temporary (Widen article buffer)."
|
|
2685 (interactive)
|
|
2686 (gnus-Subject-select-article)
|
|
2687 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
2688 (widen)))
|
|
2689
|
|
2690 (defun gnus-Subject-kill-same-subject-and-select (unmark)
|
|
2691 "Mark articles which has the same subject as read, and then select next.
|
|
2692 If argument UNMARK is positive, remove any kinds of marks.
|
|
2693 If argument UNMARK is negative, mark articles as unread instead."
|
|
2694 (interactive "P")
|
|
2695 (if unmark
|
|
2696 (setq unmark (prefix-numeric-value unmark)))
|
|
2697 (let ((count
|
|
2698 (gnus-Subject-mark-same-subject
|
|
2699 (gnus-Subject-subject-string) unmark)))
|
|
2700 ;; Select next unread article. If auto-select-same mode, should
|
|
2701 ;; select the first unread article.
|
|
2702 (gnus-Subject-next-article t (and gnus-auto-select-same
|
|
2703 (gnus-Subject-subject-string)))
|
|
2704 (message "%d articles are marked as %s"
|
|
2705 count (if unmark "unread" "read"))
|
|
2706 ))
|
|
2707
|
|
2708 (defun gnus-Subject-kill-same-subject (unmark)
|
|
2709 "Mark articles which has the same subject as read.
|
|
2710 If argument UNMARK is positive, remove any kinds of marks.
|
|
2711 If argument UNMARK is negative, mark articles as unread instead."
|
|
2712 (interactive "P")
|
|
2713 (if unmark
|
|
2714 (setq unmark (prefix-numeric-value unmark)))
|
|
2715 (let ((count
|
|
2716 (gnus-Subject-mark-same-subject
|
|
2717 (gnus-Subject-subject-string) unmark)))
|
|
2718 ;; If marked as read, go to next unread subject.
|
|
2719 (if (null unmark)
|
|
2720 ;; Go to next unread subject.
|
|
2721 (gnus-Subject-next-subject 1 t))
|
|
2722 (message "%d articles are marked as %s"
|
|
2723 count (if unmark "unread" "read"))
|
|
2724 ))
|
|
2725
|
|
2726 (defun gnus-Subject-mark-same-subject (subject &optional unmark)
|
|
2727 "Mark articles with same SUBJECT as read, and return marked number.
|
|
2728 If optional argument UNMARK is positive, remove any kinds of marks.
|
|
2729 If optional argument UNMARK is negative, mark articles as unread instead."
|
|
2730 (let ((count 1))
|
|
2731 (save-excursion
|
|
2732 (cond ((null unmark)
|
|
2733 (gnus-Subject-mark-as-read nil "K"))
|
|
2734 ((> unmark 0)
|
|
2735 (gnus-Subject-mark-as-unread nil t))
|
|
2736 (t
|
|
2737 (gnus-Subject-mark-as-unread)))
|
|
2738 (while (and subject
|
|
2739 (gnus-Subject-search-forward nil subject))
|
|
2740 (cond ((null unmark)
|
|
2741 (gnus-Subject-mark-as-read nil "K"))
|
|
2742 ((> unmark 0)
|
|
2743 (gnus-Subject-mark-as-unread nil t))
|
|
2744 (t
|
|
2745 (gnus-Subject-mark-as-unread)))
|
|
2746 (setq count (1+ count))
|
|
2747 ))
|
|
2748 ;; Hide killed thread subtrees. Does not work properly always.
|
|
2749 ;;(and (null unmark)
|
|
2750 ;; gnus-thread-hide-killed
|
|
2751 ;; (gnus-Subject-hide-thread))
|
|
2752 ;; Return number of articles marked as read.
|
|
2753 count
|
|
2754 ))
|
|
2755
|
|
2756 (defun gnus-Subject-mark-as-unread-forward (count)
|
|
2757 "Mark current article as unread, and then go forward.
|
|
2758 Argument COUNT specifies number of articles marked as unread."
|
|
2759 (interactive "p")
|
|
2760 (while (> count 0)
|
|
2761 (gnus-Subject-mark-as-unread nil nil)
|
|
2762 (gnus-Subject-next-subject 1 nil)
|
|
2763 (setq count (1- count))))
|
|
2764
|
|
2765 (defun gnus-Subject-mark-as-unread-backward (count)
|
|
2766 "Mark current article as unread, and then go backward.
|
|
2767 Argument COUNT specifies number of articles marked as unread."
|
|
2768 (interactive "p")
|
|
2769 (while (> count 0)
|
|
2770 (gnus-Subject-mark-as-unread nil nil)
|
|
2771 (gnus-Subject-prev-subject 1 nil)
|
|
2772 (setq count (1- count))))
|
|
2773
|
|
2774 (defun gnus-Subject-mark-as-unread (&optional article clear-mark)
|
|
2775 "Mark current article as unread.
|
|
2776 Optional first argument ARTICLE specifies article number to be
|
|
2777 marked as unread. Optional second argument CLEAR-MARK removes
|
|
2778 any kind of mark."
|
|
2779 (save-excursion
|
|
2780 (set-buffer gnus-Subject-buffer)
|
|
2781 ;; First of all, show hidden thread subtrees.
|
|
2782 (gnus-Subject-show-thread)
|
|
2783 (let* ((buffer-read-only nil)
|
|
2784 (current (gnus-Subject-article-number))
|
|
2785 (article (or article current)))
|
|
2786 (gnus-mark-article-as-unread article clear-mark)
|
|
2787 (if (or (eq article current)
|
|
2788 (gnus-Subject-goto-subject article))
|
|
2789 (progn
|
|
2790 (beginning-of-line)
|
|
2791 (delete-char 1)
|
|
2792 (insert (if clear-mark " " "-"))))
|
|
2793 )))
|
|
2794
|
|
2795 (defun gnus-Subject-mark-as-read-forward (count)
|
|
2796 "Mark current article as read, and then go forward.
|
|
2797 Argument COUNT specifies number of articles marked as read"
|
|
2798 (interactive "p")
|
|
2799 (while (> count 0)
|
|
2800 (gnus-Subject-mark-as-read)
|
|
2801 (gnus-Subject-next-subject 1 'unread-only)
|
|
2802 (setq count (1- count))))
|
|
2803
|
|
2804 (defun gnus-Subject-mark-as-read-backward (count)
|
|
2805 "Mark current article as read, and then go backward.
|
|
2806 Argument COUNT specifies number of articles marked as read"
|
|
2807 (interactive "p")
|
|
2808 (while (> count 0)
|
|
2809 (gnus-Subject-mark-as-read)
|
|
2810 (gnus-Subject-prev-subject 1 'unread-only)
|
|
2811 (setq count (1- count))))
|
|
2812
|
|
2813 (defun gnus-Subject-mark-as-read (&optional article mark)
|
|
2814 "Mark current article as read.
|
|
2815 Optional first argument ARTICLE specifies article number to be marked as read.
|
|
2816 Optional second argument MARK specifies a string inserted at beginning of line.
|
|
2817 Any kind of string (length 1) except for a space and `-' is ok."
|
|
2818 (save-excursion
|
|
2819 (set-buffer gnus-Subject-buffer)
|
|
2820 ;; First of all, show hidden thread subtrees.
|
|
2821 (gnus-Subject-show-thread)
|
|
2822 (let* ((buffer-read-only nil)
|
|
2823 (mark (or mark "D")) ;Default mark is `D'.
|
|
2824 (current (gnus-Subject-article-number))
|
|
2825 (article (or article current)))
|
|
2826 (gnus-mark-article-as-read article)
|
|
2827 (if (or (eq article current)
|
|
2828 (gnus-Subject-goto-subject article))
|
|
2829 (progn
|
|
2830 (beginning-of-line)
|
|
2831 (delete-char 1)
|
|
2832 (insert mark)))
|
|
2833 )))
|
|
2834
|
|
2835 (defun gnus-Subject-clear-mark-forward (count)
|
|
2836 "Remove current article's mark, and go forward.
|
|
2837 Argument COUNT specifies number of articles unmarked"
|
|
2838 (interactive "p")
|
|
2839 (while (> count 0)
|
|
2840 (gnus-Subject-mark-as-unread nil t)
|
|
2841 (gnus-Subject-next-subject 1 nil)
|
|
2842 (setq count (1- count))))
|
|
2843
|
|
2844 (defun gnus-Subject-clear-mark-backward (count)
|
|
2845 "Remove current article's mark, and go backward.
|
|
2846 Argument COUNT specifies number of articles unmarked"
|
|
2847 (interactive "p")
|
|
2848 (while (> count 0)
|
|
2849 (gnus-Subject-mark-as-unread nil t)
|
|
2850 (gnus-Subject-prev-subject 1 nil)
|
|
2851 (setq count (1- count))))
|
|
2852
|
|
2853 (defun gnus-Subject-delete-marked-as-read ()
|
|
2854 "Delete lines which are marked as read."
|
|
2855 (interactive)
|
|
2856 (if gnus-newsgroup-unreads
|
|
2857 (let ((buffer-read-only nil))
|
|
2858 (save-excursion
|
|
2859 (goto-char (point-min))
|
|
2860 (delete-non-matching-lines "^[ ---]"))
|
|
2861 ;; Adjust point.
|
|
2862 (if (eobp)
|
|
2863 (gnus-Subject-prev-subject 1)
|
|
2864 (beginning-of-line)
|
|
2865 (search-forward ":" nil t)))
|
|
2866 ;; It is not so good idea to make the buffer empty.
|
|
2867 (message "All articles are marked as read")
|
|
2868 ))
|
|
2869
|
|
2870 (defun gnus-Subject-delete-marked-with (marks)
|
|
2871 "Delete lines which are marked with MARKS (e.g. \"DK\")."
|
|
2872 (interactive "sMarks: ")
|
|
2873 (let ((buffer-read-only nil))
|
|
2874 (save-excursion
|
|
2875 (goto-char (point-min))
|
|
2876 (delete-matching-lines (concat "^[" marks "]")))
|
|
2877 ;; Adjust point.
|
|
2878 (or (zerop (buffer-size))
|
|
2879 (if (eobp)
|
|
2880 (gnus-Subject-prev-subject 1)
|
|
2881 (beginning-of-line)
|
|
2882 (search-forward ":" nil t)))
|
|
2883 ))
|
|
2884
|
|
2885 ;; Thread-based commands.
|
|
2886
|
|
2887 (defun gnus-Subject-toggle-threads (arg)
|
|
2888 "Toggle showing conversation threads.
|
|
2889 With arg, turn showing conversation threads on iff arg is positive."
|
|
2890 (interactive "P")
|
|
2891 (let ((current (gnus-Subject-article-number)))
|
|
2892 (setq gnus-show-threads
|
|
2893 (if (null arg) (not gnus-show-threads)
|
|
2894 (> (prefix-numeric-value arg) 0)))
|
|
2895 (gnus-Subject-prepare)
|
|
2896 (gnus-Subject-goto-subject current)
|
|
2897 ))
|
|
2898
|
|
2899 (defun gnus-Subject-show-all-threads ()
|
|
2900 "Show all thread subtrees."
|
|
2901 (interactive)
|
|
2902 (if gnus-show-threads
|
|
2903 (save-excursion
|
|
2904 (let ((buffer-read-only nil))
|
|
2905 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
|
|
2906 ))))
|
|
2907
|
|
2908 (defun gnus-Subject-show-thread ()
|
|
2909 "Show thread subtrees."
|
|
2910 (interactive)
|
|
2911 (if gnus-show-threads
|
|
2912 (save-excursion
|
|
2913 (let ((buffer-read-only nil))
|
|
2914 (subst-char-in-region (progn
|
|
2915 (beginning-of-line) (point))
|
|
2916 (progn
|
|
2917 (end-of-line) (point))
|
|
2918 ?\^M ?\n t)
|
|
2919 ))))
|
|
2920
|
|
2921 (defun gnus-Subject-hide-all-threads ()
|
|
2922 "Hide all thread subtrees."
|
|
2923 (interactive)
|
|
2924 (if gnus-show-threads
|
|
2925 (save-excursion
|
|
2926 ;; Adjust cursor point.
|
|
2927 (goto-char (point-min))
|
|
2928 (search-forward ":" nil t)
|
|
2929 (let ((level (current-column)))
|
|
2930 (gnus-Subject-hide-thread)
|
|
2931 (while (gnus-Subject-search-forward)
|
|
2932 (and (>= level (current-column))
|
|
2933 (gnus-Subject-hide-thread)))
|
|
2934 ))))
|
|
2935
|
|
2936 (defun gnus-Subject-hide-thread ()
|
|
2937 "Hide thread subtrees."
|
|
2938 (interactive)
|
|
2939 (if gnus-show-threads
|
|
2940 (save-excursion
|
|
2941 ;; Adjust cursor point.
|
|
2942 (beginning-of-line)
|
|
2943 (search-forward ":" nil t)
|
|
2944 (let ((buffer-read-only nil)
|
|
2945 (init (point))
|
|
2946 (last (point))
|
|
2947 (level (current-column)))
|
|
2948 (while (and (gnus-Subject-search-forward)
|
|
2949 (< level (current-column)))
|
|
2950 ;; Interested in lower levels.
|
|
2951 (if (< level (current-column))
|
|
2952 (progn
|
|
2953 (setq last (point))
|
|
2954 ))
|
|
2955 )
|
|
2956 (subst-char-in-region init last ?\n ?\^M t)
|
|
2957 ))))
|
|
2958
|
|
2959 (defun gnus-Subject-next-thread (n)
|
|
2960 "Go to the same level next thread.
|
|
2961 Argument N specifies the number of threads."
|
|
2962 (interactive "p")
|
|
2963 ;; Adjust cursor point.
|
|
2964 (beginning-of-line)
|
|
2965 (search-forward ":" nil t)
|
|
2966 (let ((init (point))
|
|
2967 (last (point))
|
|
2968 (level (current-column)))
|
|
2969 (while (and (> n 0)
|
|
2970 (gnus-Subject-search-forward)
|
|
2971 (<= level (current-column)))
|
|
2972 ;; We have to skip lower levels.
|
|
2973 (if (= level (current-column))
|
|
2974 (progn
|
|
2975 (setq last (point))
|
|
2976 (setq n (1- n))
|
|
2977 ))
|
|
2978 )
|
|
2979 ;; Return non-nil if successfully move to the next.
|
|
2980 (prog1 (not (= init last))
|
|
2981 (goto-char last))
|
|
2982 ))
|
|
2983
|
|
2984 (defun gnus-Subject-prev-thread (n)
|
|
2985 "Go to the same level previous thread.
|
|
2986 Argument N specifies the number of threads."
|
|
2987 (interactive "p")
|
|
2988 ;; Adjust cursor point.
|
|
2989 (beginning-of-line)
|
|
2990 (search-forward ":" nil t)
|
|
2991 (let ((init (point))
|
|
2992 (last (point))
|
|
2993 (level (current-column)))
|
|
2994 (while (and (> n 0)
|
|
2995 (gnus-Subject-search-backward)
|
|
2996 (<= level (current-column)))
|
|
2997 ;; We have to skip lower levels.
|
|
2998 (if (= level (current-column))
|
|
2999 (progn
|
|
3000 (setq last (point))
|
|
3001 (setq n (1- n))
|
|
3002 ))
|
|
3003 )
|
|
3004 ;; Return non-nil if successfully move to the previous.
|
|
3005 (prog1 (not (= init last))
|
|
3006 (goto-char last))
|
|
3007 ))
|
|
3008
|
|
3009 (defun gnus-Subject-down-thread (d)
|
|
3010 "Go downward current thread.
|
|
3011 Argument D specifies the depth goes down."
|
|
3012 (interactive "p")
|
|
3013 ;; Adjust cursor point.
|
|
3014 (beginning-of-line)
|
|
3015 (search-forward ":" nil t)
|
|
3016 (let ((last (point))
|
|
3017 (level (current-column)))
|
|
3018 (while (and (> d 0)
|
|
3019 (gnus-Subject-search-forward)
|
|
3020 (<= level (current-column))) ;<= can be <. Which do you like?
|
|
3021 ;; We have to skip the same levels.
|
|
3022 (if (< level (current-column))
|
|
3023 (progn
|
|
3024 (setq last (point))
|
|
3025 (setq level (current-column))
|
|
3026 (setq d (1- d))
|
|
3027 ))
|
|
3028 )
|
|
3029 (goto-char last)
|
|
3030 ))
|
|
3031
|
|
3032 (defun gnus-Subject-up-thread (d)
|
|
3033 "Go upward current thread.
|
|
3034 Argument D specifies the depth goes up."
|
|
3035 (interactive "p")
|
|
3036 ;; Adjust cursor point.
|
|
3037 (beginning-of-line)
|
|
3038 (search-forward ":" nil t)
|
|
3039 (let ((last (point))
|
|
3040 (level (current-column)))
|
|
3041 (while (and (> d 0)
|
|
3042 (gnus-Subject-search-backward))
|
|
3043 ;; We have to skip the same levels.
|
|
3044 (if (> level (current-column))
|
|
3045 (progn
|
|
3046 (setq last (point))
|
|
3047 (setq level (current-column))
|
|
3048 (setq d (1- d))
|
|
3049 ))
|
|
3050 )
|
|
3051 (goto-char last)
|
|
3052 ))
|
|
3053
|
|
3054 (defun gnus-Subject-kill-thread (unmark)
|
|
3055 "Mark articles under current thread as read.
|
|
3056 If argument UNMARK is positive, remove any kinds of marks.
|
|
3057 If argument UNMARK is negative, mark articles as unread instead."
|
|
3058 (interactive "P")
|
|
3059 (if unmark
|
|
3060 (setq unmark (prefix-numeric-value unmark)))
|
|
3061 ;; Adjust cursor point.
|
|
3062 (beginning-of-line)
|
|
3063 (search-forward ":" nil t)
|
|
3064 (save-excursion
|
|
3065 (let ((level (current-column)))
|
|
3066 ;; Mark current article.
|
|
3067 (cond ((null unmark)
|
|
3068 (gnus-Subject-mark-as-read nil "K"))
|
|
3069 ((> unmark 0)
|
|
3070 (gnus-Subject-mark-as-unread nil t))
|
|
3071 (t
|
|
3072 (gnus-Subject-mark-as-unread))
|
|
3073 )
|
|
3074 ;; Mark following articles.
|
|
3075 (while (and (gnus-Subject-search-forward)
|
|
3076 (< level (current-column)))
|
|
3077 (cond ((null unmark)
|
|
3078 (gnus-Subject-mark-as-read nil "K"))
|
|
3079 ((> unmark 0)
|
|
3080 (gnus-Subject-mark-as-unread nil t))
|
|
3081 (t
|
|
3082 (gnus-Subject-mark-as-unread))
|
|
3083 ))
|
|
3084 ))
|
|
3085 ;; Hide killed subtrees.
|
|
3086 (and (null unmark)
|
|
3087 gnus-thread-hide-killed
|
|
3088 (gnus-Subject-hide-thread))
|
|
3089 ;; If marked as read, go to next unread subject.
|
|
3090 (if (null unmark)
|
|
3091 ;; Go to next unread subject.
|
|
3092 (gnus-Subject-next-subject 1 t))
|
|
3093 )
|
|
3094
|
|
3095 (defun gnus-Subject-toggle-truncation (arg)
|
|
3096 "Toggle truncation of subject lines.
|
|
3097 With ARG, turn line truncation on iff ARG is positive."
|
|
3098 (interactive "P")
|
|
3099 (setq truncate-lines
|
|
3100 (if (null arg) (not truncate-lines)
|
|
3101 (> (prefix-numeric-value arg) 0)))
|
|
3102 (redraw-display))
|
|
3103
|
|
3104 (defun gnus-Subject-sort-by-number (reverse)
|
|
3105 "Sort subject display buffer by article number.
|
|
3106 Argument REVERSE means reverse order."
|
|
3107 (interactive "P")
|
|
3108 (gnus-Subject-sort-subjects
|
|
3109 (function
|
|
3110 (lambda (a b)
|
|
3111 (< (nntp-header-number a) (nntp-header-number b))))
|
|
3112 reverse
|
|
3113 ))
|
|
3114
|
|
3115 (defun gnus-Subject-sort-by-author (reverse)
|
|
3116 "Sort subject display buffer by author name alphabetically.
|
|
3117 If case-fold-search is non-nil, case of letters is ignored.
|
|
3118 Argument REVERSE means reverse order."
|
|
3119 (interactive "P")
|
|
3120 (gnus-Subject-sort-subjects
|
|
3121 (function
|
|
3122 (lambda (a b)
|
|
3123 (gnus-string-lessp (nntp-header-from a) (nntp-header-from b))))
|
|
3124 reverse
|
|
3125 ))
|
|
3126
|
|
3127 (defun gnus-Subject-sort-by-subject (reverse)
|
|
3128 "Sort subject display buffer by subject alphabetically. `Re:'s are ignored.
|
|
3129 If case-fold-search is non-nil, case of letters is ignored.
|
|
3130 Argument REVERSE means reverse order."
|
|
3131 (interactive "P")
|
|
3132 (gnus-Subject-sort-subjects
|
|
3133 (function
|
|
3134 (lambda (a b)
|
|
3135 (gnus-string-lessp
|
|
3136 (gnus-simplify-subject (nntp-header-subject a) 're-only)
|
|
3137 (gnus-simplify-subject (nntp-header-subject b) 're-only))))
|
|
3138 reverse
|
|
3139 ))
|
|
3140
|
|
3141 (defun gnus-Subject-sort-by-date (reverse)
|
|
3142 "Sort subject display buffer by posted date.
|
|
3143 Argument REVERSE means reverse order."
|
|
3144 (interactive "P")
|
|
3145 (gnus-Subject-sort-subjects
|
|
3146 (function
|
|
3147 (lambda (a b)
|
|
3148 (gnus-date-lessp (nntp-header-date a) (nntp-header-date b))))
|
|
3149 reverse
|
|
3150 ))
|
|
3151
|
|
3152 (defun gnus-Subject-sort-subjects (predicate &optional reverse)
|
|
3153 "Sort subject display buffer by PREDICATE.
|
|
3154 Optional argument REVERSE means reverse order."
|
|
3155 (let ((current (gnus-Subject-article-number)))
|
|
3156 (gnus-sort-headers predicate reverse)
|
|
3157 (gnus-Subject-prepare)
|
|
3158 (gnus-Subject-goto-subject current)
|
|
3159 ))
|
|
3160
|
|
3161 (defun gnus-Subject-reselect-current-group (show-all)
|
|
3162 "Once exit and then reselect the current newsgroup.
|
|
3163 Prefix argument SHOW-ALL means to select all articles."
|
|
3164 (interactive "P")
|
|
3165 (let ((current-subject (gnus-Subject-article-number)))
|
|
3166 (gnus-Subject-exit t)
|
|
3167 ;; We have to adjust the point of Group mode buffer because the
|
|
3168 ;; current point was moved to the next unread newsgroup by
|
|
3169 ;; exiting.
|
|
3170 (gnus-Subject-jump-to-group gnus-newsgroup-name)
|
|
3171 (gnus-Group-read-group show-all t)
|
|
3172 (gnus-Subject-goto-subject current-subject)
|
|
3173 ))
|
|
3174
|
|
3175 (defun gnus-Subject-caesar-message (rotnum)
|
|
3176 "Caesar rotates all letters of current message by 13/47 places.
|
|
3177 With prefix arg, specifies the number of places to rotate each letter forward.
|
|
3178 Caesar rotates Japanese letters by 47 places in any case."
|
|
3179 (interactive "P")
|
|
3180 (gnus-Subject-select-article)
|
|
3181 (gnus-overload-functions)
|
|
3182 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
3183 (save-restriction
|
|
3184 (widen)
|
|
3185 ;; We don't want to jump to the beginning of the message.
|
|
3186 ;; `save-excursion' does not do its job.
|
|
3187 (move-to-window-line 0)
|
|
3188 (let ((last (point)))
|
|
3189 (news-caesar-buffer-body rotnum)
|
|
3190 (goto-char last)
|
|
3191 (recenter 0)
|
|
3192 ))
|
|
3193 ))
|
|
3194
|
|
3195 (defun gnus-Subject-rmail-digest ()
|
|
3196 "Run RMAIL on current digest article.
|
|
3197 `gnus-Select-digest-hook' will be called with no arguments, if that
|
|
3198 value is non-nil. It is possible to modify the article so that Rmail
|
|
3199 can work with it.
|
|
3200
|
|
3201 `gnus-Rmail-digest-hook' will be called with no arguments, if that value
|
|
3202 is non-nil. The hook is intended to customize Rmail mode."
|
|
3203 (interactive)
|
|
3204 (gnus-Subject-select-article)
|
|
3205 (require 'rmail)
|
|
3206 (let ((artbuf gnus-Article-buffer)
|
|
3207 (digbuf (get-buffer-create gnus-Digest-buffer))
|
|
3208 (mail-header-separator ""))
|
|
3209 (set-buffer digbuf)
|
|
3210 (buffer-flush-undo (current-buffer))
|
|
3211 (setq buffer-read-only nil)
|
|
3212 (erase-buffer)
|
|
3213 (insert-buffer-substring artbuf)
|
|
3214 (run-hooks 'gnus-Select-digest-hook)
|
|
3215 (gnus-convert-article-to-rmail)
|
|
3216 (goto-char (point-min))
|
|
3217 ;; Rmail initializations.
|
|
3218 (rmail-insert-rmail-file-header)
|
|
3219 (rmail-mode)
|
|
3220 (rmail-set-message-counters)
|
|
3221 (rmail-show-message)
|
|
3222 (condition-case ()
|
|
3223 (progn
|
|
3224 (undigestify-rmail-message)
|
|
3225 (rmail-expunge) ;Delete original message.
|
|
3226 ;; File name is meaningless but `save-buffer' requires it.
|
|
3227 (setq buffer-file-name "GNUS Digest")
|
|
3228 (setq mode-line-buffer-identification
|
|
3229 (concat "Digest: "
|
|
3230 (nntp-header-subject gnus-current-headers)))
|
|
3231 ;; There is no need to write this buffer to a file.
|
|
3232 (make-local-variable 'write-file-hooks)
|
|
3233 (setq write-file-hooks
|
|
3234 (list (function
|
|
3235 (lambda ()
|
|
3236 (set-buffer-modified-p nil)
|
|
3237 (message "(No changes need to be saved)")
|
|
3238 'no-need-to-write-this-buffer))))
|
|
3239 ;; Default file name saving digest messages.
|
|
3240 (setq rmail-last-rmail-file
|
|
3241 (funcall gnus-rmail-save-name
|
|
3242 gnus-newsgroup-name
|
|
3243 gnus-current-headers
|
|
3244 gnus-newsgroup-last-rmail
|
|
3245 ))
|
|
3246 (setq rmail-last-file
|
|
3247 (funcall gnus-mail-save-name
|
|
3248 gnus-newsgroup-name
|
|
3249 gnus-current-headers
|
|
3250 gnus-newsgroup-last-mail
|
|
3251 ))
|
|
3252 ;; Prevent generating new buffer named ***<N> each time.
|
|
3253 (setq rmail-summary-buffer
|
|
3254 (get-buffer-create gnus-Digest-summary-buffer))
|
|
3255 (run-hooks 'gnus-Rmail-digest-hook)
|
|
3256 ;; Take all windows safely.
|
|
3257 (gnus-configure-windows '(1 0 0))
|
|
3258 (pop-to-buffer gnus-Group-buffer)
|
|
3259 ;; Use Subject and Article windows for Digest summary and
|
|
3260 ;; Digest buffers.
|
|
3261 (if gnus-digest-show-summary
|
|
3262 (let ((gnus-Subject-buffer gnus-Digest-summary-buffer)
|
|
3263 (gnus-Article-buffer gnus-Digest-buffer))
|
|
3264 (gnus-configure-windows 'SelectArticle)
|
|
3265 (pop-to-buffer gnus-Digest-buffer)
|
|
3266 (rmail-summary)
|
|
3267 (pop-to-buffer gnus-Digest-summary-buffer)
|
|
3268 (message (substitute-command-keys
|
|
3269 "Type \\[rmail-summary-quit] to return to GNUS")))
|
|
3270 (let ((gnus-Subject-buffer gnus-Digest-buffer))
|
|
3271 (gnus-configure-windows 'ExpandSubject)
|
|
3272 (pop-to-buffer gnus-Digest-buffer)
|
|
3273 (message (substitute-command-keys
|
|
3274 "Type \\[rmail-quit] to return to GNUS")))
|
|
3275 )
|
|
3276 ;; Move the buffers to the end of buffer list.
|
|
3277 (bury-buffer gnus-Article-buffer)
|
|
3278 (bury-buffer gnus-Group-buffer)
|
|
3279 (bury-buffer gnus-Digest-summary-buffer)
|
|
3280 (bury-buffer gnus-Digest-buffer))
|
|
3281 (error (set-buffer-modified-p nil)
|
|
3282 (kill-buffer digbuf)
|
|
3283 ;; This command should not signal an error because the
|
|
3284 ;; command is called from hooks.
|
|
3285 (ding) (message "Article is not a digest")))
|
|
3286 ))
|
|
3287
|
|
3288 (defun gnus-Subject-save-article ()
|
|
3289 "Save this article using default saver function.
|
|
3290 Variable `gnus-default-article-saver' specifies the saver function."
|
|
3291 (interactive)
|
|
3292 (gnus-Subject-select-article
|
|
3293 (not (null gnus-save-all-headers)) gnus-save-all-headers)
|
|
3294 (if gnus-default-article-saver
|
|
3295 (call-interactively gnus-default-article-saver)
|
|
3296 (error "No default saver is defined.")))
|
|
3297
|
|
3298 (defun gnus-Subject-save-in-rmail (&optional filename)
|
|
3299 "Append this article to Rmail file.
|
|
3300 Optional argument FILENAME specifies file name.
|
|
3301 Directory to save to is default to `gnus-article-save-directory' which
|
|
3302 is initialized from the SAVEDIR environment variable."
|
|
3303 (interactive)
|
|
3304 (gnus-Subject-select-article
|
|
3305 (not (null gnus-save-all-headers)) gnus-save-all-headers)
|
|
3306 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
3307 (save-excursion
|
|
3308 (save-restriction
|
|
3309 (widen)
|
|
3310 (let ((default-name
|
|
3311 (funcall gnus-rmail-save-name
|
|
3312 gnus-newsgroup-name
|
|
3313 gnus-current-headers
|
|
3314 gnus-newsgroup-last-rmail
|
|
3315 )))
|
|
3316 (or filename
|
|
3317 (setq filename
|
|
3318 (read-file-name
|
|
3319 (concat "Save article in Rmail file: (default "
|
|
3320 (file-name-nondirectory default-name)
|
|
3321 ") ")
|
|
3322 (file-name-directory default-name)
|
|
3323 default-name)))
|
|
3324 (gnus-make-directory (file-name-directory filename))
|
|
3325 (gnus-output-to-rmail filename)
|
|
3326 ;; Remember the directory name to save articles.
|
|
3327 (setq gnus-newsgroup-last-rmail filename)
|
|
3328 )))
|
|
3329 ))
|
|
3330
|
|
3331 (defun gnus-Subject-save-in-mail (&optional filename)
|
|
3332 "Append this article to Unix mail file.
|
|
3333 Optional argument FILENAME specifies file name.
|
|
3334 Directory to save to is default to `gnus-article-save-directory' which
|
|
3335 is initialized from the SAVEDIR environment variable."
|
|
3336 (interactive)
|
|
3337 (gnus-Subject-select-article
|
|
3338 (not (null gnus-save-all-headers)) gnus-save-all-headers)
|
|
3339 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
3340 (save-excursion
|
|
3341 (save-restriction
|
|
3342 (widen)
|
|
3343 (let ((default-name
|
|
3344 (funcall gnus-mail-save-name
|
|
3345 gnus-newsgroup-name
|
|
3346 gnus-current-headers
|
|
3347 gnus-newsgroup-last-mail
|
|
3348 )))
|
|
3349 (or filename
|
|
3350 (setq filename
|
|
3351 (read-file-name
|
|
3352 (concat "Save article in Unix mail file: (default "
|
|
3353 (file-name-nondirectory default-name)
|
|
3354 ") ")
|
|
3355 (file-name-directory default-name)
|
|
3356 default-name)))
|
|
3357 (gnus-make-directory (file-name-directory filename))
|
|
3358 (rmail-output filename)
|
|
3359 ;; Remember the directory name to save articles.
|
|
3360 (setq gnus-newsgroup-last-mail filename)
|
|
3361 )))
|
|
3362 ))
|
|
3363
|
|
3364 (defun gnus-Subject-save-in-file (&optional filename)
|
|
3365 "Append this article to file.
|
|
3366 Optional argument FILENAME specifies file name.
|
|
3367 Directory to save to is default to `gnus-article-save-directory' which
|
|
3368 is initialized from the SAVEDIR environment variable."
|
|
3369 (interactive)
|
|
3370 (gnus-Subject-select-article
|
|
3371 (not (null gnus-save-all-headers)) gnus-save-all-headers)
|
|
3372 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
3373 (save-excursion
|
|
3374 (save-restriction
|
|
3375 (widen)
|
|
3376 (let ((default-name
|
|
3377 (funcall gnus-file-save-name
|
|
3378 gnus-newsgroup-name
|
|
3379 gnus-current-headers
|
|
3380 gnus-newsgroup-last-file
|
|
3381 )))
|
|
3382 (or filename
|
|
3383 (setq filename
|
|
3384 (read-file-name
|
|
3385 (concat "Save article in file: (default "
|
|
3386 (file-name-nondirectory default-name)
|
|
3387 ") ")
|
|
3388 (file-name-directory default-name)
|
|
3389 default-name)))
|
|
3390 (gnus-make-directory (file-name-directory filename))
|
|
3391 (gnus-output-to-file filename)
|
|
3392 ;; Remember the directory name to save articles.
|
|
3393 (setq gnus-newsgroup-last-file filename)
|
|
3394 )))
|
|
3395 ))
|
|
3396
|
|
3397 (defun gnus-Subject-save-in-folder (&optional folder)
|
|
3398 "Save this article to MH folder (using `rcvstore' in MH library).
|
|
3399 Optional argument FOLDER specifies folder name."
|
|
3400 (interactive)
|
|
3401 (gnus-Subject-select-article
|
|
3402 (not (null gnus-save-all-headers)) gnus-save-all-headers)
|
|
3403 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
3404 (save-restriction
|
|
3405 (widen)
|
|
3406 ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
|
|
3407 (mh-find-path)
|
|
3408 (let ((folder
|
|
3409 (or folder
|
|
3410 (mh-prompt-for-folder "Save article in"
|
|
3411 (funcall gnus-folder-save-name
|
|
3412 gnus-newsgroup-name
|
|
3413 gnus-current-headers
|
|
3414 gnus-newsgroup-last-folder
|
|
3415 )
|
|
3416 t
|
|
3417 )))
|
|
3418 (errbuf (get-buffer-create " *GNUS rcvstore*")))
|
|
3419 (unwind-protect
|
|
3420 (call-process-region (point-min) (point-max)
|
|
3421 (expand-file-name "rcvstore" mh-lib)
|
|
3422 nil errbuf nil folder)
|
|
3423 (set-buffer errbuf)
|
|
3424 (if (zerop (buffer-size))
|
|
3425 (message "Article saved in folder: %s" folder)
|
|
3426 (message "%s" (buffer-string)))
|
|
3427 (kill-buffer errbuf)
|
|
3428 (setq gnus-newsgroup-last-folder folder))
|
|
3429 ))
|
|
3430 ))
|
|
3431
|
|
3432 (defun gnus-Subject-pipe-output ()
|
|
3433 "Pipe this article to subprocess."
|
|
3434 (interactive)
|
|
3435 ;; Ignore `gnus-save-all-headers' since this is not save command.
|
|
3436 (gnus-Subject-select-article)
|
|
3437 (gnus-eval-in-buffer-window gnus-Article-buffer
|
|
3438 (save-restriction
|
|
3439 (widen)
|
|
3440 (let ((command (read-string "Shell command on article: "
|
|
3441 gnus-last-shell-command)))
|
|
3442 (if (string-equal command "")
|
|
3443 (setq command gnus-last-shell-command))
|
|
3444 (shell-command-on-region (point-min) (point-max) command nil)
|
|
3445 (setq gnus-last-shell-command command)
|
|
3446 ))
|
|
3447 ))
|
|
3448
|
|
3449 (defun gnus-Subject-catch-up (all &optional quietly)
|
|
3450 "Mark all articles not marked as unread in this newsgroup as read.
|
|
3451 If prefix argument ALL is non-nil, all articles are marked as read."
|
|
3452 (interactive "P")
|
|
3453 (if (or quietly
|
|
3454 (y-or-n-p
|
|
3455 (if all
|
|
3456 "Do you really want to mark everything as read? "
|
|
3457 "Delete all articles not marked as unread? ")))
|
|
3458 (let ((unmarked
|
|
3459 (gnus-set-difference gnus-newsgroup-unreads
|
|
3460 (if (not all) gnus-newsgroup-marked))))
|
|
3461 (message "") ;Erase "Yes or No" question.
|
|
3462 (while unmarked
|
|
3463 (gnus-Subject-mark-as-read (car unmarked) "C")
|
|
3464 (setq unmarked (cdr unmarked))
|
|
3465 ))
|
|
3466 ))
|
|
3467
|
|
3468 (defun gnus-Subject-catch-up-all (&optional quietly)
|
|
3469 "Mark all articles in this newsgroup as read."
|
|
3470 (interactive)
|
|
3471 (gnus-Subject-catch-up t quietly))
|
|
3472
|
|
3473 (defun gnus-Subject-catch-up-and-exit (all &optional quietly)
|
|
3474 "Mark all articles not marked as unread in this newsgroup as read, then exit.
|
|
3475 If prefix argument ALL is non-nil, all articles are marked as read."
|
|
3476 (interactive "P")
|
|
3477 (if (or quietly
|
|
3478 (y-or-n-p
|
|
3479 (if all
|
|
3480 "Do you really want to mark everything as read? "
|
|
3481 "Delete all articles not marked as unread? ")))
|
|
3482 (let ((unmarked
|
|
3483 (gnus-set-difference gnus-newsgroup-unreads
|
|
3484 (if (not all) gnus-newsgroup-marked))))
|
|
3485 (message "") ;Erase "Yes or No" question.
|
|
3486 (while unmarked
|
|
3487 (gnus-mark-article-as-read (car unmarked))
|
|
3488 (setq unmarked (cdr unmarked)))
|
|
3489 ;; Select next newsgroup or exit.
|
|
3490 (cond ((eq gnus-auto-select-next 'quietly)
|
|
3491 ;; Select next newsgroup quietly.
|
|
3492 (gnus-Subject-next-group nil))
|
|
3493 (t
|
|
3494 (gnus-Subject-exit)))
|
|
3495 )))
|
|
3496
|
|
3497 (defun gnus-Subject-catch-up-all-and-exit (&optional quietly)
|
|
3498 "Mark all articles in this newsgroup as read, and then exit."
|
|
3499 (interactive)
|
|
3500 (gnus-Subject-catch-up-and-exit t quietly))
|
|
3501
|
|
3502 (defun gnus-Subject-edit-global-kill ()
|
|
3503 "Edit a global KILL file."
|
|
3504 (interactive)
|
|
3505 (setq gnus-current-kill-article (gnus-Subject-article-number))
|
|
3506 (gnus-Kill-file-edit-file nil) ;Nil stands for global KILL file.
|
|
3507 (message
|
|
3508 (substitute-command-keys
|
|
3509 "Editing a global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
|
|
3510
|
|
3511 (defun gnus-Subject-edit-local-kill ()
|
|
3512 "Edit a local KILL file applied to the current newsgroup."
|
|
3513 (interactive)
|
|
3514 (setq gnus-current-kill-article (gnus-Subject-article-number))
|
|
3515 (gnus-Kill-file-edit-file gnus-newsgroup-name)
|
|
3516 (message
|
|
3517 (substitute-command-keys
|
|
3518 "Editing a local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
|
|
3519
|
|
3520 (defun gnus-Subject-exit (&optional temporary)
|
|
3521 "Exit reading current newsgroup, and then return to group selection mode.
|
|
3522 gnus-Exit-group-hook is called with no arguments if that value is non-nil."
|
|
3523 (interactive)
|
|
3524 (let ((updated nil)
|
|
3525 (gnus-newsgroup-headers gnus-newsgroup-headers)
|
|
3526 (gnus-newsgroup-unreads gnus-newsgroup-unreads)
|
|
3527 (gnus-newsgroup-unselected gnus-newsgroup-unselected)
|
|
3528 (gnus-newsgroup-marked gnus-newsgroup-marked))
|
|
3529 ;; Important internal variables are save, so we can reenter
|
|
3530 ;; Subject Mode buffer even if hook changes them.
|
|
3531 (run-hooks 'gnus-Exit-group-hook)
|
|
3532 (gnus-update-unread-articles gnus-newsgroup-name
|
|
3533 (append gnus-newsgroup-unselected
|
|
3534 gnus-newsgroup-unreads)
|
|
3535 gnus-newsgroup-marked)
|
|
3536 ;; T means ignore unsubscribed newsgroups.
|
|
3537 (if gnus-use-cross-reference
|
|
3538 (setq updated
|
|
3539 (gnus-mark-as-read-by-xref gnus-newsgroup-name
|
|
3540 gnus-newsgroup-headers
|
|
3541 gnus-newsgroup-unreads
|
|
3542 (eq gnus-use-cross-reference t)
|
|
3543 )))
|
|
3544 ;; Do not switch windows but change the buffer to work.
|
|
3545 (set-buffer gnus-Group-buffer)
|
|
3546 ;; Update cross referenced group info.
|
|
3547 (while updated
|
|
3548 (gnus-Group-update-group (car updated) t) ;Ignore invisible group.
|
|
3549 (setq updated (cdr updated)))
|
|
3550 (gnus-Group-update-group gnus-newsgroup-name))
|
|
3551 ;; Make sure where I was, and go to next newsgroup.
|
|
3552 (gnus-Group-jump-to-group gnus-newsgroup-name)
|
|
3553 (gnus-Group-next-unread-group 1)
|
|
3554 (if temporary
|
|
3555 ;; If exiting temporary, caller should adjust Group mode
|
|
3556 ;; buffer point by itself.
|
|
3557 nil ;Nothing to do.
|
|
3558 ;; Return to Group mode buffer.
|
|
3559 (if (get-buffer gnus-Subject-buffer)
|
|
3560 (bury-buffer gnus-Subject-buffer))
|
|
3561 (if (get-buffer gnus-Article-buffer)
|
|
3562 (bury-buffer gnus-Article-buffer))
|
|
3563 (gnus-configure-windows 'ExitNewsgroup)
|
|
3564 (pop-to-buffer gnus-Group-buffer)))
|
|
3565
|
|
3566 (defun gnus-Subject-quit ()
|
|
3567 "Quit reading current newsgroup without updating read article info."
|
|
3568 (interactive)
|
|
3569 (if (y-or-n-p "Do you really wanna quit reading this group? ")
|
|
3570 (progn
|
|
3571 (message "") ;Erase "Yes or No" question.
|
|
3572 ;; Return to Group selection mode.
|
|
3573 (if (get-buffer gnus-Subject-buffer)
|
|
3574 (bury-buffer gnus-Subject-buffer))
|
|
3575 (if (get-buffer gnus-Article-buffer)
|
|
3576 (bury-buffer gnus-Article-buffer))
|
|
3577 (gnus-configure-windows 'ExitNewsgroup)
|
|
3578 (pop-to-buffer gnus-Group-buffer)
|
|
3579 (gnus-Group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
|
|
3580 (gnus-Group-next-group 1) ;(gnus-Group-next-unread-group 1)
|
|
3581 )))
|
|
3582
|
|
3583 (defun gnus-Subject-describe-briefly ()
|
|
3584 "Describe Subject mode commands briefly."
|
|
3585 (interactive)
|
|
3586 (message
|
|
3587 (concat
|
|
3588 (substitute-command-keys "\\[gnus-Subject-next-page]:Select ")
|
|
3589 (substitute-command-keys "\\[gnus-Subject-next-unread-article]:Forward ")
|
|
3590 (substitute-command-keys "\\[gnus-Subject-prev-unread-article]:Backward ")
|
|
3591 (substitute-command-keys "\\[gnus-Subject-exit]:Exit ")
|
|
3592 (substitute-command-keys "\\[gnus-Info-find-node]:Run Info ")
|
|
3593 (substitute-command-keys "\\[gnus-Subject-describe-briefly]:This help")
|
|
3594 )))
|
|
3595
|
|
3596
|
|
3597 ;;;
|
|
3598 ;;; GNUS Article Mode
|
|
3599 ;;;
|
|
3600
|
|
3601 (if gnus-Article-mode-map
|
|
3602 nil
|
|
3603 (setq gnus-Article-mode-map (make-keymap))
|
|
3604 (suppress-keymap gnus-Article-mode-map)
|
|
3605 (define-key gnus-Article-mode-map " " 'gnus-Article-next-page)
|
|
3606 (define-key gnus-Article-mode-map "\177" 'gnus-Article-prev-page)
|
|
3607 (define-key gnus-Article-mode-map "r" 'gnus-Article-refer-article)
|
|
3608 (define-key gnus-Article-mode-map "o" 'gnus-Article-pop-article)
|
|
3609 (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects)
|
|
3610 (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects)
|
|
3611 (define-key gnus-Article-mode-map "?" 'gnus-Article-describe-briefly)
|
|
3612 (define-key gnus-Article-mode-map "\C-c\C-i" 'gnus-Info-find-node))
|
|
3613
|
|
3614 (defun gnus-Article-mode ()
|
|
3615 "Major mode for browsing through an article.
|
|
3616 All normal editing commands are turned off.
|
|
3617 Instead, these commands are available:
|
|
3618 \\{gnus-Article-mode-map}
|
|
3619
|
|
3620 Various hooks for customization:
|
|
3621 gnus-Article-mode-hook
|
|
3622 Entry to this mode calls the value with no arguments, if that
|
|
3623 value is non-nil.
|
|
3624
|
|
3625 gnus-Article-prepare-hook
|
|
3626 Called with no arguments after an article is prepared for reading,
|
|
3627 if that value is non-nil."
|
|
3628 (interactive)
|
|
3629 (kill-all-local-variables)
|
|
3630 ;; Gee. Why don't you upgrade?
|
|
3631 (cond ((boundp 'mode-line-modified)
|
|
3632 (setq mode-line-modified "--- "))
|
|
3633 ((listp (default-value 'mode-line-format))
|
|
3634 (setq mode-line-format
|
|
3635 (cons "--- " (cdr (default-value 'mode-line-format))))))
|
|
3636 (make-local-variable 'global-mode-string)
|
|
3637 (setq global-mode-string nil)
|
|
3638 (setq major-mode 'gnus-Article-mode)
|
|
3639 (setq mode-name "Article")
|
|
3640 (gnus-Article-set-mode-line)
|
|
3641 (use-local-map gnus-Article-mode-map)
|
|
3642 (make-local-variable 'page-delimiter)
|
|
3643 (setq page-delimiter gnus-page-delimiter)
|
|
3644 (make-local-variable 'mail-header-separator)
|
|
3645 (setq mail-header-separator "") ;For caesar function.
|
|
3646 (buffer-flush-undo (current-buffer))
|
|
3647 (setq buffer-read-only t) ;Disable modification
|
|
3648 (run-hooks 'gnus-Article-mode-hook))
|
|
3649
|
|
3650 (defun gnus-Article-setup-buffer ()
|
|
3651 "Initialize Article mode buffer."
|
|
3652 (or (get-buffer gnus-Article-buffer)
|
|
3653 (save-excursion
|
|
3654 (set-buffer (get-buffer-create gnus-Article-buffer))
|
|
3655 (gnus-Article-mode))
|
|
3656 ))
|
|
3657
|
|
3658 (defun gnus-Article-prepare (article &optional all-headers)
|
|
3659 "Prepare ARTICLE in Article mode buffer.
|
|
3660 If optional argument ALL-HEADERS is non-nil, all headers are inserted."
|
|
3661 (save-excursion
|
|
3662 (set-buffer gnus-Article-buffer)
|
|
3663 (let ((buffer-read-only nil))
|
|
3664 (erase-buffer)
|
|
3665 (if (gnus-request-article article)
|
|
3666 (progn
|
|
3667 ;; Prepare article buffer
|
|
3668 (insert-buffer-substring nntp-server-buffer)
|
|
3669 (setq gnus-have-all-headers (or all-headers gnus-show-all-headers))
|
|
3670 (if (and (numberp article)
|
|
3671 (not (eq article gnus-current-article)))
|
|
3672 ;; Seems me that a new article is selected.
|
|
3673 (progn
|
|
3674 ;; gnus-current-article must be an article number.
|
|
3675 (setq gnus-last-article gnus-current-article)
|
|
3676 (setq gnus-current-article article)
|
|
3677 (setq gnus-current-headers
|
|
3678 (gnus-find-header-by-number gnus-newsgroup-headers
|
|
3679 gnus-current-article))
|
|
3680 ;; Clear articles history only when articles are
|
|
3681 ;; retrieved by article numbers.
|
|
3682 (setq gnus-current-history nil)
|
|
3683 (run-hooks 'gnus-Mark-article-hook)
|
|
3684 ))
|
|
3685 ;; Hooks for modifying contents of the article. This hook
|
|
3686 ;; must be called before being narrowed.
|
|
3687 (run-hooks 'gnus-Article-prepare-hook)
|
|
3688 ;; Delete unnecessary headers.
|
|
3689 (or gnus-have-all-headers
|
|
3690 (gnus-Article-delete-headers))
|
|
3691 ;; Do page break.
|
|
3692 (goto-char (point-min))
|
|
3693 (if gnus-break-pages
|
|
3694 (gnus-narrow-to-page))
|
|
3695 ;; Next function must be called after setting
|
|
3696 ;; `gnus-current-article' variable and narrowed to page.
|
|
3697 (gnus-Article-set-mode-line)
|
|
3698 )
|
|
3699 (if (numberp article)
|
|
3700 (gnus-Subject-mark-as-read article))
|
|
3701 (ding) (message "No such article (may be canceled)"))
|
|
3702 )))
|
|
3703
|
|
3704 (defun gnus-Article-show-all-headers ()
|
|
3705 "Show all article headers in Article mode buffer."
|
|
3706 (or gnus-have-all-headers
|
|
3707 (gnus-Article-prepare gnus-current-article t)))
|
|
3708
|
|
3709 ;;(defun gnus-Article-set-mode-line ()
|
|
3710 ;; "Set Article mode line string."
|
|
3711 ;; (setq mode-line-buffer-identification
|
|
3712 ;; (list 17
|
|
3713 ;; (format "GNUS: %s {%d-%d} %d"
|
|
3714 ;; gnus-newsgroup-name
|
|
3715 ;; gnus-newsgroup-begin
|
|
3716 ;; gnus-newsgroup-end
|
|
3717 ;; gnus-current-article
|
|
3718 ;; )))
|
|
3719 ;; (set-buffer-modified-p t))
|
|
3720
|
|
3721 (defun gnus-Article-set-mode-line ()
|
|
3722 "Set Article mode line string."
|
|
3723 (let ((unmarked
|
|
3724 (- (length gnus-newsgroup-unreads)
|
|
3725 (length (gnus-intersection
|
|
3726 gnus-newsgroup-unreads gnus-newsgroup-marked))))
|
|
3727 (unselected
|
|
3728 (- (length gnus-newsgroup-unselected)
|
|
3729 (length (gnus-intersection
|
|
3730 gnus-newsgroup-unselected gnus-newsgroup-marked)))))
|
|
3731 (setq mode-line-buffer-identification
|
|
3732 (list 17
|
|
3733 (format "GNUS: %s{%d} %s"
|
|
3734 gnus-newsgroup-name
|
|
3735 gnus-current-article
|
|
3736 ;; This is proposed by tale@pawl.rpi.edu.
|
|
3737 (cond ((and (zerop unmarked)
|
|
3738 (zerop unselected))
|
|
3739 " ")
|
|
3740 ((zerop unselected)
|
|
3741 (format "%d more" unmarked))
|
|
3742 (t
|
|
3743 (format "%d(+%d) more" unmarked unselected)))
|
|
3744 ))))
|
|
3745 (set-buffer-modified-p t))
|
|
3746
|
|
3747 (defun gnus-Article-delete-headers ()
|
|
3748 "Delete unnecessary headers."
|
|
3749 (save-excursion
|
|
3750 (save-restriction
|
|
3751 (goto-char (point-min))
|
|
3752 (narrow-to-region (point-min)
|
|
3753 (progn (search-forward "\n\n" nil 'move) (point)))
|
|
3754 (goto-char (point-min))
|
|
3755 (and (stringp gnus-ignored-headers)
|
|
3756 (while (re-search-forward gnus-ignored-headers nil t)
|
|
3757 (beginning-of-line)
|
|
3758 (delete-region (point)
|
|
3759 (progn (re-search-forward "\n[^ \t]")
|
|
3760 (forward-char -1)
|
|
3761 (point)))))
|
|
3762 )))
|
|
3763
|
|
3764 ;; Working on article's buffer
|
|
3765
|
|
3766 (defun gnus-Article-next-page (lines)
|
|
3767 "Show next page of current article.
|
|
3768 If end of article, return non-nil. Otherwise return nil.
|
|
3769 Argument LINES specifies lines to be scrolled up."
|
|
3770 (interactive "P")
|
|
3771 (move-to-window-line -1)
|
|
3772 ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
|
|
3773 (if (save-excursion
|
|
3774 (end-of-line)
|
|
3775 (and (pos-visible-in-window-p) ;Not continuation line.
|
|
3776 (eobp)))
|
|
3777 ;; Nothing in this page.
|
|
3778 (if (or (not gnus-break-pages)
|
|
3779 (save-excursion
|
|
3780 (save-restriction
|
|
3781 (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
|
|
3782 t ;Nothing more.
|
|
3783 (gnus-narrow-to-page 1) ;Go to next page.
|
|
3784 nil
|
|
3785 )
|
|
3786 ;; More in this page.
|
|
3787 (condition-case ()
|
|
3788 (scroll-up lines)
|
|
3789 (end-of-buffer
|
|
3790 ;; Long lines may cause an end-of-buffer error.
|
|
3791 (goto-char (point-max))))
|
|
3792 nil
|
|
3793 ))
|
|
3794
|
|
3795 (defun gnus-Article-prev-page (lines)
|
|
3796 "Show previous page of current article.
|
|
3797 Argument LINES specifies lines to be scrolled down."
|
|
3798 (interactive "P")
|
|
3799 (move-to-window-line 0)
|
|
3800 (if (and gnus-break-pages
|
|
3801 (bobp)
|
|
3802 (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
|
|
3803 (progn
|
|
3804 (gnus-narrow-to-page -1) ;Go to previous page.
|
|
3805 (goto-char (point-max))
|
|
3806 (recenter -1))
|
|
3807 (scroll-down lines)))
|
|
3808
|
|
3809 (defun gnus-Article-next-digest (nth)
|
|
3810 "Move to head of NTH next digested message.
|
|
3811 Set mark at end of digested message."
|
|
3812 ;; Stop page breaking in digest mode.
|
|
3813 (widen)
|
|
3814 (end-of-line)
|
|
3815 ;; Skip NTH - 1 digest.
|
|
3816 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
|
|
3817 ;; Digest separator is customizable.
|
|
3818 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
|
|
3819 (while (and (> nth 1)
|
|
3820 (re-search-forward gnus-digest-separator nil 'move))
|
|
3821 (setq nth (1- nth)))
|
|
3822 (if (re-search-forward gnus-digest-separator nil t)
|
|
3823 (let ((begin (point)))
|
|
3824 ;; Search for end of this message.
|
|
3825 (end-of-line)
|
|
3826 (if (re-search-forward gnus-digest-separator nil t)
|
|
3827 (progn
|
|
3828 (search-backward "\n\n") ;This may be incorrect.
|
|
3829 (forward-line 1))
|
|
3830 (goto-char (point-max)))
|
|
3831 (push-mark) ;Set mark at end of digested message.
|
|
3832 (goto-char begin)
|
|
3833 (beginning-of-line)
|
|
3834 ;; Show From: and Subject: fields.
|
|
3835 (recenter 1))
|
|
3836 (message "End of message")
|
|
3837 ))
|
|
3838
|
|
3839 (defun gnus-Article-prev-digest (nth)
|
|
3840 "Move to head of NTH previous digested message."
|
|
3841 ;; Stop page breaking in digest mode.
|
|
3842 (widen)
|
|
3843 (beginning-of-line)
|
|
3844 ;; Skip NTH - 1 digest.
|
|
3845 ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
|
|
3846 ;; Digest separator is customizable.
|
|
3847 ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
|
|
3848 (while (and (> nth 1)
|
|
3849 (re-search-backward gnus-digest-separator nil 'move))
|
|
3850 (setq nth (1- nth)))
|
|
3851 (if (re-search-backward gnus-digest-separator nil t)
|
|
3852 (let ((begin (point)))
|
|
3853 ;; Search for end of this message.
|
|
3854 (end-of-line)
|
|
3855 (if (re-search-forward gnus-digest-separator nil t)
|
|
3856 (progn
|
|
3857 (search-backward "\n\n") ;This may be incorrect.
|
|
3858 (forward-line 1))
|
|
3859 (goto-char (point-max)))
|
|
3860 (push-mark) ;Set mark at end of digested message.
|
|
3861 (goto-char begin)
|
|
3862 ;; Show From: and Subject: fields.
|
|
3863 (recenter 1))
|
|
3864 (goto-char (point-min))
|
|
3865 (message "Top of message")
|
|
3866 ))
|
|
3867
|
|
3868 (defun gnus-Article-refer-article ()
|
|
3869 "Read article specified by message-id around point."
|
|
3870 (interactive)
|
|
3871 (save-window-excursion
|
|
3872 (save-excursion
|
|
3873 (re-search-forward ">" nil t) ;Move point to end of "<....>".
|
|
3874 (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
|
|
3875 (let ((message-id
|
|
3876 (buffer-substring (match-beginning 1) (match-end 1))))
|
|
3877 (set-buffer gnus-Subject-buffer)
|
|
3878 (gnus-Subject-refer-article message-id))
|
|
3879 (error "No references around point"))
|
|
3880 )))
|
|
3881
|
|
3882 (defun gnus-Article-pop-article ()
|
|
3883 "Pop up article history."
|
|
3884 (interactive)
|
|
3885 (save-window-excursion
|
|
3886 (set-buffer gnus-Subject-buffer)
|
|
3887 (gnus-Subject-refer-article nil)))
|
|
3888
|
|
3889 (defun gnus-Article-show-subjects ()
|
|
3890 "Reconfigure windows to show headers."
|
|
3891 (interactive)
|
|
3892 (gnus-configure-windows 'SelectArticle)
|
|
3893 (pop-to-buffer gnus-Subject-buffer)
|
|
3894 (gnus-Subject-goto-subject gnus-current-article))
|
|
3895
|
|
3896 (defun gnus-Article-describe-briefly ()
|
|
3897 "Describe Article mode commands briefly."
|
|
3898 (interactive)
|
|
3899 (message
|
|
3900 (concat
|
|
3901 (substitute-command-keys "\\[gnus-Article-next-page]:Next page ")
|
|
3902 (substitute-command-keys "\\[gnus-Article-prev-page]:Prev page ")
|
|
3903 (substitute-command-keys "\\[gnus-Article-show-subjects]:Show headers ")
|
|
3904 (substitute-command-keys "\\[gnus-Info-find-node]:Run Info ")
|
|
3905 (substitute-command-keys "\\[gnus-Article-describe-briefly]:This help")
|
|
3906 )))
|
|
3907
|
|
3908
|
|
3909 ;;;
|
|
3910 ;;; GNUS KILL-File Mode
|
|
3911 ;;;
|
|
3912
|
|
3913 (if gnus-Kill-file-mode-map
|
|
3914 nil
|
|
3915 (setq gnus-Kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
|
|
3916 (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-s" 'gnus-Kill-file-kill-by-subject)
|
|
3917 (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-a" 'gnus-Kill-file-kill-by-author)
|
|
3918 (define-key gnus-Kill-file-mode-map "\C-c\C-a" 'gnus-Kill-file-apply-buffer)
|
|
3919 (define-key gnus-Kill-file-mode-map "\C-c\C-e" 'gnus-Kill-file-apply-last-sexp)
|
|
3920 (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit)
|
|
3921 (define-key gnus-Kill-file-mode-map "\C-c\C-i" 'gnus-Info-find-node))
|
|
3922
|
|
3923 (defun gnus-Kill-file-mode ()
|
|
3924 "Major mode for editing KILL file.
|
|
3925
|
|
3926 In addition to Emacs-Lisp Mode, the following commands are available:
|
|
3927
|
|
3928 \\[gnus-Kill-file-kill-by-subject] Insert KILL command for current subject.
|
|
3929 \\[gnus-Kill-file-kill-by-author] Insert KILL command for current author.
|
|
3930 \\[gnus-Kill-file-apply-buffer] Apply current buffer to selected newsgroup.
|
|
3931 \\[gnus-Kill-file-apply-last-sexp] Apply sexp before point to selected newsgroup.
|
|
3932 \\[gnus-Kill-file-exit] Save file and exit editing KILL file.
|
|
3933 \\[gnus-Info-find-node] Read Info about KILL file.
|
|
3934
|
|
3935 A KILL file contains lisp expressions to be applied to a selected
|
|
3936 newsgroup. The purpose is to mark articles as read on the basis of
|
|
3937 some set of regexps. A global KILL file is applied to every newsgroup,
|
|
3938 and a local KILL file is applied to a specified newsgroup. Since a
|
|
3939 global KILL file is applied to every newsgroup, for better performance
|
|
3940 use a local one.
|
|
3941
|
|
3942 A KILL file can contain any kind of Emacs lisp expressions expected
|
|
3943 to be evaluated in the Subject buffer. Writing lisp programs for this
|
|
3944 purpose is not so easy because the internal working of GNUS must be
|
|
3945 well-known. For this reason, GNUS provides a general function which
|
|
3946 does this easily for non-Lisp programmers.
|
|
3947
|
|
3948 The `gnus-kill' function executes commands available in Subject Mode
|
|
3949 by their key sequences. `gnus-kill' should be called with FIELD,
|
|
3950 REGEXP and optional COMMAND and ALL. FIELD is a string representing
|
|
3951 the header field or an empty string. If FIELD is an empty string, the
|
|
3952 entire article body is searched for. REGEXP is a string which is
|
|
3953 compared with FIELD value. COMMAND is a string representing a valid
|
|
3954 key sequence in Subject Mode or Lisp expression. COMMAND is default to
|
|
3955 '(gnus-Subject-mark-as-read nil \"X\"). Make sure that COMMAND is
|
|
3956 executed in the Subject buffer. If the second optional argument ALL
|
|
3957 is non-nil, the COMMAND is applied to articles which are already
|
|
3958 marked as read or unread. Articles which are marked are skipped over
|
|
3959 by default.
|
|
3960
|
|
3961 For example, if you want to mark articles of which subjects contain
|
|
3962 the string `AI' as read, a possible KILL file may look like:
|
|
3963
|
|
3964 (gnus-kill \"Subject\" \"AI\")
|
|
3965
|
|
3966 If you want to mark articles with `D' instead of `X', you can use
|
|
3967 the following expression:
|
|
3968
|
|
3969 (gnus-kill \"Subject\" \"AI\" \"d\")
|
|
3970
|
|
3971 In this example it is assumed that the command
|
|
3972 `gnus-Subject-mark-as-read-forward' is assigned to `d' in Subject Mode.
|
|
3973
|
|
3974 It is possible to delete unnecessary headers which are marked with
|
|
3975 `X' in a KILL file as follows:
|
|
3976
|
|
3977 (gnus-expunge \"X\")
|
|
3978
|
|
3979 If the Subject buffer is empty after applying KILL files, GNUS will
|
|
3980 exit the selected newsgroup normally. If headers which are marked
|
|
3981 with `D' are deleted in a KILL file, it is impossible to read articles
|
|
3982 which are marked as read in the previous GNUS sessions. Marks other
|
|
3983 than `D' should be used for articles which should really be deleted.
|
|
3984
|
|
3985 Entry to this mode calls emacs-lisp-mode-hook and
|
|
3986 gnus-Kill-file-mode-hook with no arguments, if that value is non-nil."
|
|
3987 (interactive)
|
|
3988 (kill-all-local-variables)
|
|
3989 (use-local-map gnus-Kill-file-mode-map)
|
|
3990 (set-syntax-table emacs-lisp-mode-syntax-table)
|
|
3991 (setq major-mode 'gnus-Kill-file-mode)
|
|
3992 (setq mode-name "KILL-File")
|
|
3993 (lisp-mode-variables nil)
|
|
3994 (run-hooks 'emacs-lisp-mode-hook 'gnus-Kill-file-mode-hook))
|
|
3995
|
|
3996 (defun gnus-Kill-file-edit-file (newsgroup)
|
|
3997 "Begin editing a KILL file of NEWSGROUP.
|
|
3998 If NEWSGROUP is nil, the global KILL file is selected."
|
|
3999 (interactive "sNewsgroup: ")
|
|
4000 (let ((file (gnus-newsgroup-kill-file newsgroup)))
|
|
4001 (gnus-make-directory (file-name-directory file))
|
|
4002 ;; Save current window configuration if this is first invocation.
|
|
4003 (or (and (get-file-buffer file)
|
|
4004 (get-buffer-window (get-file-buffer file)))
|
|
4005 (setq gnus-winconf-kill-file (current-window-configuration)))
|
|
4006 ;; Hack windows.
|
|
4007 (let ((buffer (find-file-noselect file)))
|
|
4008 (cond ((get-buffer-window buffer)
|
|
4009 (pop-to-buffer buffer))
|
|
4010 ((eq major-mode 'gnus-Group-mode)
|
|
4011 (gnus-configure-windows '(1 0 0)) ;Take all windows.
|
|
4012 (pop-to-buffer gnus-Group-buffer)
|
|
4013 (let ((gnus-Subject-buffer buffer))
|
|
4014 (gnus-configure-windows '(1 1 0)) ;Split into two.
|
|
4015 (pop-to-buffer buffer)))
|
|
4016 ((eq major-mode 'gnus-Subject-mode)
|
|
4017 (gnus-configure-windows 'SelectArticle)
|
|
4018 (pop-to-buffer gnus-Article-buffer)
|
|
4019 (bury-buffer gnus-Article-buffer)
|
|
4020 (switch-to-buffer buffer))
|
|
4021 (t ;No good rules.
|
|
4022 (find-file-other-window file))
|
|
4023 ))
|
|
4024 (gnus-Kill-file-mode)
|
|
4025 ))
|
|
4026
|
|
4027 (defun gnus-Kill-file-kill-by-subject ()
|
|
4028 "Insert KILL command for current subject."
|
|
4029 (interactive)
|
|
4030 (insert
|
|
4031 (format "(gnus-kill \"Subject\" %s)\n"
|
|
4032 (prin1-to-string
|
|
4033 (if gnus-current-kill-article
|
|
4034 (regexp-quote
|
|
4035 (nntp-header-subject
|
|
4036 (gnus-find-header-by-number gnus-newsgroup-headers
|
|
4037 gnus-current-kill-article)))
|
|
4038 "")))))
|
|
4039
|
|
4040 (defun gnus-Kill-file-kill-by-author ()
|
|
4041 "Insert KILL command for current author."
|
|
4042 (interactive)
|
|
4043 (insert
|
|
4044 (format "(gnus-kill \"From\" %s)\n"
|
|
4045 (prin1-to-string
|
|
4046 (if gnus-current-kill-article
|
|
4047 (regexp-quote
|
|
4048 (nntp-header-from
|
|
4049 (gnus-find-header-by-number gnus-newsgroup-headers
|
|
4050 gnus-current-kill-article)))
|
|
4051 "")))))
|
|
4052
|
|
4053 (defun gnus-Kill-file-apply-buffer ()
|
|
4054 "Apply current buffer to current newsgroup."
|
|
4055 (interactive)
|
|
4056 (if (and gnus-current-kill-article
|
|
4057 (get-buffer gnus-Subject-buffer))
|
|
4058 ;; Assume newsgroup is selected.
|
|
4059 (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
|
|
4060 (save-excursion
|
|
4061 (save-window-excursion
|
|
4062 (pop-to-buffer gnus-Subject-buffer)
|
|
4063 (eval (car (read-from-string string))))))
|
|
4064 (ding) (message "No newsgroup is selected.")))
|
|
4065
|
|
4066 (defun gnus-Kill-file-apply-last-sexp ()
|
|
4067 "Apply sexp before point in current buffer to current newsgroup."
|
|
4068 (interactive)
|
|
4069 (if (and gnus-current-kill-article
|
|
4070 (get-buffer gnus-Subject-buffer))
|
|
4071 ;; Assume newsgroup is selected.
|
|
4072 (let ((string
|
|
4073 (buffer-substring
|
|
4074 (save-excursion (forward-sexp -1) (point)) (point))))
|
|
4075 (save-excursion
|
|
4076 (save-window-excursion
|
|
4077 (pop-to-buffer gnus-Subject-buffer)
|
|
4078 (eval (car (read-from-string string))))))
|
|
4079 (ding) (message "No newsgroup is selected.")))
|
|
4080
|
|
4081 (defun gnus-Kill-file-exit ()
|
|
4082 "Save a KILL file, then return to the previous buffer."
|
|
4083 (interactive)
|
|
4084 (save-buffer)
|
|
4085 (let ((killbuf (current-buffer)))
|
|
4086 ;; We don't want to return to Article buffer.
|
|
4087 (and (get-buffer gnus-Article-buffer)
|
|
4088 (bury-buffer (get-buffer gnus-Article-buffer)))
|
|
4089 ;; Delete the KILL file windows.
|
|
4090 (delete-windows-on killbuf)
|
|
4091 ;; Restore last window configuration if available.
|
|
4092 (and gnus-winconf-kill-file
|
|
4093 (set-window-configuration gnus-winconf-kill-file))
|
|
4094 (setq gnus-winconf-kill-file nil)
|
|
4095 ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu.
|
|
4096 (kill-buffer killbuf)))
|
|
4097
|
|
4098
|
|
4099 ;;;
|
|
4100 ;;; Utility functions
|
|
4101 ;;;
|
|
4102
|
|
4103 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
|
|
4104
|
|
4105 (defun gnus-batch-kill ()
|
|
4106 "Run batched KILL.
|
|
4107 Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
|
|
4108 (if (not noninteractive)
|
|
4109 (error "gnus-batch-kill is to be used only with -batch"))
|
|
4110 (let* ((group nil)
|
|
4111 (subscribed nil)
|
|
4112 (newsrc nil)
|
|
4113 (yes-and-no
|
|
4114 (gnus-parse-n-options
|
|
4115 (apply (function concat)
|
|
4116 (mapcar (function (lambda (g) (concat g " ")))
|
|
4117 command-line-args-left))))
|
|
4118 (yes (car yes-and-no))
|
|
4119 (no (cdr yes-and-no))
|
|
4120 ;; Disable verbose message.
|
|
4121 (gnus-novice-user nil)
|
|
4122 (gnus-large-newsgroup nil)
|
|
4123 (nntp-large-newsgroup nil))
|
|
4124 ;; Eat all arguments.
|
|
4125 (setq command-line-args-left nil)
|
|
4126 ;; Startup GNUS.
|
|
4127 (gnus)
|
|
4128 ;; Apply kills to specified newsgroups in command line arguments.
|
|
4129 (setq newsrc (copy-sequence gnus-newsrc-assoc))
|
|
4130 (while newsrc
|
|
4131 (setq group (car (car newsrc)))
|
|
4132 (setq subscribed (nth 1 (car newsrc)))
|
|
4133 (setq newsrc (cdr newsrc))
|
|
4134 (if (and subscribed
|
|
4135 (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
|
|
4136 (if yes
|
|
4137 (string-match yes group) t)
|
|
4138 (or (null no)
|
|
4139 (not (string-match no group))))
|
|
4140 (progn
|
|
4141 (gnus-Subject-read-group group nil t)
|
|
4142 (if (eq (current-buffer) (get-buffer gnus-Subject-buffer))
|
|
4143 (gnus-Subject-exit t))
|
|
4144 ))
|
|
4145 )
|
|
4146 ;; Finally, exit Emacs.
|
|
4147 (set-buffer gnus-Group-buffer)
|
|
4148 (gnus-Group-exit)
|
|
4149 ))
|
|
4150
|
|
4151 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
|
|
4152 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
4153 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
|
|
4154 Otherwise, it is like ~/News/news/group/num."
|
|
4155 (let ((default
|
|
4156 (expand-file-name
|
|
4157 (concat (if gnus-use-long-file-name
|
|
4158 (capitalize newsgroup)
|
|
4159 (gnus-newsgroup-directory-form newsgroup))
|
|
4160 "/" (int-to-string (nntp-header-number headers)))
|
|
4161 (or gnus-article-save-directory "~/News"))))
|
|
4162 (if (and last-file
|
|
4163 (string-equal (file-name-directory default)
|
|
4164 (file-name-directory last-file))
|
|
4165 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
|
|
4166 default
|
|
4167 (or last-file default))))
|
|
4168
|
|
4169 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
|
|
4170 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
4171 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
|
|
4172 Otherwise, it is like ~/News/news/group/num."
|
|
4173 (let ((default
|
|
4174 (expand-file-name
|
|
4175 (concat (if gnus-use-long-file-name
|
|
4176 newsgroup
|
|
4177 (gnus-newsgroup-directory-form newsgroup))
|
|
4178 "/" (int-to-string (nntp-header-number headers)))
|
|
4179 (or gnus-article-save-directory "~/News"))))
|
|
4180 (if (and last-file
|
|
4181 (string-equal (file-name-directory default)
|
|
4182 (file-name-directory last-file))
|
|
4183 (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
|
|
4184 default
|
|
4185 (or last-file default))))
|
|
4186
|
|
4187 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
|
|
4188 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
4189 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
|
|
4190 Otherwise, it is like ~/News/news/group/news."
|
|
4191 (or last-file
|
|
4192 (expand-file-name
|
|
4193 (if gnus-use-long-file-name
|
|
4194 (capitalize newsgroup)
|
|
4195 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
|
|
4196 (or gnus-article-save-directory "~/News"))))
|
|
4197
|
|
4198 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
|
|
4199 "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
|
|
4200 If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
|
|
4201 Otherwise, it is like ~/News/news/group/news."
|
|
4202 (or last-file
|
|
4203 (expand-file-name
|
|
4204 (if gnus-use-long-file-name
|
|
4205 newsgroup
|
|
4206 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
|
|
4207 (or gnus-article-save-directory "~/News"))))
|
|
4208
|
|
4209 (defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
|
|
4210 "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
|
|
4211 If variable `gnus-use-long-file-name' is nil, it is +News.group.
|
|
4212 Otherwise, it is like +news/group."
|
|
4213 (or last-folder
|
|
4214 (concat "+"
|
|
4215 (if gnus-use-long-file-name
|
|
4216 (capitalize newsgroup)
|
|
4217 (gnus-newsgroup-directory-form newsgroup)))))
|
|
4218
|
|
4219 (defun gnus-folder-save-name (newsgroup headers &optional last-folder)
|
|
4220 "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
|
|
4221 If variable `gnus-use-long-file-name' is nil, it is +news.group.
|
|
4222 Otherwise, it is like +news/group."
|
|
4223 (or last-folder
|
|
4224 (concat "+"
|
|
4225 (if gnus-use-long-file-name
|
|
4226 newsgroup
|
|
4227 (gnus-newsgroup-directory-form newsgroup)))))
|
|
4228
|
|
4229 (defun gnus-apply-kill-file ()
|
|
4230 "Apply KILL file to the current newsgroup."
|
|
4231 ;; Apply the global KILL file.
|
|
4232 (load (gnus-newsgroup-kill-file nil) t nil t)
|
|
4233 ;; And then apply the local KILL file.
|
|
4234 (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
|
|
4235
|
|
4236 (defun gnus-Newsgroup-kill-file (newsgroup)
|
|
4237 "Return the name of a KILL file of NEWSGROUP.
|
|
4238 If NEWSGROUP is nil, return the global KILL file instead."
|
|
4239 (cond ((or (null newsgroup)
|
|
4240 (string-equal newsgroup ""))
|
|
4241 ;; The global KILL file is placed at top of the directory.
|
|
4242 (expand-file-name gnus-kill-file-name
|
|
4243 (or gnus-article-save-directory "~/News")))
|
|
4244 (gnus-use-long-file-name
|
|
4245 ;; Append ".KILL" to capitalized newsgroup name.
|
|
4246 (expand-file-name (concat (capitalize newsgroup)
|
|
4247 "." gnus-kill-file-name)
|
|
4248 (or gnus-article-save-directory "~/News")))
|
|
4249 (t
|
|
4250 ;; Place "KILL" under the hierarchical directory.
|
|
4251 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
|
|
4252 "/" gnus-kill-file-name)
|
|
4253 (or gnus-article-save-directory "~/News")))
|
|
4254 ))
|
|
4255
|
|
4256 (defun gnus-newsgroup-kill-file (newsgroup)
|
|
4257 "Return the name of a KILL file of NEWSGROUP.
|
|
4258 If NEWSGROUP is nil, return the global KILL file instead."
|
|
4259 (cond ((or (null newsgroup)
|
|
4260 (string-equal newsgroup ""))
|
|
4261 ;; The global KILL file is placed at top of the directory.
|
|
4262 (expand-file-name gnus-kill-file-name
|
|
4263 (or gnus-article-save-directory "~/News")))
|
|
4264 (gnus-use-long-file-name
|
|
4265 ;; Append ".KILL" to newsgroup name.
|
|
4266 (expand-file-name (concat newsgroup "." gnus-kill-file-name)
|
|
4267 (or gnus-article-save-directory "~/News")))
|
|
4268 (t
|
|
4269 ;; Place "KILL" under the hierarchical directory.
|
|
4270 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
|
|
4271 "/" gnus-kill-file-name)
|
|
4272 (or gnus-article-save-directory "~/News")))
|
|
4273 ))
|
|
4274
|
|
4275 (defun gnus-newsgroup-directory-form (newsgroup)
|
|
4276 "Make hierarchical directory name from NEWSGROUP name."
|
|
4277 (let ((newsgroup (substring newsgroup 0)) ;Copy string.
|
|
4278 (len (length newsgroup))
|
|
4279 (idx 0))
|
|
4280 ;; Replace all occurence of `.' with `/'.
|
|
4281 (while (< idx len)
|
|
4282 (if (= (aref newsgroup idx) ?.)
|
|
4283 (aset newsgroup idx ?/))
|
|
4284 (setq idx (1+ idx)))
|
|
4285 newsgroup
|
|
4286 ))
|
|
4287
|
|
4288 (defun gnus-make-directory (directory)
|
|
4289 "Make DIRECTORY recursively."
|
|
4290 (let ((directory (expand-file-name directory default-directory)))
|
|
4291 (or (file-exists-p directory)
|
|
4292 (gnus-make-directory-1 "" directory))
|
|
4293 ))
|
|
4294
|
|
4295 (defun gnus-make-directory-1 (head tail)
|
|
4296 (cond ((string-match "^/\\([^/]+\\)" tail)
|
|
4297 (setq head
|
|
4298 (concat (file-name-as-directory head)
|
|
4299 (substring tail (match-beginning 1) (match-end 1))))
|
|
4300 (or (file-exists-p head)
|
|
4301 (call-process "mkdir" nil nil nil head))
|
|
4302 (gnus-make-directory-1 head (substring tail (match-end 1))))
|
|
4303 ((string-equal tail "") t)
|
|
4304 ))
|
|
4305
|
|
4306 (defun gnus-simplify-subject (subject &optional re-only)
|
|
4307 "Remove `Re:' and words in parentheses.
|
|
4308 If optional argument RE-ONLY is non-nil, strip `Re:' only."
|
|
4309 (let ((case-fold-search t)) ;Ignore case.
|
|
4310 ;; Remove `Re:' and `Re^N:'.
|
|
4311 (if (string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ \t]+\\)+" subject)
|
|
4312 (setq subject (substring subject (match-end 0))))
|
|
4313 ;; Remove words in parentheses from end.
|
|
4314 (or re-only
|
|
4315 (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
|
|
4316 (setq subject (substring subject 0 (match-beginning 0)))))
|
|
4317 ;; Return subject string.
|
|
4318 subject
|
|
4319 ))
|
|
4320
|
|
4321 (defun gnus-optional-lines-and-from (header)
|
|
4322 "Return a string like `NNN:AUTHOR' from HEADER."
|
|
4323 (let ((name-length (length "umerin@photon")))
|
|
4324 (substring (format "%3d:%s"
|
|
4325 ;; Lines of the article.
|
|
4326 ;; Suggested by dana@bellcore.com.
|
|
4327 (nntp-header-lines header)
|
|
4328 ;; Its author.
|
|
4329 (concat (mail-strip-quoted-names
|
|
4330 (nntp-header-from header))
|
|
4331 (make-string name-length ? )))
|
|
4332 ;; 4 stands for length of `NNN:'.
|
|
4333 0 (+ 4 name-length))))
|
|
4334
|
|
4335 (defun gnus-optional-lines (header)
|
|
4336 "Return a string like `NNN' from HEADER."
|
|
4337 (format "%4d" (nntp-header-lines header)))
|
|
4338
|
|
4339 (defun gnus-sort-headers (predicate &optional reverse)
|
|
4340 "Sort current group headers by PREDICATE safely.
|
|
4341 *Safely* means C-g quitting is disabled during sorting.
|
|
4342 Optional argument REVERSE means reverse order."
|
|
4343 (let ((inhibit-quit t))
|
|
4344 (setq gnus-newsgroup-headers
|
|
4345 (if reverse
|
|
4346 (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
|
|
4347 (sort gnus-newsgroup-headers predicate)))
|
|
4348 ))
|
|
4349
|
|
4350 (defun gnus-string-lessp (a b)
|
|
4351 "Return T if first arg string is less than second in lexicographic order.
|
|
4352 If case-fold-search is non-nil, case of letters is ignored."
|
|
4353 (if case-fold-search
|
|
4354 (string-lessp (downcase a) (downcase b)) (string-lessp a b)))
|
|
4355
|
|
4356 (defun gnus-date-lessp (date1 date2)
|
|
4357 "Return T if DATE1 is earlyer than DATE2."
|
|
4358 (string-lessp (gnus-comparable-date date1)
|
|
4359 (gnus-comparable-date date2)))
|
|
4360
|
|
4361 (defun gnus-comparable-date (date)
|
|
4362 "Make comparable string by string-lessp from DATE."
|
|
4363 (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
|
|
4364 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
|
|
4365 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
|
|
4366 ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
|
|
4367 (date (or date "")))
|
|
4368 ;; Can understand the following styles:
|
|
4369 ;; (1) 14 Apr 89 03:20:12 GMT
|
|
4370 ;; (2) Fri, 17 Mar 89 4:01:33 GMT
|
|
4371 (if (string-match
|
|
4372 "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
|
|
4373 (concat
|
|
4374 ;; Year
|
|
4375 (substring date (match-beginning 3) (match-end 3))
|
|
4376 ;; Month
|
|
4377 (cdr
|
|
4378 (assoc
|
|
4379 (upcase (substring date (match-beginning 2) (match-end 2))) month))
|
|
4380 ;; Day
|
|
4381 (format "%2d" (string-to-int
|
|
4382 (substring date
|
|
4383 (match-beginning 1) (match-end 1))))
|
|
4384 ;; Time
|
|
4385 (substring date (match-beginning 4) (match-end 4)))
|
|
4386 ;; Cannot understand DATE string.
|
|
4387 date
|
|
4388 )
|
|
4389 ))
|
|
4390
|
|
4391 (defun gnus-fetch-field (field)
|
|
4392 "Return the value of the header FIELD of current article."
|
|
4393 (save-excursion
|
|
4394 (save-restriction
|
|
4395 (widen)
|
|
4396 (goto-char (point-min))
|
|
4397 (narrow-to-region (point-min)
|
|
4398 (progn (search-forward "\n\n" nil 'move) (point)))
|
|
4399 (mail-fetch-field field))))
|
|
4400
|
|
4401 (fset 'gnus-expunge 'gnus-Subject-delete-marked-with)
|
|
4402
|
|
4403 (defun gnus-kill (field regexp &optional command all)
|
|
4404 "If FIELD of an article matches REGEXP, execute COMMAND.
|
|
4405 Optional third argument COMMAND is default to
|
|
4406 (gnus-Subject-mark-as-read nil \"X\").
|
|
4407 If optional fourth argument ALL is non-nil, articles marked are also applied
|
|
4408 to. If FIELD is an empty string (or nil), entire article body is searched for.
|
|
4409 COMMAND must be a lisp expression or a string representing a key sequence."
|
|
4410 ;; We don't want to change current point nor window configuration.
|
|
4411 (save-excursion
|
|
4412 (save-window-excursion
|
|
4413 ;; Selected window must be Subject mode buffer to execute
|
|
4414 ;; keyboard macros correctly. See command_loop_1.
|
|
4415 (switch-to-buffer gnus-Subject-buffer 'norecord)
|
|
4416 (goto-char (point-min)) ;From the beginning.
|
|
4417 (if (null command)
|
|
4418 (setq command '(gnus-Subject-mark-as-read nil "X")))
|
|
4419 (gnus-execute field regexp command nil (not all))
|
|
4420 )))
|
|
4421
|
|
4422 (defun gnus-execute (field regexp form &optional backward ignore-marked)
|
|
4423 "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
|
|
4424 If FIELD is an empty string (or nil), entire article body is searched for.
|
|
4425 If optional fifth argument BACKWARD is non-nil, do backward instead.
|
|
4426 If optional sixth argument IGNORE-MARKED is non-nil, articles which are
|
|
4427 marked as read or unread are ignored."
|
|
4428 (let ((function nil)
|
|
4429 (header nil)
|
|
4430 (article nil))
|
|
4431 (if (string-equal field "")
|
|
4432 (setq field nil))
|
|
4433 (if (null field)
|
|
4434 nil
|
|
4435 (or (stringp field)
|
|
4436 (setq field (symbol-name field)))
|
|
4437 ;; Get access function of header filed.
|
|
4438 (setq function (intern-soft (concat "gnus-header-" (downcase field))))
|
|
4439 (if (and function (fboundp function))
|
|
4440 (setq function (symbol-function function))
|
|
4441 (error "Unknown header field: \"%s\"" field)))
|
|
4442 ;; Make FORM funcallable.
|
|
4443 (if (and (listp form) (not (eq (car form) 'lambda)))
|
|
4444 (setq form (list 'lambda nil form)))
|
|
4445 ;; Starting from the current article.
|
|
4446 (or (and ignore-marked
|
|
4447 ;; Articles marked as read and unread should be ignored.
|
|
4448 (setq article (gnus-Subject-article-number))
|
|
4449 (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
|
|
4450 (memq article gnus-newsgroup-marked) ;Marked as unread.
|
|
4451 ))
|
|
4452 (gnus-execute-1 function regexp form))
|
|
4453 (while (gnus-Subject-search-subject backward ignore-marked nil)
|
|
4454 (gnus-execute-1 function regexp form))
|
|
4455 ))
|
|
4456
|
|
4457 (defun gnus-execute-1 (function regexp form)
|
|
4458 (save-excursion
|
|
4459 ;; The point of Subject mode buffer must be saved during execution.
|
|
4460 (let ((article (gnus-Subject-article-number)))
|
|
4461 (if (null article)
|
|
4462 nil ;Nothing to do.
|
|
4463 (if function
|
|
4464 ;; Compare with header field.
|
|
4465 (let ((header (gnus-find-header-by-number
|
|
4466 gnus-newsgroup-headers article))
|
|
4467 (value nil))
|
|
4468 (and header
|
|
4469 (progn
|
|
4470 (setq value (funcall function header))
|
|
4471 ;; Number (Lines:) or symbol must be converted to string.
|
|
4472 (or (stringp value)
|
|
4473 (setq value (prin1-to-string value)))
|
|
4474 (string-match regexp value))
|
|
4475 (if (stringp form) ;Keyboard macro.
|
|
4476 (execute-kbd-macro form)
|
|
4477 (funcall form))))
|
|
4478 ;; Search article body.
|
|
4479 (let ((gnus-current-article nil) ;Save article pointer.
|
|
4480 (gnus-last-article nil)
|
|
4481 (gnus-break-pages nil) ;No need to break pages.
|
|
4482 (gnus-Mark-article-hook nil)) ;Inhibit marking as read.
|
|
4483 (message "Searching for article: %d..." article)
|
|
4484 (gnus-Article-setup-buffer)
|
|
4485 (gnus-Article-prepare article t)
|
|
4486 (if (save-excursion
|
|
4487 (set-buffer gnus-Article-buffer)
|
|
4488 (goto-char (point-min))
|
|
4489 (re-search-forward regexp nil t))
|
|
4490 (if (stringp form) ;Keyboard macro.
|
|
4491 (execute-kbd-macro form)
|
|
4492 (funcall form))))
|
|
4493 ))
|
|
4494 )))
|
|
4495
|
|
4496 ;;; caesar-region written by phr@prep.ai.mit.edu Nov 86
|
|
4497 ;;; modified by tower@prep Nov 86
|
|
4498 ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
|
|
4499
|
|
4500 (defun gnus-caesar-region (&optional n)
|
|
4501 "Caesar rotation of region by N, default 13, for decrypting netnews.
|
|
4502 ROT47 will be performed for Japanese text in any case."
|
|
4503 (interactive (if current-prefix-arg ; Was there a prefix arg?
|
|
4504 (list (prefix-numeric-value current-prefix-arg))
|
|
4505 (list nil)))
|
|
4506 (cond ((not (numberp n)) (setq n 13))
|
|
4507 ((< n 0) (setq n (- 26 (% (- n) 26))))
|
|
4508 (t (setq n (% n 26)))) ;canonicalize N
|
|
4509 (if (not (zerop n)) ; no action needed for a rot of 0
|
|
4510 (progn
|
|
4511 (if (or (not (boundp 'caesar-translate-table))
|
|
4512 (/= (aref caesar-translate-table ?a) (+ ?a n)))
|
|
4513 (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
|
|
4514 (message "Building caesar-translate-table...")
|
|
4515 (setq caesar-translate-table (make-vector 256 0))
|
|
4516 (while (< i 256)
|
|
4517 (aset caesar-translate-table i i)
|
|
4518 (setq i (1+ i)))
|
|
4519 (setq lower (concat lower lower) upper (upcase lower) i 0)
|
|
4520 (while (< i 26)
|
|
4521 (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
|
|
4522 (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
|
|
4523 (setq i (1+ i)))
|
|
4524 ;; ROT47 for Japanese text.
|
|
4525 ;; Thanks to ichikawa@flab.fujitsu.junet.
|
|
4526 (setq i 161)
|
|
4527 (let ((t1 (logior ?O 128))
|
|
4528 (t2 (logior ?! 128))
|
|
4529 (t3 (logior ?~ 128)))
|
|
4530 (while (< i 256)
|
|
4531 (aset caesar-translate-table i
|
|
4532 (let ((v (aref caesar-translate-table i)))
|
|
4533 (if (<= v t1) (if (< v t2) v (+ v 47))
|
|
4534 (if (<= v t3) (- v 47) v))))
|
|
4535 (setq i (1+ i))))
|
|
4536 (message "Building caesar-translate-table... done")))
|
|
4537 (let ((from (region-beginning))
|
|
4538 (to (region-end))
|
|
4539 (i 0) str len)
|
|
4540 (setq str (buffer-substring from to))
|
|
4541 (setq len (length str))
|
|
4542 (while (< i len)
|
|
4543 (aset str i (aref caesar-translate-table (aref str i)))
|
|
4544 (setq i (1+ i)))
|
|
4545 (goto-char from)
|
|
4546 (delete-region from to)
|
|
4547 (insert str)))))
|
|
4548
|
|
4549 ;; Functions accessing headers.
|
|
4550 ;; Functions are more convenient than macros in some case.
|
|
4551
|
|
4552 (defun gnus-header-number (header)
|
|
4553 "Return article number in HEADER."
|
|
4554 (nntp-header-number header))
|
|
4555
|
|
4556 (defun gnus-header-subject (header)
|
|
4557 "Return subject string in HEADER."
|
|
4558 (nntp-header-subject header))
|
|
4559
|
|
4560 (defun gnus-header-from (header)
|
|
4561 "Return author string in HEADER."
|
|
4562 (nntp-header-from header))
|
|
4563
|
|
4564 (defun gnus-header-xref (header)
|
|
4565 "Return xref string in HEADER."
|
|
4566 (nntp-header-xref header))
|
|
4567
|
|
4568 (defun gnus-header-lines (header)
|
|
4569 "Return lines in HEADER."
|
|
4570 (nntp-header-lines header))
|
|
4571
|
|
4572 (defun gnus-header-date (header)
|
|
4573 "Return date in HEADER."
|
|
4574 (nntp-header-date header))
|
|
4575
|
|
4576 (defun gnus-header-id (header)
|
|
4577 "Return Id in HEADER."
|
|
4578 (nntp-header-id header))
|
|
4579
|
|
4580 (defun gnus-header-references (header)
|
|
4581 "Return references in HEADER."
|
|
4582 (nntp-header-references header))
|
|
4583
|
|
4584
|
|
4585 ;;;
|
|
4586 ;;; Article savers.
|
|
4587 ;;;
|
|
4588
|
|
4589 (defun gnus-output-to-rmail (file-name)
|
|
4590 "Append the current article to an Rmail file named FILE-NAME."
|
|
4591 (require 'rmail)
|
|
4592 ;; Most of these codes are borrowed from rmailout.el.
|
|
4593 (setq file-name (expand-file-name file-name))
|
|
4594 (setq rmail-last-rmail-file file-name)
|
|
4595 (let ((artbuf (current-buffer))
|
|
4596 (tmpbuf (get-buffer-create " *GNUS-output*")))
|
|
4597 (save-excursion
|
|
4598 (or (get-file-buffer file-name)
|
|
4599 (file-exists-p file-name)
|
|
4600 (if (yes-or-no-p
|
|
4601 (concat "\"" file-name "\" does not exist, create it? "))
|
|
4602 (let ((file-buffer (create-file-buffer file-name)))
|
|
4603 (save-excursion
|
|
4604 (set-buffer file-buffer)
|
|
4605 (rmail-insert-rmail-file-header)
|
|
4606 (let ((require-final-newline nil))
|
|
4607 (write-region (point-min) (point-max) file-name t 1)))
|
|
4608 (kill-buffer file-buffer))
|
|
4609 (error "Output file does not exist")))
|
|
4610 (set-buffer tmpbuf)
|
|
4611 (buffer-flush-undo (current-buffer))
|
|
4612 (erase-buffer)
|
|
4613 (insert-buffer-substring artbuf)
|
|
4614 (gnus-convert-article-to-rmail)
|
|
4615 ;; Decide whether to append to a file or to an Emacs buffer.
|
|
4616 (let ((outbuf (get-file-buffer file-name)))
|
|
4617 (if (not outbuf)
|
|
4618 (append-to-file (point-min) (point-max) file-name)
|
|
4619 ;; File has been visited, in buffer OUTBUF.
|
|
4620 (set-buffer outbuf)
|
|
4621 (let ((buffer-read-only nil)
|
|
4622 (msg (and (boundp 'rmail-current-message)
|
|
4623 rmail-current-message)))
|
|
4624 ;; If MSG is non-nil, buffer is in RMAIL mode.
|
|
4625 (if msg
|
|
4626 (progn (widen)
|
|
4627 (narrow-to-region (point-max) (point-max))))
|
|
4628 (insert-buffer-substring tmpbuf)
|
|
4629 (if msg
|
|
4630 (progn
|
|
4631 (goto-char (point-min))
|
|
4632 (widen)
|
|
4633 (search-backward "\^_")
|
|
4634 (narrow-to-region (point) (point-max))
|
|
4635 (goto-char (1+ (point-min)))
|
|
4636 (rmail-count-new-messages t)
|
|
4637 (rmail-show-message msg))))))
|
|
4638 )
|
|
4639 (kill-buffer tmpbuf)
|
|
4640 ))
|
|
4641
|
|
4642 (defun gnus-output-to-file (file-name)
|
|
4643 "Append the current article to a file named FILE-NAME."
|
|
4644 (setq file-name (expand-file-name file-name))
|
|
4645 (let ((artbuf (current-buffer))
|
|
4646 (tmpbuf (get-buffer-create " *GNUS-output*")))
|
|
4647 (save-excursion
|
|
4648 (set-buffer tmpbuf)
|
|
4649 (buffer-flush-undo (current-buffer))
|
|
4650 (erase-buffer)
|
|
4651 (insert-buffer-substring artbuf)
|
|
4652 ;; Append newline at end of the buffer as separator, and then
|
|
4653 ;; save it to file.
|
|
4654 (goto-char (point-max))
|
|
4655 (insert "\n")
|
|
4656 (append-to-file (point-min) (point-max) file-name))
|
|
4657 (kill-buffer tmpbuf)
|
|
4658 ))
|
|
4659
|
|
4660 (defun gnus-convert-article-to-rmail ()
|
|
4661 "Convert article in current buffer to Rmail message format."
|
|
4662 (let ((buffer-read-only nil))
|
|
4663 ;; Convert article directly into Babyl format.
|
|
4664 ;; Suggested by Rob Austein <sra@lcs.mit.edu>
|
|
4665 (goto-char (point-min))
|
|
4666 (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
|
|
4667 (while (search-forward "\n\^_" nil t) ;single char
|
|
4668 (replace-match "\n^_")) ;2 chars: "^" and "_"
|
|
4669 (goto-char (point-max))
|
|
4670 (insert "\^_")))
|
|
4671
|
|
4672 ;;(defun gnus-convert-article-to-rmail ()
|
|
4673 ;; "Convert article in current buffer to Rmail message format."
|
|
4674 ;; (let ((buffer-read-only nil))
|
|
4675 ;; ;; Insert special header of Unix mail.
|
|
4676 ;; (goto-char (point-min))
|
|
4677 ;; (insert "From "
|
|
4678 ;; (or (mail-strip-quoted-names (mail-fetch-field "from"))
|
|
4679 ;; "unknown")
|
|
4680 ;; " " (current-time-string) "\n")
|
|
4681 ;; ;; Stop quoting `From' since this seems unnecessary in most cases.
|
|
4682 ;; ;; ``Quote'' "\nFrom " as "\n>From "
|
|
4683 ;; ;;(while (search-forward "\nFrom " nil t)
|
|
4684 ;; ;; (forward-char -5)
|
|
4685 ;; ;; (insert ?>))
|
|
4686 ;; ;; Convert article to babyl format.
|
|
4687 ;; (rmail-convert-to-babyl-format)
|
|
4688 ;; ))
|
|
4689
|
|
4690
|
|
4691 ;;;
|
|
4692 ;;; Internal functions.
|
|
4693 ;;;
|
|
4694
|
|
4695 (defun gnus-start-news-server (&optional confirm)
|
|
4696 "Open network stream to remote NNTP server.
|
|
4697 If optional argument CONFIRM is non-nil, ask you host that NNTP server
|
|
4698 is running even if it is defined.
|
|
4699 Run gnus-Open-server-hook just before opening news server."
|
|
4700 (if (gnus-server-opened)
|
|
4701 ;; Stream is already opened.
|
|
4702 nil
|
|
4703 ;; Open NNTP server.
|
|
4704 (if (or confirm
|
|
4705 (null gnus-nntp-server))
|
|
4706 (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
|
|
4707 ;; Read server name with completion.
|
|
4708 (setq gnus-nntp-server
|
|
4709 (completing-read "NNTP server: "
|
|
4710 (cons (list gnus-nntp-server)
|
|
4711 gnus-secondary-servers)
|
|
4712 nil nil gnus-nntp-server))
|
|
4713 (setq gnus-nntp-server
|
|
4714 (read-string "NNTP server: " gnus-nntp-server))))
|
|
4715 ;; If no server name is given, local host is assumed.
|
|
4716 (if (string-equal gnus-nntp-server "")
|
|
4717 (setq gnus-nntp-server (system-name)))
|
|
4718 (cond ((string-match ":" gnus-nntp-server)
|
|
4719 ;; :DIRECTORY
|
|
4720 (require 'mhspool)
|
|
4721 (gnus-define-access-method 'mhspool)
|
|
4722 (message "Looking up private directory..."))
|
|
4723 ((and (null gnus-nntp-service)
|
|
4724 (string-equal gnus-nntp-server (system-name)))
|
|
4725 (require 'nnspool)
|
|
4726 (gnus-define-access-method 'nnspool)
|
|
4727 (message "Looking up local news spool..."))
|
|
4728 (t
|
|
4729 (gnus-define-access-method 'nntp)
|
|
4730 (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
|
|
4731 (run-hooks 'gnus-Open-server-hook)
|
|
4732 (cond ((gnus-open-server gnus-nntp-server gnus-nntp-service))
|
|
4733 ((and (stringp (gnus-status-message))
|
|
4734 (> (length (gnus-status-message)) 0))
|
|
4735 ;; Show valuable message if available.
|
|
4736 (error (gnus-status-message)))
|
|
4737 (t (error "Cannot open NNTP server on %s" gnus-nntp-server)))
|
|
4738 ))
|
|
4739
|
|
4740 ;; Dummy functions used only once. Should return nil.
|
|
4741 (defun gnus-server-opened () nil)
|
|
4742 (defun gnus-close-server () nil)
|
|
4743
|
|
4744 (defun gnus-define-access-method (method &optional access-methods)
|
|
4745 "Define access functions for the access METHOD.
|
|
4746 Methods defintion is taken from optional argument ACCESS-METHODS or
|
|
4747 the variable gnus-access-methods."
|
|
4748 (let ((bindings
|
|
4749 (cdr (assoc method (or access-methods gnus-access-methods)))))
|
|
4750 (if (null bindings)
|
|
4751 (error "Unknown access method: %s" method)
|
|
4752 ;; Should not use symbol-function here since overload does not work.
|
|
4753 (while bindings
|
|
4754 (fset (car (car bindings)) (cdr (car bindings)))
|
|
4755 (setq bindings (cdr bindings)))
|
|
4756 )))
|
|
4757
|
|
4758 (defun gnus-select-newsgroup (group &optional show-all)
|
|
4759 "Select newsgroup GROUP.
|
|
4760 If optional argument SHOW-ALL is non-nil, all of articles in the group
|
|
4761 are selected."
|
|
4762 (if (gnus-request-group group)
|
|
4763 (let ((articles nil))
|
|
4764 (setq gnus-newsgroup-name group)
|
|
4765 (setq gnus-newsgroup-unreads
|
|
4766 (gnus-uncompress-sequence
|
|
4767 (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
|
|
4768 (cond (show-all
|
|
4769 ;; Select all active articles.
|
|
4770 (setq articles
|
|
4771 (gnus-uncompress-sequence
|
|
4772 (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
|
|
4773 (t
|
|
4774 ;; Select unread articles only.
|
|
4775 (setq articles gnus-newsgroup-unreads)))
|
|
4776 ;; Require confirmation if selecting large newsgroup.
|
|
4777 (setq gnus-newsgroup-unselected nil)
|
|
4778 (if (not (numberp gnus-large-newsgroup))
|
|
4779 nil
|
|
4780 (let ((selected nil)
|
|
4781 (number (length articles)))
|
|
4782 (if (> number gnus-large-newsgroup)
|
|
4783 (progn
|
|
4784 (condition-case ()
|
|
4785 (let ((input
|
|
4786 (read-string
|
|
4787 (format
|
|
4788 "How many articles from %s (default %d): "
|
|
4789 gnus-newsgroup-name number))))
|
|
4790 (setq selected
|
|
4791 (if (string-equal input "")
|
|
4792 number (string-to-int input))))
|
|
4793 (quit
|
|
4794 (setq selected 0)))
|
|
4795 (cond ((and (> selected 0)
|
|
4796 (< selected number))
|
|
4797 ;; Select last N articles.
|
|
4798 (setq articles (nthcdr (- number selected) articles)))
|
|
4799 ((and (< selected 0)
|
|
4800 (< (- 0 selected) number))
|
|
4801 ;; Select first N articles.
|
|
4802 (setq selected (- 0 selected))
|
|
4803 (setq articles (copy-sequence articles))
|
|
4804 (setcdr (nthcdr (1- selected) articles) nil))
|
|
4805 ((zerop selected)
|
|
4806 (setq articles nil))
|
|
4807 ;; Otherwise select all.
|
|
4808 )
|
|
4809 ;; Get unselected unread articles.
|
|
4810 (setq gnus-newsgroup-unselected
|
|
4811 (gnus-set-difference gnus-newsgroup-unreads articles))
|
|
4812 ))
|
|
4813 ))
|
|
4814 ;; Get headers list.
|
|
4815 (setq gnus-newsgroup-headers (gnus-retrieve-headers articles))
|
|
4816 ;; UNREADS may contain expired articles, so we have to remove
|
|
4817 ;; them from the list.
|
|
4818 (setq gnus-newsgroup-unreads
|
|
4819 (gnus-intersection gnus-newsgroup-unreads
|
|
4820 (mapcar
|
|
4821 (function
|
|
4822 (lambda (header)
|
|
4823 (nntp-header-number header)))
|
|
4824 gnus-newsgroup-headers)))
|
|
4825 ;; Marked article must be a subset of unread articles.
|
|
4826 (setq gnus-newsgroup-marked
|
|
4827 (gnus-intersection (append gnus-newsgroup-unselected
|
|
4828 gnus-newsgroup-unreads)
|
|
4829 (cdr (assoc group gnus-marked-assoc))))
|
|
4830 ;; First and last article in this newsgroup.
|
|
4831 (setq gnus-newsgroup-begin
|
|
4832 (if gnus-newsgroup-headers
|
|
4833 (nntp-header-number (car gnus-newsgroup-headers))
|
|
4834 0
|
|
4835 ))
|
|
4836 (setq gnus-newsgroup-end
|
|
4837 (if gnus-newsgroup-headers
|
|
4838 (nntp-header-number
|
|
4839 (gnus-last-element gnus-newsgroup-headers))
|
|
4840 0
|
|
4841 ))
|
|
4842 ;; File name that an article was saved last.
|
|
4843 (setq gnus-newsgroup-last-rmail nil)
|
|
4844 (setq gnus-newsgroup-last-mail nil)
|
|
4845 (setq gnus-newsgroup-last-folder nil)
|
|
4846 (setq gnus-newsgroup-last-file nil)
|
|
4847 ;; Reset article pointer etc.
|
|
4848 (setq gnus-current-article nil)
|
|
4849 (setq gnus-current-headers nil)
|
|
4850 (setq gnus-current-history nil)
|
|
4851 (setq gnus-have-all-headers nil)
|
|
4852 (setq gnus-last-article nil)
|
|
4853 ;; GROUP is successfully selected.
|
|
4854 t
|
|
4855 )
|
|
4856 ))
|
|
4857
|
|
4858 (defun gnus-more-header-backward ()
|
|
4859 "Find new header backward."
|
|
4860 (let ((first
|
|
4861 (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
|
|
4862 (artnum gnus-newsgroup-begin)
|
|
4863 (header nil))
|
|
4864 (while (and (not header)
|
|
4865 (> artnum first))
|
|
4866 (setq artnum (1- artnum))
|
|
4867 (setq header (car (gnus-retrieve-headers (list artnum)))))
|
|
4868 header
|
|
4869 ))
|
|
4870
|
|
4871 (defun gnus-more-header-forward ()
|
|
4872 "Find new header forward."
|
|
4873 (let ((last
|
|
4874 (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
|
|
4875 (artnum gnus-newsgroup-end)
|
|
4876 (header nil))
|
|
4877 (while (and (not header)
|
|
4878 (< artnum last))
|
|
4879 (setq artnum (1+ artnum))
|
|
4880 (setq header (car (gnus-retrieve-headers (list artnum)))))
|
|
4881 header
|
|
4882 ))
|
|
4883
|
|
4884 (defun gnus-extend-newsgroup (header &optional backward)
|
|
4885 "Extend newsgroup selection with HEADER.
|
|
4886 Optional argument BACKWARD means extend toward backward."
|
|
4887 (if header
|
|
4888 (let ((artnum (nntp-header-number header)))
|
|
4889 (setq gnus-newsgroup-headers
|
|
4890 (if backward
|
|
4891 (cons header gnus-newsgroup-headers)
|
|
4892 (append gnus-newsgroup-headers (list header))))
|
|
4893 ;; We have to update unreads and unselected, but don't have to
|
|
4894 ;; care about gnus-newsgroup-marked.
|
|
4895 (if (memq artnum gnus-newsgroup-unselected)
|
|
4896 (setq gnus-newsgroup-unreads
|
|
4897 (cons artnum gnus-newsgroup-unreads)))
|
|
4898 (setq gnus-newsgroup-unselected
|
|
4899 (delq artnum gnus-newsgroup-unselected))
|
|
4900 (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
|
|
4901 (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
|
|
4902 )))
|
|
4903
|
|
4904 (defun gnus-mark-article-as-read (article)
|
|
4905 "Remember that ARTICLE is marked as read."
|
|
4906 ;; Remove from unread and marked list.
|
|
4907 (setq gnus-newsgroup-unreads
|
|
4908 (delq article gnus-newsgroup-unreads))
|
|
4909 (setq gnus-newsgroup-marked
|
|
4910 (delq article gnus-newsgroup-marked)))
|
|
4911
|
|
4912 (defun gnus-mark-article-as-unread (article &optional clear-mark)
|
|
4913 "Remember that ARTICLE is marked as unread.
|
|
4914 Optional argument CLEAR-MARK means ARTICLE should not be remembered
|
|
4915 that it was marked as read once."
|
|
4916 ;; Add to unread list.
|
|
4917 (or (memq article gnus-newsgroup-unreads)
|
|
4918 (setq gnus-newsgroup-unreads
|
|
4919 (cons article gnus-newsgroup-unreads)))
|
|
4920 ;; If CLEAR-MARK is non-nil, the article must be removed from marked
|
|
4921 ;; list. Otherwise, it must be added to the list.
|
|
4922 (if clear-mark
|
|
4923 (setq gnus-newsgroup-marked
|
|
4924 (delq article gnus-newsgroup-marked))
|
|
4925 (or (memq article gnus-newsgroup-marked)
|
|
4926 (setq gnus-newsgroup-marked
|
|
4927 (cons article gnus-newsgroup-marked)))))
|
|
4928
|
|
4929 (defun gnus-clear-system ()
|
|
4930 "Clear all variables and buffer."
|
|
4931 ;; Clear GNUS variables.
|
|
4932 (let ((variables gnus-variable-list))
|
|
4933 (while variables
|
|
4934 (set (car variables) nil)
|
|
4935 (setq variables (cdr variables))))
|
|
4936 ;; Clear other internal variables.
|
|
4937 (setq gnus-active-hashtb nil)
|
|
4938 (setq gnus-unread-hashtb nil)
|
|
4939 ;; Kill the startup file.
|
|
4940 (and gnus-current-startup-file
|
|
4941 (get-file-buffer gnus-current-startup-file)
|
|
4942 (kill-buffer (get-file-buffer gnus-current-startup-file)))
|
|
4943 (setq gnus-current-startup-file nil)
|
|
4944 ;; Kill GNUS buffers.
|
|
4945 (let ((buffers gnus-buffer-list))
|
|
4946 (while buffers
|
|
4947 (if (get-buffer (car buffers))
|
|
4948 (kill-buffer (car buffers)))
|
|
4949 (setq buffers (cdr buffers))
|
|
4950 )))
|
|
4951
|
|
4952 (defun gnus-configure-windows (action)
|
|
4953 "Configure GNUS windows according to the next ACTION.
|
|
4954 The ACTION is either a symbol, such as `SelectNewsgroup', or a
|
|
4955 configuration list such as `(1 1 2)'. If ACTION is not a list,
|
|
4956 configuration list is got from the variable gnus-window-configuration."
|
|
4957 (let* ((windows
|
|
4958 (if (listp action)
|
|
4959 action (car (cdr (assq action gnus-window-configuration)))))
|
|
4960 (grpwin (get-buffer-window gnus-Group-buffer))
|
|
4961 (subwin (get-buffer-window gnus-Subject-buffer))
|
|
4962 (artwin (get-buffer-window gnus-Article-buffer))
|
|
4963 (winsum nil)
|
|
4964 (height nil)
|
|
4965 (grpheight 0)
|
|
4966 (subheight 0)
|
|
4967 (artheight 0))
|
|
4968 (if (or (null windows) ;No configuration is specified.
|
|
4969 (and (eq (null grpwin)
|
|
4970 (zerop (nth 0 windows)))
|
|
4971 (eq (null subwin)
|
|
4972 (zerop (nth 1 windows)))
|
|
4973 (eq (null artwin)
|
|
4974 (zerop (nth 2 windows)))))
|
|
4975 ;; No need to change window configuration.
|
|
4976 nil
|
|
4977 (select-window (or grpwin subwin artwin (selected-window)))
|
|
4978 ;; First of all, compute the height of each window.
|
|
4979 (cond (gnus-use-full-window
|
|
4980 ;; Take up the entire screen.
|
|
4981 (delete-other-windows)
|
|
4982 (setq height (window-height (selected-window))))
|
|
4983 (t
|
|
4984 (setq height (+ (if grpwin (window-height grpwin) 0)
|
|
4985 (if subwin (window-height subwin) 0)
|
|
4986 (if artwin (window-height artwin) 0)))))
|
|
4987 ;; The Newsgroup buffer exits always. So, use it to extend the
|
|
4988 ;; Group window so as to get enough window space.
|
|
4989 (switch-to-buffer gnus-Group-buffer 'norecord)
|
|
4990 (and (get-buffer gnus-Subject-buffer)
|
|
4991 (delete-windows-on gnus-Subject-buffer))
|
|
4992 (and (get-buffer gnus-Article-buffer)
|
|
4993 (delete-windows-on gnus-Article-buffer))
|
|
4994 ;; Compute expected window height.
|
|
4995 (setq winsum (apply (function +) windows))
|
|
4996 (if (not (zerop (nth 0 windows)))
|
|
4997 (setq grpheight (max window-min-height
|
|
4998 (/ (* height (nth 0 windows)) winsum))))
|
|
4999 (if (not (zerop (nth 1 windows)))
|
|
5000 (setq subheight (max window-min-height
|
|
5001 (/ (* height (nth 1 windows)) winsum))))
|
|
5002 (if (not (zerop (nth 2 windows)))
|
|
5003 (setq artheight (max window-min-height
|
|
5004 (/ (* height (nth 2 windows)) winsum))))
|
|
5005 (setq height (+ grpheight subheight artheight))
|
|
5006 (enlarge-window (max 0 (- height (window-height (selected-window)))))
|
|
5007 ;; Then split the window.
|
|
5008 (and (not (zerop artheight))
|
|
5009 (or (not (zerop grpheight))
|
|
5010 (not (zerop subheight)))
|
|
5011 (split-window-vertically (+ grpheight subheight)))
|
|
5012 (and (not (zerop grpheight))
|
|
5013 (not (zerop subheight))
|
|
5014 (split-window-vertically grpheight))
|
|
5015 ;; Then select buffers in each window.
|
|
5016 (and (not (zerop grpheight))
|
|
5017 (progn
|
|
5018 (switch-to-buffer gnus-Group-buffer 'norecord)
|
|
5019 (other-window 1)))
|
|
5020 (and (not (zerop subheight))
|
|
5021 (progn
|
|
5022 (switch-to-buffer gnus-Subject-buffer 'norecord)
|
|
5023 (other-window 1)))
|
|
5024 (and (not (zerop artheight))
|
|
5025 (progn
|
|
5026 ;; If Article buffer does not exist, it will be created
|
|
5027 ;; and initialized.
|
|
5028 (gnus-Article-setup-buffer)
|
|
5029 (switch-to-buffer gnus-Article-buffer 'norecord)))
|
|
5030 )
|
|
5031 ))
|
|
5032
|
|
5033 (defun gnus-find-header-by-number (headers number)
|
|
5034 "Return a header which is a element of HEADERS and has NUMBER."
|
|
5035 (let ((found nil))
|
|
5036 (while (and headers (not found))
|
|
5037 ;; We cannot use `=' to accept non-numeric NUMBER.
|
|
5038 (if (eq number (nntp-header-number (car headers)))
|
|
5039 (setq found (car headers)))
|
|
5040 (setq headers (cdr headers)))
|
|
5041 found
|
|
5042 ))
|
|
5043
|
|
5044 (defun gnus-find-header-by-id (headers id)
|
|
5045 "Return a header which is a element of HEADERS and has Message-ID."
|
|
5046 (let ((found nil))
|
|
5047 (while (and headers (not found))
|
|
5048 (if (string-equal id (nntp-header-id (car headers)))
|
|
5049 (setq found (car headers)))
|
|
5050 (setq headers (cdr headers)))
|
|
5051 found
|
|
5052 ))
|
|
5053
|
|
5054 (defun gnus-version ()
|
|
5055 "Version numbers of this version of GNUS."
|
|
5056 (interactive)
|
|
5057 (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
|
|
5058 (message "%s; %s; %s; %s"
|
|
5059 gnus-version nntp-version nnspool-version mhspool-version))
|
|
5060 ((boundp 'mhspool-version)
|
|
5061 (message "%s; %s; %s"
|
|
5062 gnus-version nntp-version mhspool-version))
|
|
5063 ((boundp 'nnspool-version)
|
|
5064 (message "%s; %s; %s"
|
|
5065 gnus-version nntp-version nnspool-version))
|
|
5066 (t
|
|
5067 (message "%s; %s" gnus-version nntp-version))))
|
|
5068
|
|
5069 (defun gnus-Info-find-node ()
|
|
5070 "Find Info documentation of GNUS."
|
|
5071 (interactive)
|
|
5072 (require 'info)
|
|
5073 ;; Enlarge info window if needed.
|
|
5074 (cond ((eq major-mode 'gnus-Group-mode)
|
|
5075 (gnus-configure-windows '(1 0 0)) ;Take all windows.
|
|
5076 (pop-to-buffer gnus-Group-buffer))
|
|
5077 ((eq major-mode 'gnus-Subject-mode)
|
|
5078 (gnus-configure-windows '(0 1 0)) ;Take all windows.
|
|
5079 (pop-to-buffer gnus-Subject-buffer)))
|
|
5080 (Info-goto-node (cdr (assq major-mode gnus-Info-nodes))))
|
|
5081
|
|
5082 (defun gnus-overload-functions (&optional overloads)
|
|
5083 "Overload functions specified by optional argument OVERLOADS.
|
|
5084 If nothing is specified, use the variable gnus-overload-functions."
|
|
5085 (let ((defs nil)
|
|
5086 (overloads (or overloads gnus-overload-functions)))
|
|
5087 (while overloads
|
|
5088 (setq defs (car overloads))
|
|
5089 (setq overloads (cdr overloads))
|
|
5090 ;; Load file before overloading function if necessary. Make
|
|
5091 ;; sure we cannot use `requre' always.
|
|
5092 (and (not (fboundp (car defs)))
|
|
5093 (car (cdr (cdr defs)))
|
|
5094 (load (car (cdr (cdr defs))) nil 'nomessage))
|
|
5095 (fset (car defs) (car (cdr defs)))
|
|
5096 )))
|
|
5097
|
|
5098 (defun gnus-make-threads (newsgroup-headers)
|
|
5099 "Make conversation threads tree from NEWSGROUP-HEADERS."
|
|
5100 (let ((headers newsgroup-headers)
|
|
5101 (h nil)
|
|
5102 (d nil)
|
|
5103 (roots nil)
|
|
5104 (dependencies nil))
|
|
5105 ;; Make message dependency alist.
|
|
5106 (while headers
|
|
5107 (setq h (car headers))
|
|
5108 (setq headers (cdr headers))
|
|
5109 ;; Ignore invalid headers.
|
|
5110 (if (vectorp h) ;Depends on nntp.el.
|
|
5111 (progn
|
|
5112 ;; Ignore broken references, e.g "<123@a.b.c".
|
|
5113 (setq d (and (nntp-header-references h)
|
|
5114 (string-match "\\(<[^<>]+>\\)[^>]*$"
|
|
5115 (nntp-header-references h))
|
|
5116 (gnus-find-header-by-id
|
|
5117 newsgroup-headers
|
|
5118 (substring (nntp-header-references h)
|
|
5119 (match-beginning 1) (match-end 1)))))
|
|
5120 ;; Check subject equality.
|
|
5121 (or gnus-thread-ignore-subject
|
|
5122 (null d)
|
|
5123 (string-equal (gnus-simplify-subject
|
|
5124 (nntp-header-subject h) 're)
|
|
5125 (gnus-simplify-subject
|
|
5126 (nntp-header-subject d) 're))
|
|
5127 ;; H should be a thread root.
|
|
5128 (setq d nil))
|
|
5129 ;; H depends on D.
|
|
5130 (setq dependencies
|
|
5131 (cons (cons h d) dependencies))
|
|
5132 ;; H is a thread root.
|
|
5133 (if (null d)
|
|
5134 (setq roots (cons h roots)))
|
|
5135 ))
|
|
5136 )
|
|
5137 ;; Make complete threads from the roots.
|
|
5138 ;; Note: dependencies are in reverse order, but
|
|
5139 ;; gnus-make-threads-1 processes it in reverse order again. So,
|
|
5140 ;; we don't have to worry about it.
|
|
5141 (mapcar
|
|
5142 (function
|
|
5143 (lambda (root)
|
|
5144 (gnus-make-threads-1 root dependencies))) (nreverse roots))
|
|
5145 ))
|
|
5146
|
|
5147 (defun gnus-make-threads-1 (parent dependencies)
|
|
5148 (let ((children nil)
|
|
5149 (d nil)
|
|
5150 (depends dependencies))
|
|
5151 ;; Find children.
|
|
5152 (while depends
|
|
5153 (setq d (car depends))
|
|
5154 (setq depends (cdr depends))
|
|
5155 (and (cdr d)
|
|
5156 (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
|
|
5157 (setq children (cons (car d) children))))
|
|
5158 ;; Go down.
|
|
5159 (cons parent
|
|
5160 (mapcar
|
|
5161 (function
|
|
5162 (lambda (child)
|
|
5163 (gnus-make-threads-1 child dependencies))) children))
|
|
5164 ))
|
|
5165
|
|
5166 (defun gnus-narrow-to-page (&optional arg)
|
|
5167 "Make text outside current page invisible except for page delimiter.
|
|
5168 A numeric arg specifies to move forward or backward by that many pages,
|
|
5169 thus showing a page other than the one point was originally in."
|
|
5170 (interactive "P")
|
|
5171 (setq arg (if arg (prefix-numeric-value arg) 0))
|
|
5172 (save-excursion
|
|
5173 (forward-page -1) ;Beginning of current page.
|
|
5174 (widen)
|
|
5175 (if (> arg 0)
|
|
5176 (forward-page arg)
|
|
5177 (if (< arg 0)
|
|
5178 (forward-page (1- arg))))
|
|
5179 ;; Find the end of the page.
|
|
5180 (forward-page)
|
|
5181 ;; If we stopped due to end of buffer, stay there.
|
|
5182 ;; If we stopped after a page delimiter, put end of restriction
|
|
5183 ;; at the beginning of that line.
|
|
5184 ;; These are commented out.
|
|
5185 ;; (if (save-excursion (beginning-of-line)
|
|
5186 ;; (looking-at page-delimiter))
|
|
5187 ;; (beginning-of-line))
|
|
5188 (narrow-to-region (point)
|
|
5189 (progn
|
|
5190 ;; Find the top of the page.
|
|
5191 (forward-page -1)
|
|
5192 ;; If we found beginning of buffer, stay there.
|
|
5193 ;; If extra text follows page delimiter on same line,
|
|
5194 ;; include it.
|
|
5195 ;; Otherwise, show text starting with following line.
|
|
5196 (if (and (eolp) (not (bobp)))
|
|
5197 (forward-line 1))
|
|
5198 (point)))
|
|
5199 ))
|
|
5200
|
|
5201 (defun gnus-last-element (list)
|
|
5202 "Return last element of LIST."
|
|
5203 (let ((last nil))
|
|
5204 (while list
|
|
5205 (if (null (cdr list))
|
|
5206 (setq last (car list)))
|
|
5207 (setq list (cdr list)))
|
|
5208 last
|
|
5209 ))
|
|
5210
|
|
5211 (defun gnus-set-difference (list1 list2)
|
|
5212 "Return a list of elements of LIST1 that do not appear in LIST2."
|
|
5213 (let ((list1 (copy-sequence list1)))
|
|
5214 (while list2
|
|
5215 (setq list1 (delq (car list2) list1))
|
|
5216 (setq list2 (cdr list2)))
|
|
5217 list1
|
|
5218 ))
|
|
5219
|
|
5220 (defun gnus-intersection (list1 list2)
|
|
5221 "Return a list of elements that appear in both LIST1 and LIST2."
|
|
5222 (let ((result nil))
|
|
5223 (while list2
|
|
5224 (if (memq (car list2) list1)
|
|
5225 (setq result (cons (car list2) result)))
|
|
5226 (setq list2 (cdr list2)))
|
|
5227 result
|
|
5228 ))
|
|
5229
|
|
5230
|
|
5231 ;;;
|
|
5232 ;;; Get information about active articles, already read articles, and
|
|
5233 ;;; still unread articles.
|
|
5234 ;;;
|
|
5235
|
|
5236 ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
|
|
5237 ;; (("general" t (1 . 1))
|
|
5238 ;; ("misc" t (1 . 10) (12 . 15))
|
|
5239 ;; ("test" nil (1 . 99)) ...)
|
|
5240 ;; GNUS internal format of gnus-marked-assoc:
|
|
5241 ;; (("general" 1 2 3)
|
|
5242 ;; ("misc" 2) ...)
|
|
5243 ;; GNUS internal format of gnus-active-hashtb:
|
|
5244 ;; (("general" t (1 . 1))
|
|
5245 ;; ("misc" t (1 . 10))
|
|
5246 ;; ("test" nil (1 . 99)) ...)
|
|
5247 ;; GNUS internal format of gnus-unread-hashtb:
|
|
5248 ;; (("general" 1 (1 . 1))
|
|
5249 ;; ("misc" 14 (1 . 10) (12 . 15))
|
|
5250 ;; ("test" 99 (1 . 99)) ...)
|
|
5251
|
|
5252 (defun gnus-setup-news-info (&optional rawfile)
|
|
5253 "Setup news information.
|
|
5254 If optional argument RAWFILE is non-nil, force to read raw startup file."
|
|
5255 (let ((init (not (and gnus-newsrc-assoc
|
|
5256 gnus-active-hashtb
|
|
5257 gnus-unread-hashtb
|
|
5258 (not rawfile)
|
|
5259 ))))
|
|
5260 ;; We have to clear some variables to re-initialize news info.
|
|
5261 (if init
|
|
5262 (setq gnus-newsrc-assoc nil
|
|
5263 gnus-active-hashtb nil
|
|
5264 gnus-unread-hashtb nil))
|
|
5265 (if init
|
|
5266 (gnus-read-newsrc-file rawfile))
|
|
5267 (gnus-read-active-file)
|
|
5268 (gnus-expire-marked-articles)
|
|
5269 (gnus-get-unread-articles)
|
|
5270 ;; Check new newsgroups and subscribe them.
|
|
5271 (if init
|
|
5272 (let ((new-newsgroups (gnus-find-new-newsgroups)))
|
|
5273 (while new-newsgroups
|
|
5274 (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
|
|
5275 (setq new-newsgroups (cdr new-newsgroups))
|
|
5276 )))
|
|
5277 ))
|
|
5278
|
|
5279 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
|
|
5280 "Subscribe new NEWSGROUP.
|
|
5281 If optional argument NEXT is non-nil, it is inserted before NEXT."
|
|
5282 (gnus-insert-newsgroup (list newsgroup t) next)
|
|
5283 (message "Newsgroup %s is subscribed" newsgroup))
|
|
5284
|
|
5285 (defun gnus-add-newsgroup (newsgroup)
|
|
5286 "Subscribe new NEWSGROUP safely and put it at top."
|
|
5287 (and (null (assoc newsgroup gnus-newsrc-assoc)) ;Really new?
|
|
5288 (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
|
|
5289 (gnus-insert-newsgroup (or (assoc newsgroup gnus-killed-assoc)
|
|
5290 (list newsgroup t))
|
|
5291 (car (car gnus-newsrc-assoc)))))
|
|
5292
|
|
5293 (defun gnus-find-new-newsgroups ()
|
|
5294 "Looking for new newsgroups and return names.
|
|
5295 `-n' option of options line in .newsrc file is recognized."
|
|
5296 (let ((group nil)
|
|
5297 (new-newsgroups nil))
|
|
5298 (mapatoms
|
|
5299 (function
|
|
5300 (lambda (sym)
|
|
5301 (setq group (symbol-name sym))
|
|
5302 ;; Taking account of `-n' option.
|
|
5303 (and (or (null gnus-newsrc-options-n-no)
|
|
5304 (not (string-match gnus-newsrc-options-n-no group))
|
|
5305 (and gnus-newsrc-options-n-yes
|
|
5306 (string-match gnus-newsrc-options-n-yes group)))
|
|
5307 (null (assoc group gnus-killed-assoc)) ;Ignore killed.
|
|
5308 (null (assoc group gnus-newsrc-assoc)) ;Really new.
|
|
5309 ;; Find new newsgroup.
|
|
5310 (setq new-newsgroups
|
|
5311 (cons group new-newsgroups)))
|
|
5312 ))
|
|
5313 gnus-active-hashtb)
|
|
5314 ;; Return new newsgroups.
|
|
5315 new-newsgroups
|
|
5316 ))
|
|
5317
|
|
5318 (defun gnus-kill-newsgroup (group)
|
|
5319 "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."
|
|
5320 (let ((info (assoc group gnus-newsrc-assoc)))
|
|
5321 (if (null info)
|
|
5322 nil
|
|
5323 ;; Delete from gnus-newsrc-assoc
|
|
5324 (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
|
|
5325 ;; Add to gnus-killed-assoc.
|
|
5326 (setq gnus-killed-assoc
|
|
5327 (cons info
|
|
5328 (delq (assoc group gnus-killed-assoc) gnus-killed-assoc)))
|
|
5329 ;; Clear unread hashtable.
|
|
5330 ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
|
|
5331 (gnus-sethash group nil gnus-unread-hashtb)
|
|
5332 ;; Then delete from .newsrc
|
|
5333 (gnus-update-newsrc-buffer group 'delete)
|
|
5334 ;; Return the deleted newsrc entry.
|
|
5335 info
|
|
5336 )))
|
|
5337
|
|
5338 (defun gnus-insert-newsgroup (info &optional next)
|
|
5339 "Insert newsrc INFO entry before NEXT.
|
|
5340 If optional argument NEXT is nil, appended to the last."
|
|
5341 (if (null info)
|
|
5342 (error "Invalid argument: %s" info))
|
|
5343 (let* ((group (car info)) ;Newsgroup name.
|
|
5344 (range
|
|
5345 (gnus-difference-of-range
|
|
5346 (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
|
|
5347 ;; Check duplication.
|
|
5348 (if (assoc group gnus-newsrc-assoc)
|
|
5349 (error "Duplicated: %s" group))
|
|
5350 ;; Insert to gnus-newsrc-assoc.
|
|
5351 (if (string-equal next (car (car gnus-newsrc-assoc)))
|
|
5352 (setq gnus-newsrc-assoc
|
|
5353 (cons info gnus-newsrc-assoc))
|
|
5354 (let ((found nil)
|
|
5355 (rest gnus-newsrc-assoc)
|
|
5356 (tail (cons nil gnus-newsrc-assoc)))
|
|
5357 ;; Seach insertion point.
|
|
5358 (while (and (not found) rest)
|
|
5359 (if (string-equal next (car (car rest)))
|
|
5360 (setq found t)
|
|
5361 (setq rest (cdr rest))
|
|
5362 (setq tail (cdr tail))
|
|
5363 ))
|
|
5364 ;; Find it.
|
|
5365 (setcdr tail nil)
|
|
5366 (setq gnus-newsrc-assoc
|
|
5367 (append gnus-newsrc-assoc (cons info rest)))
|
|
5368 ))
|
|
5369 ;; Delete from gnus-killed-assoc.
|
|
5370 (setq gnus-killed-assoc
|
|
5371 (delq (assoc group gnus-killed-assoc) gnus-killed-assoc))
|
|
5372 ;; Then insert to .newsrc.
|
|
5373 (gnus-update-newsrc-buffer group nil next)
|
|
5374 ;; Add to gnus-unread-hashtb.
|
|
5375 (gnus-sethash group
|
|
5376 (cons group ;Newsgroup name.
|
|
5377 (cons (gnus-number-of-articles range) range))
|
|
5378 gnus-unread-hashtb)
|
|
5379 ))
|
|
5380
|
|
5381 (defun gnus-check-killed-newsgroups ()
|
|
5382 "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc."
|
|
5383 (let ((group nil)
|
|
5384 (new-killed nil)
|
|
5385 (old-killed gnus-killed-assoc))
|
|
5386 (while old-killed
|
|
5387 (setq group (car (car old-killed)))
|
|
5388 (and (or (null gnus-newsrc-options-n-no)
|
|
5389 (not (string-match gnus-newsrc-options-n-no group))
|
|
5390 (and gnus-newsrc-options-n-yes
|
|
5391 (string-match gnus-newsrc-options-n-yes group)))
|
|
5392 (null (assoc group gnus-newsrc-assoc)) ;No duplication.
|
|
5393 ;; Subscribed in options line and not in gnus-newsrc-assoc.
|
|
5394 (setq new-killed
|
|
5395 (cons (car old-killed) new-killed)))
|
|
5396 (setq old-killed (cdr old-killed))
|
|
5397 )
|
|
5398 (setq gnus-killed-assoc (nreverse new-killed))
|
|
5399 ))
|
|
5400
|
|
5401 (defun gnus-check-bogus-newsgroups (&optional confirm)
|
|
5402 "Delete bogus newsgroups.
|
|
5403 If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
|
|
5404 (let ((group nil) ;Newsgroup name temporary used.
|
|
5405 (old-newsrc gnus-newsrc-assoc)
|
|
5406 (new-newsrc nil)
|
|
5407 (bogus nil) ;List of bogus newsgroups.
|
|
5408 (old-killed gnus-killed-assoc)
|
|
5409 (new-killed nil)
|
|
5410 (old-marked gnus-marked-assoc)
|
|
5411 (new-marked nil))
|
|
5412 (message "Checking bogus newsgroups...")
|
|
5413 ;; Update gnus-newsrc-assoc.
|
|
5414 (while old-newsrc
|
|
5415 (setq group (car (car old-newsrc)))
|
|
5416 (if (or (gnus-gethash group gnus-active-hashtb)
|
|
5417 (and confirm
|
|
5418 (not (y-or-n-p
|
|
5419 (format "Delete bogus newsgroup: %s " group)))))
|
|
5420 ;; Active newsgroup.
|
|
5421 (setq new-newsrc (cons (car old-newsrc) new-newsrc))
|
|
5422 ;; Found a bogus newsgroup.
|
|
5423 (setq bogus (cons group bogus)))
|
|
5424 (setq old-newsrc (cdr old-newsrc))
|
|
5425 )
|
|
5426 (setq gnus-newsrc-assoc (nreverse new-newsrc))
|
|
5427 ;; Update gnus-killed-assoc.
|
|
5428 ;; The killed newsgroups are deleted without any confirmations.
|
|
5429 (while old-killed
|
|
5430 (setq group (car (car old-killed)))
|
|
5431 (and (gnus-gethash group gnus-active-hashtb)
|
|
5432 (null (assoc group gnus-newsrc-assoc))
|
|
5433 ;; Active and really killed newsgroup.
|
|
5434 (setq new-killed (cons (car old-killed) new-killed)))
|
|
5435 (setq old-killed (cdr old-killed))
|
|
5436 )
|
|
5437 (setq gnus-killed-assoc (nreverse new-killed))
|
|
5438 ;; Remove BOGUS from .newsrc file.
|
|
5439 (while bogus
|
|
5440 (gnus-update-newsrc-buffer (car bogus) 'delete)
|
|
5441 (setq bogus (cdr bogus)))
|
|
5442 ;; Update gnus-marked-assoc.
|
|
5443 (while old-marked
|
|
5444 (setq group (car (car old-marked)))
|
|
5445 (if (and (cdr (car old-marked)) ;Non-empty?
|
|
5446 (assoc group gnus-newsrc-assoc)) ;Not bogus?
|
|
5447 (setq new-marked (cons (car old-marked) new-marked)))
|
|
5448 (setq old-marked (cdr old-marked)))
|
|
5449 (setq gnus-marked-assoc new-marked)
|
|
5450 (message "Checking bogus newsgroups... done")
|
|
5451 ))
|
|
5452
|
|
5453 (defun gnus-get-unread-articles ()
|
|
5454 "Compute diffs between active and read articles."
|
|
5455 (let ((read gnus-newsrc-assoc)
|
|
5456 (group-info nil)
|
|
5457 (group-name nil)
|
|
5458 (active nil)
|
|
5459 (range nil))
|
|
5460 (message "Checking new news...")
|
|
5461 (or gnus-unread-hashtb
|
|
5462 (setq gnus-unread-hashtb (gnus-make-hashtable)))
|
|
5463 (while read
|
|
5464 (setq group-info (car read)) ;About one newsgroup
|
|
5465 (setq group-name (car group-info))
|
|
5466 (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
|
|
5467 (if (and gnus-octive-hashtb
|
|
5468 ;; Is nothing changed?
|
|
5469 (equal active
|
|
5470 (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
|
|
5471 ;; Is this newsgroup in the unread hash table?
|
|
5472 (gnus-gethash group-name gnus-unread-hashtb)
|
|
5473 )
|
|
5474 nil ;Nothing to do.
|
|
5475 (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
|
|
5476 (gnus-sethash group-name
|
|
5477 (cons group-name ;Group name
|
|
5478 (cons (gnus-number-of-articles range)
|
|
5479 range)) ;Range of unread articles
|
|
5480 gnus-unread-hashtb)
|
|
5481 )
|
|
5482 (setq read (cdr read))
|
|
5483 )
|
|
5484 (message "Checking new news... done")
|
|
5485 ))
|
|
5486
|
|
5487 (defun gnus-expire-marked-articles ()
|
|
5488 "Check expired article which is marked as unread."
|
|
5489 (let ((marked-assoc gnus-marked-assoc)
|
|
5490 (updated-assoc nil)
|
|
5491 (marked nil) ;Current marked info.
|
|
5492 (articles nil) ;List of marked articles.
|
|
5493 (updated nil) ;List of real marked.
|
|
5494 (begin nil))
|
|
5495 (while marked-assoc
|
|
5496 (setq marked (car marked-assoc))
|
|
5497 (setq articles (cdr marked))
|
|
5498 (setq updated nil)
|
|
5499 (setq begin
|
|
5500 (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
|
|
5501 (while (and begin articles)
|
|
5502 (if (>= (car articles) begin)
|
|
5503 ;; This article is still active.
|
|
5504 (setq updated (cons (car articles) updated)))
|
|
5505 (setq articles (cdr articles)))
|
|
5506 (if updated
|
|
5507 (setq updated-assoc
|
|
5508 (cons (cons (car marked) updated) updated-assoc)))
|
|
5509 (setq marked-assoc (cdr marked-assoc)))
|
|
5510 (setq gnus-marked-assoc updated-assoc)
|
|
5511 ))
|
|
5512
|
|
5513 (defun gnus-mark-as-read-by-xref
|
|
5514 (group headers unreads &optional subscribed-only)
|
|
5515 "Mark articles as read using cross references and return updated newsgroups.
|
|
5516 Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."
|
|
5517 (let ((xref-list nil)
|
|
5518 (header nil)
|
|
5519 (xrefs nil) ;One Xref: field info.
|
|
5520 (xref nil) ;(NEWSGROUP . ARTICLE)
|
|
5521 (gname nil) ;Newsgroup name
|
|
5522 (article nil)) ;Article number
|
|
5523 (while headers
|
|
5524 (setq header (car headers))
|
|
5525 (if (memq (nntp-header-number header) unreads)
|
|
5526 ;; This article is not yet marked as read.
|
|
5527 nil
|
|
5528 (setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
|
|
5529 ;; For each cross reference info. in one Xref: field.
|
|
5530 (while xrefs
|
|
5531 (setq xref (car xrefs))
|
|
5532 (setq gname (car xref)) ;Newsgroup name
|
|
5533 (setq article (cdr xref)) ;Article number
|
|
5534 (or (string-equal group gname) ;Ignore current newsgroup.
|
|
5535 ;; Ignore unsubscribed newsgroup if requested.
|
|
5536 (and subscribed-only
|
|
5537 (not (nth 1 (assoc gname gnus-newsrc-assoc))))
|
|
5538 ;; Ignore article marked as unread.
|
|
5539 (memq article (cdr (assoc gname gnus-marked-assoc)))
|
|
5540 (let ((group-xref (assoc gname xref-list)))
|
|
5541 (if group-xref
|
|
5542 (if (memq article (cdr group-xref))
|
|
5543 nil ;Alread marked.
|
|
5544 (setcdr group-xref (cons article (cdr group-xref))))
|
|
5545 ;; Create new assoc entry for GROUP.
|
|
5546 (setq xref-list (cons (list gname article) xref-list)))
|
|
5547 ))
|
|
5548 (setq xrefs (cdr xrefs))
|
|
5549 ))
|
|
5550 (setq headers (cdr headers)))
|
|
5551 ;; Mark cross referenced articles as read.
|
|
5552 (gnus-mark-xrefed-as-read xref-list)
|
|
5553 ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
|
|
5554 ;; Return list of updated group name.
|
|
5555 (mapcar (function car) xref-list)
|
|
5556 ))
|
|
5557
|
|
5558 (defun gnus-parse-xref-field (xref-value)
|
|
5559 "Parse Xref: field value, and return list of `(group . article-id)'."
|
|
5560 (let ((xref-list nil)
|
|
5561 (xref-value (or xref-value "")))
|
|
5562 ;; Remove server host name.
|
|
5563 (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
|
|
5564 (setq xref-value (substring xref-value (match-beginning 1)))
|
|
5565 (setq xref-value nil))
|
|
5566 ;; Process each xref info.
|
|
5567 (while xref-value
|
|
5568 (if (string-match
|
|
5569 "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
|
|
5570 (progn
|
|
5571 (setq xref-list
|
|
5572 (cons
|
|
5573 (cons
|
|
5574 ;; Group name
|
|
5575 (substring xref-value (match-beginning 1) (match-end 1))
|
|
5576 ;; Article-ID
|
|
5577 (string-to-int
|
|
5578 (substring xref-value (match-beginning 2) (match-end 2))))
|
|
5579 xref-list))
|
|
5580 (setq xref-value (substring xref-value (match-end 2))))
|
|
5581 (setq xref-value nil)))
|
|
5582 ;; Return alist.
|
|
5583 xref-list
|
|
5584 ))
|
|
5585
|
|
5586 (defun gnus-mark-xrefed-as-read (xrefs)
|
|
5587 "Update unread article information using XREFS alist."
|
|
5588 (let ((group nil)
|
|
5589 (idlist nil)
|
|
5590 (unread nil))
|
|
5591 (while xrefs
|
|
5592 (setq group (car (car xrefs)))
|
|
5593 (setq idlist (cdr (car xrefs)))
|
|
5594 (setq unread (gnus-uncompress-sequence
|
|
5595 (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
|
|
5596 (while idlist
|
|
5597 (setq unread (delq (car idlist) unread))
|
|
5598 (setq idlist (cdr idlist)))
|
|
5599 (gnus-update-unread-articles group unread 'ignore)
|
|
5600 (setq xrefs (cdr xrefs))
|
|
5601 )))
|
|
5602
|
|
5603 (defun gnus-update-unread-articles (group unread-list marked-list)
|
|
5604 "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
|
|
5605 (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
|
|
5606 (unread (gnus-gethash group gnus-unread-hashtb)))
|
|
5607 (if (or (null active) (null unread))
|
|
5608 ;; Ignore unknown newsgroup.
|
|
5609 nil
|
|
5610 ;; Update gnus-unread-hashtb.
|
|
5611 (if unread-list
|
|
5612 (setcdr (cdr unread)
|
|
5613 (gnus-compress-sequence unread-list))
|
|
5614 ;; All of the articles are read.
|
|
5615 (setcdr (cdr unread) '((0 . 0))))
|
|
5616 ;; Number of unread articles.
|
|
5617 (setcar (cdr unread)
|
|
5618 (gnus-number-of-articles (nthcdr 2 unread)))
|
|
5619 ;; Update gnus-newsrc-assoc.
|
|
5620 (if (> (car active) 0)
|
|
5621 ;; Articles from 1 to N are not active.
|
|
5622 (setq active (cons 1 (cdr active))))
|
|
5623 (setcdr (cdr (assoc group gnus-newsrc-assoc))
|
|
5624 (gnus-difference-of-range active (nthcdr 2 unread)))
|
|
5625 ;; Update .newsrc buffer.
|
|
5626 (gnus-update-newsrc-buffer group)
|
|
5627 ;; Update gnus-marked-assoc.
|
|
5628 (if (listp marked-list) ;Includes NIL.
|
|
5629 (let ((marked (assoc group gnus-marked-assoc)))
|
|
5630 (cond (marked
|
|
5631 (setcdr marked marked-list))
|
|
5632 (marked-list ;Non-NIL.
|
|
5633 (setq gnus-marked-assoc
|
|
5634 (cons (cons group marked-list)
|
|
5635 gnus-marked-assoc)))
|
|
5636 )))
|
|
5637 )))
|
|
5638
|
|
5639 (defun gnus-read-active-file ()
|
|
5640 "Get active file from NNTP server."
|
|
5641 (message "Reading active file...")
|
|
5642 (if (gnus-request-list) ;Get active file from server
|
|
5643 (save-excursion
|
|
5644 (set-buffer nntp-server-buffer)
|
|
5645 ;; Save OLD active info.
|
|
5646 (setq gnus-octive-hashtb gnus-active-hashtb)
|
|
5647 (setq gnus-active-hashtb (gnus-make-hashtable))
|
|
5648 (gnus-active-to-gnus-format)
|
|
5649 (message "Reading active file... done"))
|
|
5650 (error "Cannot read active file from NNTP server.")))
|
|
5651
|
|
5652 (defun gnus-active-to-gnus-format ()
|
|
5653 "Convert active file format to internal format."
|
|
5654 ;; Delete unnecessary lines.
|
|
5655 (goto-char (point-min))
|
|
5656 (delete-matching-lines "^to\\..*$")
|
|
5657 ;; Store active file in hashtable.
|
|
5658 (goto-char (point-min))
|
|
5659 (while
|
|
5660 (re-search-forward
|
|
5661 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
|
|
5662 nil t)
|
|
5663 (gnus-sethash
|
|
5664 (buffer-substring (match-beginning 1) (match-end 1))
|
|
5665 (list (buffer-substring (match-beginning 1) (match-end 1))
|
|
5666 (string-equal
|
|
5667 "y" (buffer-substring (match-beginning 4) (match-end 4)))
|
|
5668 (cons (string-to-int
|
|
5669 (buffer-substring (match-beginning 3) (match-end 3)))
|
|
5670 (string-to-int
|
|
5671 (buffer-substring (match-beginning 2) (match-end 2)))))
|
|
5672 gnus-active-hashtb)))
|
|
5673
|
|
5674 (defun gnus-read-newsrc-file (&optional rawfile)
|
|
5675 "Read startup FILE.
|
|
5676 If optional argument RAWFILE is non-nil, the raw startup file is read."
|
|
5677 (setq gnus-current-startup-file
|
|
5678 (let* ((file (expand-file-name gnus-startup-file nil))
|
|
5679 (real-file (concat file "-" gnus-nntp-server)))
|
|
5680 (if (file-exists-p real-file)
|
|
5681 real-file file)))
|
|
5682 ;; Reset variables which may be included in the quick startup file.
|
|
5683 (let ((variables gnus-variable-list))
|
|
5684 (while variables
|
|
5685 (set (car variables) nil)
|
|
5686 (setq variables (cdr variables))))
|
|
5687 (let* ((newsrc-file gnus-current-startup-file)
|
|
5688 (quick-file (concat newsrc-file ".el"))
|
|
5689 (quick-loaded nil)
|
|
5690 (newsrc-mod (nth 5 (file-attributes newsrc-file)))
|
|
5691 (quick-mod (nth 5 (file-attributes quick-file))))
|
|
5692 (save-excursion
|
|
5693 ;; Prepare .newsrc buffer.
|
|
5694 (set-buffer (find-file-noselect newsrc-file))
|
|
5695 ;; It is not so good idea turning off undo.
|
|
5696 ;;(buffer-flush-undo (current-buffer))
|
|
5697 ;; Load quick .newsrc to restore gnus-marked-assoc and
|
|
5698 ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date.
|
|
5699 (condition-case nil
|
|
5700 (setq quick-loaded (load quick-file t t t))
|
|
5701 (error nil))
|
|
5702 (cond ((and (not rawfile) ;Not forced to read the raw file.
|
|
5703 (or (and (fboundp 'file-newer-than-file-p)
|
|
5704 (file-newer-than-file-p quick-file newsrc-file))
|
|
5705 (and newsrc-mod quick-mod
|
|
5706 ;; .newsrc.el is newer than .newsrc.
|
|
5707 ;; Some older version does not support function
|
|
5708 ;; `file-newer-than-file-p'.
|
|
5709 (or (< (car newsrc-mod) (car quick-mod))
|
|
5710 (and (= (car newsrc-mod) (car quick-mod))
|
|
5711 (<= (nth 1 newsrc-mod) (nth 1 quick-mod))))
|
|
5712 ))
|
|
5713 quick-loaded
|
|
5714 gnus-newsrc-assoc ;Really loaded?
|
|
5715 )
|
|
5716 ;; We don't have to read the raw startup file.
|
|
5717 )
|
|
5718 (t
|
|
5719 ;; Since .newsrc file is newer than quick file, read it.
|
|
5720 (message "Reading %s..." newsrc-file)
|
|
5721 (gnus-newsrc-to-gnus-format)
|
|
5722 (gnus-check-killed-newsgroups)
|
|
5723 (message "Reading %s... Done" newsrc-file)))
|
|
5724 )))
|
|
5725
|
|
5726 (defun gnus-make-newsrc-file (file)
|
|
5727 "Make server dependent file name by catenating FILE and server host name."
|
|
5728 (let* ((file (expand-file-name file nil))
|
|
5729 (real-file (concat file "-" gnus-nntp-server)))
|
|
5730 (if (file-exists-p real-file)
|
|
5731 real-file file)
|
|
5732 ))
|
|
5733
|
|
5734 (defun gnus-newsrc-to-gnus-format ()
|
|
5735 "Parse current buffer as .newsrc file."
|
|
5736 (let ((newsgroup nil)
|
|
5737 (subscribe nil)
|
|
5738 (ranges nil)
|
|
5739 (subrange nil)
|
|
5740 (read-list nil))
|
|
5741 ;; We have to re-initialize these variable (except for
|
|
5742 ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup
|
|
5743 ;; file may contain bogus values.
|
|
5744 (setq gnus-newsrc-options nil)
|
|
5745 (setq gnus-newsrc-options-n-yes nil)
|
|
5746 (setq gnus-newsrc-options-n-no nil)
|
|
5747 (setq gnus-newsrc-assoc nil)
|
|
5748 ;; Save options line to variable.
|
|
5749 ;; Lines beginning with white spaces are treated as continuation
|
|
5750 ;; line. Refer man page of newsrc(5).
|
|
5751 (goto-char (point-min))
|
|
5752 (if (re-search-forward
|
|
5753 "^[ \t]*options[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)[ \t]*$" nil t)
|
|
5754 (progn
|
|
5755 ;; Save entire options line.
|
|
5756 (setq gnus-newsrc-options
|
|
5757 (buffer-substring (match-beginning 1) (match-end 1)))
|
|
5758 ;; Compile "-n" option.
|
|
5759 (if (string-match "\\(^\\|[ \t\n]\\)-n" gnus-newsrc-options)
|
|
5760 (let ((yes-and-no
|
|
5761 (gnus-parse-n-options
|
|
5762 (substring gnus-newsrc-options (match-end 0)))))
|
|
5763 (setq gnus-newsrc-options-n-yes (car yes-and-no))
|
|
5764 (setq gnus-newsrc-options-n-no (cdr yes-and-no))
|
|
5765 ))
|
|
5766 ))
|
|
5767 ;; Parse body of .newsrc file
|
|
5768 ;; Options line continuation lines must be also considered here.
|
|
5769 ;; Before supporting continuation lines, " newsgroup ! 1-5" was
|
|
5770 ;; okay, but now it is invalid. It should be "newsgroup! 1-5".
|
|
5771 (goto-char (point-min))
|
|
5772 ;; Due to overflows in regex.c, change the following regexp:
|
|
5773 ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$"
|
|
5774 ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem).
|
|
5775 (while (re-search-forward
|
|
5776 "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" nil t)
|
|
5777 (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
|
|
5778 ;; Check duplications of newsgroups.
|
|
5779 ;; Note: Checking the duplications takes very long time.
|
|
5780 (if (assoc newsgroup gnus-newsrc-assoc)
|
|
5781 (message "Ignore duplicated newsgroup: %s" newsgroup)
|
|
5782 (setq subscribe
|
|
5783 (string-equal
|
|
5784 ":" (buffer-substring (match-beginning 2) (match-end 2))))
|
|
5785 (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
|
|
5786 (setq read-list nil)
|
|
5787 (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
|
|
5788 (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
|
|
5789 (setq ranges (substring ranges (match-end 1)))
|
|
5790 (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
|
|
5791 (setq read-list
|
|
5792 (cons
|
|
5793 (cons (string-to-int
|
|
5794 (substring subrange
|
|
5795 (match-beginning 1) (match-end 1)))
|
|
5796 (string-to-int
|
|
5797 (substring subrange
|
|
5798 (match-beginning 2) (match-end 2))))
|
|
5799 read-list)))
|
|
5800 ((string-match "^[0-9]+$" subrange)
|
|
5801 (setq read-list
|
|
5802 (cons (cons (string-to-int subrange)
|
|
5803 (string-to-int subrange))
|
|
5804 read-list)))
|
|
5805 (t
|
|
5806 (ding) (message "Ignoring bogus lines of %s" newsgroup)
|
|
5807 (sit-for 0))
|
|
5808 ))
|
|
5809 (setq gnus-newsrc-assoc
|
|
5810 (cons (cons newsgroup (cons subscribe (nreverse read-list)))
|
|
5811 gnus-newsrc-assoc))
|
|
5812 ))
|
|
5813 (setq gnus-newsrc-assoc
|
|
5814 (nreverse gnus-newsrc-assoc))
|
|
5815 ))
|
|
5816
|
|
5817 (defun gnus-parse-n-options (options)
|
|
5818 "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
|
|
5819 (let ((yes nil)
|
|
5820 (no nil)
|
|
5821 (yes-or-no nil) ;`!' or not.
|
|
5822 (newsgroup nil))
|
|
5823 ;; Parse each newsgroup description such as "comp.all". Commas
|
|
5824 ;; and white spaces can be a newsgroup separator.
|
|
5825 (while
|
|
5826 (string-match "^[ \t\n,]*\\(!?\\)\\([^--- \t\n,][^ \t\n,]*\\)" options)
|
|
5827 (setq yes-or-no
|
|
5828 (substring options (match-beginning 1) (match-end 1)))
|
|
5829 (setq newsgroup
|
|
5830 (regexp-quote
|
|
5831 (substring options
|
|
5832 (match-beginning 2) (match-end 2))))
|
|
5833 (setq options (substring options (match-end 2)))
|
|
5834 ;; Rewrite "all" to ".+" not ".*". ".+" requires at least one
|
|
5835 ;; character.
|
|
5836 (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
|
|
5837 (setq newsgroup
|
|
5838 (concat (substring newsgroup 0 (match-end 1))
|
|
5839 ".+"
|
|
5840 (substring newsgroup (match-beginning 2)))))
|
|
5841 (cond ((string-equal yes-or-no "!")
|
|
5842 (setq no (cons newsgroup no)))
|
|
5843 ((string-equal newsgroup ".+")) ;Ignore `all'.
|
|
5844 (t
|
|
5845 (setq yes (cons newsgroup yes)))
|
|
5846 ))
|
|
5847 ;; Make a cons of regexps from parsing result.
|
|
5848 (cons (if yes
|
|
5849 (concat "^\\("
|
|
5850 (apply (function concat)
|
|
5851 (mapcar
|
|
5852 (function
|
|
5853 (lambda (newsgroup)
|
|
5854 (concat newsgroup "\\|")))
|
|
5855 (cdr yes)))
|
|
5856 (car yes) "\\)"))
|
|
5857 (if no
|
|
5858 (concat "^\\("
|
|
5859 (apply (function concat)
|
|
5860 (mapcar
|
|
5861 (function
|
|
5862 (lambda (newsgroup)
|
|
5863 (concat newsgroup "\\|")))
|
|
5864 (cdr no)))
|
|
5865 (car no) "\\)")))
|
|
5866 ))
|
|
5867
|
|
5868 (defun gnus-save-newsrc-file ()
|
|
5869 "Save to .newsrc FILE."
|
|
5870 ;; Note: We cannot save .newsrc file if all newsgroups are removed
|
|
5871 ;; from the variable gnus-newsrc-assoc.
|
|
5872 (and (or gnus-newsrc-assoc gnus-killed-assoc)
|
|
5873 gnus-current-startup-file
|
|
5874 (save-excursion
|
|
5875 ;; A buffer containing .newsrc file may be deleted.
|
|
5876 (set-buffer (find-file-noselect gnus-current-startup-file))
|
|
5877 (if (not (buffer-modified-p))
|
|
5878 (message "(No changes need to be saved)")
|
|
5879 (message "Saving %s..." gnus-current-startup-file)
|
|
5880 (let ((make-backup-files t)
|
|
5881 (version-control nil)
|
|
5882 (require-final-newline t)) ;Don't ask even if requested.
|
|
5883 ;; Make backup file of master newsrc.
|
|
5884 ;; You can stop or change version control of backup file.
|
|
5885 ;; Suggested by jason@violet.berkeley.edu.
|
|
5886 (run-hooks 'gnus-Save-newsrc-hook)
|
|
5887 (save-buffer))
|
|
5888 ;; Quickly loadable .newsrc.
|
|
5889 (set-buffer (get-buffer-create " *GNUS-newsrc*"))
|
|
5890 (buffer-flush-undo (current-buffer))
|
|
5891 (erase-buffer)
|
|
5892 (gnus-gnus-to-quick-newsrc-format)
|
|
5893 (let ((make-backup-files nil)
|
|
5894 (version-control nil)
|
|
5895 (require-final-newline t)) ;Don't ask even if requested.
|
|
5896 (write-file (concat gnus-current-startup-file ".el")))
|
|
5897 (kill-buffer (current-buffer))
|
|
5898 (message "Saving %s... Done" gnus-current-startup-file)
|
|
5899 ))
|
|
5900 ))
|
|
5901
|
|
5902 (defun gnus-update-newsrc-buffer (group &optional delete next)
|
|
5903 "Incrementally update .newsrc buffer about GROUP.
|
|
5904 If optional second argument DELETE is non-nil, delete the group.
|
|
5905 If optional third argument NEXT is non-nil, inserted before it."
|
|
5906 (save-excursion
|
|
5907 ;; Taking account of the killed startup file.
|
|
5908 ;; Suggested by tale@pawl.rpi.edu.
|
|
5909 (set-buffer (or (get-file-buffer gnus-current-startup-file)
|
|
5910 (find-file-noselect gnus-current-startup-file)))
|
|
5911 ;; Options line continuation lines must be also considered here.
|
|
5912 ;; Before supporting continuation lines, " newsgroup ! 1-5" was
|
|
5913 ;; okay, but now it is invalid. It should be "newsgroup! 1-5".
|
|
5914 (let ((deleted nil)
|
|
5915 (buffer-read-only nil)) ;May be not modifiable.
|
|
5916 ;; Delete ALL entries which match for GROUP.
|
|
5917 (goto-char (point-min))
|
|
5918 (while (re-search-forward
|
|
5919 (concat "^" (regexp-quote group) "[:!]") nil t)
|
|
5920 (beginning-of-line)
|
|
5921 (delete-region (point) (progn (forward-line 1) (point)))
|
|
5922 (setq deleted t) ;Old entry is deleted.
|
|
5923 )
|
|
5924 (if delete
|
|
5925 nil
|
|
5926 ;; Insert group entry.
|
|
5927 (let ((newsrc (assoc group gnus-newsrc-assoc)))
|
|
5928 (if (null newsrc)
|
|
5929 nil
|
|
5930 ;; Find insertion point.
|
|
5931 (cond (deleted nil) ;Insert here.
|
|
5932 ((and (stringp next)
|
|
5933 (progn
|
|
5934 (goto-char (point-min))
|
|
5935 (re-search-forward
|
|
5936 (concat "^" (regexp-quote next) "[:!]") nil t)))
|
|
5937 (beginning-of-line))
|
|
5938 (t
|
|
5939 (goto-char (point-max))
|
|
5940 (or (bolp)
|
|
5941 (insert "\n"))))
|
|
5942 ;; Insert after options line.
|
|
5943 (if (looking-at "^[ \t]*options\\([ \t]\\|$\\)")
|
|
5944 (progn
|
|
5945 (forward-line 1)
|
|
5946 ;; Skip continuation lines.
|
|
5947 (while (and (not (eobp))
|
|
5948 (looking-at "^[ \t]+"))
|
|
5949 (forward-line 1))))
|
|
5950 (insert group ;Group name
|
|
5951 (if (nth 1 newsrc) ": " "! ")) ;Subscribed?
|
|
5952 (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
|
|
5953 (insert "\n")
|
|
5954 )))
|
|
5955 )))
|
|
5956
|
|
5957 (defun gnus-gnus-to-quick-newsrc-format ()
|
|
5958 "Insert GNUS variables such as `gnus-newsrc-assoc' in Lisp format."
|
|
5959 (insert ";; GNUS internal format of .newsrc.\n")
|
|
5960 (insert ";; Touch .newsrc instead if you think to remove this file.\n")
|
|
5961 (let ((variable nil)
|
|
5962 (variables gnus-variable-list)
|
|
5963 ;; Temporary rebind to make changes invisible.
|
|
5964 (gnus-killed-assoc gnus-killed-assoc))
|
|
5965 ;; Remove duplicated or unsubscribed newsgroups in gnus-killed-assoc.
|
|
5966 (gnus-check-killed-newsgroups)
|
|
5967 ;; Then, insert lisp expressions.
|
|
5968 (while variables
|
|
5969 (setq variable (car variables))
|
|
5970 (and (boundp variable)
|
|
5971 (symbol-value variable)
|
|
5972 (insert "(setq " (symbol-name variable) " '"
|
|
5973 (prin1-to-string (symbol-value variable))
|
|
5974 ")\n"))
|
|
5975 (setq variables (cdr variables)))
|
|
5976 ))
|
|
5977
|
|
5978 (defun gnus-ranges-to-newsrc-format (ranges)
|
|
5979 "Insert ranges of read articles."
|
|
5980 (let ((range nil)) ;Range is a pair of BEGIN and END.
|
|
5981 (while ranges
|
|
5982 (setq range (car ranges))
|
|
5983 (setq ranges (cdr ranges))
|
|
5984 (cond ((= (car range) (cdr range))
|
|
5985 (if (= (car range) 0)
|
|
5986 (setq ranges nil) ;No unread articles.
|
|
5987 (insert (int-to-string (car range)))
|
|
5988 (if ranges (insert ","))
|
|
5989 ))
|
|
5990 (t
|
|
5991 (insert (int-to-string (car range))
|
|
5992 "-"
|
|
5993 (int-to-string (cdr range)))
|
|
5994 (if ranges (insert ","))
|
|
5995 ))
|
|
5996 )))
|
|
5997
|
|
5998 (defun gnus-compress-sequence (numbers)
|
|
5999 "Convert list of sorted numbers to ranges."
|
|
6000 (let* ((numbers (sort (copy-sequence numbers) (function <)))
|
|
6001 (first (car numbers))
|
|
6002 (last (car numbers))
|
|
6003 (result nil))
|
|
6004 (while numbers
|
|
6005 (cond ((= last (car numbers)) nil) ;Omit duplicated number
|
|
6006 ((= (1+ last) (car numbers)) ;Still in sequence
|
|
6007 (setq last (car numbers)))
|
|
6008 (t ;End of one sequence
|
|
6009 (setq result (cons (cons first last) result))
|
|
6010 (setq first (car numbers))
|
|
6011 (setq last (car numbers)))
|
|
6012 )
|
|
6013 (setq numbers (cdr numbers))
|
|
6014 )
|
|
6015 (nreverse (cons (cons first last) result))
|
|
6016 ))
|
|
6017
|
|
6018 (defun gnus-uncompress-sequence (ranges)
|
|
6019 "Expand compressed format of sequence."
|
|
6020 (let ((first nil)
|
|
6021 (last nil)
|
|
6022 (result nil))
|
|
6023 (while ranges
|
|
6024 (setq first (car (car ranges)))
|
|
6025 (setq last (cdr (car ranges)))
|
|
6026 (while (< first last)
|
|
6027 (setq result (cons first result))
|
|
6028 (setq first (1+ first)))
|
|
6029 (setq result (cons first result))
|
|
6030 (setq ranges (cdr ranges))
|
|
6031 )
|
|
6032 (nreverse result)
|
|
6033 ))
|
|
6034
|
|
6035 (defun gnus-number-of-articles (range)
|
|
6036 "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
|
|
6037 (let ((count 0))
|
|
6038 (while range
|
|
6039 (if (/= (cdr (car range)) 0)
|
|
6040 ;; If end1 is 0, it must be skipped. Usually no articles in
|
|
6041 ;; this group.
|
|
6042 (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
|
|
6043 (setq range (cdr range))
|
|
6044 )
|
|
6045 count ;Result
|
|
6046 ))
|
|
6047
|
|
6048 (defun gnus-difference-of-range (src obj)
|
|
6049 "Compute (SRC - OBJ) on range.
|
|
6050 Range of SRC is expressed as `(beg . end)'.
|
|
6051 Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
|
|
6052 (let ((beg (car src))
|
|
6053 (end (cdr src))
|
|
6054 (range nil)) ;This is result.
|
|
6055 ;; Src may be nil.
|
|
6056 (while (and src obj)
|
|
6057 (let ((beg1 (car (car obj)))
|
|
6058 (end1 (cdr (car obj))))
|
|
6059 (cond ((> beg end)
|
|
6060 (setq obj nil)) ;Terminate loop
|
|
6061 ((< beg beg1)
|
|
6062 (setq range (cons (cons beg (min (1- beg1) end)) range))
|
|
6063 (setq beg (1+ end1)))
|
|
6064 ((>= beg beg1)
|
|
6065 (setq beg (max beg (1+ end1))))
|
|
6066 )
|
|
6067 (setq obj (cdr obj)) ;Next OBJ
|
|
6068 ))
|
|
6069 ;; Src may be nil.
|
|
6070 (if (and src (<= beg end))
|
|
6071 (setq range (cons (cons beg end) range)))
|
|
6072 ;; Result
|
|
6073 (if range
|
|
6074 (nreverse range)
|
|
6075 (list (cons 0 0)))
|
|
6076 ))
|
|
6077
|
|
6078
|
|
6079 ;;Local variables:
|
|
6080 ;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
|
|
6081 ;;end:
|