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