Commit | Line | Data |
---|---|---|
41487370 | 1 | ;;; gnus.el --- a newsreader for GNU Emacs |
fc103e78 | 2 | ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. |
44cdca98 | 3 | |
41487370 LMI |
4 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
5 | ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
44cdca98 | 6 | ;; Keywords: news |
e5167999 | 7 | |
745bc783 JB |
8 | ;; This file is part of GNU Emacs. |
9 | ||
08b684de RS |
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
11 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
08b684de RS |
13 | ;; any later version. |
14 | ||
745bc783 | 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
08b684de | 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
231f989b | 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
08b684de | 18 | ;; GNU General Public License for more details. |
745bc783 | 19 | |
08b684de | 20 | ;; You should have received a copy of the GNU General Public License |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
745bc783 | 24 | |
e5167999 ER |
25 | ;;; Commentary: |
26 | ||
44cdca98 | 27 | ;;; Code: |
745bc783 | 28 | |
41487370 LMI |
29 | (eval '(run-hooks 'gnus-load-hook)) |
30 | ||
745bc783 | 31 | (require 'mail-utils) |
70fcd1c2 | 32 | (require 'timezone) |
41487370 | 33 | (require 'nnheader) |
231f989b LMI |
34 | (require 'nnmail) |
35 | (require 'backquote) | |
564b670b | 36 | (require 'nnoo) |
231f989b LMI |
37 | |
38 | (eval-when-compile (require 'cl)) | |
39 | ||
40 | (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/") | |
41 | "*Directory variable from which all other Gnus file variables are derived.") | |
41487370 | 42 | |
231f989b | 43 | ;; Site dependent variables. These variables should be defined in |
41487370 | 44 | ;; paths.el. |
745bc783 | 45 | |
44cdca98 | 46 | (defvar gnus-default-nntp-server nil |
41487370 LMI |
47 | "Specify a default NNTP server. |
48 | This variable should be defined in paths.el, and should never be set | |
49 | by the user. | |
50 | If you want to change servers, you should use `gnus-select-method'. | |
51 | See the documentation to that variable.") | |
52 | ||
231f989b | 53 | (defvar gnus-backup-default-subscribed-newsgroups |
41487370 LMI |
54 | '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") |
55 | "Default default new newsgroups the first time Gnus is run. | |
56 | Should be set in paths.el, and shouldn't be touched by the user.") | |
57 | ||
58 | (defvar gnus-local-domain nil | |
59 | "Local domain name without a host name. | |
60 | The DOMAINNAME environment variable is used instead if it is defined. | |
61 | If the `system-name' function returns the full Internet name, there is | |
62 | no need to set this variable.") | |
63 | ||
64 | (defvar gnus-local-organization nil | |
65 | "String with a description of what organization (if any) the user belongs to. | |
66 | The ORGANIZATION environment variable is used instead if it is defined. | |
67 | If this variable contains a function, this function will be called | |
231f989b | 68 | with the current newsgroup name as the argument. The function should |
41487370 LMI |
69 | return a string. |
70 | ||
71 | In any case, if the string (either in the variable, in the environment | |
72 | variable, or returned by the function) is a file name, the contents of | |
73 | this file will be used as the organization.") | |
74 | ||
41487370 LMI |
75 | ;; Customization variables |
76 | ||
77 | ;; Don't touch this variable. | |
343fbb30 | 78 | (defvar gnus-nntp-service "nntp" |
b027f415 | 79 | "*NNTP service name (\"nntp\" or 119). |
231f989b | 80 | This is an obsolete variable, which is scarcely used. If you use an |
41487370 LMI |
81 | nntp server for your newsgroup and want to change the port number |
82 | used to 899, you would say something along these lines: | |
b027f415 | 83 | |
41487370 LMI |
84 | (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") |
85 | ||
231f989b LMI |
86 | (defvar gnus-nntpserver-file "/etc/nntpserver" |
87 | "*A file with only the name of the nntp server in it.") | |
88 | ||
89 | ;; This function is used to check both the environment variable | |
90 | ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find | |
91 | ;; an nntp server name default. | |
92 | (defun gnus-getenv-nntpserver () | |
93 | (or (getenv "NNTPSERVER") | |
94 | (and (file-readable-p gnus-nntpserver-file) | |
95 | (save-excursion | |
96 | (set-buffer (get-buffer-create " *gnus nntp*")) | |
97 | (buffer-disable-undo (current-buffer)) | |
98 | (insert-file-contents gnus-nntpserver-file) | |
99 | (let ((name (buffer-string))) | |
100 | (prog1 | |
101 | (if (string-match "^[ \t\n]*$" name) | |
102 | nil | |
103 | name) | |
104 | (kill-buffer (current-buffer)))))))) | |
105 | ||
106 | (defvar gnus-select-method | |
41487370 | 107 | (nconc |
231f989b LMI |
108 | (list 'nntp (or (condition-case () |
109 | (gnus-getenv-nntpserver) | |
110 | (error nil)) | |
41487370 LMI |
111 | (if (and gnus-default-nntp-server |
112 | (not (string= gnus-default-nntp-server ""))) | |
113 | gnus-default-nntp-server) | |
114 | (system-name))) | |
115 | (if (or (null gnus-nntp-service) | |
116 | (equal gnus-nntp-service "nntp")) | |
231f989b | 117 | nil |
41487370 LMI |
118 | (list gnus-nntp-service))) |
119 | "*Default method for selecting a newsgroup. | |
120 | This variable should be a list, where the first element is how the | |
231f989b | 121 | news is to be fetched, the second is the address. |
41487370 LMI |
122 | |
123 | For instance, if you want to get your news via NNTP from | |
124 | \"flab.flab.edu\", you could say: | |
125 | ||
126 | (setq gnus-select-method '(nntp \"flab.flab.edu\")) | |
127 | ||
128 | If you want to use your local spool, say: | |
129 | ||
130 | (setq gnus-select-method (list 'nnspool (system-name))) | |
131 | ||
132 | If you use this variable, you must set `gnus-nntp-server' to nil. | |
133 | ||
134 | There is a lot more to know about select methods and virtual servers - | |
135 | see the manual for details.") | |
136 | ||
231f989b LMI |
137 | (defvar gnus-message-archive-method |
138 | `(nnfolder | |
139 | "archive" | |
140 | (nnfolder-directory ,(nnheader-concat message-directory "archive")) | |
141 | (nnfolder-active-file | |
142 | ,(nnheader-concat message-directory "archive/active")) | |
143 | (nnfolder-get-new-mail nil) | |
144 | (nnfolder-inhibit-expiry t)) | |
145 | "*Method used for archiving messages you've sent. | |
146 | This should be a mail method. | |
147 | ||
148 | It's probably not a very effective to change this variable once you've | |
149 | run Gnus once. After doing that, you must edit this server from the | |
150 | server buffer.") | |
41487370 | 151 | |
564b670b LMI |
152 | (defvar gnus-message-archive-group nil |
153 | "*Name of the group in which to save the messages you've written. | |
154 | This can either be a string, a list of strings; or an alist | |
155 | of regexps/functions/forms to be evaluated to return a string (or a list | |
156 | of strings). The functions are called with the name of the current | |
157 | group (or nil) as a parameter. | |
158 | ||
159 | Normally the group names returned by this variable should be | |
160 | unprefixed -- which implictly means \"store on the archive server\". | |
161 | However, you may wish to store the message on some other server. In | |
162 | that case, just return a fully prefixed name of the group -- | |
163 | \"nnml+private:mail.misc\", for instance.") | |
164 | ||
41487370 LMI |
165 | (defvar gnus-refer-article-method nil |
166 | "*Preferred method for fetching an article by Message-ID. | |
167 | If you are reading news from the local spool (with nnspool), fetching | |
231f989b | 168 | articles by Message-ID is painfully slow. By setting this method to an |
41487370 LMI |
169 | nntp method, you might get acceptable results. |
170 | ||
171 | The value of this variable must be a valid select method as discussed | |
231f989b | 172 | in the documentation of `gnus-select-method'.") |
41487370 LMI |
173 | |
174 | (defvar gnus-secondary-select-methods nil | |
175 | "*A list of secondary methods that will be used for reading news. | |
176 | This is a list where each element is a complete select method (see | |
231f989b | 177 | `gnus-select-method'). |
41487370 LMI |
178 | |
179 | If, for instance, you want to read your mail with the nnml backend, | |
180 | you could set this variable: | |
181 | ||
182 | (setq gnus-secondary-select-methods '((nnml \"\")))") | |
343fbb30 | 183 | |
41487370 LMI |
184 | (defvar gnus-secondary-servers nil |
185 | "*List of NNTP servers that the user can choose between interactively. | |
186 | To make Gnus query you for a server, you have to give `gnus' a | |
187 | non-numeric prefix - `C-u M-x gnus', in short.") | |
188 | ||
189 | (defvar gnus-nntp-server nil | |
190 | "*The name of the host running the NNTP server. | |
231f989b | 191 | This variable is semi-obsolete. Use the `gnus-select-method' |
41487370 LMI |
192 | variable instead.") |
193 | ||
194 | (defvar gnus-startup-file "~/.newsrc" | |
195 | "*Your `.newsrc' file. | |
196 | `.newsrc-SERVER' will be used instead if that exists.") | |
197 | ||
198 | (defvar gnus-init-file "~/.gnus" | |
199 | "*Your Gnus elisp startup file. | |
200 | If a file with the .el or .elc suffixes exist, it will be read | |
231f989b | 201 | instead.") |
41487370 LMI |
202 | |
203 | (defvar gnus-group-faq-directory | |
231f989b LMI |
204 | '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" |
205 | "/ftp@sunsite.auc.dk:/pub/usenet/" | |
206 | "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" | |
207 | "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" | |
208 | "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" | |
209 | "/ftp@rtfm.mit.edu:/pub/usenet/" | |
210 | "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" | |
211 | "/ftp@ftp.sunet.se:/pub/usenet/" | |
212 | "/ftp@nctuccca.edu.tw:/USENET/FAQ/" | |
213 | "/ftp@hwarang.postech.ac.kr:/pub/usenet/" | |
214 | "/ftp@ftp.hk.super.net:/mirror/faqs/") | |
41487370 LMI |
215 | "*Directory where the group FAQs are stored. |
216 | This will most commonly be on a remote machine, and the file will be | |
217 | fetched by ange-ftp. | |
218 | ||
231f989b | 219 | This variable can also be a list of directories. In that case, the |
564b670b LMI |
220 | first element in the list will be used by default. The others can |
221 | be used when being prompted for a site. | |
231f989b | 222 | |
41487370 LMI |
223 | Note that Gnus uses an aol machine as the default directory. If this |
224 | feels fundamentally unclean, just think of it as a way to finally get | |
225 | something of value back from them. | |
226 | ||
227 | If the default site is too slow, try one of these: | |
228 | ||
231f989b LMI |
229 | North America: mirrors.aol.com /pub/rtfm/usenet |
230 | ftp.seas.gwu.edu /pub/rtfm | |
231 | rtfm.mit.edu /pub/usenet | |
232 | Europe: ftp.uni-paderborn.de /pub/FAQ | |
233 | src.doc.ic.ac.uk /usenet/news-FAQS | |
234 | ftp.sunet.se /pub/usenet | |
235 | sunsite.auc.dk /pub/usenet | |
236 | Asia: nctuccca.edu.tw /USENET/FAQ | |
237 | hwarang.postech.ac.kr /pub/usenet | |
238 | ftp.hk.super.net /mirror/faqs") | |
41487370 LMI |
239 | |
240 | (defvar gnus-group-archive-directory | |
231f989b | 241 | "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" |
41487370 LMI |
242 | "*The address of the (ding) archives.") |
243 | ||
244 | (defvar gnus-group-recent-archive-directory | |
245 | "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" | |
246 | "*The address of the most recent (ding) articles.") | |
247 | ||
248 | (defvar gnus-default-subscribed-newsgroups nil | |
249 | "*This variable lists what newsgroups should be subscribed the first time Gnus is used. | |
250 | It should be a list of strings. | |
251 | If it is `t', Gnus will not do anything special the first time it is | |
252 | started; it'll just use the normal newsgroups subscription methods.") | |
745bc783 JB |
253 | |
254 | (defvar gnus-use-cross-reference t | |
41487370 | 255 | "*Non-nil means that cross referenced articles will be marked as read. |
b027f415 | 256 | If nil, ignore cross references. If t, mark articles as read in |
231f989b LMI |
257 | subscribed newsgroups. If neither t nor nil, mark as read in all |
258 | newsgroups.") | |
259 | ||
260 | (defvar gnus-single-article-buffer t | |
261 | "*If non-nil, display all articles in the same buffer. | |
262 | If nil, each group will get its own article buffer.") | |
745bc783 | 263 | |
41487370 LMI |
264 | (defvar gnus-use-dribble-file t |
265 | "*Non-nil means that Gnus will use a dribble file to store user updates. | |
266 | If Emacs should crash without saving the .newsrc files, complete | |
267 | information can be restored from the dribble file.") | |
745bc783 | 268 | |
231f989b LMI |
269 | (defvar gnus-dribble-directory nil |
270 | "*The directory where dribble files will be saved. | |
271 | If this variable is nil, the directory where the .newsrc files are | |
272 | saved will be used.") | |
273 | ||
41487370 LMI |
274 | (defvar gnus-asynchronous nil |
275 | "*If non-nil, Gnus will supply backends with data needed for async article fetching.") | |
276 | ||
231f989b LMI |
277 | (defvar gnus-kill-summary-on-exit t |
278 | "*If non-nil, kill the summary buffer when you exit from it. | |
279 | If nil, the summary will become a \"*Dead Summary*\" buffer, and | |
280 | it will be killed sometime later.") | |
745bc783 | 281 | |
41487370 LMI |
282 | (defvar gnus-large-newsgroup 200 |
283 | "*The number of articles which indicates a large newsgroup. | |
284 | If the number of articles in a newsgroup is greater than this value, | |
285 | confirmation is required for selecting the newsgroup.") | |
286 | ||
287 | ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>. | |
288 | (defvar gnus-no-groups-message "No news is horrible news" | |
289 | "*Message displayed by Gnus when no groups are available.") | |
290 | ||
291 | (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) | |
292 | "*Non-nil means that the default name of a file to save articles in is the group name. | |
293 | If it's nil, the directory form of the group name is used instead. | |
294 | ||
295 | If this variable is a list, and the list contains the element | |
296 | `not-score', long file names will not be used for score files; if it | |
297 | contains the element `not-save', long file names will not be used for | |
298 | saving; and if it contains the element `not-kill', long file names | |
231f989b LMI |
299 | will not be used for kill files. |
300 | ||
301 | Note that the default for this variable varies according to what system | |
302 | type you're using. On `usg-unix-v' and `xenix' this variable defaults | |
303 | to nil while on all other systems it defaults to t.") | |
41487370 | 304 | |
231f989b LMI |
305 | (defvar gnus-article-save-directory gnus-directory |
306 | "*Name of the directory articles will be saved in (default \"~/News\").") | |
745bc783 | 307 | |
231f989b LMI |
308 | (defvar gnus-kill-files-directory gnus-directory |
309 | "*Name of the directory where kill files will be stored (default \"~/News\").") | |
1507a647 | 310 | |
41487370 | 311 | (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail |
b027f415 | 312 | "*A function to save articles in your favorite format. |
745bc783 JB |
313 | The function must be interactively callable (in other words, it must |
314 | be an Emacs command). | |
315 | ||
41487370 LMI |
316 | Gnus provides the following functions: |
317 | ||
318 | * gnus-summary-save-in-rmail (Rmail format) | |
319 | * gnus-summary-save-in-mail (Unix mail format) | |
320 | * gnus-summary-save-in-folder (MH folder) | |
321 | * gnus-summary-save-in-file (article format). | |
322 | * gnus-summary-save-in-vm (use VM's folder format).") | |
745bc783 | 323 | |
231f989b LMI |
324 | (defvar gnus-prompt-before-saving 'always |
325 | "*This variable says how much prompting is to be done when saving articles. | |
326 | If it is nil, no prompting will be done, and the articles will be | |
327 | saved to the default files. If this variable is `always', each and | |
328 | every article that is saved will be preceded by a prompt, even when | |
329 | saving large batches of articles. If this variable is neither nil not | |
330 | `always', there the user will be prompted once for a file name for | |
331 | each invocation of the saving commands.") | |
332 | ||
745bc783 | 333 | (defvar gnus-rmail-save-name (function gnus-plain-save-name) |
b027f415 | 334 | "*A function generating a file name to save articles in Rmail format. |
745bc783 JB |
335 | The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") |
336 | ||
337 | (defvar gnus-mail-save-name (function gnus-plain-save-name) | |
b027f415 | 338 | "*A function generating a file name to save articles in Unix mail format. |
745bc783 JB |
339 | The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") |
340 | ||
341 | (defvar gnus-folder-save-name (function gnus-folder-save-name) | |
b027f415 | 342 | "*A function generating a file name to save articles in MH folder. |
745bc783 JB |
343 | The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.") |
344 | ||
345 | (defvar gnus-file-save-name (function gnus-numeric-save-name) | |
b027f415 | 346 | "*A function generating a file name to save articles in article format. |
41487370 LMI |
347 | The function is called with NEWSGROUP, HEADERS, and optional |
348 | LAST-FILE.") | |
745bc783 | 349 | |
231f989b LMI |
350 | (defvar gnus-split-methods |
351 | '((gnus-article-archive-name)) | |
41487370 | 352 | "*Variable used to suggest where articles are to be saved. |
41487370 LMI |
353 | For instance, if you would like to save articles related to Gnus in |
354 | the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", | |
355 | you could set this variable to something like: | |
356 | ||
357 | '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") | |
231f989b LMI |
358 | (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) |
359 | ||
360 | This variable is an alist where the where the key is the match and the | |
361 | value is a list of possible files to save in if the match is non-nil. | |
362 | ||
363 | If the match is a string, it is used as a regexp match on the | |
364 | article. If the match is a symbol, that symbol will be funcalled | |
365 | from the buffer of the article to be saved with the newsgroup as the | |
366 | parameter. If it is a list, it will be evaled in the same buffer. | |
367 | ||
368 | If this form or function returns a string, this string will be used as | |
369 | a possible file name; and if it returns a non-nil list, that list will | |
370 | be used as possible file names.") | |
371 | ||
372 | (defvar gnus-move-split-methods nil | |
373 | "*Variable used to suggest where articles are to be moved to. | |
374 | It uses the same syntax as the `gnus-split-methods' variable.") | |
41487370 LMI |
375 | |
376 | (defvar gnus-save-score nil | |
377 | "*If non-nil, save group scoring info.") | |
378 | ||
379 | (defvar gnus-use-adaptive-scoring nil | |
380 | "*If non-nil, use some adaptive scoring scheme.") | |
381 | ||
231f989b LMI |
382 | (defvar gnus-use-cache 'passive |
383 | "*If nil, Gnus will ignore the article cache. | |
384 | If `passive', it will allow entering (and reading) articles | |
385 | explicitly entered into the cache. If anything else, use the | |
386 | cache to the full extent of the law.") | |
387 | ||
388 | (defvar gnus-use-trees nil | |
389 | "*If non-nil, display a thread tree buffer.") | |
390 | ||
391 | (defvar gnus-use-grouplens nil | |
392 | "*If non-nil, use GroupLens ratings.") | |
393 | ||
394 | (defvar gnus-keep-backlog nil | |
395 | "*If non-nil, Gnus will keep read articles for later re-retrieval. | |
396 | If it is a number N, then Gnus will only keep the last N articles | |
397 | read. If it is neither nil nor a number, Gnus will keep all read | |
398 | articles. This is not a good idea.") | |
399 | ||
400 | (defvar gnus-use-nocem nil | |
401 | "*If non-nil, Gnus will read NoCeM cancel messages.") | |
402 | ||
403 | (defvar gnus-use-demon nil | |
404 | "If non-nil, Gnus might use some demons.") | |
41487370 LMI |
405 | |
406 | (defvar gnus-use-scoring t | |
407 | "*If non-nil, enable scoring.") | |
408 | ||
231f989b LMI |
409 | (defvar gnus-use-picons nil |
410 | "*If non-nil, display picons.") | |
411 | ||
41487370 LMI |
412 | (defvar gnus-fetch-old-headers nil |
413 | "*Non-nil means that Gnus will try to build threads by grabbing old headers. | |
414 | If an unread article in the group refers to an older, already read (or | |
415 | just marked as read) article, the old article will not normally be | |
416 | displayed in the Summary buffer. If this variable is non-nil, Gnus | |
417 | will attempt to grab the headers to the old articles, and thereby | |
231f989b | 418 | build complete threads. If it has the value `some', only enough |
41487370 | 419 | headers to connect otherwise loose threads will be displayed. |
231f989b LMI |
420 | This variable can also be a number. In that case, no more than that |
421 | number of old headers will be fetched. | |
41487370 | 422 | |
231f989b | 423 | The server has to support NOV for any of this to work.") |
41487370 LMI |
424 | |
425 | ;see gnus-cus.el | |
426 | ;(defvar gnus-visual t | |
427 | ; "*If non-nil, will do various highlighting. | |
428 | ;If nil, no mouse highlights (or any other highlights) will be | |
429 | ;performed. This might speed up Gnus some when generating large group | |
430 | ;and summary buffers.") | |
745bc783 JB |
431 | |
432 | (defvar gnus-novice-user t | |
41487370 LMI |
433 | "*Non-nil means that you are a usenet novice. |
434 | If non-nil, verbose messages may be displayed and confirmations may be | |
435 | required.") | |
436 | ||
437 | (defvar gnus-expert-user nil | |
438 | "*Non-nil means that you will never be asked for confirmation about anything. | |
439 | And that means *anything*.") | |
440 | ||
441 | (defvar gnus-verbose 7 | |
442 | "*Integer that says how verbose Gnus should be. | |
443 | The higher the number, the more messages Gnus will flash to say what | |
444 | it's doing. At zero, Gnus will be totally mute; at five, Gnus will | |
445 | display most important messages; and at ten, Gnus will keep on | |
446 | jabbering all the time.") | |
447 | ||
448 | (defvar gnus-keep-same-level nil | |
449 | "*Non-nil means that the next newsgroup after the current will be on the same level. | |
450 | When you type, for instance, `n' after reading the last article in the | |
231f989b | 451 | current newsgroup, you will go to the next newsgroup. If this variable |
41487370 | 452 | is nil, the next newsgroup will be the next from the group |
231f989b | 453 | buffer. |
41487370 LMI |
454 | If this variable is non-nil, Gnus will either put you in the |
455 | next newsgroup with the same level, or, if no such newsgroup is | |
456 | available, the next newsgroup with the lowest possible level higher | |
457 | than the current level. | |
458 | If this variable is `best', Gnus will make the next newsgroup the one | |
459 | with the best level.") | |
460 | ||
461 | (defvar gnus-summary-make-false-root 'adopt | |
462 | "*nil means that Gnus won't gather loose threads. | |
463 | If the root of a thread has expired or been read in a previous | |
464 | session, the information necessary to build a complete thread has been | |
231f989b LMI |
465 | lost. Instead of having many small sub-threads from this original thread |
466 | scattered all over the summary buffer, Gnus can gather them. | |
41487370 LMI |
467 | |
468 | If non-nil, Gnus will try to gather all loose sub-threads from an | |
469 | original thread into one large thread. | |
470 | ||
471 | If this variable is non-nil, it should be one of `none', `adopt', | |
472 | `dummy' or `empty'. | |
473 | ||
474 | If this variable is `none', Gnus will not make a false root, but just | |
475 | present the sub-threads after another. | |
476 | If this variable is `dummy', Gnus will create a dummy root that will | |
477 | have all the sub-threads as children. | |
478 | If this variable is `adopt', Gnus will make one of the \"children\" | |
479 | the parent and mark all the step-children as such. | |
480 | If this variable is `empty', the \"children\" are printed with empty | |
231f989b | 481 | subject fields. (Or rather, they will be printed with a string |
41487370 LMI |
482 | given by the `gnus-summary-same-subject' variable.)") |
483 | ||
231f989b LMI |
484 | (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" |
485 | "*A regexp to match subjects to be excluded from loose thread gathering. | |
486 | As loose thread gathering is done on subjects only, that means that | |
487 | there can be many false gatherings performed. By rooting out certain | |
488 | common subjects, gathering might become saner.") | |
489 | ||
41487370 LMI |
490 | (defvar gnus-summary-gather-subject-limit nil |
491 | "*Maximum length of subject comparisons when gathering loose threads. | |
492 | Use nil to compare full subjects. Setting this variable to a low | |
493 | number will help gather threads that have been corrupted by | |
494 | newsreaders chopping off subject lines, but it might also mean that | |
495 | unrelated articles that have subject that happen to begin with the | |
496 | same few characters will be incorrectly gathered. | |
497 | ||
498 | If this variable is `fuzzy', Gnus will use a fuzzy algorithm when | |
499 | comparing subjects.") | |
500 | ||
231f989b LMI |
501 | (defvar gnus-simplify-ignored-prefixes nil |
502 | "*Regexp, matches for which are removed from subject lines when simplifying.") | |
503 | ||
504 | (defvar gnus-build-sparse-threads nil | |
505 | "*If non-nil, fill in the gaps in threads. | |
506 | If `some', only fill in the gaps that are needed to tie loose threads | |
507 | together. If `more', fill in all leaf nodes that Gnus can find. If | |
508 | non-nil and non-`some', fill in all gaps that Gnus manages to guess.") | |
509 | ||
510 | (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject | |
511 | "Function used for gathering loose threads. | |
512 | There are two pre-defined functions: `gnus-gather-threads-by-subject', | |
513 | which only takes Subjects into consideration; and | |
514 | `gnus-gather-threads-by-references', which compared the References | |
515 | headers of the articles to find matches.") | |
516 | ||
41487370 LMI |
517 | ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. |
518 | (defvar gnus-summary-same-subject "" | |
519 | "*String indicating that the current article has the same subject as the previous. | |
520 | This variable will only be used if the value of | |
521 | `gnus-summary-make-false-root' is `empty'.") | |
522 | ||
523 | (defvar gnus-summary-goto-unread t | |
231f989b LMI |
524 | "*If non-nil, marking commands will go to the next unread article. |
525 | If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article, | |
526 | whether it is read or not.") | |
41487370 LMI |
527 | |
528 | (defvar gnus-group-goto-unread t | |
529 | "*If non-nil, movement commands will go to the next unread and subscribed group.") | |
530 | ||
231f989b LMI |
531 | (defvar gnus-goto-next-group-when-activating t |
532 | "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.") | |
533 | ||
41487370 LMI |
534 | (defvar gnus-check-new-newsgroups t |
535 | "*Non-nil means that Gnus will add new newsgroups at startup. | |
536 | If this variable is `ask-server', Gnus will ask the server for new | |
231f989b | 537 | groups since the last time it checked. This means that the killed list |
41487370 | 538 | is no longer necessary, so you could set `gnus-save-killed-list' to |
231f989b | 539 | nil. |
41487370 | 540 | |
231f989b | 541 | A variant is to have this variable be a list of select methods. Gnus |
41487370 LMI |
542 | will then use the `ask-server' method on all these select methods to |
543 | query for new groups from all those servers. | |
544 | ||
545 | Eg. | |
231f989b LMI |
546 | (setq gnus-check-new-newsgroups |
547 | '((nntp \"some.server\") (nntp \"other.server\"))) | |
41487370 LMI |
548 | |
549 | If this variable is nil, then you have to tell Gnus explicitly to | |
550 | check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].") | |
551 | ||
552 | (defvar gnus-check-bogus-newsgroups nil | |
553 | "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. | |
554 | If this variable is nil, then you have to tell Gnus explicitly to | |
555 | check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].") | |
556 | ||
557 | (defvar gnus-read-active-file t | |
558 | "*Non-nil means that Gnus will read the entire active file at startup. | |
559 | If this variable is nil, Gnus will only know about the groups in your | |
560 | `.newsrc' file. | |
561 | ||
562 | If this variable is `some', Gnus will try to only read the relevant | |
563 | parts of the active file from the server. Not all servers support | |
564 | this, and it might be quite slow with other servers, but this should | |
565 | generally be faster than both the t and nil value. | |
566 | ||
567 | If you set this variable to nil or `some', you probably still want to | |
568 | be told about new newsgroups that arrive. To do that, set | |
569 | `gnus-check-new-newsgroups' to `ask-server'. This may not work | |
570 | properly with all servers.") | |
571 | ||
572 | (defvar gnus-level-subscribed 5 | |
573 | "*Groups with levels less than or equal to this variable are subscribed.") | |
574 | ||
575 | (defvar gnus-level-unsubscribed 7 | |
576 | "*Groups with levels less than or equal to this variable are unsubscribed. | |
577 | Groups with levels less than `gnus-level-subscribed', which should be | |
578 | less than this variable, are subscribed.") | |
579 | ||
580 | (defvar gnus-level-zombie 8 | |
581 | "*Groups with this level are zombie groups.") | |
582 | ||
583 | (defvar gnus-level-killed 9 | |
584 | "*Groups with this level are killed.") | |
585 | ||
586 | (defvar gnus-level-default-subscribed 3 | |
587 | "*New subscribed groups will be subscribed at this level.") | |
588 | ||
589 | (defvar gnus-level-default-unsubscribed 6 | |
590 | "*New unsubscribed groups will be unsubscribed at this level.") | |
591 | ||
231f989b LMI |
592 | (defvar gnus-activate-level (1+ gnus-level-subscribed) |
593 | "*Groups higher than this level won't be activated on startup. | |
594 | Setting this variable to something log might save lots of time when | |
595 | you have many groups that you aren't interested in.") | |
596 | ||
41487370 LMI |
597 | (defvar gnus-activate-foreign-newsgroups 4 |
598 | "*If nil, Gnus will not check foreign newsgroups at startup. | |
231f989b | 599 | If it is non-nil, it should be a number between one and nine. Foreign |
41487370 | 600 | newsgroups that have a level lower or equal to this number will be |
231f989b LMI |
601 | activated on startup. For instance, if you want to active all |
602 | subscribed newsgroups, but not the rest, you'd set this variable to | |
41487370 LMI |
603 | `gnus-level-subscribed'. |
604 | ||
605 | If you subscribe to lots of newsgroups from different servers, startup | |
231f989b | 606 | might take a while. By setting this variable to nil, you'll save time, |
41487370 LMI |
607 | but you won't be told how many unread articles there are in the |
608 | groups.") | |
609 | ||
610 | (defvar gnus-save-newsrc-file t | |
611 | "*Non-nil means that Gnus will save the `.newsrc' file. | |
612 | Gnus always saves its own startup file, which is called | |
613 | \".newsrc.eld\". The file called \".newsrc\" is in a format that can | |
614 | be readily understood by other newsreaders. If you don't plan on | |
615 | using other newsreaders, set this variable to nil to save some time on | |
616 | exit.") | |
617 | ||
618 | (defvar gnus-save-killed-list t | |
619 | "*If non-nil, save the list of killed groups to the startup file. | |
231f989b LMI |
620 | If you set this variable to nil, you'll save both time (when starting |
621 | and quitting) and space (both memory and disk), but it will also mean | |
622 | that Gnus has no record of which groups are new and which are old, so | |
623 | the automatic new newsgroups subscription methods become meaningless. | |
624 | ||
625 | You should always set `gnus-check-new-newsgroups' to `ask-server' or | |
626 | nil if you set this variable to nil.") | |
b027f415 RS |
627 | |
628 | (defvar gnus-interactive-catchup t | |
41487370 | 629 | "*If non-nil, require your confirmation when catching up a group.") |
745bc783 | 630 | |
b027f415 | 631 | (defvar gnus-interactive-exit t |
41487370 LMI |
632 | "*If non-nil, require your confirmation when exiting Gnus.") |
633 | ||
634 | (defvar gnus-kill-killed t | |
635 | "*If non-nil, Gnus will apply kill files to already killed articles. | |
636 | If it is nil, Gnus will never apply kill files to articles that have | |
637 | already been through the scoring process, which might very well save lots | |
638 | of time.") | |
639 | ||
640 | (defvar gnus-extract-address-components 'gnus-extract-address-components | |
641 | "*Function for extracting address components from a From header. | |
642 | Two pre-defined function exist: `gnus-extract-address-components', | |
643 | which is the default, quite fast, and too simplistic solution, and | |
644 | `mail-extract-address-components', which works much better, but is | |
645 | slower.") | |
b027f415 | 646 | |
41487370 LMI |
647 | (defvar gnus-summary-default-score 0 |
648 | "*Default article score level. | |
649 | If this variable is nil, scoring will be disabled.") | |
745bc783 | 650 | |
41487370 LMI |
651 | (defvar gnus-summary-zcore-fuzz 0 |
652 | "*Fuzziness factor for the zcore in the summary buffer. | |
653 | Articles with scores closer than this to `gnus-summary-default-score' | |
654 | will not be marked.") | |
655 | ||
656 | (defvar gnus-simplify-subject-fuzzy-regexp nil | |
231f989b LMI |
657 | "*Strings to be removed when doing fuzzy matches. |
658 | This can either be a regular expression or list of regular expressions | |
659 | that will be removed from subject strings if fuzzy subject | |
660 | simplification is selected.") | |
661 | ||
662 | (defvar gnus-permanently-visible-groups nil | |
663 | "*Regexp to match groups that should always be listed in the group buffer. | |
664 | This means that they will still be listed when there are no unread | |
665 | articles in the groups.") | |
666 | ||
667 | (defvar gnus-list-groups-with-ticked-articles t | |
668 | "*If non-nil, list groups that have only ticked articles. | |
669 | If nil, only list groups that have unread articles.") | |
41487370 LMI |
670 | |
671 | (defvar gnus-group-default-list-level gnus-level-subscribed | |
231f989b | 672 | "*Default listing level. |
41487370 LMI |
673 | Ignored if `gnus-group-use-permanent-levels' is non-nil.") |
674 | ||
675 | (defvar gnus-group-use-permanent-levels nil | |
676 | "*If non-nil, once you set a level, Gnus will use this level.") | |
b027f415 | 677 | |
231f989b LMI |
678 | (defvar gnus-group-list-inactive-groups t |
679 | "*If non-nil, inactive groups will be listed.") | |
680 | ||
b027f415 | 681 | (defvar gnus-show-mime nil |
41487370 LMI |
682 | "*If non-nil, do mime processing of articles. |
683 | The articles will simply be fed to the function given by | |
684 | `gnus-show-mime-method'.") | |
745bc783 | 685 | |
41487370 | 686 | (defvar gnus-strict-mime t |
231f989b LMI |
687 | "*If nil, MIME-decode even if there is no Mime-Version header in the article.") |
688 | ||
689 | (defvar gnus-show-mime-method 'metamail-buffer | |
41487370 LMI |
690 | "*Function to process a MIME message. |
691 | The function is called from the article buffer.") | |
745bc783 | 692 | |
231f989b LMI |
693 | (defvar gnus-decode-encoded-word-method (lambda ()) |
694 | "*Function to decode a MIME encoded-words. | |
695 | The function is called from the article buffer.") | |
696 | ||
41487370 LMI |
697 | (defvar gnus-show-threads t |
698 | "*If non-nil, display threads in summary mode.") | |
745bc783 JB |
699 | |
700 | (defvar gnus-thread-hide-subtree nil | |
41487370 LMI |
701 | "*If non-nil, hide all threads initially. |
702 | If threads are hidden, you have to run the command | |
703 | `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' | |
704 | to expose hidden threads.") | |
745bc783 JB |
705 | |
706 | (defvar gnus-thread-hide-killed t | |
41487370 | 707 | "*If non-nil, hide killed threads automatically.") |
745bc783 JB |
708 | |
709 | (defvar gnus-thread-ignore-subject nil | |
41487370 LMI |
710 | "*If non-nil, ignore subjects and do all threading based on the Reference header. |
711 | If nil, which is the default, articles that have different subjects | |
712 | from their parents will start separate threads.") | |
745bc783 | 713 | |
231f989b LMI |
714 | (defvar gnus-thread-operation-ignore-subject t |
715 | "*If non-nil, subjects will be ignored when doing thread commands. | |
716 | This affects commands like `gnus-summary-kill-thread' and | |
717 | `gnus-summary-lower-thread'. | |
718 | ||
719 | If this variable is nil, articles in the same thread with different | |
720 | subjects will not be included in the operation in question. If this | |
721 | variable is `fuzzy', only articles that have subjects that are fuzzily | |
722 | equal will be included.") | |
723 | ||
745bc783 | 724 | (defvar gnus-thread-indent-level 4 |
41487370 LMI |
725 | "*Number that says how much each sub-thread should be indented.") |
726 | ||
231f989b | 727 | (defvar gnus-ignored-newsgroups |
41487370 | 728 | (purecopy (mapconcat 'identity |
231f989b LMI |
729 | '("^to\\." ; not "real" groups |
730 | "^[0-9. \t]+ " ; all digits in name | |
731 | "[][\"#'()]" ; bogus characters | |
732 | ) | |
733 | "\\|")) | |
8483b957 | 734 | "*A regexp to match uninteresting newsgroups in the active file. |
b027f415 RS |
735 | Any lines in the active file matching this regular expression are |
736 | removed from the newsgroup list before anything else is done to it, | |
41487370 | 737 | thus making them effectively non-existent.") |
745bc783 JB |
738 | |
739 | (defvar gnus-ignored-headers | |
41487370 LMI |
740 | "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" |
741 | "*All headers that match this regexp will be hidden. | |
231f989b | 742 | This variable can also be a list of regexps of headers to be ignored. |
41487370 LMI |
743 | If `gnus-visible-headers' is non-nil, this variable will be ignored.") |
744 | ||
231f989b | 745 | (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-" |
41487370 | 746 | "*All headers that do not match this regexp will be hidden. |
231f989b | 747 | This variable can also be a list of regexp of headers to remain visible. |
41487370 LMI |
748 | If this variable is non-nil, `gnus-ignored-headers' will be ignored.") |
749 | ||
750 | (defvar gnus-sorted-header-list | |
231f989b | 751 | '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" |
41487370 LMI |
752 | "^Cc:" "^Date:" "^Organization:") |
753 | "*This variable is a list of regular expressions. | |
754 | If it is non-nil, headers that match the regular expressions will | |
755 | be placed first in the article buffer in the sequence specified by | |
756 | this list.") | |
745bc783 | 757 | |
231f989b LMI |
758 | (defvar gnus-boring-article-headers |
759 | '(empty followup-to reply-to) | |
760 | "*Headers that are only to be displayed if they have interesting data. | |
761 | Possible values in this list are `empty', `newsgroups', `followup-to', | |
762 | `reply-to', and `date'.") | |
763 | ||
745bc783 | 764 | (defvar gnus-show-all-headers nil |
41487370 | 765 | "*If non-nil, don't hide any headers.") |
745bc783 | 766 | |
b027f415 | 767 | (defvar gnus-save-all-headers t |
41487370 | 768 | "*If non-nil, don't remove any headers before saving.") |
745bc783 | 769 | |
231f989b LMI |
770 | (defvar gnus-saved-headers gnus-visible-headers |
771 | "*Headers to keep if `gnus-save-all-headers' is nil. | |
772 | If `gnus-save-all-headers' is non-nil, this variable will be ignored. | |
773 | If that variable is nil, however, all headers that match this regexp | |
774 | will be kept while the rest will be deleted before saving.") | |
775 | ||
41487370 LMI |
776 | (defvar gnus-inhibit-startup-message nil |
777 | "*If non-nil, the startup message will not be displayed.") | |
778 | ||
779 | (defvar gnus-signature-separator "^-- *$" | |
780 | "Regexp matching signature separator.") | |
745bc783 | 781 | |
231f989b LMI |
782 | (defvar gnus-signature-limit nil |
783 | "Provide a limit to what is considered a signature. | |
784 | If it is a number, no signature may not be longer (in characters) than | |
785 | that number. If it is a function, the function will be called without | |
786 | any parameters, and if it returns nil, there is no signature in the | |
787 | buffer. If it is a string, it will be used as a regexp. If it | |
788 | matches, the text in question is not a signature.") | |
789 | ||
745bc783 | 790 | (defvar gnus-auto-extend-newsgroup t |
41487370 | 791 | "*If non-nil, extend newsgroup forward and backward when requested.") |
745bc783 JB |
792 | |
793 | (defvar gnus-auto-select-first t | |
231f989b LMI |
794 | "*If nil, don't select the first unread article when entering a group. |
795 | If this variable is `best', select the highest-scored unread article | |
796 | in the group. If neither nil nor `best', select the first unread | |
797 | article. | |
798 | ||
745bc783 | 799 | If you want to prevent automatic selection of the first unread article |
41487370 | 800 | in some newsgroups, set the variable to nil in |
231f989b | 801 | `gnus-select-group-hook'.") |
745bc783 JB |
802 | |
803 | (defvar gnus-auto-select-next t | |
41487370 LMI |
804 | "*If non-nil, offer to go to the next group from the end of the previous. |
805 | If the value is t and the next newsgroup is empty, Gnus will exit | |
231f989b LMI |
806 | summary mode and go back to group mode. If the value is neither nil |
807 | nor t, Gnus will select the following unread newsgroup. In | |
41487370 | 808 | particular, if the value is the symbol `quietly', the next unread |
231f989b LMI |
809 | newsgroup will be selected without any confirmation, and if it is |
810 | `almost-quietly', the next group will be selected without any | |
811 | confirmation if you are located on the last article in the group. | |
812 | Finally, if this variable is `slightly-quietly', the `Z n' command | |
813 | will go to the next group without confirmation.") | |
745bc783 JB |
814 | |
815 | (defvar gnus-auto-select-same nil | |
41487370 | 816 | "*If non-nil, select the next article with the same subject.") |
745bc783 | 817 | |
41487370 LMI |
818 | (defvar gnus-summary-check-current nil |
819 | "*If non-nil, consider the current article when moving. | |
820 | The \"unread\" movement commands will stay on the same line if the | |
821 | current article is unread.") | |
b027f415 | 822 | |
41487370 | 823 | (defvar gnus-auto-center-summary t |
231f989b LMI |
824 | "*If non-nil, always center the current summary buffer. |
825 | In particular, if `vertical' do only vertical recentering. If non-nil | |
826 | and non-`vertical', do both horizontal and vertical recentering.") | |
745bc783 JB |
827 | |
828 | (defvar gnus-break-pages t | |
41487370 LMI |
829 | "*If non-nil, do page breaking on articles. |
830 | The page delimiter is specified by the `gnus-page-delimiter' | |
831 | variable.") | |
745bc783 JB |
832 | |
833 | (defvar gnus-page-delimiter "^\^L" | |
41487370 LMI |
834 | "*Regexp describing what to use as article page delimiters. |
835 | The default value is \"^\^L\", which is a form linefeed at the | |
836 | beginning of a line.") | |
745bc783 JB |
837 | |
838 | (defvar gnus-use-full-window t | |
41487370 LMI |
839 | "*If non-nil, use the entire Emacs screen.") |
840 | ||
841 | (defvar gnus-window-configuration nil | |
842 | "Obsolete variable. See `gnus-buffer-configuration'.") | |
843 | ||
231f989b LMI |
844 | (defvar gnus-window-min-width 2 |
845 | "*Minimum width of Gnus buffers.") | |
846 | ||
847 | (defvar gnus-window-min-height 1 | |
848 | "*Minimum height of Gnus buffers.") | |
849 | ||
41487370 | 850 | (defvar gnus-buffer-configuration |
231f989b LMI |
851 | '((group |
852 | (vertical 1.0 | |
853 | (group 1.0 point) | |
854 | (if gnus-carpal '(group-carpal 4)))) | |
855 | (summary | |
856 | (vertical 1.0 | |
857 | (summary 1.0 point) | |
858 | (if gnus-carpal '(summary-carpal 4)))) | |
859 | (article | |
860 | (cond | |
861 | (gnus-use-picons | |
862 | '(frame 1.0 | |
863 | (vertical 1.0 | |
864 | (summary 0.25 point) | |
865 | (if gnus-carpal '(summary-carpal 4)) | |
866 | (article 1.0)) | |
867 | (vertical ((height . 5) (width . 15) | |
868 | (user-position . t) | |
869 | (left . -1) (top . 1)) | |
870 | (picons 1.0)))) | |
871 | (gnus-use-trees | |
872 | '(vertical 1.0 | |
873 | (summary 0.25 point) | |
874 | (tree 0.25) | |
875 | (article 1.0))) | |
876 | (t | |
877 | '(vertical 1.0 | |
878 | (summary 0.25 point) | |
879 | (if gnus-carpal '(summary-carpal 4)) | |
231f989b LMI |
880 | (article 1.0))))) |
881 | (server | |
882 | (vertical 1.0 | |
883 | (server 1.0 point) | |
884 | (if gnus-carpal '(server-carpal 2)))) | |
885 | (browse | |
886 | (vertical 1.0 | |
887 | (browse 1.0 point) | |
888 | (if gnus-carpal '(browse-carpal 2)))) | |
889 | (message | |
890 | (vertical 1.0 | |
891 | (message 1.0 point))) | |
892 | (pick | |
893 | (vertical 1.0 | |
894 | (article 1.0 point))) | |
895 | (info | |
896 | (vertical 1.0 | |
897 | (info 1.0 point))) | |
898 | (summary-faq | |
899 | (vertical 1.0 | |
900 | (summary 0.25) | |
901 | (faq 1.0 point))) | |
902 | (edit-group | |
903 | (vertical 1.0 | |
904 | (group 0.5) | |
905 | (edit-group 1.0 point))) | |
906 | (edit-server | |
907 | (vertical 1.0 | |
908 | (server 0.5) | |
909 | (edit-server 1.0 point))) | |
910 | (edit-score | |
911 | (vertical 1.0 | |
912 | (summary 0.25) | |
913 | (edit-score 1.0 point))) | |
914 | (post | |
915 | (vertical 1.0 | |
916 | (post 1.0 point))) | |
917 | (reply | |
918 | (vertical 1.0 | |
919 | (article-copy 0.5) | |
920 | (message 1.0 point))) | |
921 | (forward | |
922 | (vertical 1.0 | |
923 | (message 1.0 point))) | |
924 | (reply-yank | |
925 | (vertical 1.0 | |
926 | (message 1.0 point))) | |
927 | (mail-bounce | |
928 | (vertical 1.0 | |
929 | (article 0.5) | |
930 | (message 1.0 point))) | |
931 | (draft | |
932 | (vertical 1.0 | |
933 | (draft 1.0 point))) | |
934 | (pipe | |
935 | (vertical 1.0 | |
936 | (summary 0.25 point) | |
937 | (if gnus-carpal '(summary-carpal 4)) | |
938 | ("*Shell Command Output*" 1.0))) | |
939 | (bug | |
940 | (vertical 1.0 | |
941 | ("*Gnus Help Bug*" 0.5) | |
942 | ("*Gnus Bug*" 1.0 point))) | |
943 | (compose-bounce | |
944 | (vertical 1.0 | |
945 | (article 0.5) | |
946 | (message 1.0 point)))) | |
41487370 LMI |
947 | "Window configuration for all possible Gnus buffers. |
948 | This variable is a list of lists. Each of these lists has a NAME and | |
231f989b | 949 | a RULE. The NAMEs are commonsense names like `group', which names a |
41487370 LMI |
950 | rule used when displaying the group buffer; `summary', which names a |
951 | rule for what happens when you enter a group and do not display an | |
952 | article buffer; and so on. See the value of this variable for a | |
953 | complete list of NAMEs. | |
954 | ||
231f989b | 955 | Each RULE is a list of vectors. The first element in this vector is |
41487370 LMI |
956 | the name of the buffer to be displayed; the second element is the |
957 | percentage of the screen this buffer is to occupy (a number in the | |
958 | 0.0-0.99 range); the optional third element is `point', which should | |
959 | be present to denote which buffer point is to go to after making this | |
960 | buffer configuration.") | |
961 | ||
962 | (defvar gnus-window-to-buffer | |
963 | '((group . gnus-group-buffer) | |
964 | (summary . gnus-summary-buffer) | |
965 | (article . gnus-article-buffer) | |
966 | (server . gnus-server-buffer) | |
967 | (browse . "*Gnus Browse Server*") | |
968 | (edit-group . gnus-group-edit-buffer) | |
969 | (edit-server . gnus-server-edit-buffer) | |
970 | (group-carpal . gnus-carpal-group-buffer) | |
971 | (summary-carpal . gnus-carpal-summary-buffer) | |
972 | (server-carpal . gnus-carpal-server-buffer) | |
973 | (browse-carpal . gnus-carpal-browse-buffer) | |
974 | (edit-score . gnus-score-edit-buffer) | |
231f989b LMI |
975 | (message . gnus-message-buffer) |
976 | (mail . gnus-message-buffer) | |
977 | (post-news . gnus-message-buffer) | |
978 | (faq . gnus-faq-buffer) | |
979 | (picons . "*Picons*") | |
980 | (tree . gnus-tree-buffer) | |
981 | (info . gnus-info-buffer) | |
982 | (article-copy . gnus-article-copy) | |
983 | (draft . gnus-draft-buffer)) | |
41487370 LMI |
984 | "Mapping from short symbols to buffer names or buffer variables.") |
985 | ||
986 | (defvar gnus-carpal nil | |
987 | "*If non-nil, display clickable icons.") | |
988 | ||
989 | (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies | |
990 | "*Function called with a group name when new group is detected. | |
991 | A few pre-made functions are supplied: `gnus-subscribe-randomly' | |
992 | inserts new groups at the beginning of the list of groups; | |
993 | `gnus-subscribe-alphabetically' inserts new groups in strict | |
994 | alphabetic order; `gnus-subscribe-hierarchically' inserts new groups | |
995 | in hierarchical newsgroup order; `gnus-subscribe-interactively' asks | |
231f989b LMI |
996 | for your decision; `gnus-subscribe-killed' kills all new groups; |
997 | `gnus-subscribe-zombies' will make all new groups into zombies.") | |
41487370 LMI |
998 | |
999 | ;; Suggested by a bug report by Hallvard B Furuseth. | |
231f989b | 1000 | ;; <h.b.furuseth@usit.uio.no>. |
41487370 | 1001 | (defvar gnus-subscribe-options-newsgroup-method |
b027f415 | 1002 | (function gnus-subscribe-alphabetically) |
41487370 LMI |
1003 | "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. |
1004 | If, for instance, you want to subscribe to all newsgroups in the | |
1005 | \"no\" and \"alt\" hierarchies, you'd put the following in your | |
1006 | .newsrc file: | |
1007 | ||
1008 | options -n no.all alt.all | |
1009 | ||
1010 | Gnus will the subscribe all new newsgroups in these hierarchies with | |
1011 | the subscription method in this variable.") | |
1012 | ||
1013 | (defvar gnus-subscribe-hierarchical-interactive nil | |
1014 | "*If non-nil, Gnus will offer to subscribe hierarchically. | |
1015 | When a new hierarchy appears, Gnus will ask the user: | |
1016 | ||
1017 | 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): | |
1018 | ||
1019 | If the user pressed `d', Gnus will descend the hierarchy, `y' will | |
1020 | subscribe to all newsgroups in the hierarchy and `s' will skip this | |
1021 | hierarchy in its entirety.") | |
1022 | ||
1023 | (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet | |
1024 | "*Function used for sorting the group buffer. | |
1025 | This function will be called with group info entries as the arguments | |
1026 | for the groups to be sorted. Pre-made functions include | |
231f989b LMI |
1027 | `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread', |
1028 | `gnus-group-sort-by-level', `gnus-group-sort-by-score', and | |
1029 | `gnus-group-sort-by-rank'. | |
1030 | ||
1031 | This variable can also be a list of sorting functions. In that case, | |
1032 | the most significant sort function should be the last function in the | |
1033 | list.") | |
41487370 LMI |
1034 | |
1035 | ;; Mark variables suggested by Thomas Michanek | |
231f989b | 1036 | ;; <Thomas.Michanek@telelogic.se>. |
41487370 LMI |
1037 | (defvar gnus-unread-mark ? |
1038 | "*Mark used for unread articles.") | |
1039 | (defvar gnus-ticked-mark ?! | |
1040 | "*Mark used for ticked articles.") | |
1041 | (defvar gnus-dormant-mark ?? | |
1042 | "*Mark used for dormant articles.") | |
1043 | (defvar gnus-del-mark ?r | |
1044 | "*Mark used for del'd articles.") | |
1045 | (defvar gnus-read-mark ?R | |
1046 | "*Mark used for read articles.") | |
1047 | (defvar gnus-expirable-mark ?E | |
1048 | "*Mark used for expirable articles.") | |
1049 | (defvar gnus-killed-mark ?K | |
1050 | "*Mark used for killed articles.") | |
231f989b LMI |
1051 | (defvar gnus-souped-mark ?F |
1052 | "*Mark used for killed articles.") | |
41487370 LMI |
1053 | (defvar gnus-kill-file-mark ?X |
1054 | "*Mark used for articles killed by kill files.") | |
1055 | (defvar gnus-low-score-mark ?Y | |
1056 | "*Mark used for articles with a low score.") | |
1057 | (defvar gnus-catchup-mark ?C | |
1058 | "*Mark used for articles that are caught up.") | |
1059 | (defvar gnus-replied-mark ?A | |
1060 | "*Mark used for articles that have been replied to.") | |
231f989b LMI |
1061 | (defvar gnus-cached-mark ?* |
1062 | "*Mark used for articles that are in the cache.") | |
1063 | (defvar gnus-saved-mark ?S | |
1064 | "*Mark used for articles that have been saved to.") | |
1065 | (defvar gnus-process-mark ?# | |
41487370 LMI |
1066 | "*Process mark.") |
1067 | (defvar gnus-ancient-mark ?O | |
1068 | "*Mark used for ancient articles.") | |
231f989b LMI |
1069 | (defvar gnus-sparse-mark ?Q |
1070 | "*Mark used for sparsely reffed articles.") | |
41487370 LMI |
1071 | (defvar gnus-canceled-mark ?G |
1072 | "*Mark used for canceled articles.") | |
1073 | (defvar gnus-score-over-mark ?+ | |
1074 | "*Score mark used for articles with high scores.") | |
1075 | (defvar gnus-score-below-mark ?- | |
1076 | "*Score mark used for articles with low scores.") | |
1077 | (defvar gnus-empty-thread-mark ? | |
1078 | "*There is no thread under the article.") | |
1079 | (defvar gnus-not-empty-thread-mark ?= | |
1080 | "*There is a thread under the article.") | |
41487370 LMI |
1081 | |
1082 | (defvar gnus-view-pseudo-asynchronously nil | |
1083 | "*If non-nil, Gnus will view pseudo-articles asynchronously.") | |
1084 | ||
1085 | (defvar gnus-view-pseudos nil | |
1086 | "*If `automatic', pseudo-articles will be viewed automatically. | |
1087 | If `not-confirm', pseudos will be viewed automatically, and the user | |
1088 | will not be asked to confirm the command.") | |
1089 | ||
1090 | (defvar gnus-view-pseudos-separately t | |
1091 | "*If non-nil, one pseudo-article will be created for each file to be viewed. | |
1092 | If nil, all files that use the same viewing command will be given as a | |
1093 | list of parameters to that command.") | |
1094 | ||
231f989b LMI |
1095 | (defvar gnus-insert-pseudo-articles t |
1096 | "*If non-nil, insert pseudo-articles when decoding articles.") | |
1097 | ||
1098 | (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n" | |
41487370 LMI |
1099 | "*Format of group lines. |
1100 | It works along the same lines as a normal formatting string, | |
1101 | with some simple extensions. | |
1102 | ||
1103 | %M Only marked articles (character, \"*\" or \" \") | |
1104 | %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") | |
1105 | %L Level of subscribedness (integer) | |
1106 | %N Number of unread articles (integer) | |
1107 | %I Number of dormant articles (integer) | |
1108 | %i Number of ticked and dormant (integer) | |
1109 | %T Number of ticked articles (integer) | |
1110 | %R Number of read articles (integer) | |
1111 | %t Total number of articles (integer) | |
1112 | %y Number of unread, unticked articles (integer) | |
1113 | %G Group name (string) | |
1114 | %g Qualified group name (string) | |
1115 | %D Group description (string) | |
1116 | %s Select method (string) | |
1117 | %o Moderated group (char, \"m\") | |
1118 | %p Process mark (char) | |
1119 | %O Moderated group (string, \"(m)\" or \"\") | |
231f989b LMI |
1120 | %P Topic indentation (string) |
1121 | %l Whether there are GroupLens predictions for this group (string) | |
41487370 LMI |
1122 | %n Select from where (string) |
1123 | %z A string that look like `<%s:%n>' if a foreign select method is used | |
231f989b | 1124 | %u User defined specifier. The next character in the format string should |
41487370 | 1125 | be a letter. Gnus will call the function gnus-user-format-function-X, |
231f989b LMI |
1126 | where X is the letter following %u. The function will be passed the |
1127 | current header as argument. The function should return a string, which | |
41487370 LMI |
1128 | will be inserted into the buffer just like information from any other |
1129 | group specifier. | |
1130 | ||
1131 | Text between %( and %) will be highlighted with `gnus-mouse-face' when | |
1132 | the mouse point move inside the area. There can only be one such area. | |
1133 | ||
231f989b | 1134 | Note that this format specification is not always respected. For |
41487370 | 1135 | reasons of efficiency, when listing killed groups, this specification |
231f989b | 1136 | is ignored altogether. If the spec is changed considerably, your |
41487370 LMI |
1137 | output may end up looking strange when listing both alive and killed |
1138 | groups. | |
1139 | ||
1140 | If you use %o or %O, reading the active file will be slower and quite | |
1141 | a bit of extra memory will be used. %D will also worsen performance. | |
1142 | Also note that if you change the format specification to include any | |
1143 | of these specs, you must probably re-start Gnus to see them go into | |
231f989b | 1144 | effect.") |
41487370 LMI |
1145 | |
1146 | (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" | |
1147 | "*The format specification of the lines in the summary buffer. | |
1148 | ||
1149 | It works along the same lines as a normal formatting string, | |
1150 | with some simple extensions. | |
1151 | ||
1152 | %N Article number, left padded with spaces (string) | |
1153 | %S Subject (string) | |
1154 | %s Subject if it is at the root of a thread, and \"\" otherwise (string) | |
1155 | %n Name of the poster (string) | |
1156 | %a Extracted name of the poster (string) | |
1157 | %A Extracted address of the poster (string) | |
1158 | %F Contents of the From: header (string) | |
1159 | %x Contents of the Xref: header (string) | |
1160 | %D Date of the article (string) | |
1161 | %d Date of the article (string) in DD-MMM format | |
1162 | %M Message-id of the article (string) | |
1163 | %r References of the article (string) | |
1164 | %c Number of characters in the article (integer) | |
1165 | %L Number of lines in the article (integer) | |
1166 | %I Indentation based on thread level (a string of spaces) | |
1167 | %T A string with two possible values: 80 spaces if the article | |
1168 | is on thread level two or larger and 0 spaces on level one | |
1169 | %R \"A\" if this article has been replied to, \" \" otherwise (character) | |
1170 | %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") | |
1171 | %[ Opening bracket (character, \"[\" or \"<\") | |
1172 | %] Closing bracket (character, \"]\" or \">\") | |
1173 | %> Spaces of length thread-level (string) | |
1174 | %< Spaces of length (- 20 thread-level) (string) | |
1175 | %i Article score (number) | |
1176 | %z Article zcore (character) | |
1177 | %t Number of articles under the current thread (number). | |
1178 | %e Whether the thread is empty or not (character). | |
231f989b LMI |
1179 | %l GroupLens score (string). |
1180 | %u User defined specifier. The next character in the format string should | |
41487370 | 1181 | be a letter. Gnus will call the function gnus-user-format-function-X, |
231f989b LMI |
1182 | where X is the letter following %u. The function will be passed the |
1183 | current header as argument. The function should return a string, which | |
41487370 LMI |
1184 | will be inserted into the summary just like information from any other |
1185 | summary specifier. | |
1186 | ||
1187 | Text between %( and %) will be highlighted with `gnus-mouse-face' | |
231f989b | 1188 | when the mouse point is placed inside the area. There can only be one |
41487370 LMI |
1189 | such area. |
1190 | ||
1191 | The %U (status), %R (replied) and %z (zcore) specs have to be handled | |
231f989b LMI |
1192 | with care. For reasons of efficiency, Gnus will compute what column |
1193 | these characters will end up in, and \"hard-code\" that. This means that | |
1194 | it is illegal to have these specs after a variable-length spec. Well, | |
41487370 LMI |
1195 | you might not be arrested, but your summary buffer will look strange, |
1196 | which is bad enough. | |
1197 | ||
1198 | The smart choice is to have these specs as for to the left as | |
231f989b | 1199 | possible. |
41487370 LMI |
1200 | |
1201 | This restriction may disappear in later versions of Gnus.") | |
1202 | ||
231f989b LMI |
1203 | (defvar gnus-summary-dummy-line-format |
1204 | "* %(: :%) %S\n" | |
41487370 LMI |
1205 | "*The format specification for the dummy roots in the summary buffer. |
1206 | It works along the same lines as a normal formatting string, | |
1207 | with some simple extensions. | |
1208 | ||
1209 | %S The subject") | |
1210 | ||
231f989b LMI |
1211 | (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" |
1212 | "*The format specification for the summary mode line. | |
1213 | It works along the same lines as a normal formatting string, | |
1214 | with some simple extensions: | |
1215 | ||
1216 | %G Group name | |
1217 | %p Unprefixed group name | |
1218 | %A Current article number | |
1219 | %V Gnus version | |
1220 | %U Number of unread articles in the group | |
1221 | %e Number of unselected articles in the group | |
1222 | %Z A string with unread/unselected article counts | |
1223 | %g Shortish group name | |
1224 | %S Subject of the current article | |
1225 | %u User-defined spec | |
1226 | %s Current score file name | |
1227 | %d Number of dormant articles | |
1228 | %r Number of articles that have been marked as read in this session | |
1229 | %E Number of articles expunged by the score files") | |
1230 | ||
1231 | (defvar gnus-article-mode-line-format "Gnus: %%b %S" | |
1232 | "*The format specification for the article mode line. | |
1233 | See `gnus-summary-mode-line-format' for a closer description.") | |
1234 | ||
1235 | (defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}" | |
1236 | "*The format specification for the group mode line. | |
1237 | It works along the same lines as a normal formatting string, | |
1238 | with some simple extensions: | |
41487370 | 1239 | |
231f989b LMI |
1240 | %S The native news server. |
1241 | %M The native select method. | |
1242 | %: \":\" if %S isn't \"\".") | |
41487370 LMI |
1243 | |
1244 | (defvar gnus-valid-select-methods | |
1245 | '(("nntp" post address prompt-address) | |
231f989b LMI |
1246 | ("nnspool" post address) |
1247 | ("nnvirtual" post-mail virtual prompt-address) | |
1248 | ("nnmbox" mail respool address) | |
1249 | ("nnml" mail respool address) | |
1250 | ("nnmh" mail respool address) | |
1251 | ("nndir" post-mail prompt-address address) | |
1252 | ("nneething" none address prompt-address) | |
1253 | ("nndoc" none address prompt-address) | |
1254 | ("nnbabyl" mail address respool) | |
1255 | ("nnkiboze" post virtual) | |
1256 | ("nnsoup" post-mail address) | |
1257 | ("nndraft" post-mail) | |
1258 | ("nnfolder" mail respool address)) | |
41487370 LMI |
1259 | "An alist of valid select methods. |
1260 | The first element of each list lists should be a string with the name | |
231f989b | 1261 | of the select method. The other elements may be be the category of |
41487370 LMI |
1262 | this method (ie. `post', `mail', `none' or whatever) or other |
1263 | properties that this method has (like being respoolable). | |
1264 | If you implement a new select method, all you should have to change is | |
231f989b | 1265 | this variable. I think.") |
41487370 | 1266 | |
231f989b | 1267 | (defvar gnus-updated-mode-lines '(group article summary tree) |
41487370 | 1268 | "*List of buffers that should update their mode lines. |
231f989b | 1269 | The list may contain the symbols `group', `article' and `summary'. If |
41487370 | 1270 | the corresponding symbol is present, Gnus will keep that mode line |
231f989b | 1271 | updated with information that may be pertinent. |
41487370 LMI |
1272 | If this variable is nil, screen refresh may be quicker.") |
1273 | ||
1274 | ;; Added by Keinonen Kari <kk85613@cs.tut.fi>. | |
6346a6e6 | 1275 | (defvar gnus-mode-non-string-length nil |
41487370 LMI |
1276 | "*Max length of mode-line non-string contents. |
1277 | If this is nil, Gnus will take space as is needed, leaving the rest | |
1278 | of the modeline intact.") | |
1279 | ||
1280 | ;see gnus-cus.el | |
1281 | ;(defvar gnus-mouse-face 'highlight | |
1282 | ; "*Face used for mouse highlighting in Gnus. | |
1283 | ;No mouse highlights will be done if `gnus-visual' is nil.") | |
1284 | ||
231f989b | 1285 | (defvar gnus-summary-mark-below 0 |
41487370 LMI |
1286 | "*Mark all articles with a score below this variable as read. |
1287 | This variable is local to each summary buffer and usually set by the | |
231f989b LMI |
1288 | score file.") |
1289 | ||
1290 | (defvar gnus-article-sort-functions '(gnus-article-sort-by-number) | |
1291 | "*List of functions used for sorting articles in the summary buffer. | |
1292 | This variable is only used when not using a threaded display.") | |
41487370 LMI |
1293 | |
1294 | (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) | |
1295 | "*List of functions used for sorting threads in the summary buffer. | |
1296 | By default, threads are sorted by article number. | |
1297 | ||
1298 | Each function takes two threads and return non-nil if the first thread | |
1299 | should be sorted before the other. If you use more than one function, | |
231f989b LMI |
1300 | the primary sort function should be the last. You should probably |
1301 | always include `gnus-thread-sort-by-number' in the list of sorting | |
1302 | functions -- preferably first. | |
41487370 LMI |
1303 | |
1304 | Ready-mady functions include `gnus-thread-sort-by-number', | |
1305 | `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', | |
1306 | `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and | |
1307 | `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').") | |
1308 | ||
1309 | (defvar gnus-thread-score-function '+ | |
1310 | "*Function used for calculating the total score of a thread. | |
1311 | ||
1312 | The function is called with the scores of the article and each | |
1313 | subthread and should then return the score of the thread. | |
1314 | ||
1315 | Some functions you can use are `+', `max', or `min'.") | |
1316 | ||
231f989b LMI |
1317 | (defvar gnus-summary-expunge-below nil |
1318 | "All articles that have a score less than this variable will be expunged.") | |
1319 | ||
1320 | (defvar gnus-thread-expunge-below nil | |
1321 | "All threads that have a total score less than this variable will be expunged. | |
1322 | See `gnus-thread-score-function' for en explanation of what a | |
1323 | \"thread score\" is.") | |
1324 | ||
1325 | (defvar gnus-auto-subscribed-groups | |
1326 | "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" | |
1327 | "*All new groups that match this regexp will be subscribed automatically. | |
1328 | Note that this variable only deals with new groups. It has no effect | |
564b670b LMI |
1329 | whatsoever on old groups. |
1330 | ||
1331 | New groups that match this regexp will not be handled by | |
1332 | `gnus-subscribe-newsgroup-method'. Instead, they will | |
1333 | be subscribed using `gnus-subscribe-options-newsgroup-method'.") | |
231f989b | 1334 | |
41487370 LMI |
1335 | (defvar gnus-options-subscribe nil |
1336 | "*All new groups matching this regexp will be subscribed unconditionally. | |
231f989b | 1337 | Note that this variable deals only with new newsgroups. This variable |
564b670b LMI |
1338 | does not affect old newsgroups. |
1339 | ||
1340 | New groups that match this regexp will not be handled by | |
1341 | `gnus-subscribe-newsgroup-method'. Instead, they will | |
1342 | be subscribed using `gnus-subscribe-options-newsgroup-method'.") | |
41487370 LMI |
1343 | |
1344 | (defvar gnus-options-not-subscribe nil | |
1345 | "*All new groups matching this regexp will be ignored. | |
231f989b | 1346 | Note that this variable deals only with new newsgroups. This variable |
41487370 LMI |
1347 | does not affect old (already subscribed) newsgroups.") |
1348 | ||
1349 | (defvar gnus-auto-expirable-newsgroups nil | |
1350 | "*Groups in which to automatically mark read articles as expirable. | |
1351 | If non-nil, this should be a regexp that should match all groups in | |
1352 | which to perform auto-expiry. This only makes sense for mail groups.") | |
1353 | ||
231f989b LMI |
1354 | (defvar gnus-total-expirable-newsgroups nil |
1355 | "*Groups in which to perform expiry of all read articles. | |
1356 | Use with extreme caution. All groups that match this regexp will be | |
1357 | expiring - which means that all read articles will be deleted after | |
1358 | (say) one week. (This only goes for mail groups and the like, of | |
1359 | course.)") | |
1360 | ||
1361 | (defvar gnus-group-uncollapsed-levels 1 | |
1362 | "Number of group name elements to leave alone when making a short group name.") | |
1363 | ||
41487370 LMI |
1364 | (defvar gnus-hidden-properties '(invisible t intangible t) |
1365 | "Property list to use for hiding text.") | |
1366 | ||
1367 | (defvar gnus-modtime-botch nil | |
231f989b LMI |
1368 | "*Non-nil means .newsrc should be deleted prior to save. |
1369 | Its use is due to the bogus appearance that .newsrc was modified on | |
1370 | disc.") | |
41487370 LMI |
1371 | |
1372 | ;; Hooks. | |
745bc783 | 1373 | |
b027f415 | 1374 | (defvar gnus-group-mode-hook nil |
41487370 | 1375 | "*A hook for Gnus group mode.") |
745bc783 | 1376 | |
b027f415 | 1377 | (defvar gnus-summary-mode-hook nil |
41487370 LMI |
1378 | "*A hook for Gnus summary mode. |
1379 | This hook is run before any variables are set in the summary buffer.") | |
745bc783 | 1380 | |
b027f415 | 1381 | (defvar gnus-article-mode-hook nil |
41487370 LMI |
1382 | "*A hook for Gnus article mode.") |
1383 | ||
231f989b | 1384 | (defvar gnus-summary-prepare-exit-hook nil |
41487370 LMI |
1385 | "*A hook called when preparing to exit from the summary buffer. |
1386 | It calls `gnus-summary-expire-articles' by default.") | |
1387 | (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) | |
745bc783 | 1388 | |
231f989b | 1389 | (defvar gnus-summary-exit-hook nil |
41487370 | 1390 | "*A hook called on exit from the summary buffer.") |
745bc783 | 1391 | |
231f989b LMI |
1392 | (defvar gnus-group-catchup-group-hook nil |
1393 | "*A hook run when catching up a group from the group buffer.") | |
1394 | ||
1395 | (defvar gnus-group-update-group-hook nil | |
1396 | "*A hook called when updating group lines.") | |
1397 | ||
b027f415 | 1398 | (defvar gnus-open-server-hook nil |
41487370 LMI |
1399 | "*A hook called just before opening connection to the news server.") |
1400 | ||
1401 | (defvar gnus-load-hook nil | |
1402 | "*A hook run while Gnus is loaded.") | |
745bc783 | 1403 | |
b027f415 | 1404 | (defvar gnus-startup-hook nil |
41487370 LMI |
1405 | "*A hook called at startup. |
1406 | This hook is called after Gnus is connected to the NNTP server.") | |
1407 | ||
1408 | (defvar gnus-get-new-news-hook nil | |
1409 | "*A hook run just before Gnus checks for new news.") | |
1410 | ||
231f989b LMI |
1411 | (defvar gnus-after-getting-new-news-hook nil |
1412 | "*A hook run after Gnus checks for new news.") | |
1413 | ||
41487370 LMI |
1414 | (defvar gnus-group-prepare-function 'gnus-group-prepare-flat |
1415 | "*A function that is called to generate the group buffer. | |
1416 | The function is called with three arguments: The first is a number; | |
1417 | all group with a level less or equal to that number should be listed, | |
231f989b LMI |
1418 | if the second is non-nil, empty groups should also be displayed. If |
1419 | the third is non-nil, it is a number. No groups with a level lower | |
41487370 LMI |
1420 | than this number should be displayed. |
1421 | ||
1422 | The only current function implemented is `gnus-group-prepare-flat'.") | |
745bc783 | 1423 | |
b027f415 | 1424 | (defvar gnus-group-prepare-hook nil |
41487370 LMI |
1425 | "*A hook called after the group buffer has been generated. |
1426 | If you want to modify the group buffer, you can use this hook.") | |
745bc783 | 1427 | |
b027f415 | 1428 | (defvar gnus-summary-prepare-hook nil |
41487370 LMI |
1429 | "*A hook called after the summary buffer has been generated. |
1430 | If you want to modify the summary buffer, you can use this hook.") | |
745bc783 | 1431 | |
231f989b LMI |
1432 | (defvar gnus-summary-generate-hook nil |
1433 | "*A hook run just before generating the summary buffer. | |
1434 | This hook is commonly used to customize threading variables and the | |
1435 | like.") | |
1436 | ||
b027f415 | 1437 | (defvar gnus-article-prepare-hook nil |
41487370 | 1438 | "*A hook called after an article has been prepared in the article buffer. |
745bc783 JB |
1439 | If you want to run a special decoding program like nkf, use this hook.") |
1440 | ||
41487370 LMI |
1441 | ;(defvar gnus-article-display-hook nil |
1442 | ; "*A hook called after the article is displayed in the article buffer. | |
1443 | ;The hook is designed to change the contents of the article | |
231f989b | 1444 | ;buffer. Typical functions that this hook may contain are |
41487370 | 1445 | ;`gnus-article-hide-headers' (hide selected headers), |
231f989b | 1446 | ;`gnus-article-maybe-highlight' (perform fancy article highlighting), |
41487370 LMI |
1447 | ;`gnus-article-hide-signature' (hide signature) and |
1448 | ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") | |
1449 | ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted) | |
1450 | ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike) | |
1451 | ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) | |
1452 | ||
41487370 LMI |
1453 | (defvar gnus-article-x-face-too-ugly nil |
1454 | "Regexp matching posters whose face shouldn't be shown automatically.") | |
1455 | ||
b027f415 RS |
1456 | (defvar gnus-select-group-hook nil |
1457 | "*A hook called when a newsgroup is selected. | |
b027f415 RS |
1458 | |
1459 | If you'd like to simplify subjects like the | |
1460 | `gnus-summary-next-same-subject' command does, you can use the | |
1461 | following hook: | |
1462 | ||
41487370 LMI |
1463 | (setq gnus-select-group-hook |
1464 | (list | |
8483b957 | 1465 | (lambda () |
41487370 LMI |
1466 | (mapcar (lambda (header) |
1467 | (mail-header-set-subject | |
8483b957 RS |
1468 | header |
1469 | (gnus-simplify-subject | |
41487370 LMI |
1470 | (mail-header-subject header) 're-only))) |
1471 | gnus-newsgroup-headers))))") | |
745bc783 | 1472 | |
231f989b LMI |
1473 | (defvar gnus-select-article-hook nil |
1474 | "*A hook called when an article is selected.") | |
745bc783 | 1475 | |
8483b957 | 1476 | (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) |
41487370 LMI |
1477 | "*A hook called to apply kill files to a group. |
1478 | This hook is intended to apply a kill file to the selected newsgroup. | |
8483b957 | 1479 | The function `gnus-apply-kill-file' is called by default. |
745bc783 | 1480 | |
41487370 | 1481 | Since a general kill file is too heavy to use only for a few |
231f989b | 1482 | newsgroups, I recommend you to use a lighter hook function. For |
41487370 | 1483 | example, if you'd like to apply a kill file to articles which contains |
745bc783 JB |
1484 | a string `rmgroup' in subject in newsgroup `control', you can use the |
1485 | following hook: | |
1486 | ||
41487370 | 1487 | (setq gnus-apply-kill-hook |
8483b957 | 1488 | (list |
8483b957 RS |
1489 | (lambda () |
1490 | (cond ((string-match \"control\" gnus-newsgroup-name) | |
1491 | (gnus-kill \"Subject\" \"rmgroup\") | |
41487370 | 1492 | (gnus-expunge \"X\"))))))") |
b027f415 | 1493 | |
231f989b | 1494 | (defvar gnus-visual-mark-article-hook |
41487370 LMI |
1495 | (list 'gnus-highlight-selected-summary) |
1496 | "*Hook run after selecting an article in the summary buffer. | |
1497 | It is meant to be used for highlighting the article in some way. It | |
1498 | is not run if `gnus-visual' is nil.") | |
b027f415 | 1499 | |
231f989b | 1500 | (defvar gnus-parse-headers-hook nil |
7e988fb6 | 1501 | "*A hook called before parsing the headers.") |
231f989b | 1502 | (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522) |
7e988fb6 | 1503 | |
b027f415 | 1504 | (defvar gnus-exit-group-hook nil |
41487370 | 1505 | "*A hook called when exiting (not quitting) summary mode.") |
745bc783 | 1506 | |
b027f415 | 1507 | (defvar gnus-suspend-gnus-hook nil |
41487370 | 1508 | "*A hook called when suspending (not exiting) Gnus.") |
745bc783 | 1509 | |
b027f415 | 1510 | (defvar gnus-exit-gnus-hook nil |
41487370 | 1511 | "*A hook called when exiting Gnus.") |
745bc783 | 1512 | |
231f989b LMI |
1513 | (defvar gnus-after-exiting-gnus-hook nil |
1514 | "*A hook called after exiting Gnus.") | |
1515 | ||
b027f415 | 1516 | (defvar gnus-save-newsrc-hook nil |
231f989b LMI |
1517 | "*A hook called before saving any of the newsrc files.") |
1518 | ||
1519 | (defvar gnus-save-quick-newsrc-hook nil | |
1520 | "*A hook called just before saving the quick newsrc file. | |
1521 | Can be used to turn version control on or off.") | |
de032aaa | 1522 | |
231f989b LMI |
1523 | (defvar gnus-save-standard-newsrc-hook nil |
1524 | "*A hook called just before saving the standard newsrc file. | |
1525 | Can be used to turn version control on or off.") | |
1526 | ||
1527 | (defvar gnus-summary-update-hook | |
41487370 LMI |
1528 | (list 'gnus-summary-highlight-line) |
1529 | "*A hook called when a summary line is changed. | |
1530 | The hook will not be called if `gnus-visual' is nil. | |
de032aaa | 1531 | |
41487370 LMI |
1532 | The default function `gnus-summary-highlight-line' will |
1533 | highlight the line according to the `gnus-summary-highlight' | |
1534 | variable.") | |
de032aaa | 1535 | |
231f989b LMI |
1536 | (defvar gnus-group-update-hook '(gnus-group-highlight-line) |
1537 | "*A hook called when a group line is changed. | |
1538 | The hook will not be called if `gnus-visual' is nil. | |
1539 | ||
1540 | The default function `gnus-group-highlight-line' will | |
1541 | highlight the line according to the `gnus-group-highlight' | |
1542 | variable.") | |
1543 | ||
1544 | (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) | |
41487370 LMI |
1545 | "*A hook called when an article is selected for the first time. |
1546 | The hook is intended to mark an article as read (or unread) | |
1547 | automatically when it is selected.") | |
de032aaa | 1548 | |
231f989b LMI |
1549 | (defvar gnus-group-change-level-function nil |
1550 | "Function run when a group level is changed. | |
1551 | It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.") | |
1552 | ||
41487370 LMI |
1553 | ;; Remove any hilit infestation. |
1554 | (add-hook 'gnus-startup-hook | |
1555 | (lambda () | |
1556 | (remove-hook 'gnus-summary-prepare-hook | |
1557 | 'hilit-rehighlight-buffer-quietly) | |
1558 | (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks) | |
231f989b LMI |
1559 | (setq gnus-mark-article-hook |
1560 | '(gnus-summary-mark-read-and-unread-as-read)) | |
41487370 LMI |
1561 | (remove-hook 'gnus-article-prepare-hook |
1562 | 'hilit-rehighlight-buffer-quietly))) | |
de032aaa | 1563 | |
745bc783 | 1564 | \f |
41487370 | 1565 | ;; Internal variables |
745bc783 | 1566 | |
231f989b LMI |
1567 | (defvar gnus-tree-buffer "*Tree*" |
1568 | "Buffer where Gnus thread trees are displayed.") | |
1569 | ||
1570 | ;; Dummy variable. | |
1571 | (defvar gnus-use-generic-from nil) | |
1572 | ||
1573 | (defvar gnus-thread-indent-array nil) | |
1574 | (defvar gnus-thread-indent-array-level gnus-thread-indent-level) | |
1575 | ||
1576 | (defvar gnus-newsrc-file-version nil) | |
1577 | ||
1578 | (defvar gnus-method-history nil) | |
1579 | ;; Variable holding the user answers to all method prompts. | |
1580 | ||
1581 | (defvar gnus-group-history nil) | |
1582 | ;; Variable holding the user answers to all group prompts. | |
1583 | ||
1584 | (defvar gnus-server-alist nil | |
1585 | "List of available servers.") | |
1586 | ||
1587 | (defvar gnus-group-indentation-function nil) | |
1588 | ||
1589 | (defvar gnus-topic-indentation "") ;; Obsolete variable. | |
1590 | ||
1591 | (defvar gnus-goto-missing-group-function nil) | |
1592 | ||
1593 | (defvar gnus-override-subscribe-method nil) | |
1594 | ||
1595 | (defvar gnus-group-goto-next-group-function nil | |
1596 | "Function to override finding the next group after listing groups.") | |
1597 | ||
1598 | (defconst gnus-article-mark-lists | |
1599 | '((marked . tick) (replied . reply) | |
1600 | (expirable . expire) (killed . killed) | |
1601 | (bookmarks . bookmark) (dormant . dormant) | |
1602 | (scored . score) (saved . save) | |
1603 | (cached . cache) | |
1604 | )) | |
1605 | ||
41487370 LMI |
1606 | ;; Avoid highlighting in kill files. |
1607 | (defvar gnus-summary-inhibit-highlight nil) | |
1608 | (defvar gnus-newsgroup-selected-overlay nil) | |
745bc783 | 1609 | |
231f989b LMI |
1610 | (defvar gnus-inhibit-hiding nil) |
1611 | (defvar gnus-group-indentation "") | |
1612 | (defvar gnus-inhibit-limiting nil) | |
1613 | (defvar gnus-created-frames nil) | |
1614 | ||
41487370 LMI |
1615 | (defvar gnus-article-mode-map nil) |
1616 | (defvar gnus-dribble-buffer nil) | |
1617 | (defvar gnus-headers-retrieved-by nil) | |
1618 | (defvar gnus-article-reply nil) | |
1619 | (defvar gnus-override-method nil) | |
1620 | (defvar gnus-article-check-size nil) | |
1621 | ||
1622 | (defvar gnus-current-score-file nil) | |
231f989b | 1623 | (defvar gnus-newsgroup-adaptive-score-file nil) |
41487370 LMI |
1624 | (defvar gnus-scores-exclude-files nil) |
1625 | ||
231f989b LMI |
1626 | (defvar gnus-opened-servers nil) |
1627 | ||
41487370 | 1628 | (defvar gnus-current-move-group nil) |
231f989b LMI |
1629 | (defvar gnus-current-copy-group nil) |
1630 | (defvar gnus-current-crosspost-group nil) | |
41487370 LMI |
1631 | |
1632 | (defvar gnus-newsgroup-dependencies nil) | |
41487370 LMI |
1633 | (defvar gnus-newsgroup-async nil) |
1634 | (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") | |
1635 | ||
1636 | (defvar gnus-newsgroup-adaptive nil) | |
1637 | ||
1638 | (defvar gnus-summary-display-table nil) | |
231f989b LMI |
1639 | (defvar gnus-summary-display-article-function nil) |
1640 | ||
1641 | (defvar gnus-summary-highlight-line-function nil | |
1642 | "Function called after highlighting a summary line.") | |
1643 | ||
1644 | (defvar gnus-group-line-format-alist | |
1645 | `((?M gnus-tmp-marked-mark ?c) | |
1646 | (?S gnus-tmp-subscribed ?c) | |
1647 | (?L gnus-tmp-level ?d) | |
1648 | (?N (cond ((eq number t) "*" ) | |
1649 | ((numberp number) | |
1650 | (int-to-string | |
1651 | (+ number | |
1652 | (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) | |
1653 | (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) | |
1654 | (t number)) ?s) | |
1655 | (?R gnus-tmp-number-of-read ?s) | |
1656 | (?t gnus-tmp-number-total ?d) | |
1657 | (?y gnus-tmp-number-of-unread ?s) | |
1658 | (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) | |
1659 | (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) | |
1660 | (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) | |
1661 | (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) | |
1662 | (?g gnus-tmp-group ?s) | |
1663 | (?G gnus-tmp-qualified-group ?s) | |
1664 | (?c (gnus-short-group-name gnus-tmp-group) ?s) | |
1665 | (?D gnus-tmp-newsgroup-description ?s) | |
1666 | (?o gnus-tmp-moderated ?c) | |
1667 | (?O gnus-tmp-moderated-string ?s) | |
1668 | (?p gnus-tmp-process-marked ?c) | |
1669 | (?s gnus-tmp-news-server ?s) | |
1670 | (?n gnus-tmp-news-method ?s) | |
1671 | (?P gnus-group-indentation ?s) | |
1672 | (?l gnus-tmp-grouplens ?s) | |
1673 | (?z gnus-tmp-news-method-string ?s) | |
1674 | (?u gnus-tmp-user-defined ?s))) | |
1675 | ||
1676 | (defvar gnus-summary-line-format-alist | |
1677 | `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) | |
1678 | (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) | |
1679 | (?s gnus-tmp-subject-or-nil ?s) | |
1680 | (?n gnus-tmp-name ?s) | |
1681 | (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) | |
1682 | ?s) | |
1683 | (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) | |
1684 | gnus-tmp-from) ?s) | |
1685 | (?F gnus-tmp-from ?s) | |
1686 | (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) | |
1687 | (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) | |
1688 | (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) | |
1689 | (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) | |
1690 | (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) | |
1691 | (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) | |
1692 | (?L gnus-tmp-lines ?d) | |
1693 | (?I gnus-tmp-indentation ?s) | |
1694 | (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) | |
1695 | (?R gnus-tmp-replied ?c) | |
1696 | (?\[ gnus-tmp-opening-bracket ?c) | |
1697 | (?\] gnus-tmp-closing-bracket ?c) | |
1698 | (?\> (make-string gnus-tmp-level ? ) ?s) | |
1699 | (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) | |
1700 | (?i gnus-tmp-score ?d) | |
1701 | (?z gnus-tmp-score-char ?c) | |
1702 | (?l (bbb-grouplens-score gnus-tmp-header) ?s) | |
1703 | (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) | |
1704 | (?U gnus-tmp-unread ?c) | |
1705 | (?t (gnus-summary-number-of-articles-in-thread | |
1706 | (and (boundp 'thread) (car thread)) gnus-tmp-level) | |
1707 | ?d) | |
1708 | (?e (gnus-summary-number-of-articles-in-thread | |
1709 | (and (boundp 'thread) (car thread)) gnus-tmp-level t) | |
1710 | ?c) | |
1711 | (?u gnus-tmp-user-defined ?s)) | |
41487370 LMI |
1712 | "An alist of format specifications that can appear in summary lines, |
1713 | and what variables they correspond with, along with the type of the | |
1714 | variable (string, integer, character, etc).") | |
1715 | ||
231f989b LMI |
1716 | (defvar gnus-summary-dummy-line-format-alist |
1717 | `((?S gnus-tmp-subject ?s) | |
1718 | (?N gnus-tmp-number ?d) | |
1719 | (?u gnus-tmp-user-defined ?s))) | |
1720 | ||
1721 | (defvar gnus-summary-mode-line-format-alist | |
1722 | `((?G gnus-tmp-group-name ?s) | |
1723 | (?g (gnus-short-group-name gnus-tmp-group-name) ?s) | |
1724 | (?p (gnus-group-real-name gnus-tmp-group-name) ?s) | |
1725 | (?A gnus-tmp-article-number ?d) | |
1726 | (?Z gnus-tmp-unread-and-unselected ?s) | |
1727 | (?V gnus-version ?s) | |
1728 | (?U gnus-tmp-unread-and-unticked ?d) | |
1729 | (?S gnus-tmp-subject ?s) | |
1730 | (?e gnus-tmp-unselected ?d) | |
1731 | (?u gnus-tmp-user-defined ?s) | |
1732 | (?d (length gnus-newsgroup-dormant) ?d) | |
1733 | (?t (length gnus-newsgroup-marked) ?d) | |
1734 | (?r (length gnus-newsgroup-reads) ?d) | |
1735 | (?E gnus-newsgroup-expunged-tally ?d) | |
1736 | (?s (gnus-current-score-file-nondirectory) ?s))) | |
1737 | ||
1738 | (defvar gnus-article-mode-line-format-alist | |
1739 | gnus-summary-mode-line-format-alist) | |
1740 | ||
1741 | (defvar gnus-group-mode-line-format-alist | |
1742 | `((?S gnus-tmp-news-server ?s) | |
1743 | (?M gnus-tmp-news-method ?s) | |
1744 | (?u gnus-tmp-user-defined ?s) | |
1745 | (?: gnus-tmp-colon ?s))) | |
41487370 LMI |
1746 | |
1747 | (defvar gnus-have-read-active-file nil) | |
1748 | ||
1749 | (defconst gnus-maintainer | |
1750 | "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" | |
1751 | "The mail address of the Gnus maintainers.") | |
1752 | ||
b1cfbae4 | 1753 | (defconst gnus-version-number "5.3" |
41487370 | 1754 | "Version number for this version of Gnus.") |
44cdca98 | 1755 | |
231f989b LMI |
1756 | (defconst gnus-version (format "Gnus v%s" gnus-version-number) |
1757 | "Version string for this version of Gnus.") | |
1758 | ||
b027f415 | 1759 | (defvar gnus-info-nodes |
231f989b LMI |
1760 | '((gnus-group-mode "(gnus)The Group Buffer") |
1761 | (gnus-summary-mode "(gnus)The Summary Buffer") | |
1762 | (gnus-article-mode "(gnus)The Article Buffer") | |
1763 | (gnus-server-mode "(gnus)The Server Buffer") | |
1764 | (gnus-browse-mode "(gnus)Browse Foreign Server") | |
1765 | (gnus-tree-mode "(gnus)Tree Display") | |
1766 | ) | |
1767 | "Alist of major modes and related Info nodes.") | |
745bc783 | 1768 | |
41487370 | 1769 | (defvar gnus-group-buffer "*Group*") |
b027f415 RS |
1770 | (defvar gnus-summary-buffer "*Summary*") |
1771 | (defvar gnus-article-buffer "*Article*") | |
41487370 LMI |
1772 | (defvar gnus-server-buffer "*Server*") |
1773 | ||
1774 | (defvar gnus-work-buffer " *gnus work*") | |
1775 | ||
231f989b LMI |
1776 | (defvar gnus-original-article-buffer " *Original Article*") |
1777 | (defvar gnus-original-article nil) | |
1778 | ||
41487370 LMI |
1779 | (defvar gnus-buffer-list nil |
1780 | "Gnus buffers that should be killed on exit.") | |
745bc783 | 1781 | |
231f989b LMI |
1782 | (defvar gnus-slave nil |
1783 | "Whether this Gnus is a slave or not.") | |
745bc783 JB |
1784 | |
1785 | (defvar gnus-variable-list | |
41487370 | 1786 | '(gnus-newsrc-options gnus-newsrc-options-n |
231f989b | 1787 | gnus-newsrc-last-checked-date |
41487370 | 1788 | gnus-newsrc-alist gnus-server-alist |
231f989b LMI |
1789 | gnus-killed-list gnus-zombie-list |
1790 | gnus-topic-topology gnus-topic-alist | |
1791 | gnus-format-specs) | |
41487370 | 1792 | "Gnus variables saved in the quick startup file.") |
745bc783 | 1793 | |
745bc783 | 1794 | (defvar gnus-newsrc-options nil |
41487370 | 1795 | "Options line in the .newsrc file.") |
745bc783 | 1796 | |
41487370 | 1797 | (defvar gnus-newsrc-options-n nil |
231f989b | 1798 | "List of regexps representing groups to be subscribed/ignored unconditionally.") |
745bc783 | 1799 | |
41487370 LMI |
1800 | (defvar gnus-newsrc-last-checked-date nil |
1801 | "Date Gnus last asked server for new newsgroups.") | |
745bc783 | 1802 | |
231f989b LMI |
1803 | (defvar gnus-topic-topology nil |
1804 | "The complete topic hierarchy.") | |
1805 | ||
1806 | (defvar gnus-topic-alist nil | |
1807 | "The complete topic-group alist.") | |
1808 | ||
41487370 | 1809 | (defvar gnus-newsrc-alist nil |
b027f415 | 1810 | "Assoc list of read articles. |
41487370 | 1811 | gnus-newsrc-hashtb should be kept so that both hold the same information.") |
b027f415 RS |
1812 | |
1813 | (defvar gnus-newsrc-hashtb nil | |
41487370 | 1814 | "Hashtable of gnus-newsrc-alist.") |
745bc783 | 1815 | |
41487370 LMI |
1816 | (defvar gnus-killed-list nil |
1817 | "List of killed newsgroups.") | |
b027f415 RS |
1818 | |
1819 | (defvar gnus-killed-hashtb nil | |
41487370 | 1820 | "Hash table equivalent of gnus-killed-list.") |
745bc783 | 1821 | |
41487370 LMI |
1822 | (defvar gnus-zombie-list nil |
1823 | "List of almost dead newsgroups.") | |
b027f415 | 1824 | |
41487370 LMI |
1825 | (defvar gnus-description-hashtb nil |
1826 | "Descriptions of newsgroups.") | |
745bc783 | 1827 | |
41487370 LMI |
1828 | (defvar gnus-list-of-killed-groups nil |
1829 | "List of newsgroups that have recently been killed by the user.") | |
745bc783 JB |
1830 | |
1831 | (defvar gnus-active-hashtb nil | |
1832 | "Hashtable of active articles.") | |
1833 | ||
41487370 LMI |
1834 | (defvar gnus-moderated-list nil |
1835 | "List of moderated newsgroups.") | |
1836 | ||
1837 | (defvar gnus-group-marked nil) | |
745bc783 JB |
1838 | |
1839 | (defvar gnus-current-startup-file nil | |
1840 | "Startup file for the current host.") | |
1841 | ||
1842 | (defvar gnus-last-search-regexp nil | |
1843 | "Default regexp for article search command.") | |
1844 | ||
1845 | (defvar gnus-last-shell-command nil | |
1846 | "Default shell command on article.") | |
1847 | ||
41487370 LMI |
1848 | (defvar gnus-current-select-method nil |
1849 | "The current method for selecting a newsgroup.") | |
1850 | ||
1851 | (defvar gnus-group-list-mode nil) | |
1852 | ||
1853 | (defvar gnus-article-internal-prepare-hook nil) | |
745bc783 JB |
1854 | |
1855 | (defvar gnus-newsgroup-name nil) | |
1856 | (defvar gnus-newsgroup-begin nil) | |
1857 | (defvar gnus-newsgroup-end nil) | |
1858 | (defvar gnus-newsgroup-last-rmail nil) | |
1859 | (defvar gnus-newsgroup-last-mail nil) | |
1860 | (defvar gnus-newsgroup-last-folder nil) | |
1861 | (defvar gnus-newsgroup-last-file nil) | |
41487370 LMI |
1862 | (defvar gnus-newsgroup-auto-expire nil) |
1863 | (defvar gnus-newsgroup-active nil) | |
745bc783 | 1864 | |
231f989b LMI |
1865 | (defvar gnus-newsgroup-data nil) |
1866 | (defvar gnus-newsgroup-data-reverse nil) | |
1867 | (defvar gnus-newsgroup-limit nil) | |
1868 | (defvar gnus-newsgroup-limits nil) | |
1869 | ||
745bc783 JB |
1870 | (defvar gnus-newsgroup-unreads nil |
1871 | "List of unread articles in the current newsgroup.") | |
1872 | ||
1873 | (defvar gnus-newsgroup-unselected nil | |
1874 | "List of unselected unread articles in the current newsgroup.") | |
1875 | ||
41487370 LMI |
1876 | (defvar gnus-newsgroup-reads nil |
1877 | "Alist of read articles and article marks in the current newsgroup.") | |
1878 | ||
231f989b LMI |
1879 | (defvar gnus-newsgroup-expunged-tally nil) |
1880 | ||
745bc783 | 1881 | (defvar gnus-newsgroup-marked nil |
41487370 LMI |
1882 | "List of ticked articles in the current newsgroup (a subset of unread art).") |
1883 | ||
1884 | (defvar gnus-newsgroup-killed nil | |
1885 | "List of ranges of articles that have been through the scoring process.") | |
1886 | ||
231f989b LMI |
1887 | (defvar gnus-newsgroup-cached nil |
1888 | "List of articles that come from the article cache.") | |
1889 | ||
1890 | (defvar gnus-newsgroup-saved nil | |
1891 | "List of articles that have been saved.") | |
1892 | ||
41487370 LMI |
1893 | (defvar gnus-newsgroup-kill-headers nil) |
1894 | ||
1895 | (defvar gnus-newsgroup-replied nil | |
1896 | "List of articles that have been replied to in the current newsgroup.") | |
1897 | ||
1898 | (defvar gnus-newsgroup-expirable nil | |
1899 | "List of articles in the current newsgroup that can be expired.") | |
1900 | ||
1901 | (defvar gnus-newsgroup-processable nil | |
1902 | "List of articles in the current newsgroup that can be processed.") | |
1903 | ||
1904 | (defvar gnus-newsgroup-bookmarks nil | |
1905 | "List of articles in the current newsgroup that have bookmarks.") | |
1906 | ||
1907 | (defvar gnus-newsgroup-dormant nil | |
1908 | "List of dormant articles in the current newsgroup.") | |
1909 | ||
1910 | (defvar gnus-newsgroup-scored nil | |
1911 | "List of scored articles in the current newsgroup.") | |
745bc783 JB |
1912 | |
1913 | (defvar gnus-newsgroup-headers nil | |
41487370 | 1914 | "List of article headers in the current newsgroup.") |
231f989b LMI |
1915 | |
1916 | (defvar gnus-newsgroup-threads nil) | |
1917 | ||
1918 | (defvar gnus-newsgroup-prepared nil | |
1919 | "Whether the current group has been prepared properly.") | |
745bc783 | 1920 | |
41487370 LMI |
1921 | (defvar gnus-newsgroup-ancient nil |
1922 | "List of `gnus-fetch-old-headers' articles in the current newsgroup.") | |
1923 | ||
231f989b LMI |
1924 | (defvar gnus-newsgroup-sparse nil) |
1925 | ||
745bc783 | 1926 | (defvar gnus-current-article nil) |
41487370 | 1927 | (defvar gnus-article-current nil) |
745bc783 | 1928 | (defvar gnus-current-headers nil) |
41487370 | 1929 | (defvar gnus-have-all-headers nil) |
745bc783 | 1930 | (defvar gnus-last-article nil) |
41487370 | 1931 | (defvar gnus-newsgroup-history nil) |
745bc783 JB |
1932 | (defvar gnus-current-kill-article nil) |
1933 | ||
1934 | ;; Save window configuration. | |
41487370 LMI |
1935 | (defvar gnus-prev-winconf nil) |
1936 | ||
41487370 LMI |
1937 | (defvar gnus-summary-mark-positions nil) |
1938 | (defvar gnus-group-mark-positions nil) | |
1939 | ||
41487370 LMI |
1940 | (defvar gnus-reffed-article-number nil) |
1941 | ||
231f989b | 1942 | ;;; Let the byte-compiler know that we know about this variable. |
41487370 LMI |
1943 | (defvar rmail-default-rmail-file) |
1944 | ||
b94ae5f7 | 1945 | (defvar gnus-cache-removable-articles nil) |
41487370 | 1946 | |
231f989b LMI |
1947 | (defvar gnus-dead-summary nil) |
1948 | ||
1949 | (defconst gnus-summary-local-variables | |
1950 | '(gnus-newsgroup-name | |
1951 | gnus-newsgroup-begin gnus-newsgroup-end | |
1952 | gnus-newsgroup-last-rmail gnus-newsgroup-last-mail | |
1953 | gnus-newsgroup-last-folder gnus-newsgroup-last-file | |
1954 | gnus-newsgroup-auto-expire gnus-newsgroup-unreads | |
41487370 | 1955 | gnus-newsgroup-unselected gnus-newsgroup-marked |
231f989b | 1956 | gnus-newsgroup-reads gnus-newsgroup-saved |
41487370 LMI |
1957 | gnus-newsgroup-replied gnus-newsgroup-expirable |
1958 | gnus-newsgroup-processable gnus-newsgroup-killed | |
1959 | gnus-newsgroup-bookmarks gnus-newsgroup-dormant | |
231f989b LMI |
1960 | gnus-newsgroup-headers gnus-newsgroup-threads |
1961 | gnus-newsgroup-prepared gnus-summary-highlight-line-function | |
41487370 LMI |
1962 | gnus-current-article gnus-current-headers gnus-have-all-headers |
1963 | gnus-last-article gnus-article-internal-prepare-hook | |
1964 | gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay | |
1965 | gnus-newsgroup-scored gnus-newsgroup-kill-headers | |
231f989b LMI |
1966 | gnus-newsgroup-async gnus-thread-expunge-below |
1967 | gnus-score-alist gnus-current-score-file gnus-summary-expunge-below | |
1968 | (gnus-summary-mark-below . global) | |
1969 | gnus-newsgroup-active gnus-scores-exclude-files | |
41487370 | 1970 | gnus-newsgroup-history gnus-newsgroup-ancient |
231f989b | 1971 | gnus-newsgroup-sparse |
41487370 | 1972 | (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) |
231f989b LMI |
1973 | gnus-newsgroup-adaptive-score-file |
1974 | (gnus-newsgroup-expunged-tally . 0) | |
1975 | gnus-cache-removable-articles gnus-newsgroup-cached | |
1976 | gnus-newsgroup-data gnus-newsgroup-data-reverse | |
1977 | gnus-newsgroup-limit gnus-newsgroup-limits) | |
41487370 LMI |
1978 | "Variables that are buffer-local to the summary buffers.") |
1979 | ||
1980 | (defconst gnus-bug-message | |
1981 | "Sending a bug report to the Gnus Towers. | |
1982 | ======================================== | |
1983 | ||
1984 | The buffer below is a mail buffer. When you press `C-c C-c', it will | |
231f989b | 1985 | be sent to the Gnus Bug Exterminators. |
41487370 LMI |
1986 | |
1987 | At the bottom of the buffer you'll see lots of variable settings. | |
1988 | Please do not delete those. They will tell the Bug People what your | |
1989 | environment is, so that it will be easier to locate the bugs. | |
1990 | ||
1991 | If you have found a bug that makes Emacs go \"beep\", set | |
231f989b | 1992 | debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') |
41487370 LMI |
1993 | and include the backtrace in your bug report. |
1994 | ||
1995 | Please describe the bug in annoying, painstaking detail. | |
1996 | ||
1997 | Thank you for your help in stamping out bugs. | |
1998 | ") | |
1999 | ||
2000 | ;;; End of variables. | |
2001 | ||
2002 | ;; Define some autoload functions Gnus might use. | |
2003 | (eval-and-compile | |
2004 | ||
231f989b LMI |
2005 | ;; This little mapcar goes through the list below and marks the |
2006 | ;; symbols in question as autoloaded functions. | |
2007 | (mapcar | |
2008 | (lambda (package) | |
2009 | (let ((interactive (nth 1 (memq ':interactive package)))) | |
2010 | (mapcar | |
2011 | (lambda (function) | |
2012 | (let (keymap) | |
2013 | (when (consp function) | |
2014 | (setq keymap (car (memq 'keymap function))) | |
2015 | (setq function (car function))) | |
2016 | (autoload function (car package) nil interactive keymap))) | |
2017 | (if (eq (nth 1 package) ':interactive) | |
2018 | (cdddr package) | |
2019 | (cdr package))))) | |
2020 | '(("metamail" metamail-buffer) | |
2021 | ("info" Info-goto-node) | |
2022 | ("hexl" hexl-hex-string-to-integer) | |
2023 | ("pp" pp pp-to-string pp-eval-expression) | |
2024 | ("mail-extr" mail-extract-address-components) | |
2025 | ("nnmail" nnmail-split-fancy nnmail-article-group) | |
2026 | ("nnvirtual" nnvirtual-catchup-group) | |
2027 | ("timezone" timezone-make-date-arpa-standard timezone-fix-time | |
2028 | timezone-make-sortable-date timezone-make-time-string) | |
2029 | ("rmailout" rmail-output) | |
2030 | ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages | |
2031 | rmail-show-message) | |
2032 | ("gnus-soup" :interactive t | |
2033 | gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article | |
2034 | gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) | |
2035 | ("nnsoup" nnsoup-pack-replies) | |
5ccf5115 | 2036 | ("score-mode" :interactive t gnus-score-mode) |
231f989b LMI |
2037 | ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder |
2038 | gnus-Folder-save-name gnus-folder-save-name) | |
2039 | ("gnus-mh" :interactive t gnus-summary-save-in-folder) | |
2040 | ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar | |
2041 | gnus-server-make-menu-bar gnus-article-make-menu-bar | |
2042 | gnus-browse-make-menu-bar gnus-highlight-selected-summary | |
2043 | gnus-summary-highlight-line gnus-carpal-setup-buffer | |
2044 | gnus-group-highlight-line | |
2045 | gnus-article-add-button gnus-insert-next-page-button | |
2046 | gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu) | |
2047 | ("gnus-vis" :interactive t | |
2048 | gnus-article-push-button gnus-article-press-button | |
2049 | gnus-article-highlight gnus-article-highlight-some | |
2050 | gnus-article-highlight-headers gnus-article-highlight-signature | |
2051 | gnus-article-add-buttons gnus-article-add-buttons-to-head | |
2052 | gnus-article-next-button gnus-article-prev-button) | |
2053 | ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail | |
2054 | gnus-demon-add-disconnection gnus-demon-add-handler | |
2055 | gnus-demon-remove-handler) | |
2056 | ("gnus-demon" :interactive t | |
2057 | gnus-demon-init gnus-demon-cancel) | |
2058 | ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree | |
2059 | gnus-tree-open gnus-tree-close) | |
2060 | ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close | |
2061 | gnus-nocem-unwanted-article-p) | |
2062 | ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info) | |
2063 | ("gnus-srvr" gnus-browse-foreign-server) | |
2064 | ("gnus-cite" :interactive t | |
2065 | gnus-article-highlight-citation gnus-article-hide-citation-maybe | |
2066 | gnus-article-hide-citation gnus-article-fill-cited-article | |
2067 | gnus-article-hide-citation-in-followups) | |
2068 | ("gnus-kill" gnus-kill gnus-apply-kill-file-internal | |
2069 | gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author | |
2070 | gnus-execute gnus-expunge) | |
2071 | ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers | |
2072 | gnus-cache-possibly-remove-articles gnus-cache-request-article | |
2073 | gnus-cache-retrieve-headers gnus-cache-possibly-alter-active | |
2074 | gnus-cache-enter-remove-article gnus-cached-article-p | |
2075 | gnus-cache-open gnus-cache-close gnus-cache-update-article) | |
2076 | ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article | |
2077 | gnus-cache-remove-article) | |
2078 | ("gnus-score" :interactive t | |
2079 | gnus-summary-increase-score gnus-summary-lower-score | |
2080 | gnus-score-flush-cache gnus-score-close | |
2081 | gnus-score-raise-same-subject-and-select | |
2082 | gnus-score-raise-same-subject gnus-score-default | |
2083 | gnus-score-raise-thread gnus-score-lower-same-subject-and-select | |
2084 | gnus-score-lower-same-subject gnus-score-lower-thread | |
2085 | gnus-possibly-score-headers gnus-summary-raise-score | |
2086 | gnus-summary-set-score gnus-summary-current-score) | |
2087 | ("gnus-score" | |
2088 | (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers | |
2089 | gnus-current-score-file-nondirectory gnus-score-adaptive | |
2090 | gnus-score-find-trace gnus-score-file-name) | |
2091 | ("gnus-edit" :interactive t gnus-score-customize) | |
2092 | ("gnus-topic" :interactive t gnus-topic-mode) | |
2093 | ("gnus-topic" gnus-topic-remove-group) | |
2094 | ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) | |
2095 | ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) | |
2096 | ("gnus-uu" :interactive t | |
2097 | gnus-uu-digest-mail-forward gnus-uu-digest-post-forward | |
2098 | gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer | |
2099 | gnus-uu-mark-by-regexp gnus-uu-mark-all | |
2100 | gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu | |
2101 | gnus-uu-decode-uu-and-save gnus-uu-decode-unshar | |
2102 | gnus-uu-decode-unshar-and-save gnus-uu-decode-save | |
2103 | gnus-uu-decode-binhex gnus-uu-decode-uu-view | |
2104 | gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view | |
2105 | gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view | |
2106 | gnus-uu-decode-binhex-view) | |
2107 | ("gnus-msg" (gnus-summary-send-map keymap) | |
2108 | gnus-mail-yank-original gnus-mail-send-and-exit | |
2109 | gnus-article-mail gnus-new-mail gnus-mail-reply) | |
2110 | ("gnus-msg" :interactive t | |
2111 | gnus-group-post-news gnus-group-mail gnus-summary-post-news | |
2112 | gnus-summary-followup gnus-summary-followup-with-original | |
2113 | gnus-summary-cancel-article gnus-summary-supersede-article | |
2114 | gnus-post-news gnus-inews-news | |
2115 | gnus-summary-reply gnus-summary-reply-with-original | |
2116 | gnus-summary-mail-forward gnus-summary-mail-other-window | |
2117 | gnus-bug) | |
2118 | ("gnus-picon" :interactive t gnus-article-display-picons | |
564b670b LMI |
2119 | gnus-group-display-picons gnus-picons-article-display-x-face |
2120 | gnus-picons-display-x-face) | |
231f989b LMI |
2121 | ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p |
2122 | gnus-grouplens-mode) | |
2123 | ("smiley" :interactive t gnus-smiley-display) | |
2124 | ("gnus-vm" gnus-vm-mail-setup) | |
2125 | ("gnus-vm" :interactive t gnus-summary-save-in-vm | |
2126 | gnus-summary-save-article-vm)))) | |
745bc783 JB |
2127 | |
2128 | \f | |
41487370 LMI |
2129 | |
2130 | ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
2131 | ;; If you want the cursor to go somewhere else, set these two | |
2132 | ;; functions in some startup hook to whatever you want. | |
231f989b LMI |
2133 | (defalias 'gnus-summary-position-point 'gnus-goto-colon) |
2134 | (defalias 'gnus-group-position-point 'gnus-goto-colon) | |
41487370 LMI |
2135 | |
2136 | ;;; Various macros and substs. | |
745bc783 | 2137 | |
231f989b LMI |
2138 | (defun gnus-header-from (header) |
2139 | (mail-header-from header)) | |
2140 | ||
745bc783 | 2141 | (defmacro gnus-eval-in-buffer-window (buffer &rest forms) |
231f989b LMI |
2142 | "Pop to BUFFER, evaluate FORMS, and then return to the original window." |
2143 | (let ((tempvar (make-symbol "GnusStartBufferWindow")) | |
2144 | (w (make-symbol "w")) | |
2145 | (buf (make-symbol "buf"))) | |
2146 | `(let* ((,tempvar (selected-window)) | |
2147 | (,buf ,buffer) | |
2148 | (,w (get-buffer-window ,buf 'visible))) | |
745bc783 JB |
2149 | (unwind-protect |
2150 | (progn | |
231f989b LMI |
2151 | (if ,w |
2152 | (select-window ,w) | |
2153 | (pop-to-buffer ,buf)) | |
2154 | ,@forms) | |
2155 | (select-window ,tempvar))))) | |
2156 | ||
2157 | (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) | |
2158 | (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) | |
2159 | (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) | |
745bc783 JB |
2160 | |
2161 | (defmacro gnus-gethash (string hashtable) | |
2162 | "Get hash value of STRING in HASHTABLE." | |
231f989b | 2163 | `(symbol-value (intern-soft ,string ,hashtable))) |
745bc783 JB |
2164 | |
2165 | (defmacro gnus-sethash (string value hashtable) | |
231f989b LMI |
2166 | "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." |
2167 | `(set (intern ,string ,hashtable) ,value)) | |
2168 | ||
2169 | (defmacro gnus-intern-safe (string hashtable) | |
2170 | "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." | |
2171 | `(let ((symbol (intern ,string ,hashtable))) | |
2172 | (or (boundp symbol) | |
2173 | (set symbol nil)) | |
2174 | symbol)) | |
2175 | ||
2176 | (defmacro gnus-group-unread (group) | |
2177 | "Get the currently computed number of unread articles in GROUP." | |
2178 | `(car (gnus-gethash ,group gnus-newsrc-hashtb))) | |
2179 | ||
2180 | (defmacro gnus-group-entry (group) | |
2181 | "Get the newsrc entry for GROUP." | |
2182 | `(gnus-gethash ,group gnus-newsrc-hashtb)) | |
745bc783 | 2183 | |
231f989b LMI |
2184 | (defmacro gnus-active (group) |
2185 | "Get active info on GROUP." | |
2186 | `(gnus-gethash ,group gnus-active-hashtb)) | |
2187 | ||
2188 | (defmacro gnus-set-active (group active) | |
2189 | "Set GROUP's active info." | |
2190 | `(gnus-sethash ,group ,active gnus-active-hashtb)) | |
41487370 LMI |
2191 | |
2192 | ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> | |
2193 | ;; function `substring' might cut on a middle of multi-octet | |
2194 | ;; character. | |
2195 | (defun gnus-truncate-string (str width) | |
2196 | (substring str 0 width)) | |
2197 | ||
231f989b LMI |
2198 | ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way |
2199 | ;; to limit the length of a string. This function is necessary since | |
41487370 LMI |
2200 | ;; `(substr "abc" 0 30)' pukes with "Args out of range". |
2201 | (defsubst gnus-limit-string (str width) | |
2202 | (if (> (length str) width) | |
2203 | (substring str 0 width) | |
2204 | str)) | |
2205 | ||
2206 | (defsubst gnus-simplify-subject-re (subject) | |
2207 | "Remove \"Re:\" from subject lines." | |
231f989b LMI |
2208 | (if (string-match "^[Rr][Ee]: *" subject) |
2209 | (substring subject (match-end 0)) | |
2210 | subject)) | |
2211 | ||
2212 | (defsubst gnus-functionp (form) | |
2213 | "Return non-nil if FORM is funcallable." | |
2214 | (or (and (symbolp form) (fboundp form)) | |
2215 | (and (listp form) (eq (car form) 'lambda)))) | |
41487370 LMI |
2216 | |
2217 | (defsubst gnus-goto-char (point) | |
2218 | (and point (goto-char point))) | |
2219 | ||
2220 | (defmacro gnus-buffer-exists-p (buffer) | |
231f989b LMI |
2221 | `(let ((buffer ,buffer)) |
2222 | (and buffer | |
2223 | (funcall (if (stringp buffer) 'get-buffer 'buffer-name) | |
2224 | buffer)))) | |
41487370 LMI |
2225 | |
2226 | (defmacro gnus-kill-buffer (buffer) | |
231f989b LMI |
2227 | `(let ((buf ,buffer)) |
2228 | (if (gnus-buffer-exists-p buf) | |
2229 | (kill-buffer buf)))) | |
41487370 LMI |
2230 | |
2231 | (defsubst gnus-point-at-bol () | |
231f989b | 2232 | "Return point at the beginning of the line." |
41487370 LMI |
2233 | (let ((p (point))) |
2234 | (beginning-of-line) | |
2235 | (prog1 | |
2236 | (point) | |
2237 | (goto-char p)))) | |
2238 | ||
2239 | (defsubst gnus-point-at-eol () | |
231f989b | 2240 | "Return point at the end of the line." |
41487370 LMI |
2241 | (let ((p (point))) |
2242 | (end-of-line) | |
2243 | (prog1 | |
2244 | (point) | |
2245 | (goto-char p)))) | |
2246 | ||
231f989b LMI |
2247 | (defun gnus-alive-p () |
2248 | "Say whether Gnus is running or not." | |
2249 | (and gnus-group-buffer | |
2250 | (get-buffer gnus-group-buffer))) | |
2251 | ||
2252 | (defun gnus-delete-first (elt list) | |
2253 | "Delete by side effect the first occurrence of ELT as a member of LIST." | |
2254 | (if (equal (car list) elt) | |
2255 | (cdr list) | |
2256 | (let ((total list)) | |
2257 | (while (and (cdr list) | |
2258 | (not (equal (cadr list) elt))) | |
2259 | (setq list (cdr list))) | |
2260 | (when (cdr list) | |
2261 | (setcdr list (cddr list))) | |
2262 | total))) | |
2263 | ||
41487370 LMI |
2264 | ;; Delete the current line (and the next N lines.); |
2265 | (defmacro gnus-delete-line (&optional n) | |
231f989b LMI |
2266 | `(delete-region (progn (beginning-of-line) (point)) |
2267 | (progn (forward-line ,(or n 1)) (point)))) | |
41487370 LMI |
2268 | |
2269 | ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>. | |
2270 | (defvar gnus-init-inhibit nil) | |
2271 | (defun gnus-read-init-file (&optional inhibit-next) | |
2272 | (if gnus-init-inhibit | |
2273 | (setq gnus-init-inhibit nil) | |
2274 | (setq gnus-init-inhibit inhibit-next) | |
2275 | (and gnus-init-file | |
231f989b | 2276 | (or (and (file-exists-p gnus-init-file) |
41487370 LMI |
2277 | ;; Don't try to load a directory. |
2278 | (not (file-directory-p gnus-init-file))) | |
2279 | (file-exists-p (concat gnus-init-file ".el")) | |
2280 | (file-exists-p (concat gnus-init-file ".elc"))) | |
231f989b LMI |
2281 | (condition-case var |
2282 | (load gnus-init-file nil t) | |
2283 | (error | |
2284 | (error "Error in %s: %s" gnus-init-file var)))))) | |
2285 | ||
2286 | ;; Info access macros. | |
2287 | ||
2288 | (defmacro gnus-info-group (info) | |
2289 | `(nth 0 ,info)) | |
2290 | (defmacro gnus-info-rank (info) | |
2291 | `(nth 1 ,info)) | |
2292 | (defmacro gnus-info-read (info) | |
2293 | `(nth 2 ,info)) | |
2294 | (defmacro gnus-info-marks (info) | |
2295 | `(nth 3 ,info)) | |
2296 | (defmacro gnus-info-method (info) | |
2297 | `(nth 4 ,info)) | |
2298 | (defmacro gnus-info-params (info) | |
2299 | `(nth 5 ,info)) | |
2300 | ||
2301 | (defmacro gnus-info-level (info) | |
2302 | `(let ((rank (gnus-info-rank ,info))) | |
2303 | (if (consp rank) | |
2304 | (car rank) | |
2305 | rank))) | |
2306 | (defmacro gnus-info-score (info) | |
2307 | `(let ((rank (gnus-info-rank ,info))) | |
2308 | (or (and (consp rank) (cdr rank)) 0))) | |
2309 | ||
2310 | (defmacro gnus-info-set-group (info group) | |
2311 | `(setcar ,info ,group)) | |
2312 | (defmacro gnus-info-set-rank (info rank) | |
2313 | `(setcar (nthcdr 1 ,info) ,rank)) | |
2314 | (defmacro gnus-info-set-read (info read) | |
2315 | `(setcar (nthcdr 2 ,info) ,read)) | |
2316 | (defmacro gnus-info-set-marks (info marks) | |
2317 | `(setcar (nthcdr 3 ,info) ,marks)) | |
2318 | (defmacro gnus-info-set-method (info method) | |
2319 | `(setcar (nthcdr 4 ,info) ,method)) | |
2320 | (defmacro gnus-info-set-params (info params) | |
2321 | `(setcar (nthcdr 5 ,info) ,params)) | |
2322 | ||
2323 | (defmacro gnus-info-set-level (info level) | |
2324 | `(let ((rank (cdr ,info))) | |
2325 | (if (consp (car rank)) | |
2326 | (setcar (car rank) ,level) | |
2327 | (setcar rank ,level)))) | |
2328 | (defmacro gnus-info-set-score (info score) | |
2329 | `(let ((rank (cdr ,info))) | |
2330 | (if (consp (car rank)) | |
2331 | (setcdr (car rank) ,score) | |
2332 | (setcar rank (cons (car rank) ,score))))) | |
2333 | ||
2334 | (defmacro gnus-get-info (group) | |
2335 | `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) | |
2336 | ||
2337 | (defun gnus-byte-code (func) | |
2338 | "Return a form that can be `eval'ed based on FUNC." | |
2339 | (let ((fval (symbol-function func))) | |
2340 | (if (byte-code-function-p fval) | |
2341 | (let ((flist (append fval nil))) | |
2342 | (setcar flist 'byte-code) | |
2343 | flist) | |
2344 | (cons 'progn (cddr fval))))) | |
2345 | ||
2346 | ;; Find out whether the gnus-visual TYPE is wanted. | |
2347 | (defun gnus-visual-p (&optional type class) | |
2348 | (and gnus-visual ; Has to be non-nil, at least. | |
2349 | (if (not type) ; We don't care about type. | |
2350 | gnus-visual | |
2351 | (if (listp gnus-visual) ; It's a list, so we check it. | |
2352 | (or (memq type gnus-visual) | |
2353 | (memq class gnus-visual)) | |
2354 | t)))) | |
2355 | ||
2356 | ;;; Load the compatability functions. | |
41487370 LMI |
2357 | |
2358 | (require 'gnus-cus) | |
2359 | (require 'gnus-ems) | |
745bc783 | 2360 | |
41487370 | 2361 | \f |
231f989b LMI |
2362 | ;;; |
2363 | ;;; Shutdown | |
2364 | ;;; | |
2365 | ||
2366 | (defvar gnus-shutdown-alist nil) | |
2367 | ||
2368 | (defun gnus-add-shutdown (function &rest symbols) | |
2369 | "Run FUNCTION whenever one of SYMBOLS is shut down." | |
2370 | (push (cons function symbols) gnus-shutdown-alist)) | |
2371 | ||
2372 | (defun gnus-shutdown (symbol) | |
2373 | "Shut down everything that waits for SYMBOL." | |
2374 | (let ((alist gnus-shutdown-alist) | |
2375 | entry) | |
2376 | (while (setq entry (pop alist)) | |
2377 | (when (memq symbol (cdr entry)) | |
2378 | (funcall (car entry)))))) | |
2379 | ||
2380 | \f | |
2381 | ||
2382 | ;; Format specs. The chunks below are the machine-generated forms | |
2383 | ;; that are to be evaled as the result of the default format strings. | |
2384 | ;; We write them in here to get them byte-compiled. That way the | |
2385 | ;; default actions will be quite fast, while still retaining the full | |
2386 | ;; flexibility of the user-defined format specs. | |
2387 | ||
2388 | ;; First we have lots of dummy defvars to let the compiler know these | |
2389 | ;; are really dynamic variables. | |
2390 | ||
2391 | (defvar gnus-tmp-unread) | |
2392 | (defvar gnus-tmp-replied) | |
2393 | (defvar gnus-tmp-score-char) | |
2394 | (defvar gnus-tmp-indentation) | |
2395 | (defvar gnus-tmp-opening-bracket) | |
2396 | (defvar gnus-tmp-lines) | |
2397 | (defvar gnus-tmp-name) | |
2398 | (defvar gnus-tmp-closing-bracket) | |
2399 | (defvar gnus-tmp-subject-or-nil) | |
2400 | (defvar gnus-tmp-subject) | |
2401 | (defvar gnus-tmp-marked) | |
2402 | (defvar gnus-tmp-marked-mark) | |
2403 | (defvar gnus-tmp-subscribed) | |
2404 | (defvar gnus-tmp-process-marked) | |
2405 | (defvar gnus-tmp-number-of-unread) | |
2406 | (defvar gnus-tmp-group-name) | |
2407 | (defvar gnus-tmp-group) | |
2408 | (defvar gnus-tmp-article-number) | |
2409 | (defvar gnus-tmp-unread-and-unselected) | |
2410 | (defvar gnus-tmp-news-method) | |
2411 | (defvar gnus-tmp-news-server) | |
2412 | (defvar gnus-tmp-article-number) | |
2413 | (defvar gnus-mouse-face) | |
2414 | (defvar gnus-mouse-face-prop) | |
2415 | ||
2416 | (defun gnus-summary-line-format-spec () | |
2417 | (insert gnus-tmp-unread gnus-tmp-replied | |
2418 | gnus-tmp-score-char gnus-tmp-indentation) | |
2419 | (gnus-put-text-property | |
2420 | (point) | |
2421 | (progn | |
2422 | (insert | |
2423 | gnus-tmp-opening-bracket | |
2424 | (format "%4d: %-20s" | |
2425 | gnus-tmp-lines | |
2426 | (if (> (length gnus-tmp-name) 20) | |
2427 | (substring gnus-tmp-name 0 20) | |
2428 | gnus-tmp-name)) | |
2429 | gnus-tmp-closing-bracket) | |
2430 | (point)) | |
2431 | gnus-mouse-face-prop gnus-mouse-face) | |
2432 | (insert " " gnus-tmp-subject-or-nil "\n")) | |
2433 | ||
2434 | (defvar gnus-summary-line-format-spec | |
2435 | (gnus-byte-code 'gnus-summary-line-format-spec)) | |
2436 | ||
2437 | (defun gnus-summary-dummy-line-format-spec () | |
2438 | (insert "* ") | |
2439 | (gnus-put-text-property | |
2440 | (point) | |
2441 | (progn | |
2442 | (insert ": :") | |
2443 | (point)) | |
2444 | gnus-mouse-face-prop gnus-mouse-face) | |
2445 | (insert " " gnus-tmp-subject "\n")) | |
2446 | ||
2447 | (defvar gnus-summary-dummy-line-format-spec | |
2448 | (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) | |
2449 | ||
2450 | (defun gnus-group-line-format-spec () | |
2451 | (insert gnus-tmp-marked-mark gnus-tmp-subscribed | |
2452 | gnus-tmp-process-marked | |
2453 | gnus-group-indentation | |
2454 | (format "%5s: " gnus-tmp-number-of-unread)) | |
2455 | (gnus-put-text-property | |
2456 | (point) | |
2457 | (progn | |
2458 | (insert gnus-tmp-group "\n") | |
2459 | (1- (point))) | |
2460 | gnus-mouse-face-prop gnus-mouse-face)) | |
2461 | (defvar gnus-group-line-format-spec | |
2462 | (gnus-byte-code 'gnus-group-line-format-spec)) | |
2463 | ||
2464 | (defvar gnus-format-specs | |
2465 | `((version . ,emacs-version) | |
2466 | (group ,gnus-group-line-format ,gnus-group-line-format-spec) | |
2467 | (summary-dummy ,gnus-summary-dummy-line-format | |
2468 | ,gnus-summary-dummy-line-format-spec) | |
2469 | (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec))) | |
2470 | ||
2471 | (defvar gnus-article-mode-line-format-spec nil) | |
2472 | (defvar gnus-summary-mode-line-format-spec nil) | |
2473 | (defvar gnus-group-mode-line-format-spec nil) | |
2474 | ||
2475 | ;;; Phew. All that gruft is over, fortunately. | |
2476 | ||
2477 | \f | |
41487370 LMI |
2478 | ;;; |
2479 | ;;; Gnus Utility Functions | |
2480 | ;;; | |
745bc783 | 2481 | |
41487370 LMI |
2482 | (defun gnus-extract-address-components (from) |
2483 | (let (name address) | |
2484 | ;; First find the address - the thing with the @ in it. This may | |
2485 | ;; not be accurate in mail addresses, but does the trick most of | |
2486 | ;; the time in news messages. | |
2487 | (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) | |
2488 | (setq address (substring from (match-beginning 0) (match-end 0)))) | |
2489 | ;; Then we check whether the "name <address>" format is used. | |
2490 | (and address | |
231f989b LMI |
2491 | ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp> |
2492 | ;; Linear white space is not required. | |
2493 | (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) | |
2494 | (and (setq name (substring from 0 (match-beginning 0))) | |
41487370 LMI |
2495 | ;; Strip any quotes from the name. |
2496 | (string-match "\".*\"" name) | |
2497 | (setq name (substring name 1 (1- (match-end 0)))))) | |
2498 | ;; If not, then "address (name)" is used. | |
2499 | (or name | |
2500 | (and (string-match "(.+)" from) | |
231f989b | 2501 | (setq name (substring from (1+ (match-beginning 0)) |
41487370 LMI |
2502 | (1- (match-end 0))))) |
2503 | (and (string-match "()" from) | |
2504 | (setq name address)) | |
2505 | ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>. | |
2506 | ;; XOVER might not support folded From headers. | |
2507 | (and (string-match "(.*" from) | |
231f989b | 2508 | (setq name (substring from (1+ (match-beginning 0)) |
41487370 LMI |
2509 | (match-end 0))))) |
2510 | ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
2511 | (list (or name from) (or address from)))) | |
745bc783 | 2512 | |
41487370 LMI |
2513 | (defun gnus-fetch-field (field) |
2514 | "Return the value of the header FIELD of current article." | |
2515 | (save-excursion | |
2516 | (save-restriction | |
231f989b LMI |
2517 | (let ((case-fold-search t) |
2518 | (inhibit-point-motion-hooks t)) | |
2519 | (nnheader-narrow-to-headers) | |
2520 | (message-fetch-field field))))) | |
745bc783 | 2521 | |
41487370 LMI |
2522 | (defun gnus-goto-colon () |
2523 | (beginning-of-line) | |
2524 | (search-forward ":" (gnus-point-at-eol) t)) | |
745bc783 | 2525 | |
231f989b LMI |
2526 | ;;;###autoload |
2527 | (defun gnus-update-format (var) | |
2528 | "Update the format specification near point." | |
2529 | (interactive | |
2530 | (list | |
2531 | (save-excursion | |
2532 | (eval-defun nil) | |
2533 | ;; Find the end of the current word. | |
2534 | (re-search-forward "[ \t\n]" nil t) | |
2535 | ;; Search backward. | |
2536 | (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) | |
2537 | (match-string 1))))) | |
2538 | (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) | |
2539 | (match-string 1 var)))) | |
2540 | (entry (assq type gnus-format-specs)) | |
2541 | value spec) | |
2542 | (when entry | |
2543 | (setq gnus-format-specs (delq entry gnus-format-specs))) | |
2544 | (set | |
2545 | (intern (format "%s-spec" var)) | |
2546 | (gnus-parse-format (setq value (symbol-value (intern var))) | |
2547 | (symbol-value (intern (format "%s-alist" var))) | |
2548 | (not (string-match "mode" var)))) | |
2549 | (setq spec (symbol-value (intern (format "%s-spec" var)))) | |
2550 | (push (list type value spec) gnus-format-specs) | |
2551 | ||
2552 | (pop-to-buffer "*Gnus Format*") | |
2553 | (erase-buffer) | |
2554 | (lisp-interaction-mode) | |
2555 | (insert (pp-to-string spec)))) | |
41487370 | 2556 | |
231f989b LMI |
2557 | (defun gnus-update-format-specifications (&optional force) |
2558 | "Update all (necessary) format specifications." | |
2559 | ;; Make the indentation array. | |
41487370 LMI |
2560 | (gnus-make-thread-indent-array) |
2561 | ||
231f989b LMI |
2562 | ;; See whether all the stored info needs to be flushed. |
2563 | (when (or force | |
2564 | (not (equal emacs-version | |
2565 | (cdr (assq 'version gnus-format-specs))))) | |
2566 | (setq gnus-format-specs nil)) | |
2567 | ||
2568 | ;; Go through all the formats and see whether they need updating. | |
2569 | (let ((types '(summary summary-dummy group | |
2570 | summary-mode group-mode article-mode)) | |
2571 | new-format entry type val) | |
2572 | (while (setq type (pop types)) | |
2573 | ;; Jump to the proper buffer to find out the value of | |
2574 | ;; the variable, if possible. (It may be buffer-local.) | |
2575 | (save-excursion | |
2576 | (let ((buffer (intern (format "gnus-%s-buffer" type))) | |
2577 | val) | |
2578 | (when (and (boundp buffer) | |
2579 | (setq val (symbol-value buffer)) | |
2580 | (get-buffer val) | |
2581 | (buffer-name (get-buffer val))) | |
2582 | (set-buffer (get-buffer val))) | |
2583 | (setq new-format (symbol-value | |
2584 | (intern (format "gnus-%s-line-format" type)))))) | |
2585 | (setq entry (cdr (assq type gnus-format-specs))) | |
2586 | (if (and entry | |
2587 | (equal (car entry) new-format)) | |
2588 | ;; Use the old format. | |
2589 | (set (intern (format "gnus-%s-line-format-spec" type)) | |
2590 | (cadr entry)) | |
2591 | ;; This is a new format. | |
2592 | (setq val | |
2593 | (if (not (stringp new-format)) | |
2594 | ;; This is a function call or something. | |
2595 | new-format | |
2596 | ;; This is a "real" format. | |
2597 | (gnus-parse-format | |
2598 | new-format | |
2599 | (symbol-value | |
2600 | (intern (format "gnus-%s-line-format-alist" | |
2601 | (if (eq type 'article-mode) | |
2602 | 'summary-mode type)))) | |
2603 | (not (string-match "mode$" (symbol-name type)))))) | |
2604 | ;; Enter the new format spec into the list. | |
2605 | (if entry | |
2606 | (progn | |
2607 | (setcar (cdr entry) val) | |
2608 | (setcar entry new-format)) | |
2609 | (push (list type new-format val) gnus-format-specs)) | |
2610 | (set (intern (format "gnus-%s-line-format-spec" type)) val)))) | |
41487370 | 2611 | |
231f989b LMI |
2612 | (unless (assq 'version gnus-format-specs) |
2613 | (push (cons 'version emacs-version) gnus-format-specs)) | |
2614 | ||
2615 | (gnus-update-group-mark-positions) | |
2616 | (gnus-update-summary-mark-positions)) | |
41487370 LMI |
2617 | |
2618 | (defun gnus-update-summary-mark-positions () | |
231f989b | 2619 | "Compute where the summary marks are to go." |
41487370 | 2620 | (save-excursion |
231f989b LMI |
2621 | (when (and gnus-summary-buffer |
2622 | (get-buffer gnus-summary-buffer) | |
2623 | (buffer-name (get-buffer gnus-summary-buffer))) | |
2624 | (set-buffer gnus-summary-buffer)) | |
41487370 LMI |
2625 | (let ((gnus-replied-mark 129) |
2626 | (gnus-score-below-mark 130) | |
2627 | (gnus-score-over-mark 130) | |
2628 | (thread nil) | |
231f989b LMI |
2629 | (gnus-visual nil) |
2630 | (spec gnus-summary-line-format-spec) | |
41487370 | 2631 | pos) |
231f989b LMI |
2632 | (save-excursion |
2633 | (gnus-set-work-buffer) | |
2634 | (let ((gnus-summary-line-format-spec spec)) | |
2635 | (gnus-summary-insert-line | |
2636 | [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) | |
2637 | (goto-char (point-min)) | |
2638 | (setq pos (list (cons 'unread (and (search-forward "\200" nil t) | |
2639 | (- (point) 2))))) | |
2640 | (goto-char (point-min)) | |
2641 | (push (cons 'replied (and (search-forward "\201" nil t) | |
2642 | (- (point) 2))) | |
2643 | pos) | |
2644 | (goto-char (point-min)) | |
2645 | (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) | |
2646 | pos))) | |
41487370 | 2647 | (setq gnus-summary-mark-positions pos)))) |
745bc783 | 2648 | |
41487370 LMI |
2649 | (defun gnus-update-group-mark-positions () |
2650 | (save-excursion | |
2651 | (let ((gnus-process-mark 128) | |
231f989b LMI |
2652 | (gnus-group-marked '("dummy.group")) |
2653 | (gnus-active-hashtb (make-vector 10 0))) | |
2654 | (gnus-set-active "dummy.group" '(0 . 0)) | |
41487370 | 2655 | (gnus-set-work-buffer) |
231f989b | 2656 | (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) |
41487370 LMI |
2657 | (goto-char (point-min)) |
2658 | (setq gnus-group-mark-positions | |
2659 | (list (cons 'process (and (search-forward "\200" nil t) | |
2660 | (- (point) 2)))))))) | |
2661 | ||
231f989b LMI |
2662 | (defvar gnus-mouse-face-0 'highlight) |
2663 | (defvar gnus-mouse-face-1 'highlight) | |
2664 | (defvar gnus-mouse-face-2 'highlight) | |
2665 | (defvar gnus-mouse-face-3 'highlight) | |
2666 | (defvar gnus-mouse-face-4 'highlight) | |
2667 | ||
2668 | (defun gnus-mouse-face-function (form type) | |
2669 | `(gnus-put-text-property | |
2670 | (point) (progn ,@form (point)) | |
2671 | gnus-mouse-face-prop | |
2672 | ,(if (equal type 0) | |
2673 | 'gnus-mouse-face | |
2674 | `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) | |
2675 | ||
2676 | (defvar gnus-face-0 'bold) | |
2677 | (defvar gnus-face-1 'italic) | |
2678 | (defvar gnus-face-2 'bold-italic) | |
2679 | (defvar gnus-face-3 'bold) | |
2680 | (defvar gnus-face-4 'bold) | |
2681 | ||
2682 | (defun gnus-face-face-function (form type) | |
2683 | `(gnus-put-text-property | |
2684 | (point) (progn ,@form (point)) | |
2685 | 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) | |
41487370 LMI |
2686 | |
2687 | (defun gnus-max-width-function (el max-width) | |
2688 | (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) | |
231f989b LMI |
2689 | (if (symbolp el) |
2690 | `(if (> (length ,el) ,max-width) | |
2691 | (substring ,el 0 ,max-width) | |
2692 | ,el) | |
2693 | `(let ((val (eval ,el))) | |
2694 | (if (numberp val) | |
2695 | (setq val (int-to-string val))) | |
2696 | (if (> (length val) ,max-width) | |
2697 | (substring val 0 ,max-width) | |
2698 | val)))) | |
2699 | ||
2700 | (defun gnus-parse-format (format spec-alist &optional insert) | |
41487370 LMI |
2701 | ;; This function parses the FORMAT string with the help of the |
2702 | ;; SPEC-ALIST and returns a list that can be eval'ed to return the | |
2703 | ;; string. If the FORMAT string contains the specifiers %( and %) | |
2704 | ;; the text between them will have the mouse-face text property. | |
231f989b LMI |
2705 | (if (string-match |
2706 | "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" | |
2707 | format) | |
2708 | (gnus-parse-complex-format format spec-alist) | |
2709 | ;; This is a simple format. | |
2710 | (gnus-parse-simple-format format spec-alist insert))) | |
2711 | ||
2712 | (defun gnus-parse-complex-format (format spec-alist) | |
2713 | (save-excursion | |
2714 | (gnus-set-work-buffer) | |
2715 | (insert format) | |
2716 | (goto-char (point-min)) | |
2717 | (while (re-search-forward "\"" nil t) | |
2718 | (replace-match "\\\"" nil t)) | |
2719 | (goto-char (point-min)) | |
2720 | (insert "(\"") | |
2721 | (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) | |
2722 | (let ((number (if (match-beginning 1) | |
2723 | (match-string 1) "0")) | |
2724 | (delim (aref (match-string 2) 0))) | |
2725 | (if (or (= delim ?\() (= delim ?\{)) | |
2726 | (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") | |
2727 | " " number " \"")) | |
2728 | (replace-match "\")\"")))) | |
2729 | (goto-char (point-max)) | |
2730 | (insert "\")") | |
2731 | (goto-char (point-min)) | |
2732 | (let ((form (read (current-buffer)))) | |
2733 | (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) | |
2734 | ||
2735 | (defun gnus-complex-form-to-spec (form spec-alist) | |
2736 | (delq nil | |
2737 | (mapcar | |
2738 | (lambda (sform) | |
2739 | (if (stringp sform) | |
2740 | (gnus-parse-simple-format sform spec-alist t) | |
2741 | (funcall (intern (format "gnus-%s-face-function" (car sform))) | |
2742 | (gnus-complex-form-to-spec (cddr sform) spec-alist) | |
2743 | (nth 1 sform)))) | |
2744 | form))) | |
2745 | ||
2746 | (defun gnus-parse-simple-format (format spec-alist &optional insert) | |
41487370 | 2747 | ;; This function parses the FORMAT string with the help of the |
231f989b LMI |
2748 | ;; SPEC-ALIST and returns a list that can be eval'ed to return a |
2749 | ;; string. | |
41487370 | 2750 | (let ((max-width 0) |
231f989b | 2751 | spec flist fstring newspec elem beg result dontinsert) |
41487370 LMI |
2752 | (save-excursion |
2753 | (gnus-set-work-buffer) | |
2754 | (insert format) | |
2755 | (goto-char (point-min)) | |
231f989b LMI |
2756 | (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" |
2757 | nil t) | |
2758 | (if (= (setq spec (string-to-char (match-string 2))) ?%) | |
2759 | (setq newspec "%" | |
2760 | beg (1+ (match-beginning 0))) | |
2761 | ;; First check if there are any specs that look anything like | |
2762 | ;; "%12,12A", ie. with a "max width specification". These have | |
2763 | ;; to be treated specially. | |
2764 | (if (setq beg (match-beginning 1)) | |
2765 | (setq max-width | |
2766 | (string-to-int | |
2767 | (buffer-substring | |
2768 | (1+ (match-beginning 1)) (match-end 1)))) | |
2769 | (setq max-width 0) | |
2770 | (setq beg (match-beginning 2))) | |
2771 | ;; Find the specification from `spec-alist'. | |
2772 | (unless (setq elem (cdr (assq spec spec-alist))) | |
41487370 | 2773 | (setq elem '("*" ?s))) |
231f989b LMI |
2774 | ;; Treat user defined format specifiers specially. |
2775 | (when (eq (car elem) 'gnus-tmp-user-defined) | |
2776 | (setq elem | |
2777 | (list | |
2778 | (list (intern (concat "gnus-user-format-function-" | |
2779 | (match-string 3))) | |
2780 | 'gnus-tmp-header) ?s)) | |
2781 | (delete-region (match-beginning 3) (match-end 3))) | |
2782 | (if (not (zerop max-width)) | |
2783 | (let ((el (car elem))) | |
2784 | (cond ((= (cadr elem) ?c) | |
2785 | (setq el (list 'char-to-string el))) | |
2786 | ((= (cadr elem) ?d) | |
2787 | (setq el (list 'int-to-string el)))) | |
2788 | (setq flist (cons (gnus-max-width-function el max-width) | |
2789 | flist)) | |
2790 | (setq newspec ?s)) | |
2791 | (progn | |
2792 | (setq flist (cons (car elem) flist)) | |
2793 | (setq newspec (cadr elem))))) | |
41487370 LMI |
2794 | ;; Remove the old specification (and possibly a ",12" string). |
2795 | (delete-region beg (match-end 2)) | |
2796 | ;; Insert the new specification. | |
2797 | (goto-char beg) | |
2798 | (insert newspec)) | |
2799 | (setq fstring (buffer-substring 1 (point-max)))) | |
231f989b LMI |
2800 | ;; Do some postprocessing to increase efficiency. |
2801 | (setq | |
2802 | result | |
2803 | (cond | |
2804 | ;; Emptyness. | |
2805 | ((string= fstring "") | |
2806 | nil) | |
2807 | ;; Not a format string. | |
2808 | ((not (string-match "%" fstring)) | |
2809 | (list fstring)) | |
2810 | ;; A format string with just a single string spec. | |
2811 | ((string= fstring "%s") | |
2812 | (list (car flist))) | |
2813 | ;; A single character. | |
2814 | ((string= fstring "%c") | |
2815 | (list (car flist))) | |
2816 | ;; A single number. | |
2817 | ((string= fstring "%d") | |
2818 | (setq dontinsert) | |
2819 | (if insert | |
2820 | (list `(princ ,(car flist))) | |
2821 | (list `(int-to-string ,(car flist))))) | |
2822 | ;; Just lots of chars and strings. | |
2823 | ((string-match "\\`\\(%[cs]\\)+\\'" fstring) | |
2824 | (nreverse flist)) | |
2825 | ;; A single string spec at the beginning of the spec. | |
2826 | ((string-match "\\`%[sc][^%]+\\'" fstring) | |
2827 | (list (car flist) (substring fstring 2))) | |
2828 | ;; A single string spec in the middle of the spec. | |
2829 | ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) | |
2830 | (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) | |
2831 | ;; A single string spec in the end of the spec. | |
2832 | ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) | |
2833 | (list (match-string 1 fstring) (car flist))) | |
2834 | ;; A more complex spec. | |
2835 | (t | |
2836 | (list (cons 'format (cons fstring (nreverse flist))))))) | |
2837 | ||
2838 | (if insert | |
2839 | (when result | |
2840 | (if dontinsert | |
2841 | result | |
2842 | (cons 'insert result))) | |
2843 | (cond ((stringp result) | |
2844 | result) | |
2845 | ((consp result) | |
2846 | (cons 'concat result)) | |
2847 | (t ""))))) | |
2848 | ||
2849 | (defun gnus-eval-format (format &optional alist props) | |
2850 | "Eval the format variable FORMAT, using ALIST. | |
2851 | If PROPS, insert the result." | |
2852 | (let ((form (gnus-parse-format format alist props))) | |
2853 | (if props | |
2854 | (gnus-add-text-properties (point) (progn (eval form) (point)) props) | |
2855 | (eval form)))) | |
2856 | ||
2857 | (defun gnus-remove-text-with-property (prop) | |
2858 | "Delete all text in the current buffer with text property PROP." | |
2859 | (save-excursion | |
2860 | (goto-char (point-min)) | |
2861 | (while (not (eobp)) | |
2862 | (while (get-text-property (point) prop) | |
2863 | (delete-char 1)) | |
2864 | (goto-char (next-single-property-change (point) prop nil (point-max)))))) | |
41487370 LMI |
2865 | |
2866 | (defun gnus-set-work-buffer () | |
2867 | (if (get-buffer gnus-work-buffer) | |
2868 | (progn | |
2869 | (set-buffer gnus-work-buffer) | |
2870 | (erase-buffer)) | |
2871 | (set-buffer (get-buffer-create gnus-work-buffer)) | |
2872 | (kill-all-local-variables) | |
2873 | (buffer-disable-undo (current-buffer)) | |
2874 | (gnus-add-current-to-buffer-list))) | |
745bc783 | 2875 | |
41487370 | 2876 | ;; Article file names when saving. |
745bc783 | 2877 | |
41487370 LMI |
2878 | (defun gnus-Numeric-save-name (newsgroup headers &optional last-file) |
2879 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2880 | If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num. | |
2881 | Otherwise, it is like ~/News/news/group/num." | |
2882 | (let ((default | |
2883 | (expand-file-name | |
2884 | (concat (if (gnus-use-long-file-name 'not-save) | |
2885 | (gnus-capitalize-newsgroup newsgroup) | |
2886 | (gnus-newsgroup-directory-form newsgroup)) | |
2887 | "/" (int-to-string (mail-header-number headers))) | |
231f989b | 2888 | gnus-article-save-directory))) |
41487370 LMI |
2889 | (if (and last-file |
2890 | (string-equal (file-name-directory default) | |
2891 | (file-name-directory last-file)) | |
2892 | (string-match "^[0-9]+$" (file-name-nondirectory last-file))) | |
2893 | default | |
2894 | (or last-file default)))) | |
745bc783 | 2895 | |
41487370 LMI |
2896 | (defun gnus-numeric-save-name (newsgroup headers &optional last-file) |
2897 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2898 | If variable `gnus-use-long-file-name' is non-nil, it is | |
231f989b | 2899 | ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." |
41487370 LMI |
2900 | (let ((default |
2901 | (expand-file-name | |
2902 | (concat (if (gnus-use-long-file-name 'not-save) | |
2903 | newsgroup | |
2904 | (gnus-newsgroup-directory-form newsgroup)) | |
2905 | "/" (int-to-string (mail-header-number headers))) | |
231f989b | 2906 | gnus-article-save-directory))) |
41487370 LMI |
2907 | (if (and last-file |
2908 | (string-equal (file-name-directory default) | |
2909 | (file-name-directory last-file)) | |
2910 | (string-match "^[0-9]+$" (file-name-nondirectory last-file))) | |
2911 | default | |
2912 | (or last-file default)))) | |
745bc783 | 2913 | |
41487370 LMI |
2914 | (defun gnus-Plain-save-name (newsgroup headers &optional last-file) |
2915 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2916 | If variable `gnus-use-long-file-name' is non-nil, it is | |
2917 | ~/News/News.group. Otherwise, it is like ~/News/news/group/news." | |
2918 | (or last-file | |
2919 | (expand-file-name | |
2920 | (if (gnus-use-long-file-name 'not-save) | |
2921 | (gnus-capitalize-newsgroup newsgroup) | |
2922 | (concat (gnus-newsgroup-directory-form newsgroup) "/news")) | |
231f989b | 2923 | gnus-article-save-directory))) |
745bc783 | 2924 | |
41487370 LMI |
2925 | (defun gnus-plain-save-name (newsgroup headers &optional last-file) |
2926 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2927 | If variable `gnus-use-long-file-name' is non-nil, it is | |
2928 | ~/News/news.group. Otherwise, it is like ~/News/news/group/news." | |
2929 | (or last-file | |
2930 | (expand-file-name | |
2931 | (if (gnus-use-long-file-name 'not-save) | |
2932 | newsgroup | |
2933 | (concat (gnus-newsgroup-directory-form newsgroup) "/news")) | |
231f989b | 2934 | gnus-article-save-directory))) |
745bc783 | 2935 | |
41487370 | 2936 | ;; For subscribing new newsgroup |
745bc783 | 2937 | |
41487370 LMI |
2938 | (defun gnus-subscribe-hierarchical-interactive (groups) |
2939 | (let ((groups (sort groups 'string<)) | |
2940 | prefixes prefix start ans group starts) | |
2941 | (while groups | |
2942 | (setq prefixes (list "^")) | |
2943 | (while (and groups prefixes) | |
2944 | (while (not (string-match (car prefixes) (car groups))) | |
2945 | (setq prefixes (cdr prefixes))) | |
2946 | (setq prefix (car prefixes)) | |
2947 | (setq start (1- (length prefix))) | |
2948 | (if (and (string-match "[^\\.]\\." (car groups) start) | |
2949 | (cdr groups) | |
231f989b | 2950 | (setq prefix |
41487370 | 2951 | (concat "^" (substring (car groups) 0 (match-end 0)))) |
231f989b | 2952 | (string-match prefix (cadr groups))) |
41487370 LMI |
2953 | (progn |
2954 | (setq prefixes (cons prefix prefixes)) | |
231f989b | 2955 | (message "Descend hierarchy %s? ([y]nsq): " |
41487370 | 2956 | (substring prefix 1 (1- (length prefix)))) |
231f989b LMI |
2957 | (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q))) |
2958 | (ding) | |
2959 | (message "Descend hierarchy %s? ([y]nsq): " | |
2960 | (substring prefix 1 (1- (length prefix))))) | |
41487370 | 2961 | (cond ((= ans ?n) |
231f989b LMI |
2962 | (while (and groups |
2963 | (string-match prefix | |
41487370 | 2964 | (setq group (car groups)))) |
231f989b | 2965 | (setq gnus-killed-list |
41487370 LMI |
2966 | (cons group gnus-killed-list)) |
2967 | (gnus-sethash group group gnus-killed-hashtb) | |
2968 | (setq groups (cdr groups))) | |
2969 | (setq starts (cdr starts))) | |
2970 | ((= ans ?s) | |
231f989b LMI |
2971 | (while (and groups |
2972 | (string-match prefix | |
41487370 LMI |
2973 | (setq group (car groups)))) |
2974 | (gnus-sethash group group gnus-killed-hashtb) | |
2975 | (gnus-subscribe-alphabetically (car groups)) | |
2976 | (setq groups (cdr groups))) | |
2977 | (setq starts (cdr starts))) | |
2978 | ((= ans ?q) | |
2979 | (while groups | |
2980 | (setq group (car groups)) | |
2981 | (setq gnus-killed-list (cons group gnus-killed-list)) | |
2982 | (gnus-sethash group group gnus-killed-hashtb) | |
2983 | (setq groups (cdr groups)))) | |
2984 | (t nil))) | |
2985 | (message "Subscribe %s? ([n]yq)" (car groups)) | |
231f989b LMI |
2986 | (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n))) |
2987 | (ding) | |
2988 | (message "Subscribe %s? ([n]yq)" (car groups))) | |
41487370 LMI |
2989 | (setq group (car groups)) |
2990 | (cond ((= ans ?y) | |
2991 | (gnus-subscribe-alphabetically (car groups)) | |
2992 | (gnus-sethash group group gnus-killed-hashtb)) | |
2993 | ((= ans ?q) | |
2994 | (while groups | |
2995 | (setq group (car groups)) | |
2996 | (setq gnus-killed-list (cons group gnus-killed-list)) | |
2997 | (gnus-sethash group group gnus-killed-hashtb) | |
2998 | (setq groups (cdr groups)))) | |
231f989b | 2999 | (t |
41487370 LMI |
3000 | (setq gnus-killed-list (cons group gnus-killed-list)) |
3001 | (gnus-sethash group group gnus-killed-hashtb))) | |
3002 | (setq groups (cdr groups))))))) | |
745bc783 | 3003 | |
41487370 LMI |
3004 | (defun gnus-subscribe-randomly (newsgroup) |
3005 | "Subscribe new NEWSGROUP by making it the first newsgroup." | |
3006 | (gnus-subscribe-newsgroup newsgroup)) | |
745bc783 | 3007 | |
41487370 LMI |
3008 | (defun gnus-subscribe-alphabetically (newgroup) |
3009 | "Subscribe new NEWSGROUP and insert it in alphabetical order." | |
41487370 LMI |
3010 | (let ((groups (cdr gnus-newsrc-alist)) |
3011 | before) | |
3012 | (while (and (not before) groups) | |
231f989b LMI |
3013 | (if (string< newgroup (caar groups)) |
3014 | (setq before (caar groups)) | |
41487370 LMI |
3015 | (setq groups (cdr groups)))) |
3016 | (gnus-subscribe-newsgroup newgroup before))) | |
745bc783 | 3017 | |
41487370 LMI |
3018 | (defun gnus-subscribe-hierarchically (newgroup) |
3019 | "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." | |
3020 | ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) | |
3021 | (save-excursion | |
3022 | (set-buffer (find-file-noselect gnus-current-startup-file)) | |
3023 | (let ((groupkey newgroup) | |
3024 | before) | |
3025 | (while (and (not before) groupkey) | |
3026 | (goto-char (point-min)) | |
3027 | (let ((groupkey-re | |
3028 | (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) | |
3029 | (while (and (re-search-forward groupkey-re nil t) | |
3030 | (progn | |
231f989b | 3031 | (setq before (match-string 1)) |
41487370 LMI |
3032 | (string< before newgroup))))) |
3033 | ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) | |
3034 | (setq groupkey | |
3035 | (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) | |
3036 | (substring groupkey (match-beginning 1) (match-end 1))))) | |
564b670b LMI |
3037 | (gnus-subscribe-newsgroup newgroup before)) |
3038 | (kill-buffer (current-buffer)))) | |
41487370 | 3039 | |
231f989b LMI |
3040 | (defun gnus-subscribe-interactively (group) |
3041 | "Subscribe the new GROUP interactively. | |
3042 | It is inserted in hierarchical newsgroup order if subscribed. If not, | |
41487370 | 3043 | it is killed." |
231f989b LMI |
3044 | (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) |
3045 | (gnus-subscribe-hierarchically group) | |
3046 | (push group gnus-killed-list))) | |
3047 | ||
3048 | (defun gnus-subscribe-zombies (group) | |
3049 | "Make the new GROUP into a zombie group." | |
3050 | (push group gnus-zombie-list)) | |
41487370 | 3051 | |
231f989b LMI |
3052 | (defun gnus-subscribe-killed (group) |
3053 | "Make the new GROUP a killed group." | |
3054 | (push group gnus-killed-list)) | |
41487370 LMI |
3055 | |
3056 | (defun gnus-subscribe-newsgroup (newsgroup &optional next) | |
3057 | "Subscribe new NEWSGROUP. | |
231f989b | 3058 | If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made |
41487370 LMI |
3059 | the first newsgroup." |
3060 | ;; We subscribe the group by changing its level to `subscribed'. | |
231f989b | 3061 | (gnus-group-change-level |
41487370 LMI |
3062 | newsgroup gnus-level-default-subscribed |
3063 | gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) | |
3064 | (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)) | |
3065 | ||
3066 | ;; For directories | |
3067 | ||
3068 | (defun gnus-newsgroup-directory-form (newsgroup) | |
3069 | "Make hierarchical directory name from NEWSGROUP name." | |
b94ae5f7 | 3070 | (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) |
41487370 LMI |
3071 | (len (length newsgroup)) |
3072 | idx) | |
3073 | ;; If this is a foreign group, we don't want to translate the | |
231f989b | 3074 | ;; entire name. |
41487370 LMI |
3075 | (if (setq idx (string-match ":" newsgroup)) |
3076 | (aset newsgroup idx ?/) | |
3077 | (setq idx 0)) | |
3078 | ;; Replace all occurrences of `.' with `/'. | |
3079 | (while (< idx len) | |
3080 | (if (= (aref newsgroup idx) ?.) | |
3081 | (aset newsgroup idx ?/)) | |
3082 | (setq idx (1+ idx))) | |
3083 | newsgroup)) | |
3084 | ||
b94ae5f7 | 3085 | (defun gnus-newsgroup-savable-name (group) |
41487370 LMI |
3086 | ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) |
3087 | ;; with dots. | |
231f989b | 3088 | (nnheader-replace-chars-in-string group ?/ ?.)) |
41487370 LMI |
3089 | |
3090 | (defun gnus-make-directory (dir) | |
3091 | "Make DIRECTORY recursively." | |
231f989b | 3092 | ;; Why don't we use `(make-directory dir 'parents)'? That's just one |
41487370 LMI |
3093 | ;; of the many mysteries of the universe. |
3094 | (let* ((dir (expand-file-name dir default-directory)) | |
3095 | dirs err) | |
3096 | (if (string-match "/$" dir) | |
3097 | (setq dir (substring dir 0 (match-beginning 0)))) | |
3098 | ;; First go down the path until we find a directory that exists. | |
3099 | (while (not (file-exists-p dir)) | |
3100 | (setq dirs (cons dir dirs)) | |
3101 | (string-match "/[^/]+$" dir) | |
3102 | (setq dir (substring dir 0 (match-beginning 0)))) | |
3103 | ;; Then create all the subdirs. | |
3104 | (while (and dirs (not err)) | |
3105 | (condition-case () | |
3106 | (make-directory (car dirs)) | |
3107 | (error (setq err t))) | |
3108 | (setq dirs (cdr dirs))) | |
231f989b | 3109 | ;; We return whether we were successful or not. |
41487370 LMI |
3110 | (not dirs))) |
3111 | ||
3112 | (defun gnus-capitalize-newsgroup (newsgroup) | |
3113 | "Capitalize NEWSGROUP name." | |
3114 | (and (not (zerop (length newsgroup))) | |
3115 | (concat (char-to-string (upcase (aref newsgroup 0))) | |
3116 | (substring newsgroup 1)))) | |
3117 | ||
231f989b | 3118 | ;; Various... things. |
41487370 LMI |
3119 | |
3120 | (defun gnus-simplify-subject (subject &optional re-only) | |
3121 | "Remove `Re:' and words in parentheses. | |
231f989b | 3122 | If RE-ONLY is non-nil, strip leading `Re:'s only." |
41487370 | 3123 | (let ((case-fold-search t)) ;Ignore case. |
231f989b LMI |
3124 | ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. |
3125 | (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) | |
3126 | (setq subject (substring subject (match-end 0)))) | |
3127 | ;; Remove uninteresting prefixes. | |
3128 | (if (and (not re-only) | |
3129 | gnus-simplify-ignored-prefixes | |
3130 | (string-match gnus-simplify-ignored-prefixes subject)) | |
41487370 LMI |
3131 | (setq subject (substring subject (match-end 0)))) |
3132 | ;; Remove words in parentheses from end. | |
231f989b LMI |
3133 | (unless re-only |
3134 | (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) | |
3135 | (setq subject (substring subject 0 (match-beginning 0))))) | |
41487370 LMI |
3136 | ;; Return subject string. |
3137 | subject)) | |
3138 | ||
3139 | ;; Remove any leading "re:"s, any trailing paren phrases, and simplify | |
3140 | ;; all whitespace. | |
231f989b LMI |
3141 | ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>. |
3142 | (defun gnus-simplify-buffer-fuzzy () | |
41487370 | 3143 | (let ((case-fold-search t)) |
231f989b LMI |
3144 | (goto-char (point-min)) |
3145 | (while (search-forward "\t" nil t) | |
3146 | (replace-match " " t t)) | |
3147 | (goto-char (point-min)) | |
3148 | (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t) | |
3149 | (goto-char (match-beginning 0)) | |
3150 | (while (or | |
3151 | (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") | |
3152 | (looking-at "^[[].*: .*[]]$")) | |
3153 | (goto-char (point-min)) | |
3154 | (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" | |
3155 | nil t) | |
3156 | (replace-match "" t t)) | |
3157 | (goto-char (point-min)) | |
3158 | (while (re-search-forward "^[[].*: .*[]]$" nil t) | |
3159 | (goto-char (match-end 0)) | |
3160 | (delete-char -1) | |
3161 | (delete-region | |
3162 | (progn (goto-char (match-beginning 0))) | |
3163 | (re-search-forward ":")))) | |
3164 | (goto-char (point-min)) | |
3165 | (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t) | |
3166 | (replace-match "" t t)) | |
3167 | (goto-char (point-min)) | |
3168 | (while (re-search-forward " +" nil t) | |
3169 | (replace-match " " t t)) | |
3170 | (goto-char (point-min)) | |
3171 | (while (re-search-forward " $" nil t) | |
3172 | (replace-match "" t t)) | |
3173 | (goto-char (point-min)) | |
3174 | (while (re-search-forward "^ +" nil t) | |
3175 | (replace-match "" t t)) | |
3176 | (goto-char (point-min)) | |
3177 | (when gnus-simplify-subject-fuzzy-regexp | |
3178 | (if (listp gnus-simplify-subject-fuzzy-regexp) | |
3179 | (let ((list gnus-simplify-subject-fuzzy-regexp)) | |
3180 | (while list | |
3181 | (goto-char (point-min)) | |
3182 | (while (re-search-forward (car list) nil t) | |
3183 | (replace-match "" t t)) | |
3184 | (setq list (cdr list)))) | |
3185 | (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) | |
3186 | (replace-match "" t t)))))) | |
3187 | ||
3188 | (defun gnus-simplify-subject-fuzzy (subject) | |
3189 | "Siplify a subject string fuzzily." | |
3190 | (save-excursion | |
3191 | (gnus-set-work-buffer) | |
3192 | (let ((case-fold-search t)) | |
41487370 LMI |
3193 | (insert subject) |
3194 | (inline (gnus-simplify-buffer-fuzzy)) | |
3195 | (buffer-string)))) | |
3196 | ||
231f989b | 3197 | ;; Add the current buffer to the list of buffers to be killed on exit. |
41487370 LMI |
3198 | (defun gnus-add-current-to-buffer-list () |
3199 | (or (memq (current-buffer) gnus-buffer-list) | |
3200 | (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))) | |
3201 | ||
3202 | (defun gnus-string> (s1 s2) | |
3203 | (not (or (string< s1 s2) | |
3204 | (string= s1 s2)))) | |
3205 | ||
231f989b LMI |
3206 | (defun gnus-read-active-file-p () |
3207 | "Say whether the active file has been read from `gnus-select-method'." | |
3208 | (memq gnus-select-method gnus-have-read-active-file)) | |
41487370 LMI |
3209 | |
3210 | ;;; General various misc type functions. | |
3211 | ||
3212 | (defun gnus-clear-system () | |
3213 | "Clear all variables and buffers." | |
3214 | ;; Clear Gnus variables. | |
3215 | (let ((variables gnus-variable-list)) | |
3216 | (while variables | |
3217 | (set (car variables) nil) | |
3218 | (setq variables (cdr variables)))) | |
3219 | ;; Clear other internal variables. | |
3220 | (setq gnus-list-of-killed-groups nil | |
3221 | gnus-have-read-active-file nil | |
3222 | gnus-newsrc-alist nil | |
3223 | gnus-newsrc-hashtb nil | |
3224 | gnus-killed-list nil | |
3225 | gnus-zombie-list nil | |
3226 | gnus-killed-hashtb nil | |
3227 | gnus-active-hashtb nil | |
3228 | gnus-moderated-list nil | |
3229 | gnus-description-hashtb nil | |
231f989b LMI |
3230 | gnus-current-headers nil |
3231 | gnus-thread-indent-array nil | |
41487370 | 3232 | gnus-newsgroup-headers nil |
41487370 LMI |
3233 | gnus-newsgroup-name nil |
3234 | gnus-server-alist nil | |
231f989b LMI |
3235 | gnus-group-list-mode nil |
3236 | gnus-opened-servers nil | |
3237 | gnus-group-mark-positions nil | |
3238 | gnus-newsgroup-data nil | |
3239 | gnus-newsgroup-unreads nil | |
564b670b | 3240 | nnoo-state-alist nil |
41487370 | 3241 | gnus-current-select-method nil) |
231f989b | 3242 | (gnus-shutdown 'gnus) |
41487370 LMI |
3243 | ;; Kill the startup file. |
3244 | (and gnus-current-startup-file | |
3245 | (get-file-buffer gnus-current-startup-file) | |
3246 | (kill-buffer (get-file-buffer gnus-current-startup-file))) | |
41487370 LMI |
3247 | ;; Clear the dribble buffer. |
3248 | (gnus-dribble-clear) | |
3249 | ;; Kill global KILL file buffer. | |
231f989b LMI |
3250 | (when (get-file-buffer (gnus-newsgroup-kill-file nil)) |
3251 | (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) | |
41487370 LMI |
3252 | (gnus-kill-buffer nntp-server-buffer) |
3253 | ;; Kill Gnus buffers. | |
3254 | (while gnus-buffer-list | |
231f989b LMI |
3255 | (gnus-kill-buffer (pop gnus-buffer-list))) |
3256 | ;; Remove Gnus frames. | |
3257 | (gnus-kill-gnus-frames)) | |
3258 | ||
3259 | (defun gnus-kill-gnus-frames () | |
3260 | "Kill all frames Gnus has created." | |
3261 | (while gnus-created-frames | |
3262 | (when (frame-live-p (car gnus-created-frames)) | |
3263 | ;; We slap a condition-case around this `delete-frame' to ensure | |
3264 | ;; against errors if we try do delete the single frame that's left. | |
3265 | (condition-case () | |
3266 | (delete-frame (car gnus-created-frames)) | |
3267 | (error nil))) | |
3268 | (pop gnus-created-frames))) | |
41487370 LMI |
3269 | |
3270 | (defun gnus-windows-old-to-new (setting) | |
3271 | ;; First we take care of the really, really old Gnus 3 actions. | |
231f989b LMI |
3272 | (when (symbolp setting) |
3273 | (setq setting | |
3274 | ;; Take care of ooold GNUS 3.x values. | |
3275 | (cond ((eq setting 'SelectArticle) 'article) | |
3276 | ((memq setting '(SelectSubject ExpandSubject)) 'summary) | |
3277 | ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group) | |
3278 | (t setting)))) | |
41487370 LMI |
3279 | (if (or (listp setting) |
3280 | (not (and gnus-window-configuration | |
3281 | (memq setting '(group summary article))))) | |
3282 | setting | |
231f989b | 3283 | (let* ((setting (if (eq setting 'group) |
41487370 LMI |
3284 | (if (assq 'newsgroup gnus-window-configuration) |
3285 | 'newsgroup | |
3286 | 'newsgroups) setting)) | |
231f989b | 3287 | (elem (cadr (assq setting gnus-window-configuration))) |
41487370 LMI |
3288 | (total (apply '+ elem)) |
3289 | (types '(group summary article)) | |
3290 | (pbuf (if (eq setting 'newsgroups) 'group 'summary)) | |
3291 | (i 0) | |
3292 | perc | |
3293 | out) | |
3294 | (while (< i 3) | |
3295 | (or (not (numberp (nth i elem))) | |
3296 | (zerop (nth i elem)) | |
3297 | (progn | |
231f989b LMI |
3298 | (setq perc (if (= i 2) |
3299 | 1.0 | |
3300 | (/ (float (nth 0 elem)) total))) | |
41487370 | 3301 | (setq out (cons (if (eq pbuf (nth i types)) |
231f989b LMI |
3302 | (list (nth i types) perc 'point) |
3303 | (list (nth i types) perc)) | |
41487370 LMI |
3304 | out)))) |
3305 | (setq i (1+ i))) | |
231f989b LMI |
3306 | `(vertical 1.0 ,@(nreverse out))))) |
3307 | ||
3308 | ;;;###autoload | |
41487370 | 3309 | (defun gnus-add-configuration (conf) |
231f989b LMI |
3310 | "Add the window configuration CONF to `gnus-buffer-configuration'." |
3311 | (setq gnus-buffer-configuration | |
41487370 LMI |
3312 | (cons conf (delq (assq (car conf) gnus-buffer-configuration) |
3313 | gnus-buffer-configuration)))) | |
3314 | ||
231f989b LMI |
3315 | (defvar gnus-frame-list nil) |
3316 | ||
3317 | (defun gnus-configure-frame (split &optional window) | |
3318 | "Split WINDOW according to SPLIT." | |
3319 | (unless window | |
3320 | (setq window (get-buffer-window (current-buffer)))) | |
3321 | (select-window window) | |
3322 | ;; This might be an old-stylee buffer config. | |
3323 | (when (vectorp split) | |
3324 | (setq split (append split nil))) | |
3325 | (when (or (consp (car split)) | |
3326 | (vectorp (car split))) | |
3327 | (push 1.0 split) | |
3328 | (push 'vertical split)) | |
3329 | ;; The SPLIT might be something that is to be evaled to | |
3330 | ;; return a new SPLIT. | |
3331 | (while (and (not (assq (car split) gnus-window-to-buffer)) | |
3332 | (gnus-functionp (car split))) | |
3333 | (setq split (eval split))) | |
3334 | (let* ((type (car split)) | |
3335 | (subs (cddr split)) | |
3336 | (len (if (eq type 'horizontal) (window-width) (window-height))) | |
3337 | (total 0) | |
3338 | (window-min-width (or gnus-window-min-width window-min-width)) | |
3339 | (window-min-height (or gnus-window-min-height window-min-height)) | |
3340 | s result new-win rest comp-subs size sub) | |
3341 | (cond | |
3342 | ;; Nothing to do here. | |
3343 | ((null split)) | |
3344 | ;; Don't switch buffers. | |
3345 | ((null type) | |
3346 | (and (memq 'point split) window)) | |
3347 | ;; This is a buffer to be selected. | |
3348 | ((not (memq type '(frame horizontal vertical))) | |
3349 | (let ((buffer (cond ((stringp type) type) | |
3350 | (t (cdr (assq type gnus-window-to-buffer))))) | |
3351 | buf) | |
3352 | (unless buffer | |
3353 | (error "Illegal buffer type: %s" type)) | |
3354 | (unless (setq buf (get-buffer (if (symbolp buffer) | |
3355 | (symbol-value buffer) buffer))) | |
3356 | (setq buf (get-buffer-create (if (symbolp buffer) | |
3357 | (symbol-value buffer) buffer)))) | |
3358 | (switch-to-buffer buf) | |
3359 | ;; We return the window if it has the `point' spec. | |
3360 | (and (memq 'point split) window))) | |
3361 | ;; This is a frame split. | |
3362 | ((eq type 'frame) | |
3363 | (unless gnus-frame-list | |
3364 | (setq gnus-frame-list (list (window-frame | |
3365 | (get-buffer-window (current-buffer)))))) | |
3366 | (let ((i 0) | |
3367 | params frame fresult) | |
3368 | (while (< i (length subs)) | |
3369 | ;; Frame parameter is gotten from the sub-split. | |
3370 | (setq params (cadr (elt subs i))) | |
3371 | ;; It should be a list. | |
3372 | (unless (listp params) | |
3373 | (setq params nil)) | |
3374 | ;; Create a new frame? | |
3375 | (unless (setq frame (elt gnus-frame-list i)) | |
3376 | (nconc gnus-frame-list (list (setq frame (make-frame params)))) | |
3377 | (push frame gnus-created-frames)) | |
3378 | ;; Is the old frame still alive? | |
3379 | (unless (frame-live-p frame) | |
3380 | (setcar (nthcdr i gnus-frame-list) | |
3381 | (setq frame (make-frame params)))) | |
3382 | ;; Select the frame in question and do more splits there. | |
3383 | (select-frame frame) | |
3384 | (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) | |
3385 | (incf i)) | |
3386 | ;; Select the frame that has the selected buffer. | |
3387 | (when fresult | |
3388 | (select-frame (window-frame fresult))))) | |
3389 | ;; This is a normal split. | |
3390 | (t | |
3391 | (when (> (length subs) 0) | |
3392 | ;; First we have to compute the sizes of all new windows. | |
3393 | (while subs | |
3394 | (setq sub (append (pop subs) nil)) | |
3395 | (while (and (not (assq (car sub) gnus-window-to-buffer)) | |
3396 | (gnus-functionp (car sub))) | |
3397 | (setq sub (eval sub))) | |
3398 | (when sub | |
3399 | (push sub comp-subs) | |
3400 | (setq size (cadar comp-subs)) | |
3401 | (cond ((equal size 1.0) | |
3402 | (setq rest (car comp-subs)) | |
3403 | (setq s 0)) | |
3404 | ((floatp size) | |
3405 | (setq s (floor (* size len)))) | |
3406 | ((integerp size) | |
3407 | (setq s size)) | |
3408 | (t | |
3409 | (error "Illegal size: %s" size))) | |
3410 | ;; Try to make sure that we are inside the safe limits. | |
3411 | (cond ((zerop s)) | |
3412 | ((eq type 'horizontal) | |
3413 | (setq s (max s window-min-width))) | |
3414 | ((eq type 'vertical) | |
3415 | (setq s (max s window-min-height)))) | |
3416 | (setcar (cdar comp-subs) s) | |
3417 | (incf total s))) | |
3418 | ;; Take care of the "1.0" spec. | |
3419 | (if rest | |
3420 | (setcar (cdr rest) (- len total)) | |
3421 | (error "No 1.0 specs in %s" split)) | |
3422 | ;; The we do the actual splitting in a nice recursive | |
3423 | ;; fashion. | |
3424 | (setq comp-subs (nreverse comp-subs)) | |
3425 | (while comp-subs | |
3426 | (if (null (cdr comp-subs)) | |
3427 | (setq new-win window) | |
3428 | (setq new-win | |
3429 | (split-window window (cadar comp-subs) | |
3430 | (eq type 'horizontal)))) | |
3431 | (setq result (or (gnus-configure-frame | |
3432 | (car comp-subs) window) result)) | |
3433 | (select-window new-win) | |
3434 | (setq window new-win) | |
3435 | (setq comp-subs (cdr comp-subs)))) | |
3436 | ;; Return the proper window, if any. | |
3437 | (when result | |
3438 | (select-window result)))))) | |
3439 | ||
3440 | (defvar gnus-frame-split-p nil) | |
3441 | ||
41487370 LMI |
3442 | (defun gnus-configure-windows (setting &optional force) |
3443 | (setq setting (gnus-windows-old-to-new setting)) | |
231f989b LMI |
3444 | (let ((split (if (symbolp setting) |
3445 | (cadr (assq setting gnus-buffer-configuration)) | |
3446 | setting)) | |
3447 | all-visible) | |
3448 | ||
3449 | (setq gnus-frame-split-p nil) | |
3450 | ||
3451 | (unless split | |
3452 | (error "No such setting: %s" setting)) | |
3453 | ||
3454 | (if (and (setq all-visible (gnus-all-windows-visible-p split)) | |
3455 | (not force)) | |
41487370 LMI |
3456 | ;; All the windows mentioned are already visible, so we just |
3457 | ;; put point in the assigned buffer, and do not touch the | |
231f989b LMI |
3458 | ;; winconf. |
3459 | (select-window all-visible) | |
41487370 LMI |
3460 | |
3461 | ;; Either remove all windows or just remove all Gnus windows. | |
231f989b LMI |
3462 | (let ((frame (selected-frame))) |
3463 | (unwind-protect | |
3464 | (if gnus-use-full-window | |
3465 | ;; We want to remove all other windows. | |
3466 | (if (not gnus-frame-split-p) | |
3467 | ;; This is not a `frame' split, so we ignore the | |
3468 | ;; other frames. | |
3469 | (delete-other-windows) | |
3470 | ;; This is a `frame' split, so we delete all windows | |
3471 | ;; on all frames. | |
3472 | (mapcar | |
3473 | (lambda (frame) | |
3474 | (unless (eq (cdr (assq 'minibuffer | |
3475 | (frame-parameters frame))) | |
3476 | 'only) | |
3477 | (select-frame frame) | |
3478 | (delete-other-windows))) | |
3479 | (frame-list))) | |
3480 | ;; Just remove some windows. | |
3481 | (gnus-remove-some-windows) | |
3482 | (switch-to-buffer nntp-server-buffer)) | |
3483 | (select-frame frame))) | |
3484 | ||
3485 | (switch-to-buffer nntp-server-buffer) | |
3486 | (gnus-configure-frame split (get-buffer-window (current-buffer)))))) | |
3487 | ||
3488 | (defun gnus-all-windows-visible-p (split) | |
3489 | "Say whether all buffers in SPLIT are currently visible. | |
3490 | In particular, the value returned will be the window that | |
3491 | should have point." | |
3492 | (let ((stack (list split)) | |
3493 | (all-visible t) | |
3494 | type buffer win buf) | |
3495 | (while (and (setq split (pop stack)) | |
3496 | all-visible) | |
3497 | ;; Be backwards compatible. | |
3498 | (when (vectorp split) | |
3499 | (setq split (append split nil))) | |
3500 | (when (or (consp (car split)) | |
3501 | (vectorp (car split))) | |
3502 | (push 1.0 split) | |
3503 | (push 'vertical split)) | |
3504 | ;; The SPLIT might be something that is to be evaled to | |
3505 | ;; return a new SPLIT. | |
3506 | (while (and (not (assq (car split) gnus-window-to-buffer)) | |
3507 | (gnus-functionp (car split))) | |
3508 | (setq split (eval split))) | |
3509 | ||
3510 | (setq type (elt split 0)) | |
3511 | (cond | |
3512 | ;; Nothing here. | |
3513 | ((null split) t) | |
3514 | ;; A buffer. | |
3515 | ((not (memq type '(horizontal vertical frame))) | |
3516 | (setq buffer (cond ((stringp type) type) | |
3517 | (t (cdr (assq type gnus-window-to-buffer))))) | |
3518 | (unless buffer | |
3519 | (error "Illegal buffer type: %s" type)) | |
3520 | (when (setq buf (get-buffer (if (symbolp buffer) | |
3521 | (symbol-value buffer) | |
3522 | buffer))) | |
3523 | (setq win (get-buffer-window buf t))) | |
3524 | (if win | |
3525 | (when (memq 'point split) | |
3526 | (setq all-visible win)) | |
3527 | (setq all-visible nil))) | |
3528 | (t | |
3529 | (when (eq type 'frame) | |
3530 | (setq gnus-frame-split-p t)) | |
3531 | (setq stack (append (cddr split) stack))))) | |
3532 | (unless (eq all-visible t) | |
3533 | all-visible))) | |
41487370 LMI |
3534 | |
3535 | (defun gnus-window-top-edge (&optional window) | |
3536 | (nth 1 (window-edges window))) | |
3537 | ||
3538 | (defun gnus-remove-some-windows () | |
3539 | (let ((buffers gnus-window-to-buffer) | |
3540 | buf bufs lowest-buf lowest) | |
3541 | (save-excursion | |
3542 | ;; Remove windows on all known Gnus buffers. | |
3543 | (while buffers | |
231f989b | 3544 | (setq buf (cdar buffers)) |
41487370 LMI |
3545 | (if (symbolp buf) |
3546 | (setq buf (and (boundp buf) (symbol-value buf)))) | |
231f989b | 3547 | (and buf |
41487370 LMI |
3548 | (get-buffer-window buf) |
3549 | (progn | |
3550 | (setq bufs (cons buf bufs)) | |
3551 | (pop-to-buffer buf) | |
3552 | (if (or (not lowest) | |
3553 | (< (gnus-window-top-edge) lowest)) | |
3554 | (progn | |
3555 | (setq lowest (gnus-window-top-edge)) | |
3556 | (setq lowest-buf buf))))) | |
3557 | (setq buffers (cdr buffers))) | |
3558 | ;; Remove windows on *all* summary buffers. | |
231f989b LMI |
3559 | (walk-windows |
3560 | (lambda (win) | |
3561 | (let ((buf (window-buffer win))) | |
3562 | (if (string-match "^\\*Summary" (buffer-name buf)) | |
3563 | (progn | |
3564 | (setq bufs (cons buf bufs)) | |
3565 | (pop-to-buffer buf) | |
3566 | (if (or (not lowest) | |
3567 | (< (gnus-window-top-edge) lowest)) | |
3568 | (progn | |
3569 | (setq lowest-buf buf) | |
3570 | (setq lowest (gnus-window-top-edge))))))))) | |
3571 | (and lowest-buf | |
41487370 LMI |
3572 | (progn |
3573 | (pop-to-buffer lowest-buf) | |
3574 | (switch-to-buffer nntp-server-buffer))) | |
3575 | (while bufs | |
3576 | (and (not (eq (car bufs) lowest-buf)) | |
3577 | (delete-windows-on (car bufs))) | |
3578 | (setq bufs (cdr bufs)))))) | |
231f989b LMI |
3579 | |
3580 | (defun gnus-version (&optional arg) | |
3581 | "Version number of this version of Gnus. | |
3582 | If ARG, insert string at point." | |
3583 | (interactive "P") | |
41487370 LMI |
3584 | (let ((methods gnus-valid-select-methods) |
3585 | (mess gnus-version) | |
3586 | meth) | |
3587 | ;; Go through all the legal select methods and add their version | |
231f989b | 3588 | ;; numbers to the total version string. Only the backends that are |
41487370 | 3589 | ;; currently in use will have their message numbers taken into |
231f989b | 3590 | ;; consideration. |
41487370 | 3591 | (while methods |
231f989b | 3592 | (setq meth (intern (concat (caar methods) "-version"))) |
41487370 LMI |
3593 | (and (boundp meth) |
3594 | (stringp (symbol-value meth)) | |
3595 | (setq mess (concat mess "; " (symbol-value meth)))) | |
3596 | (setq methods (cdr methods))) | |
231f989b LMI |
3597 | (if arg |
3598 | (insert (message mess)) | |
3599 | (message mess)))) | |
41487370 LMI |
3600 | |
3601 | (defun gnus-info-find-node () | |
3602 | "Find Info documentation of Gnus." | |
3603 | (interactive) | |
3604 | ;; Enlarge info window if needed. | |
231f989b LMI |
3605 | (let ((mode major-mode) |
3606 | gnus-info-buffer) | |
3607 | (Info-goto-node (cadr (assq mode gnus-info-nodes))) | |
3608 | (setq gnus-info-buffer (current-buffer)) | |
3609 | (gnus-configure-windows 'info))) | |
41487370 LMI |
3610 | |
3611 | (defun gnus-days-between (date1 date2) | |
3612 | ;; Return the number of days between date1 and date2. | |
3613 | (- (gnus-day-number date1) (gnus-day-number date2))) | |
3614 | ||
3615 | (defun gnus-day-number (date) | |
3616 | (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) | |
3617 | (timezone-parse-date date)))) | |
231f989b | 3618 | (timezone-absolute-from-gregorian |
41487370 LMI |
3619 | (nth 1 dat) (nth 2 dat) (car dat)))) |
3620 | ||
231f989b LMI |
3621 | (defun gnus-encode-date (date) |
3622 | "Convert DATE to internal time." | |
3623 | (let* ((parse (timezone-parse-date date)) | |
3624 | (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) | |
3625 | (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) | |
3626 | (encode-time (caddr time) (cadr time) (car time) | |
3627 | (caddr date) (cadr date) (car date) (nth 4 date)))) | |
3628 | ||
3629 | (defun gnus-time-minus (t1 t2) | |
3630 | "Subtract two internal times." | |
3631 | (let ((borrow (< (cadr t1) (cadr t2)))) | |
3632 | (list (- (car t1) (car t2) (if borrow 1 0)) | |
3633 | (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) | |
41487370 LMI |
3634 | |
3635 | (defun gnus-file-newer-than (file date) | |
3636 | (let ((fdate (nth 5 (file-attributes file)))) | |
3637 | (or (> (car fdate) (car date)) | |
3638 | (and (= (car fdate) (car date)) | |
3639 | (> (nth 1 fdate) (nth 1 date)))))) | |
3640 | ||
231f989b LMI |
3641 | (defmacro gnus-local-set-keys (&rest plist) |
3642 | "Set the keys in PLIST in the current keymap." | |
3643 | `(gnus-define-keys-1 (current-local-map) ',plist)) | |
3644 | ||
3645 | (defmacro gnus-define-keys (keymap &rest plist) | |
3646 | "Define all keys in PLIST in KEYMAP." | |
3647 | `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) | |
3648 | ||
3649 | (put 'gnus-define-keys 'lisp-indent-function 1) | |
3650 | (put 'gnus-define-keys 'lisp-indent-hook 1) | |
3651 | (put 'gnus-define-keymap 'lisp-indent-function 1) | |
3652 | (put 'gnus-define-keymap 'lisp-indent-hook 1) | |
3653 | ||
3654 | (defmacro gnus-define-keymap (keymap &rest plist) | |
3655 | "Define all keys in PLIST in KEYMAP." | |
3656 | `(gnus-define-keys-1 ,keymap (quote ,plist))) | |
3657 | ||
3658 | (defun gnus-define-keys-1 (keymap plist) | |
3659 | (when (null keymap) | |
3660 | (error "Can't set keys in a null keymap")) | |
3661 | (cond ((symbolp keymap) | |
3662 | (setq keymap (symbol-value keymap))) | |
3663 | ((keymapp keymap)) | |
3664 | ((listp keymap) | |
3665 | (set (car keymap) nil) | |
3666 | (define-prefix-command (car keymap)) | |
3667 | (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) | |
3668 | (setq keymap (symbol-value (car keymap))))) | |
3669 | (let (key) | |
3670 | (while plist | |
3671 | (when (symbolp (setq key (pop plist))) | |
3672 | (setq key (symbol-value key))) | |
3673 | (define-key keymap key (pop plist))))) | |
3674 | ||
41487370 LMI |
3675 | (defun gnus-group-read-only-p (&optional group) |
3676 | "Check whether GROUP supports editing or not. | |
231f989b | 3677 | If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note |
41487370 LMI |
3678 | that that variable is buffer-local to the summary buffers." |
3679 | (let ((group (or group gnus-newsgroup-name))) | |
3680 | (not (gnus-check-backend-function 'request-replace-article group)))) | |
3681 | ||
231f989b LMI |
3682 | (defun gnus-group-total-expirable-p (group) |
3683 | "Check whether GROUP is total-expirable or not." | |
3684 | (let ((params (gnus-info-params (gnus-get-info group)))) | |
3685 | (or (memq 'total-expire params) | |
3686 | (cdr (assq 'total-expire params)) ; (total-expire . t) | |
3687 | (and gnus-total-expirable-newsgroups ; Check var. | |
3688 | (string-match gnus-total-expirable-newsgroups group))))) | |
3689 | ||
3690 | (defun gnus-group-auto-expirable-p (group) | |
3691 | "Check whether GROUP is total-expirable or not." | |
3692 | (let ((params (gnus-info-params (gnus-get-info group)))) | |
3693 | (or (memq 'auto-expire params) | |
3694 | (cdr (assq 'auto-expire params)) ; (auto-expire . t) | |
3695 | (and gnus-auto-expirable-newsgroups ; Check var. | |
3696 | (string-match gnus-auto-expirable-newsgroups group))))) | |
3697 | ||
3698 | (defun gnus-virtual-group-p (group) | |
3699 | "Say whether GROUP is virtual or not." | |
3700 | (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) | |
3701 | gnus-valid-select-methods))) | |
3702 | ||
3703 | (defun gnus-news-group-p (group &optional article) | |
3704 | "Return non-nil if GROUP (and ARTICLE) come from a news server." | |
3705 | (or (gnus-member-of-valid 'post group) ; Ordinary news group. | |
3706 | (and (gnus-member-of-valid 'post-mail group) ; Combined group. | |
3707 | (eq (gnus-request-type group article) 'news)))) | |
3708 | ||
3709 | (defsubst gnus-simplify-subject-fully (subject) | |
3710 | "Simplify a subject string according to the user's wishes." | |
3711 | (cond | |
3712 | ((null gnus-summary-gather-subject-limit) | |
3713 | (gnus-simplify-subject-re subject)) | |
3714 | ((eq gnus-summary-gather-subject-limit 'fuzzy) | |
3715 | (gnus-simplify-subject-fuzzy subject)) | |
3716 | ((numberp gnus-summary-gather-subject-limit) | |
3717 | (gnus-limit-string (gnus-simplify-subject-re subject) | |
3718 | gnus-summary-gather-subject-limit)) | |
3719 | (t | |
3720 | subject))) | |
3721 | ||
3722 | (defsubst gnus-subject-equal (s1 s2 &optional simple-first) | |
3723 | "Check whether two subjects are equal. If optional argument | |
3724 | simple-first is t, first argument is already simplified." | |
3725 | (cond | |
3726 | ((null simple-first) | |
3727 | (equal (gnus-simplify-subject-fully s1) | |
3728 | (gnus-simplify-subject-fully s2))) | |
3729 | (t | |
3730 | (equal s1 | |
3731 | (gnus-simplify-subject-fully s2))))) | |
3732 | ||
3733 | ;; Returns a list of writable groups. | |
3734 | (defun gnus-writable-groups () | |
3735 | (let ((alist gnus-newsrc-alist) | |
3736 | groups group) | |
3737 | (while (setq group (car (pop alist))) | |
3738 | (unless (gnus-group-read-only-p group) | |
3739 | (push group groups))) | |
3740 | (nreverse groups))) | |
3741 | ||
3742 | (defun gnus-completing-read (default prompt &rest args) | |
3743 | ;; Like `completing-read', except that DEFAULT is the default argument. | |
3744 | (let* ((prompt (if default | |
3745 | (concat prompt " (default " default ") ") | |
3746 | (concat prompt " "))) | |
3747 | (answer (apply 'completing-read prompt args))) | |
3748 | (if (or (null answer) (zerop (length answer))) | |
3749 | default | |
3750 | answer))) | |
3751 | ||
41487370 LMI |
3752 | ;; Two silly functions to ensure that all `y-or-n-p' questions clear |
3753 | ;; the echo area. | |
3754 | (defun gnus-y-or-n-p (prompt) | |
3755 | (prog1 | |
3756 | (y-or-n-p prompt) | |
3757 | (message ""))) | |
3758 | ||
3759 | (defun gnus-yes-or-no-p (prompt) | |
3760 | (prog1 | |
3761 | (yes-or-no-p prompt) | |
3762 | (message ""))) | |
3763 | ||
3764 | ;; Check whether to use long file names. | |
3765 | (defun gnus-use-long-file-name (symbol) | |
3766 | ;; The variable has to be set... | |
3767 | (and gnus-use-long-file-name | |
3768 | ;; If it isn't a list, then we return t. | |
3769 | (or (not (listp gnus-use-long-file-name)) | |
3770 | ;; If it is a list, and the list contains `symbol', we | |
231f989b | 3771 | ;; return nil. |
41487370 LMI |
3772 | (not (memq symbol gnus-use-long-file-name))))) |
3773 | ||
3774 | ;; I suspect there's a better way, but I haven't taken the time to do | |
3775 | ;; it yet. -erik selberg@cs.washington.edu | |
3776 | (defun gnus-dd-mmm (messy-date) | |
3777 | "Return a string like DD-MMM from a big messy string" | |
231f989b LMI |
3778 | (let ((datevec (condition-case () (timezone-parse-date messy-date) |
3779 | (error nil)))) | |
3780 | (if (not datevec) | |
3781 | "??-???" | |
3782 | (format "%2s-%s" | |
3783 | (condition-case () | |
3784 | ;; Make sure leading zeroes are stripped. | |
3785 | (number-to-string (string-to-number (aref datevec 2))) | |
3786 | (error "??")) | |
3787 | (capitalize | |
3788 | (or (car | |
3789 | (nth (1- (string-to-number (aref datevec 1))) | |
3790 | timezone-months-assoc)) | |
3791 | "???")))))) | |
3792 | ||
3793 | (defun gnus-mode-string-quote (string) | |
3794 | "Quote all \"%\" in STRING." | |
3795 | (save-excursion | |
3796 | (gnus-set-work-buffer) | |
3797 | (insert string) | |
3798 | (goto-char (point-min)) | |
3799 | (while (search-forward "%" nil t) | |
3800 | (insert "%")) | |
3801 | (buffer-string))) | |
41487370 LMI |
3802 | |
3803 | ;; Make a hash table (default and minimum size is 255). | |
3804 | ;; Optional argument HASHSIZE specifies the table size. | |
3805 | (defun gnus-make-hashtable (&optional hashsize) | |
3806 | (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0)) | |
3807 | ||
3808 | ;; Make a number that is suitable for hashing; bigger than MIN and one | |
3809 | ;; less than 2^x. | |
3810 | (defun gnus-create-hash-size (min) | |
3811 | (let ((i 1)) | |
3812 | (while (< i min) | |
3813 | (setq i (* 2 i))) | |
3814 | (1- i))) | |
3815 | ||
231f989b LMI |
3816 | ;; Show message if message has a lower level than `gnus-verbose'. |
3817 | ;; Guideline for numbers: | |
41487370 LMI |
3818 | ;; 1 - error messages, 3 - non-serious error messages, 5 - messages |
3819 | ;; for things that take a long time, 7 - not very important messages | |
3820 | ;; on stuff, 9 - messages inside loops. | |
3821 | (defun gnus-message (level &rest args) | |
3822 | (if (<= level gnus-verbose) | |
3823 | (apply 'message args) | |
b94ae5f7 | 3824 | ;; We have to do this format thingy here even if the result isn't |
41487370 LMI |
3825 | ;; shown - the return value has to be the same as the return value |
3826 | ;; from `message'. | |
3827 | (apply 'format args))) | |
3828 | ||
231f989b | 3829 | (defun gnus-error (level &rest args) |
564b670b | 3830 | "Beep an error if LEVEL is equal to or less than `gnus-verbose'." |
231f989b LMI |
3831 | (when (<= (floor level) gnus-verbose) |
3832 | (apply 'message args) | |
3833 | (ding) | |
3834 | (let (duration) | |
3835 | (when (and (floatp level) | |
3836 | (not (zerop (setq duration (* 10 (- level (floor level))))))) | |
3837 | (sit-for duration)))) | |
3838 | nil) | |
3839 | ||
41487370 LMI |
3840 | ;; Generate a unique new group name. |
3841 | (defun gnus-generate-new-group-name (leaf) | |
3842 | (let ((name leaf) | |
3843 | (num 0)) | |
3844 | (while (gnus-gethash name gnus-newsrc-hashtb) | |
3845 | (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) | |
3846 | name)) | |
3847 | ||
231f989b LMI |
3848 | (defsubst gnus-hide-text (b e props) |
3849 | "Set text PROPS on the B to E region, extending `intangible' 1 past B." | |
3850 | (gnus-add-text-properties b e props) | |
3851 | (when (memq 'intangible props) | |
3852 | (gnus-put-text-property (max (1- b) (point-min)) | |
3853 | b 'intangible (cddr (memq 'intangible props))))) | |
3854 | ||
3855 | (defsubst gnus-unhide-text (b e) | |
3856 | "Remove hidden text properties from region between B and E." | |
3857 | (remove-text-properties b e gnus-hidden-properties) | |
3858 | (when (memq 'intangible gnus-hidden-properties) | |
3859 | (gnus-put-text-property (max (1- b) (point-min)) | |
3860 | b 'intangible nil))) | |
3861 | ||
3862 | (defun gnus-hide-text-type (b e type) | |
3863 | "Hide text of TYPE between B and E." | |
3864 | (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties)))) | |
3865 | ||
3866 | (defun gnus-parent-headers (headers &optional generation) | |
3867 | "Return the headers of the GENERATIONeth parent of HEADERS." | |
3868 | (unless generation | |
3869 | (setq generation 1)) | |
3870 | (let (references parent) | |
3871 | (while (and headers (not (zerop generation))) | |
3872 | (setq references (mail-header-references headers)) | |
3873 | (when (and references | |
3874 | (setq parent (gnus-parent-id references)) | |
3875 | (setq headers (car (gnus-id-to-thread parent)))) | |
3876 | (decf generation))) | |
3877 | headers)) | |
3878 | ||
3879 | (defun gnus-parent-id (references) | |
3880 | "Return the last Message-ID in REFERENCES." | |
3881 | (when (and references | |
3882 | (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references)) | |
3883 | (substring references (match-beginning 1) (match-end 1)))) | |
3884 | ||
3885 | (defun gnus-split-references (references) | |
3886 | "Return a list of Message-IDs in REFERENCES." | |
3887 | (let ((beg 0) | |
3888 | ids) | |
3889 | (while (string-match "<[^>]+>" references beg) | |
3890 | (push (substring references (match-beginning 0) (setq beg (match-end 0))) | |
3891 | ids)) | |
3892 | (nreverse ids))) | |
3893 | ||
3894 | (defun gnus-buffer-live-p (buffer) | |
3895 | "Say whether BUFFER is alive or not." | |
3896 | (and buffer | |
3897 | (get-buffer buffer) | |
3898 | (buffer-name (get-buffer buffer)))) | |
3899 | ||
41487370 LMI |
3900 | (defun gnus-ephemeral-group-p (group) |
3901 | "Say whether GROUP is ephemeral or not." | |
231f989b | 3902 | (gnus-group-get-parameter group 'quit-config)) |
41487370 LMI |
3903 | |
3904 | (defun gnus-group-quit-config (group) | |
3905 | "Return the quit-config of GROUP." | |
231f989b | 3906 | (gnus-group-get-parameter group 'quit-config)) |
41487370 | 3907 | |
a828a776 LMI |
3908 | (defun gnus-simplify-mode-line () |
3909 | "Make mode lines a bit simpler." | |
3910 | (setq mode-line-modified "-- ") | |
231f989b LMI |
3911 | (when (listp mode-line-format) |
3912 | (make-local-variable 'mode-line-format) | |
3913 | (setq mode-line-format (copy-sequence mode-line-format)) | |
3914 | (when (equal (nth 3 mode-line-format) " ") | |
3915 | (setcar (nthcdr 3 mode-line-format) " ")))) | |
a828a776 | 3916 | |
41487370 LMI |
3917 | ;;; List and range functions |
3918 | ||
3919 | (defun gnus-last-element (list) | |
3920 | "Return last element of LIST." | |
3921 | (while (cdr list) | |
3922 | (setq list (cdr list))) | |
3923 | (car list)) | |
3924 | ||
3925 | (defun gnus-copy-sequence (list) | |
3926 | "Do a complete, total copy of a list." | |
3927 | (if (and (consp list) (not (consp (cdr list)))) | |
3928 | (cons (car list) (cdr list)) | |
231f989b | 3929 | (mapcar (lambda (elem) (if (consp elem) |
41487370 LMI |
3930 | (if (consp (cdr elem)) |
3931 | (gnus-copy-sequence elem) | |
3932 | (cons (car elem) (cdr elem))) | |
3933 | elem)) | |
3934 | list))) | |
3935 | ||
3936 | (defun gnus-set-difference (list1 list2) | |
3937 | "Return a list of elements of LIST1 that do not appear in LIST2." | |
3938 | (let ((list1 (copy-sequence list1))) | |
3939 | (while list2 | |
3940 | (setq list1 (delq (car list2) list1)) | |
3941 | (setq list2 (cdr list2))) | |
3942 | list1)) | |
3943 | ||
3944 | (defun gnus-sorted-complement (list1 list2) | |
3945 | "Return a list of elements of LIST1 that do not appear in LIST2. | |
3946 | Both lists have to be sorted over <." | |
3947 | (let (out) | |
3948 | (if (or (null list1) (null list2)) | |
3949 | (or list1 list2) | |
3950 | (while (and list1 list2) | |
3951 | (cond ((= (car list1) (car list2)) | |
3952 | (setq list1 (cdr list1) | |
3953 | list2 (cdr list2))) | |
3954 | ((< (car list1) (car list2)) | |
3955 | (setq out (cons (car list1) out)) | |
3956 | (setq list1 (cdr list1))) | |
3957 | (t | |
3958 | (setq out (cons (car list2) out)) | |
3959 | (setq list2 (cdr list2))))) | |
3960 | (nconc (nreverse out) (or list1 list2))))) | |
3961 | ||
231f989b | 3962 | (defun gnus-intersection (list1 list2) |
41487370 LMI |
3963 | (let ((result nil)) |
3964 | (while list2 | |
3965 | (if (memq (car list2) list1) | |
3966 | (setq result (cons (car list2) result))) | |
3967 | (setq list2 (cdr list2))) | |
3968 | result)) | |
3969 | ||
3970 | (defun gnus-sorted-intersection (list1 list2) | |
3971 | ;; LIST1 and LIST2 have to be sorted over <. | |
3972 | (let (out) | |
3973 | (while (and list1 list2) | |
3974 | (cond ((= (car list1) (car list2)) | |
3975 | (setq out (cons (car list1) out) | |
3976 | list1 (cdr list1) | |
3977 | list2 (cdr list2))) | |
3978 | ((< (car list1) (car list2)) | |
3979 | (setq list1 (cdr list1))) | |
3980 | (t | |
3981 | (setq list2 (cdr list2))))) | |
3982 | (nreverse out))) | |
3983 | ||
3984 | (defun gnus-set-sorted-intersection (list1 list2) | |
3985 | ;; LIST1 and LIST2 have to be sorted over <. | |
3986 | ;; This function modifies LIST1. | |
3987 | (let* ((top (cons nil list1)) | |
3988 | (prev top)) | |
3989 | (while (and list1 list2) | |
3990 | (cond ((= (car list1) (car list2)) | |
3991 | (setq prev list1 | |
3992 | list1 (cdr list1) | |
3993 | list2 (cdr list2))) | |
3994 | ((< (car list1) (car list2)) | |
3995 | (setcdr prev (cdr list1)) | |
3996 | (setq list1 (cdr list1))) | |
3997 | (t | |
3998 | (setq list2 (cdr list2))))) | |
3999 | (setcdr prev nil) | |
4000 | (cdr top))) | |
4001 | ||
4002 | (defun gnus-compress-sequence (numbers &optional always-list) | |
4003 | "Convert list of numbers to a list of ranges or a single range. | |
4004 | If ALWAYS-LIST is non-nil, this function will always release a list of | |
4005 | ranges." | |
4006 | (let* ((first (car numbers)) | |
4007 | (last (car numbers)) | |
4008 | result) | |
4009 | (if (null numbers) | |
4010 | nil | |
4011 | (if (not (listp (cdr numbers))) | |
4012 | numbers | |
4013 | (while numbers | |
4014 | (cond ((= last (car numbers)) nil) ;Omit duplicated number | |
4015 | ((= (1+ last) (car numbers)) ;Still in sequence | |
4016 | (setq last (car numbers))) | |
4017 | (t ;End of one sequence | |
231f989b | 4018 | (setq result |
41487370 LMI |
4019 | (cons (if (= first last) first |
4020 | (cons first last)) result)) | |
4021 | (setq first (car numbers)) | |
4022 | (setq last (car numbers)))) | |
4023 | (setq numbers (cdr numbers))) | |
4024 | (if (and (not always-list) (null result)) | |
4025 | (if (= first last) (list first) (cons first last)) | |
4026 | (nreverse (cons (if (= first last) first (cons first last)) | |
4027 | result))))))) | |
4028 | ||
4029 | (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) | |
4030 | (defun gnus-uncompress-range (ranges) | |
4031 | "Expand a list of ranges into a list of numbers. | |
4032 | RANGES is either a single range on the form `(num . num)' or a list of | |
4033 | these ranges." | |
4034 | (let (first last result) | |
231f989b | 4035 | (cond |
41487370 LMI |
4036 | ((null ranges) |
4037 | nil) | |
4038 | ((not (listp (cdr ranges))) | |
4039 | (setq first (car ranges)) | |
4040 | (setq last (cdr ranges)) | |
4041 | (while (<= first last) | |
4042 | (setq result (cons first result)) | |
4043 | (setq first (1+ first))) | |
4044 | (nreverse result)) | |
4045 | (t | |
4046 | (while ranges | |
4047 | (if (atom (car ranges)) | |
4048 | (if (numberp (car ranges)) | |
4049 | (setq result (cons (car ranges) result))) | |
231f989b LMI |
4050 | (setq first (caar ranges)) |
4051 | (setq last (cdar ranges)) | |
41487370 LMI |
4052 | (while (<= first last) |
4053 | (setq result (cons first result)) | |
4054 | (setq first (1+ first)))) | |
4055 | (setq ranges (cdr ranges))) | |
4056 | (nreverse result))))) | |
4057 | ||
4058 | (defun gnus-add-to-range (ranges list) | |
4059 | "Return a list of ranges that has all articles from both RANGES and LIST. | |
4060 | Note: LIST has to be sorted over `<'." | |
4061 | (if (not ranges) | |
4062 | (gnus-compress-sequence list t) | |
4063 | (setq list (copy-sequence list)) | |
4064 | (or (listp (cdr ranges)) | |
4065 | (setq ranges (list ranges))) | |
4066 | (let ((out ranges) | |
4067 | ilist lowest highest temp) | |
4068 | (while (and ranges list) | |
4069 | (setq ilist list) | |
4070 | (setq lowest (or (and (atom (car ranges)) (car ranges)) | |
231f989b LMI |
4071 | (caar ranges))) |
4072 | (while (and list (cdr list) (< (cadr list) lowest)) | |
41487370 LMI |
4073 | (setq list (cdr list))) |
4074 | (if (< (car ilist) lowest) | |
4075 | (progn | |
4076 | (setq temp list) | |
4077 | (setq list (cdr list)) | |
4078 | (setcdr temp nil) | |
4079 | (setq out (nconc (gnus-compress-sequence ilist t) out)))) | |
4080 | (setq highest (or (and (atom (car ranges)) (car ranges)) | |
231f989b | 4081 | (cdar ranges))) |
41487370 LMI |
4082 | (while (and list (<= (car list) highest)) |
4083 | (setq list (cdr list))) | |
4084 | (setq ranges (cdr ranges))) | |
4085 | (if list | |
4086 | (setq out (nconc (gnus-compress-sequence list t) out))) | |
231f989b | 4087 | (setq out (sort out (lambda (r1 r2) |
41487370 LMI |
4088 | (< (or (and (atom r1) r1) (car r1)) |
4089 | (or (and (atom r2) r2) (car r2)))))) | |
4090 | (setq ranges out) | |
4091 | (while ranges | |
4092 | (if (atom (car ranges)) | |
4093 | (if (cdr ranges) | |
231f989b LMI |
4094 | (if (atom (cadr ranges)) |
4095 | (if (= (1+ (car ranges)) (cadr ranges)) | |
41487370 | 4096 | (progn |
231f989b LMI |
4097 | (setcar ranges (cons (car ranges) |
4098 | (cadr ranges))) | |
4099 | (setcdr ranges (cddr ranges)))) | |
4100 | (if (= (1+ (car ranges)) (caadr ranges)) | |
41487370 | 4101 | (progn |
231f989b LMI |
4102 | (setcar (cadr ranges) (car ranges)) |
4103 | (setcar ranges (cadr ranges)) | |
4104 | (setcdr ranges (cddr ranges)))))) | |
41487370 | 4105 | (if (cdr ranges) |
231f989b LMI |
4106 | (if (atom (cadr ranges)) |
4107 | (if (= (1+ (cdar ranges)) (cadr ranges)) | |
41487370 | 4108 | (progn |
231f989b LMI |
4109 | (setcdr (car ranges) (cadr ranges)) |
4110 | (setcdr ranges (cddr ranges)))) | |
4111 | (if (= (1+ (cdar ranges)) (caadr ranges)) | |
41487370 | 4112 | (progn |
231f989b LMI |
4113 | (setcdr (car ranges) (cdadr ranges)) |
4114 | (setcdr ranges (cddr ranges))))))) | |
41487370 LMI |
4115 | (setq ranges (cdr ranges))) |
4116 | out))) | |
4117 | ||
4118 | (defun gnus-remove-from-range (ranges list) | |
4119 | "Return a list of ranges that has all articles from LIST removed from RANGES. | |
4120 | Note: LIST has to be sorted over `<'." | |
4121 | ;; !!! This function shouldn't look like this, but I've got a headache. | |
231f989b | 4122 | (gnus-compress-sequence |
41487370 LMI |
4123 | (gnus-sorted-complement |
4124 | (gnus-uncompress-range ranges) list))) | |
4125 | ||
4126 | (defun gnus-member-of-range (number ranges) | |
4127 | (if (not (listp (cdr ranges))) | |
231f989b | 4128 | (and (>= number (car ranges)) |
41487370 LMI |
4129 | (<= number (cdr ranges))) |
4130 | (let ((not-stop t)) | |
231f989b | 4131 | (while (and ranges |
41487370 LMI |
4132 | (if (numberp (car ranges)) |
4133 | (>= number (car ranges)) | |
231f989b | 4134 | (>= number (caar ranges))) |
41487370 LMI |
4135 | not-stop) |
4136 | (if (if (numberp (car ranges)) | |
4137 | (= number (car ranges)) | |
231f989b LMI |
4138 | (and (>= number (caar ranges)) |
4139 | (<= number (cdar ranges)))) | |
41487370 LMI |
4140 | (setq not-stop nil)) |
4141 | (setq ranges (cdr ranges))) | |
4142 | (not not-stop)))) | |
4143 | ||
231f989b LMI |
4144 | (defun gnus-range-length (range) |
4145 | "Return the length RANGE would have if uncompressed." | |
4146 | (length (gnus-uncompress-range range))) | |
4147 | ||
4148 | (defun gnus-sublist-p (list sublist) | |
4149 | "Test whether all elements in SUBLIST are members of LIST." | |
4150 | (let ((sublistp t)) | |
4151 | (while sublist | |
4152 | (unless (memq (pop sublist) list) | |
4153 | (setq sublistp nil | |
4154 | sublist nil))) | |
4155 | sublistp)) | |
4156 | ||
41487370 LMI |
4157 | \f |
4158 | ;;; | |
4159 | ;;; Gnus group mode | |
4160 | ;;; | |
4161 | ||
4162 | (defvar gnus-group-mode-map nil) | |
41487370 LMI |
4163 | (put 'gnus-group-mode 'mode-class 'special) |
4164 | ||
231f989b | 4165 | (unless gnus-group-mode-map |
41487370 LMI |
4166 | (setq gnus-group-mode-map (make-keymap)) |
4167 | (suppress-keymap gnus-group-mode-map) | |
231f989b LMI |
4168 | |
4169 | (gnus-define-keys gnus-group-mode-map | |
4170 | " " gnus-group-read-group | |
4171 | "=" gnus-group-select-group | |
4172 | "\r" gnus-group-select-group | |
4173 | "\M-\r" gnus-group-quick-select-group | |
4174 | "j" gnus-group-jump-to-group | |
4175 | "n" gnus-group-next-unread-group | |
4176 | "p" gnus-group-prev-unread-group | |
4177 | "\177" gnus-group-prev-unread-group | |
4178 | [delete] gnus-group-prev-unread-group | |
4179 | "N" gnus-group-next-group | |
4180 | "P" gnus-group-prev-group | |
4181 | "\M-n" gnus-group-next-unread-group-same-level | |
4182 | "\M-p" gnus-group-prev-unread-group-same-level | |
4183 | "," gnus-group-best-unread-group | |
4184 | "." gnus-group-first-unread-group | |
4185 | "u" gnus-group-unsubscribe-current-group | |
4186 | "U" gnus-group-unsubscribe-group | |
4187 | "c" gnus-group-catchup-current | |
4188 | "C" gnus-group-catchup-current-all | |
4189 | "l" gnus-group-list-groups | |
4190 | "L" gnus-group-list-all-groups | |
4191 | "m" gnus-group-mail | |
4192 | "g" gnus-group-get-new-news | |
4193 | "\M-g" gnus-group-get-new-news-this-group | |
4194 | "R" gnus-group-restart | |
4195 | "r" gnus-group-read-init-file | |
4196 | "B" gnus-group-browse-foreign-server | |
4197 | "b" gnus-group-check-bogus-groups | |
4198 | "F" gnus-find-new-newsgroups | |
4199 | "\C-c\C-d" gnus-group-describe-group | |
4200 | "\M-d" gnus-group-describe-all-groups | |
4201 | "\C-c\C-a" gnus-group-apropos | |
4202 | "\C-c\M-\C-a" gnus-group-description-apropos | |
4203 | "a" gnus-group-post-news | |
4204 | "\ek" gnus-group-edit-local-kill | |
4205 | "\eK" gnus-group-edit-global-kill | |
4206 | "\C-k" gnus-group-kill-group | |
4207 | "\C-y" gnus-group-yank-group | |
4208 | "\C-w" gnus-group-kill-region | |
4209 | "\C-x\C-t" gnus-group-transpose-groups | |
4210 | "\C-c\C-l" gnus-group-list-killed | |
4211 | "\C-c\C-x" gnus-group-expire-articles | |
4212 | "\C-c\M-\C-x" gnus-group-expire-all-groups | |
4213 | "V" gnus-version | |
4214 | "s" gnus-group-save-newsrc | |
4215 | "z" gnus-group-suspend | |
4216 | ; "Z" gnus-group-clear-dribble | |
4217 | "q" gnus-group-exit | |
4218 | "Q" gnus-group-quit | |
4219 | "?" gnus-group-describe-briefly | |
4220 | "\C-c\C-i" gnus-info-find-node | |
4221 | "\M-e" gnus-group-edit-group-method | |
4222 | "^" gnus-group-enter-server-mode | |
4223 | gnus-mouse-2 gnus-mouse-pick-group | |
4224 | "<" beginning-of-buffer | |
4225 | ">" end-of-buffer | |
4226 | "\C-c\C-b" gnus-bug | |
4227 | "\C-c\C-s" gnus-group-sort-groups | |
4228 | "t" gnus-topic-mode | |
4229 | "\C-c\M-g" gnus-activate-all-groups | |
4230 | "\M-&" gnus-group-universal-argument | |
4231 | "#" gnus-group-mark-group | |
4232 | "\M-#" gnus-group-unmark-group) | |
4233 | ||
4234 | (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) | |
4235 | "m" gnus-group-mark-group | |
4236 | "u" gnus-group-unmark-group | |
4237 | "w" gnus-group-mark-region | |
4238 | "m" gnus-group-mark-buffer | |
4239 | "r" gnus-group-mark-regexp | |
4240 | "U" gnus-group-unmark-all-groups) | |
4241 | ||
4242 | (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) | |
4243 | "d" gnus-group-make-directory-group | |
4244 | "h" gnus-group-make-help-group | |
4245 | "a" gnus-group-make-archive-group | |
4246 | "k" gnus-group-make-kiboze-group | |
4247 | "m" gnus-group-make-group | |
4248 | "E" gnus-group-edit-group | |
4249 | "e" gnus-group-edit-group-method | |
4250 | "p" gnus-group-edit-group-parameters | |
4251 | "v" gnus-group-add-to-virtual | |
4252 | "V" gnus-group-make-empty-virtual | |
4253 | "D" gnus-group-enter-directory | |
4254 | "f" gnus-group-make-doc-group | |
4255 | "r" gnus-group-rename-group | |
4256 | "\177" gnus-group-delete-group | |
4257 | [delete] gnus-group-delete-group) | |
4258 | ||
4259 | (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) | |
4260 | "b" gnus-group-brew-soup | |
4261 | "w" gnus-soup-save-areas | |
4262 | "s" gnus-soup-send-replies | |
4263 | "p" gnus-soup-pack-packet | |
4264 | "r" nnsoup-pack-replies) | |
4265 | ||
4266 | (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) | |
4267 | "s" gnus-group-sort-groups | |
4268 | "a" gnus-group-sort-groups-by-alphabet | |
4269 | "u" gnus-group-sort-groups-by-unread | |
4270 | "l" gnus-group-sort-groups-by-level | |
4271 | "v" gnus-group-sort-groups-by-score | |
4272 | "r" gnus-group-sort-groups-by-rank | |
4273 | "m" gnus-group-sort-groups-by-method) | |
4274 | ||
4275 | (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) | |
4276 | "k" gnus-group-list-killed | |
4277 | "z" gnus-group-list-zombies | |
4278 | "s" gnus-group-list-groups | |
4279 | "u" gnus-group-list-all-groups | |
4280 | "A" gnus-group-list-active | |
4281 | "a" gnus-group-apropos | |
4282 | "d" gnus-group-description-apropos | |
4283 | "m" gnus-group-list-matching | |
4284 | "M" gnus-group-list-all-matching | |
4285 | "l" gnus-group-list-level) | |
4286 | ||
4287 | (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) | |
4288 | "f" gnus-score-flush-cache) | |
4289 | ||
4290 | (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) | |
4291 | "f" gnus-group-fetch-faq) | |
4292 | ||
4293 | (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) | |
4294 | "l" gnus-group-set-current-level | |
4295 | "t" gnus-group-unsubscribe-current-group | |
4296 | "s" gnus-group-unsubscribe-group | |
4297 | "k" gnus-group-kill-group | |
4298 | "y" gnus-group-yank-group | |
4299 | "w" gnus-group-kill-region | |
4300 | "\C-k" gnus-group-kill-level | |
4301 | "z" gnus-group-kill-all-zombies)) | |
b027f415 RS |
4302 | |
4303 | (defun gnus-group-mode () | |
41487370 LMI |
4304 | "Major mode for reading news. |
4305 | ||
4306 | All normal editing commands are switched off. | |
4307 | \\<gnus-group-mode-map> | |
231f989b | 4308 | The group buffer lists (some of) the groups available. For instance, |
41487370 | 4309 | `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' |
231f989b | 4310 | lists all zombie groups. |
41487370 | 4311 | |
231f989b LMI |
4312 | Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe |
4313 | to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. | |
41487370 | 4314 | |
231f989b | 4315 | For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). |
41487370 LMI |
4316 | |
4317 | The following commands are available: | |
4318 | ||
4319 | \\{gnus-group-mode-map}" | |
745bc783 | 4320 | (interactive) |
231f989b LMI |
4321 | (when (and menu-bar-mode |
4322 | (gnus-visual-p 'group-menu 'menu)) | |
4323 | (gnus-group-make-menu-bar)) | |
745bc783 | 4324 | (kill-all-local-variables) |
a828a776 | 4325 | (gnus-simplify-mode-line) |
b027f415 | 4326 | (setq major-mode 'gnus-group-mode) |
41487370 LMI |
4327 | (setq mode-name "Group") |
4328 | (gnus-group-set-mode-line) | |
745bc783 | 4329 | (setq mode-line-process nil) |
b027f415 | 4330 | (use-local-map gnus-group-mode-map) |
41487370 LMI |
4331 | (buffer-disable-undo (current-buffer)) |
4332 | (setq truncate-lines t) | |
4333 | (setq buffer-read-only t) | |
231f989b LMI |
4334 | (gnus-make-local-hook 'post-command-hook) |
4335 | (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) | |
b027f415 | 4336 | (run-hooks 'gnus-group-mode-hook)) |
745bc783 | 4337 | |
231f989b LMI |
4338 | (defun gnus-clear-inboxes-moved () |
4339 | (setq nnmail-moved-inboxes nil)) | |
4340 | ||
7f410bb7 | 4341 | (defun gnus-mouse-pick-group (e) |
231f989b | 4342 | "Enter the group under the mouse pointer." |
7f410bb7 RS |
4343 | (interactive "e") |
4344 | (mouse-set-point e) | |
4345 | (gnus-group-read-group nil)) | |
4346 | ||
41487370 LMI |
4347 | ;; Look at LEVEL and find out what the level is really supposed to be. |
4348 | ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens | |
4349 | ;; will depend on whether `gnus-group-use-permanent-levels' is used. | |
4350 | (defun gnus-group-default-level (&optional level number-or-nil) | |
231f989b | 4351 | (cond |
41487370 | 4352 | (gnus-group-use-permanent-levels |
231f989b LMI |
4353 | (or (setq gnus-group-use-permanent-levels |
4354 | (or level (if (numberp gnus-group-use-permanent-levels) | |
4355 | gnus-group-use-permanent-levels | |
4356 | (or gnus-group-default-list-level | |
4357 | gnus-level-subscribed)))) | |
4358 | gnus-group-default-list-level gnus-level-subscribed)) | |
41487370 LMI |
4359 | (number-or-nil |
4360 | level) | |
4361 | (t | |
4362 | (or level gnus-group-default-list-level gnus-level-subscribed)))) | |
41487370 | 4363 | |
231f989b LMI |
4364 | ;;;###autoload |
4365 | (defun gnus-slave-no-server (&optional arg) | |
4366 | "Read network news as a slave, without connecting to local server" | |
4367 | (interactive "P") | |
4368 | (gnus-no-server arg t)) | |
41487370 LMI |
4369 | |
4370 | ;;;###autoload | |
231f989b | 4371 | (defun gnus-no-server (&optional arg slave) |
41487370 LMI |
4372 | "Read network news. |
4373 | If ARG is a positive number, Gnus will use that as the | |
231f989b | 4374 | startup level. If ARG is nil, Gnus will be started at level 2. |
41487370 LMI |
4375 | If ARG is non-nil and not a positive number, Gnus will |
4376 | prompt the user for the name of an NNTP server to use. | |
4377 | As opposed to `gnus', this command will not connect to the local server." | |
4378 | (interactive "P") | |
231f989b LMI |
4379 | (let ((val (or arg (1- gnus-level-default-subscribed)))) |
4380 | (gnus val t slave) | |
4381 | (make-local-variable 'gnus-group-use-permanent-levels) | |
4382 | (setq gnus-group-use-permanent-levels val))) | |
4383 | ||
4384 | ;;;###autoload | |
4385 | (defun gnus-slave (&optional arg) | |
4386 | "Read news as a slave." | |
4387 | (interactive "P") | |
4388 | (gnus arg nil 'slave)) | |
41487370 | 4389 | |
bba2dbcb | 4390 | ;;;###autoload |
231f989b LMI |
4391 | (defun gnus-other-frame (&optional arg) |
4392 | "Pop up a frame to read news." | |
4393 | (interactive "P") | |
4394 | (if (get-buffer gnus-group-buffer) | |
4395 | (let ((pop-up-frames t)) | |
4396 | (gnus arg)) | |
4397 | (select-frame (make-frame)) | |
4398 | (gnus arg))) | |
bba2dbcb | 4399 | |
745bc783 | 4400 | ;;;###autoload |
231f989b | 4401 | (defun gnus (&optional arg dont-connect slave) |
745bc783 | 4402 | "Read network news. |
41487370 | 4403 | If ARG is non-nil and a positive number, Gnus will use that as the |
231f989b | 4404 | startup level. If ARG is non-nil and not a positive number, Gnus will |
41487370 | 4405 | prompt the user for the name of an NNTP server to use." |
745bc783 | 4406 | (interactive "P") |
231f989b | 4407 | |
41487370 | 4408 | (if (get-buffer gnus-group-buffer) |
745bc783 | 4409 | (progn |
41487370 LMI |
4410 | (switch-to-buffer gnus-group-buffer) |
4411 | (gnus-group-get-new-news)) | |
4412 | ||
4413 | (gnus-clear-system) | |
41487370 | 4414 | (nnheader-init-server-buffer) |
41487370 | 4415 | (gnus-read-init-file) |
231f989b | 4416 | (setq gnus-slave slave) |
41487370 LMI |
4417 | |
4418 | (gnus-group-setup-buffer) | |
4419 | (let ((buffer-read-only nil)) | |
4420 | (erase-buffer) | |
4421 | (if (not gnus-inhibit-startup-message) | |
4422 | (progn | |
4423 | (gnus-group-startup-message) | |
4424 | (sit-for 0)))) | |
231f989b LMI |
4425 | |
4426 | (let ((level (and (numberp arg) (> arg 0) arg)) | |
41487370 LMI |
4427 | did-connect) |
4428 | (unwind-protect | |
4429 | (progn | |
231f989b | 4430 | (or dont-connect |
41487370 LMI |
4431 | (setq did-connect |
4432 | (gnus-start-news-server (and arg (not level)))))) | |
231f989b | 4433 | (if (and (not dont-connect) |
41487370 LMI |
4434 | (not did-connect)) |
4435 | (gnus-group-quit) | |
4436 | (run-hooks 'gnus-startup-hook) | |
231f989b | 4437 | ;; NNTP server is successfully open. |
41487370 LMI |
4438 | |
4439 | ;; Find the current startup file name. | |
231f989b | 4440 | (setq gnus-current-startup-file |
41487370 LMI |
4441 | (gnus-make-newsrc-file gnus-startup-file)) |
4442 | ||
4443 | ;; Read the dribble file. | |
231f989b LMI |
4444 | (when (or gnus-slave gnus-use-dribble-file) |
4445 | (gnus-dribble-read-file)) | |
4446 | ||
4447 | ;; Allow using GroupLens predictions. | |
4448 | (when gnus-use-grouplens | |
4449 | (bbb-login) | |
4450 | (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) | |
41487370 LMI |
4451 | |
4452 | (gnus-summary-make-display-table) | |
231f989b LMI |
4453 | ;; Do the actual startup. |
4454 | (gnus-setup-news nil level dont-connect) | |
4455 | ;; Generate the group buffer. | |
41487370 | 4456 | (gnus-group-list-groups level) |
231f989b LMI |
4457 | (gnus-group-first-unread-group) |
4458 | (gnus-configure-windows 'group) | |
4459 | (gnus-group-set-mode-line)))))) | |
41487370 LMI |
4460 | |
4461 | (defun gnus-unload () | |
4462 | "Unload all Gnus features." | |
4463 | (interactive) | |
4464 | (or (boundp 'load-history) | |
4465 | (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) | |
4466 | (let ((history load-history) | |
4467 | feature) | |
4468 | (while history | |
231f989b | 4469 | (and (string-match "^\\(gnus\\|nn\\)" (caar history)) |
41487370 LMI |
4470 | (setq feature (cdr (assq 'provide (car history)))) |
4471 | (unload-feature feature 'force)) | |
4472 | (setq history (cdr history))))) | |
4473 | ||
231f989b LMI |
4474 | (defun gnus-compile () |
4475 | "Byte-compile the user-defined format specs." | |
4476 | (interactive) | |
4477 | (let ((entries gnus-format-specs) | |
4478 | entry gnus-tmp-func) | |
4479 | (save-excursion | |
4480 | (gnus-message 7 "Compiling format specs...") | |
4481 | ||
4482 | (while entries | |
4483 | (setq entry (pop entries)) | |
4484 | (if (eq (car entry) 'version) | |
4485 | (setq gnus-format-specs (delq entry gnus-format-specs)) | |
4486 | (when (and (listp (caddr entry)) | |
4487 | (not (eq 'byte-code (caaddr entry)))) | |
4488 | (fset 'gnus-tmp-func | |
4489 | `(lambda () ,(caddr entry))) | |
4490 | (byte-compile 'gnus-tmp-func) | |
4491 | (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) | |
4492 | ||
4493 | (push (cons 'version emacs-version) gnus-format-specs) | |
4494 | ||
4495 | (gnus-message 7 "Compiling user specs...done")))) | |
4496 | ||
4497 | (defun gnus-indent-rigidly (start end arg) | |
4498 | "Indent rigidly using only spaces and no tabs." | |
4499 | (save-excursion | |
4500 | (save-restriction | |
4501 | (narrow-to-region start end) | |
4502 | (indent-rigidly start end arg) | |
4503 | (goto-char (point-min)) | |
4504 | (while (search-forward "\t" nil t) | |
4505 | (replace-match " " t t))))) | |
4506 | ||
41487370 | 4507 | (defun gnus-group-startup-message (&optional x y) |
745bc783 JB |
4508 | "Insert startup message in current buffer." |
4509 | ;; Insert the message. | |
41487370 | 4510 | (erase-buffer) |
44cdca98 | 4511 | (insert |
231f989b LMI |
4512 | (format " %s |
4513 | _ ___ _ _ | |
4514 | _ ___ __ ___ __ _ ___ | |
4515 | __ _ ___ __ ___ | |
4516 | _ ___ _ | |
4517 | _ _ __ _ | |
4518 | ___ __ _ | |
4519 | __ _ | |
4520 | _ _ _ | |
4521 | _ _ _ | |
4522 | _ _ _ | |
4523 | __ ___ | |
4524 | _ _ _ _ | |
4525 | _ _ | |
4526 | _ _ | |
4527 | _ _ | |
4528 | _ | |
4529 | __ | |
4530 | ||
4531 | " | |
4532 | "")) | |
41487370 | 4533 | ;; And then hack it. |
231f989b LMI |
4534 | (gnus-indent-rigidly (point-min) (point-max) |
4535 | (/ (max (- (window-width) (or x 46)) 0) 2)) | |
41487370 | 4536 | (goto-char (point-min)) |
231f989b | 4537 | (forward-line 1) |
41487370 LMI |
4538 | (let* ((pheight (count-lines (point-min) (point-max))) |
4539 | (wheight (window-height)) | |
231f989b | 4540 | (rest (- wheight pheight))) |
41487370 | 4541 | (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) |
41487370 LMI |
4542 | ;; Fontify some. |
4543 | (goto-char (point-min)) | |
231f989b LMI |
4544 | (and (search-forward "Praxis" nil t) |
4545 | (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) | |
41487370 | 4546 | (goto-char (point-min)) |
231f989b LMI |
4547 | (let* ((mode-string (gnus-group-set-mode-line))) |
4548 | (setq mode-line-buffer-identification | |
4549 | (list (concat gnus-version (substring (car mode-string) 4)))) | |
4550 | (set-buffer-modified-p t))) | |
41487370 LMI |
4551 | |
4552 | (defun gnus-group-setup-buffer () | |
4553 | (or (get-buffer gnus-group-buffer) | |
4554 | (progn | |
4555 | (switch-to-buffer gnus-group-buffer) | |
4556 | (gnus-add-current-to-buffer-list) | |
4557 | (gnus-group-mode) | |
4558 | (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) | |
4559 | ||
231f989b | 4560 | (defun gnus-group-list-groups (&optional level unread lowest) |
41487370 LMI |
4561 | "List newsgroups with level LEVEL or lower that have unread articles. |
4562 | Default is all subscribed groups. | |
4563 | If argument UNREAD is non-nil, groups with no unread articles are also | |
231f989b | 4564 | listed." |
41487370 LMI |
4565 | (interactive (list (if current-prefix-arg |
4566 | (prefix-numeric-value current-prefix-arg) | |
4567 | (or | |
4568 | (gnus-group-default-level nil t) | |
4569 | gnus-group-default-list-level | |
4570 | gnus-level-subscribed)))) | |
4571 | (or level | |
4572 | (setq level (car gnus-group-list-mode) | |
4573 | unread (cdr gnus-group-list-mode))) | |
4574 | (setq level (gnus-group-default-level level)) | |
4575 | (gnus-group-setup-buffer) ;May call from out of group buffer | |
231f989b | 4576 | (gnus-update-format-specifications) |
b027f415 | 4577 | (let ((case-fold-search nil) |
231f989b | 4578 | (props (text-properties-at (gnus-point-at-bol))) |
41487370 | 4579 | (group (gnus-group-group-name))) |
231f989b LMI |
4580 | (set-buffer gnus-group-buffer) |
4581 | (funcall gnus-group-prepare-function level unread lowest) | |
745bc783 | 4582 | (if (zerop (buffer-size)) |
41487370 | 4583 | (gnus-message 5 gnus-no-groups-message) |
231f989b LMI |
4584 | (goto-char (point-max)) |
4585 | (when (or (not gnus-group-goto-next-group-function) | |
4586 | (not (funcall gnus-group-goto-next-group-function | |
4587 | group props))) | |
4588 | (if (not group) | |
4589 | ;; Go to the first group with unread articles. | |
4590 | (gnus-group-search-forward t) | |
4591 | ;; Find the right group to put point on. If the current group | |
4592 | ;; has disappeared in the new listing, try to find the next | |
4593 | ;; one. If no next one can be found, just leave point at the | |
4594 | ;; first newsgroup in the buffer. | |
4595 | (if (not (gnus-goto-char | |
4596 | (text-property-any | |
4597 | (point-min) (point-max) | |
4598 | 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) | |
4599 | (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) | |
4600 | (while (and newsrc | |
4601 | (not (gnus-goto-char | |
4602 | (text-property-any | |
4603 | (point-min) (point-max) 'gnus-group | |
4604 | (gnus-intern-safe | |
4605 | (caar newsrc) gnus-active-hashtb))))) | |
4606 | (setq newsrc (cdr newsrc))) | |
4607 | (or newsrc (progn (goto-char (point-max)) | |
4608 | (forward-line -1))))))) | |
745bc783 | 4609 | ;; Adjust cursor point. |
231f989b LMI |
4610 | (gnus-group-position-point)))) |
4611 | ||
4612 | (defun gnus-group-list-level (level &optional all) | |
4613 | "List groups on LEVEL. | |
4614 | If ALL (the prefix), also list groups that have no unread articles." | |
4615 | (interactive "nList groups on level: \nP") | |
4616 | (gnus-group-list-groups level all level)) | |
41487370 | 4617 | |
231f989b | 4618 | (defun gnus-group-prepare-flat (level &optional all lowest regexp) |
41487370 LMI |
4619 | "List all newsgroups with unread articles of level LEVEL or lower. |
4620 | If ALL is non-nil, list groups that have no unread articles. | |
4621 | If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. | |
4622 | If REGEXP, only list groups matching REGEXP." | |
4623 | (set-buffer gnus-group-buffer) | |
745bc783 | 4624 | (let ((buffer-read-only nil) |
41487370 LMI |
4625 | (newsrc (cdr gnus-newsrc-alist)) |
4626 | (lowest (or lowest 1)) | |
231f989b | 4627 | info clevel unread group params) |
745bc783 | 4628 | (erase-buffer) |
41487370 LMI |
4629 | (if (< lowest gnus-level-zombie) |
4630 | ;; List living groups. | |
4631 | (while newsrc | |
4632 | (setq info (car newsrc) | |
231f989b LMI |
4633 | group (gnus-info-group info) |
4634 | params (gnus-info-params info) | |
41487370 LMI |
4635 | newsrc (cdr newsrc) |
4636 | unread (car (gnus-gethash group gnus-newsrc-hashtb))) | |
4637 | (and unread ; This group might be bogus | |
4638 | (or (not regexp) | |
4639 | (string-match regexp group)) | |
231f989b | 4640 | (<= (setq clevel (gnus-info-level info)) level) |
41487370 LMI |
4641 | (>= clevel lowest) |
4642 | (or all ; We list all groups? | |
231f989b LMI |
4643 | (if (eq unread t) ; Unactivated? |
4644 | gnus-group-list-inactive-groups ; We list unactivated | |
4645 | (> unread 0)) ; We list groups with unread articles | |
4646 | (and gnus-list-groups-with-ticked-articles | |
4647 | (cdr (assq 'tick (gnus-info-marks info)))) | |
4648 | ; And groups with tickeds | |
4649 | ;; Check for permanent visibility. | |
4650 | (and gnus-permanently-visible-groups | |
4651 | (string-match gnus-permanently-visible-groups | |
4652 | group)) | |
4653 | (memq 'visible params) | |
4654 | (cdr (assq 'visible params))) | |
4655 | (gnus-group-insert-group-line | |
4656 | group (gnus-info-level info) | |
4657 | (gnus-info-marks info) unread (gnus-info-method info))))) | |
41487370 LMI |
4658 | |
4659 | ;; List dead groups. | |
4660 | (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) | |
231f989b LMI |
4661 | (gnus-group-prepare-flat-list-dead |
4662 | (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) | |
41487370 LMI |
4663 | gnus-level-zombie ?Z |
4664 | regexp)) | |
4665 | (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) | |
231f989b LMI |
4666 | (gnus-group-prepare-flat-list-dead |
4667 | (setq gnus-killed-list (sort gnus-killed-list 'string<)) | |
41487370 LMI |
4668 | gnus-level-killed ?K regexp)) |
4669 | ||
4670 | (gnus-group-set-mode-line) | |
4671 | (setq gnus-group-list-mode (cons level all)) | |
4672 | (run-hooks 'gnus-group-prepare-hook))) | |
4673 | ||
4674 | (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) | |
b94ae5f7 | 4675 | ;; List zombies and killed lists somewhat faster, which was |
231f989b | 4676 | ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does |
41487370 | 4677 | ;; this by ignoring the group format specification altogether. |
231f989b LMI |
4678 | (let (group) |
4679 | (if regexp | |
4680 | ;; This loop is used when listing groups that match some | |
4681 | ;; regexp. | |
4682 | (while groups | |
4683 | (setq group (pop groups)) | |
4684 | (when (string-match regexp group) | |
4685 | (gnus-add-text-properties | |
4686 | (point) (prog1 (1+ (point)) | |
4687 | (insert " " mark " *: " group "\n")) | |
4688 | (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | |
41487370 | 4689 | 'gnus-unread t |
231f989b LMI |
4690 | 'gnus-level level)))) |
4691 | ;; This loop is used when listing all groups. | |
4692 | (while groups | |
4693 | (gnus-add-text-properties | |
4694 | (point) (prog1 (1+ (point)) | |
4695 | (insert " " mark " *: " | |
4696 | (setq group (pop groups)) "\n")) | |
4697 | (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | |
4698 | 'gnus-unread t | |
4699 | 'gnus-level level)))))) | |
4700 | ||
4701 | (defmacro gnus-group-real-name (group) | |
41487370 | 4702 | "Find the real name of a foreign newsgroup." |
231f989b LMI |
4703 | `(let ((gname ,group)) |
4704 | (if (string-match ":[^:]+$" gname) | |
4705 | (substring gname (1+ (match-beginning 0))) | |
4706 | gname))) | |
4707 | ||
4708 | (defsubst gnus-server-add-address (method) | |
4709 | (let ((method-name (symbol-name (car method)))) | |
4710 | (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) | |
4711 | (not (assq (intern (concat method-name "-address")) method))) | |
4712 | (append method (list (list (intern (concat method-name "-address")) | |
4713 | (nth 1 method)))) | |
4714 | method))) | |
4715 | ||
4716 | (defsubst gnus-server-get-method (group method) | |
4717 | ;; Input either a server name, and extended server name, or a | |
4718 | ;; select method, and return a select method. | |
4719 | (cond ((stringp method) | |
4720 | (gnus-server-to-method method)) | |
4721 | ((equal method gnus-select-method) | |
4722 | gnus-select-method) | |
4723 | ((and (stringp (car method)) group) | |
4724 | (gnus-server-extend-method group method)) | |
4725 | ((and method (not group) | |
4726 | (equal (cadr method) "")) | |
4727 | method) | |
4728 | (t | |
4729 | (gnus-server-add-address method)))) | |
4730 | ||
4731 | (defun gnus-server-to-method (server) | |
4732 | "Map virtual server names to select methods." | |
4733 | (or | |
4734 | ;; Is this a method, perhaps? | |
4735 | (and server (listp server) server) | |
4736 | ;; Perhaps this is the native server? | |
4737 | (and (equal server "native") gnus-select-method) | |
4738 | ;; It should be in the server alist. | |
4739 | (cdr (assoc server gnus-server-alist)) | |
4740 | ;; If not, we look through all the opened server | |
4741 | ;; to see whether we can find it there. | |
4742 | (let ((opened gnus-opened-servers)) | |
4743 | (while (and opened | |
4744 | (not (equal server (format "%s:%s" (caaar opened) | |
4745 | (cadaar opened))))) | |
4746 | (pop opened)) | |
4747 | (caar opened)))) | |
4748 | ||
4749 | (defmacro gnus-method-equal (ss1 ss2) | |
4750 | "Say whether two servers are equal." | |
4751 | `(let ((s1 ,ss1) | |
4752 | (s2 ,ss2)) | |
4753 | (or (equal s1 s2) | |
4754 | (and (= (length s1) (length s2)) | |
4755 | (progn | |
4756 | (while (and s1 (member (car s1) s2)) | |
4757 | (setq s1 (cdr s1))) | |
4758 | (null s1)))))) | |
4759 | ||
4760 | (defun gnus-server-equal (m1 m2) | |
4761 | "Say whether two methods are equal." | |
4762 | (let ((m1 (cond ((null m1) gnus-select-method) | |
4763 | ((stringp m1) (gnus-server-to-method m1)) | |
4764 | (t m1))) | |
4765 | (m2 (cond ((null m2) gnus-select-method) | |
4766 | ((stringp m2) (gnus-server-to-method m2)) | |
4767 | (t m2)))) | |
4768 | (gnus-method-equal m1 m2))) | |
4769 | ||
4770 | (defun gnus-servers-using-backend (backend) | |
4771 | "Return a list of known servers using BACKEND." | |
4772 | (let ((opened gnus-opened-servers) | |
4773 | out) | |
4774 | (while opened | |
4775 | (when (eq backend (caaar opened)) | |
4776 | (push (caar opened) out)) | |
4777 | (pop opened)) | |
4778 | out)) | |
41487370 | 4779 | |
564b670b LMI |
4780 | (defun gnus-archive-server-wanted-p () |
4781 | "Say whether the user wants to use the archive server." | |
4782 | (cond | |
4783 | ((or (not gnus-message-archive-method) | |
4784 | (not gnus-message-archive-group)) | |
4785 | nil) | |
4786 | ((and gnus-message-archive-method gnus-message-archive-group) | |
4787 | t) | |
4788 | (t | |
4789 | (let ((active (cadr (assq 'nnfolder-active-file | |
4790 | gnus-message-archive-method)))) | |
4791 | (and active | |
4792 | (file-exists-p active)))))) | |
4793 | ||
41487370 LMI |
4794 | (defun gnus-group-prefixed-name (group method) |
4795 | "Return the whole name from GROUP and METHOD." | |
4796 | (and (stringp method) (setq method (gnus-server-to-method method))) | |
4797 | (concat (format "%s" (car method)) | |
231f989b LMI |
4798 | (if (and |
4799 | (or (assoc (format "%s" (car method)) | |
4800 | (gnus-methods-using 'address)) | |
4801 | (gnus-server-equal method gnus-message-archive-method)) | |
4802 | (nth 1 method) | |
41487370 LMI |
4803 | (not (string= (nth 1 method) ""))) |
4804 | (concat "+" (nth 1 method))) | |
4805 | ":" group)) | |
4806 | ||
4807 | (defun gnus-group-real-prefix (group) | |
4808 | "Return the prefix of the current group name." | |
4809 | (if (string-match "^[^:]+:" group) | |
4810 | (substring group 0 (match-end 0)) | |
4811 | "")) | |
4812 | ||
231f989b LMI |
4813 | (defun gnus-group-method (group) |
4814 | "Return the server or method used for selecting GROUP." | |
41487370 LMI |
4815 | (let ((prefix (gnus-group-real-prefix group))) |
4816 | (if (equal prefix "") | |
4817 | gnus-select-method | |
231f989b LMI |
4818 | (let ((servers gnus-opened-servers) |
4819 | (server "") | |
4820 | backend possible found) | |
4821 | (if (string-match "^[^\\+]+\\+" prefix) | |
4822 | (setq backend (intern (substring prefix 0 (1- (match-end 0)))) | |
4823 | server (substring prefix (match-end 0) (1- (length prefix)))) | |
4824 | (setq backend (intern (substring prefix 0 (1- (length prefix)))))) | |
4825 | (while servers | |
4826 | (when (eq (caaar servers) backend) | |
4827 | (setq possible (caar servers)) | |
4828 | (when (equal (cadaar servers) server) | |
4829 | (setq found (caar servers)))) | |
4830 | (pop servers)) | |
4831 | (or (car (rassoc found gnus-server-alist)) | |
4832 | found | |
4833 | (car (rassoc possible gnus-server-alist)) | |
4834 | possible | |
4835 | (list backend server)))))) | |
4836 | ||
4837 | (defsubst gnus-secondary-method-p (method) | |
4838 | "Return whether METHOD is a secondary select method." | |
4839 | (let ((methods gnus-secondary-select-methods) | |
4840 | (gmethod (gnus-server-get-method nil method))) | |
4841 | (while (and methods | |
4842 | (not (equal (gnus-server-get-method nil (car methods)) | |
4843 | gmethod))) | |
4844 | (setq methods (cdr methods))) | |
4845 | methods)) | |
41487370 LMI |
4846 | |
4847 | (defun gnus-group-foreign-p (group) | |
231f989b LMI |
4848 | "Say whether a group is foreign or not." |
4849 | (and (not (gnus-group-native-p group)) | |
4850 | (not (gnus-group-secondary-p group)))) | |
4851 | ||
4852 | (defun gnus-group-native-p (group) | |
4853 | "Say whether the group is native or not." | |
4854 | (not (string-match ":" group))) | |
4855 | ||
4856 | (defun gnus-group-secondary-p (group) | |
4857 | "Say whether the group is secondary or not." | |
4858 | (gnus-secondary-method-p (gnus-find-method-for-group group))) | |
4859 | ||
4860 | (defun gnus-group-get-parameter (group &optional symbol) | |
4861 | "Returns the group parameters for GROUP. | |
4862 | If SYMBOL, return the value of that symbol in the group parameters." | |
4863 | (let ((params (gnus-info-params (gnus-get-info group)))) | |
4864 | (if symbol | |
4865 | (gnus-group-parameter-value params symbol) | |
4866 | params))) | |
4867 | ||
4868 | (defun gnus-group-parameter-value (params symbol) | |
4869 | "Return the value of SYMBOL in group PARAMS." | |
4870 | (or (car (memq symbol params)) ; It's either a simple symbol | |
4871 | (cdr (assq symbol params)))) ; or a cons. | |
4872 | ||
4873 | (defun gnus-group-add-parameter (group param) | |
4874 | "Add parameter PARAM to GROUP." | |
4875 | (let ((info (gnus-get-info group))) | |
4876 | (if (not info) | |
4877 | () ; This is a dead group. We just ignore it. | |
4878 | ;; Cons the new param to the old one and update. | |
4879 | (gnus-group-set-info (cons param (gnus-info-params info)) | |
4880 | group 'params)))) | |
4881 | ||
4882 | (defun gnus-group-set-parameter (group name value) | |
4883 | "Set parameter NAME to VALUE in GROUP." | |
4884 | (let ((info (gnus-get-info group))) | |
4885 | (if (not info) | |
4886 | () ; This is a dead group. We just ignore it. | |
4887 | (let ((old-params (gnus-info-params info)) | |
4888 | (new-params (list (cons name value)))) | |
4889 | (while old-params | |
4890 | (if (or (not (listp (car old-params))) | |
4891 | (not (eq (caar old-params) name))) | |
4892 | (setq new-params (append new-params (list (car old-params))))) | |
4893 | (setq old-params (cdr old-params))) | |
4894 | (gnus-group-set-info new-params group 'params))))) | |
4895 | ||
4896 | (defun gnus-group-add-score (group &optional score) | |
4897 | "Add SCORE to the GROUP score. | |
4898 | If SCORE is nil, add 1 to the score of GROUP." | |
4899 | (let ((info (gnus-get-info group))) | |
4900 | (when info | |
4901 | (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) | |
4902 | ||
4903 | (defun gnus-summary-bubble-group () | |
4904 | "Increase the score of the current group. | |
4905 | This is a handy function to add to `gnus-summary-exit-hook' to | |
4906 | increase the score of each group you read." | |
4907 | (gnus-group-add-score gnus-newsgroup-name)) | |
41487370 LMI |
4908 | |
4909 | (defun gnus-group-set-info (info &optional method-only-group part) | |
4910 | (let* ((entry (gnus-gethash | |
231f989b LMI |
4911 | (or method-only-group (gnus-info-group info)) |
4912 | gnus-newsrc-hashtb)) | |
41487370 | 4913 | (part-info info) |
231f989b LMI |
4914 | (info (if method-only-group (nth 2 entry) info)) |
4915 | method) | |
4916 | (when method-only-group | |
4917 | (unless entry | |
4918 | (error "Trying to change non-existent group %s" method-only-group)) | |
b94ae5f7 | 4919 | ;; We have received parts of the actual group info - either the |
231f989b | 4920 | ;; select method or the group parameters. We first check |
41487370 LMI |
4921 | ;; whether we have to extend the info, and if so, do that. |
4922 | (let ((len (length info)) | |
4923 | (total (if (eq part 'method) 5 6))) | |
231f989b LMI |
4924 | (when (< len total) |
4925 | (setcdr (nthcdr (1- len) info) | |
4926 | (make-list (- total len) nil))) | |
41487370 LMI |
4927 | ;; Then we enter the new info. |
4928 | (setcar (nthcdr (1- total) info) part-info))) | |
231f989b | 4929 | (unless entry |
41487370 LMI |
4930 | ;; This is a new group, so we just create it. |
4931 | (save-excursion | |
4932 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
4933 | (setq method (gnus-info-method info)) |
4934 | (when (gnus-server-equal method "native") | |
4935 | (setq method nil)) | |
4936 | (save-excursion | |
4937 | (set-buffer gnus-group-buffer) | |
4938 | (if method | |
4939 | ;; It's a foreign group... | |
4940 | (gnus-group-make-group | |
4941 | (gnus-group-real-name (gnus-info-group info)) | |
4942 | (if (stringp method) method | |
4943 | (prin1-to-string (car method))) | |
4944 | (and (consp method) | |
4945 | (nth 1 (gnus-info-method info)))) | |
4946 | ;; It's a native group. | |
4947 | (gnus-group-make-group (gnus-info-group info)))) | |
41487370 | 4948 | (gnus-message 6 "Note: New group created") |
231f989b LMI |
4949 | (setq entry |
4950 | (gnus-gethash (gnus-group-prefixed-name | |
4951 | (gnus-group-real-name (gnus-info-group info)) | |
4952 | (or (gnus-info-method info) gnus-select-method)) | |
41487370 LMI |
4953 | gnus-newsrc-hashtb)))) |
4954 | ;; Whether it was a new group or not, we now have the entry, so we | |
4955 | ;; can do the update. | |
4956 | (if entry | |
4957 | (progn | |
4958 | (setcar (nthcdr 2 entry) info) | |
231f989b LMI |
4959 | (when (and (not (eq (car entry) t)) |
4960 | (gnus-active (gnus-info-group info))) | |
4961 | (setcar entry (length (gnus-list-of-unread-articles (car info)))))) | |
4962 | (error "No such group: %s" (gnus-info-group info))))) | |
41487370 LMI |
4963 | |
4964 | (defun gnus-group-set-method-info (group select-method) | |
4965 | (gnus-group-set-info select-method group 'method)) | |
4966 | ||
4967 | (defun gnus-group-set-params-info (group params) | |
4968 | (gnus-group-set-info params group 'params)) | |
4969 | ||
4970 | (defun gnus-group-update-group-line () | |
231f989b | 4971 | "Update the current line in the group buffer." |
41487370 LMI |
4972 | (let* ((buffer-read-only nil) |
4973 | (group (gnus-group-group-name)) | |
231f989b LMI |
4974 | (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) |
4975 | gnus-group-indentation) | |
4976 | (when group | |
4977 | (and entry | |
4978 | (not (gnus-ephemeral-group-p group)) | |
4979 | (gnus-dribble-enter | |
4980 | (concat "(gnus-group-set-info '" | |
4981 | (prin1-to-string (nth 2 entry)) ")"))) | |
4982 | (setq gnus-group-indentation (gnus-group-group-indentation)) | |
4983 | (gnus-delete-line) | |
4984 | (gnus-group-insert-group-line-info group) | |
4985 | (forward-line -1) | |
4986 | (gnus-group-position-point)))) | |
41487370 LMI |
4987 | |
4988 | (defun gnus-group-insert-group-line-info (group) | |
231f989b LMI |
4989 | "Insert GROUP on the current line." |
4990 | (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) | |
41487370 LMI |
4991 | active info) |
4992 | (if entry | |
de032aaa | 4993 | (progn |
231f989b | 4994 | ;; (Un)subscribed group. |
41487370 | 4995 | (setq info (nth 2 entry)) |
231f989b LMI |
4996 | (gnus-group-insert-group-line |
4997 | group (gnus-info-level info) (gnus-info-marks info) | |
4998 | (or (car entry) t) (gnus-info-method info))) | |
4999 | ;; This group is dead. | |
5000 | (gnus-group-insert-group-line | |
5001 | group | |
41487370 | 5002 | (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) |
231f989b LMI |
5003 | nil |
5004 | (if (setq active (gnus-active group)) | |
5005 | (- (1+ (cdr active)) (car active)) 0) | |
5006 | nil)))) | |
5007 | ||
5008 | (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level | |
5009 | gnus-tmp-marked number | |
5010 | gnus-tmp-method) | |
5011 | "Insert a group line in the group buffer." | |
5012 | (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) | |
5013 | (gnus-tmp-number-total | |
5014 | (if gnus-tmp-active | |
5015 | (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) | |
5016 | 0)) | |
5017 | (gnus-tmp-number-of-unread | |
41487370 LMI |
5018 | (if (numberp number) (int-to-string (max 0 number)) |
5019 | "*")) | |
231f989b | 5020 | (gnus-tmp-number-of-read |
41487370 | 5021 | (if (numberp number) |
231f989b | 5022 | (int-to-string (max 0 (- gnus-tmp-number-total number))) |
41487370 | 5023 | "*")) |
231f989b LMI |
5024 | (gnus-tmp-subscribed |
5025 | (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) | |
5026 | ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) | |
5027 | ((= gnus-tmp-level gnus-level-zombie) ?Z) | |
5028 | (t ?K))) | |
5029 | (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) | |
5030 | (gnus-tmp-newsgroup-description | |
41487370 | 5031 | (if gnus-description-hashtb |
231f989b | 5032 | (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") |
41487370 | 5033 | "")) |
231f989b LMI |
5034 | (gnus-tmp-moderated |
5035 | (if (member gnus-tmp-group gnus-moderated-list) ?m ? )) | |
5036 | (gnus-tmp-moderated-string | |
5037 | (if (eq gnus-tmp-moderated ?m) "(m)" "")) | |
5038 | (gnus-tmp-method | |
5039 | (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) | |
5040 | (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) | |
5041 | (gnus-tmp-news-method (or (car gnus-tmp-method) "")) | |
5042 | (gnus-tmp-news-method-string | |
5043 | (if gnus-tmp-method | |
5044 | (format "(%s:%s)" (car gnus-tmp-method) | |
5045 | (cadr gnus-tmp-method)) "")) | |
5046 | (gnus-tmp-marked-mark | |
5047 | (if (and (numberp number) | |
5048 | (zerop number) | |
5049 | (cdr (assq 'tick gnus-tmp-marked))) | |
5050 | ?* ? )) | |
5051 | (gnus-tmp-process-marked | |
5052 | (if (member gnus-tmp-group gnus-group-marked) | |
5053 | gnus-process-mark ? )) | |
5054 | (gnus-tmp-grouplens | |
5055 | (or (and gnus-use-grouplens | |
5056 | (bbb-grouplens-group-p gnus-tmp-group)) | |
5057 | "")) | |
41487370 | 5058 | (buffer-read-only nil) |
231f989b | 5059 | header gnus-tmp-header) ; passed as parameter to user-funcs. |
41487370 | 5060 | (beginning-of-line) |
231f989b LMI |
5061 | (gnus-add-text-properties |
5062 | (point) | |
5063 | (prog1 (1+ (point)) | |
5064 | ;; Insert the text. | |
5065 | (eval gnus-group-line-format-spec)) | |
5066 | `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) | |
5067 | gnus-unread ,(if (numberp number) | |
5068 | (string-to-int gnus-tmp-number-of-unread) | |
5069 | t) | |
5070 | gnus-marked ,gnus-tmp-marked-mark | |
5071 | gnus-indentation ,gnus-group-indentation | |
5072 | gnus-level ,gnus-tmp-level)) | |
5073 | (when (inline (gnus-visual-p 'group-highlight 'highlight)) | |
5074 | (forward-line -1) | |
5075 | (run-hooks 'gnus-group-update-hook) | |
5076 | (forward-line)) | |
5077 | ;; Allow XEmacs to remove front-sticky text properties. | |
5078 | (gnus-group-remove-excess-properties))) | |
745bc783 | 5079 | |
b027f415 | 5080 | (defun gnus-group-update-group (group &optional visible-only) |
231f989b LMI |
5081 | "Update all lines where GROUP appear. |
5082 | If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't | |
5083 | already." | |
41487370 LMI |
5084 | (save-excursion |
5085 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
5086 | ;; The buffer may be narrowed. |
5087 | (save-restriction | |
5088 | (widen) | |
5089 | (let ((ident (gnus-intern-safe group gnus-active-hashtb)) | |
5090 | (loc (point-min)) | |
5091 | found buffer-read-only) | |
5092 | ;; Enter the current status into the dribble buffer. | |
5093 | (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) | |
5094 | (if (and entry (not (gnus-ephemeral-group-p group))) | |
5095 | (gnus-dribble-enter | |
5096 | (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) | |
5097 | ")")))) | |
5098 | ;; Find all group instances. If topics are in use, each group | |
5099 | ;; may be listed in more than once. | |
5100 | (while (setq loc (text-property-any | |
5101 | loc (point-max) 'gnus-group ident)) | |
5102 | (setq found t) | |
5103 | (goto-char loc) | |
5104 | (let ((gnus-group-indentation (gnus-group-group-indentation))) | |
5105 | (gnus-delete-line) | |
5106 | (gnus-group-insert-group-line-info group) | |
5107 | (save-excursion | |
5108 | (forward-line -1) | |
5109 | (run-hooks 'gnus-group-update-group-hook))) | |
5110 | (setq loc (1+ loc))) | |
5111 | (unless (or found visible-only) | |
41487370 LMI |
5112 | ;; No such line in the buffer, find out where it's supposed to |
5113 | ;; go, and insert it there (or at the end of the buffer). | |
231f989b LMI |
5114 | (if gnus-goto-missing-group-function |
5115 | (funcall gnus-goto-missing-group-function group) | |
5116 | (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) | |
5117 | (while (and entry (car entry) | |
5118 | (not | |
5119 | (gnus-goto-char | |
5120 | (text-property-any | |
5121 | (point-min) (point-max) | |
5122 | 'gnus-group (gnus-intern-safe | |
5123 | (caar entry) gnus-active-hashtb))))) | |
5124 | (setq entry (cdr entry))) | |
5125 | (or entry (goto-char (point-max))))) | |
5126 | ;; Finally insert the line. | |
5127 | (let ((gnus-group-indentation (gnus-group-group-indentation))) | |
5128 | (gnus-group-insert-group-line-info group) | |
5129 | (save-excursion | |
5130 | (forward-line -1) | |
5131 | (run-hooks 'gnus-group-update-group-hook)))) | |
5132 | (gnus-group-set-mode-line))))) | |
41487370 LMI |
5133 | |
5134 | (defun gnus-group-set-mode-line () | |
231f989b LMI |
5135 | "Update the mode line in the group buffer." |
5136 | (when (memq 'group gnus-updated-mode-lines) | |
5137 | ;; Yes, we want to keep this mode line updated. | |
5138 | (save-excursion | |
5139 | (set-buffer gnus-group-buffer) | |
41487370 LMI |
5140 | (let* ((gformat (or gnus-group-mode-line-format-spec |
5141 | (setq gnus-group-mode-line-format-spec | |
231f989b LMI |
5142 | (gnus-parse-format |
5143 | gnus-group-mode-line-format | |
41487370 | 5144 | gnus-group-mode-line-format-alist)))) |
231f989b LMI |
5145 | (gnus-tmp-news-server (cadr gnus-select-method)) |
5146 | (gnus-tmp-news-method (car gnus-select-method)) | |
5147 | (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) | |
41487370 | 5148 | (max-len 60) |
231f989b LMI |
5149 | gnus-tmp-header ;Dummy binding for user-defined formats |
5150 | ;; Get the resulting string. | |
5151 | (modified | |
5152 | (and gnus-dribble-buffer | |
5153 | (buffer-name gnus-dribble-buffer) | |
5154 | (buffer-modified-p gnus-dribble-buffer) | |
5155 | (save-excursion | |
5156 | (set-buffer gnus-dribble-buffer) | |
5157 | (not (zerop (buffer-size)))))) | |
41487370 | 5158 | (mode-string (eval gformat))) |
231f989b LMI |
5159 | ;; Say whether the dribble buffer has been modified. |
5160 | (setq mode-line-modified | |
5161 | (if modified "---*- " "----- ")) | |
5162 | ;; If the line is too long, we chop it off. | |
5163 | (when (> (length mode-string) max-len) | |
5164 | (setq mode-string (substring mode-string 0 (- max-len 4)))) | |
5165 | (prog1 | |
5166 | (setq mode-line-buffer-identification | |
5167 | (gnus-mode-line-buffer-identification | |
5168 | (list mode-string))) | |
5169 | (set-buffer-modified-p modified)))))) | |
745bc783 | 5170 | |
b027f415 | 5171 | (defun gnus-group-group-name () |
41487370 LMI |
5172 | "Get the name of the newsgroup on the current line." |
5173 | (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) | |
5174 | (and group (symbol-name group)))) | |
5175 | ||
5176 | (defun gnus-group-group-level () | |
5177 | "Get the level of the newsgroup on the current line." | |
5178 | (get-text-property (gnus-point-at-bol) 'gnus-level)) | |
5179 | ||
231f989b LMI |
5180 | (defun gnus-group-group-indentation () |
5181 | "Get the indentation of the newsgroup on the current line." | |
5182 | (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) | |
5183 | (and gnus-group-indentation-function | |
5184 | (funcall gnus-group-indentation-function)) | |
5185 | "")) | |
5186 | ||
41487370 LMI |
5187 | (defun gnus-group-group-unread () |
5188 | "Get the number of unread articles of the newsgroup on the current line." | |
5189 | (get-text-property (gnus-point-at-bol) 'gnus-unread)) | |
5190 | ||
5191 | (defun gnus-group-search-forward (&optional backward all level first-too) | |
5192 | "Find the next newsgroup with unread articles. | |
5193 | If BACKWARD is non-nil, find the previous newsgroup instead. | |
5194 | If ALL is non-nil, just find any newsgroup. | |
5195 | If LEVEL is non-nil, find group with level LEVEL, or higher if no such | |
5196 | group exists. | |
5197 | If FIRST-TOO, the current line is also eligible as a target." | |
5198 | (let ((way (if backward -1 1)) | |
5199 | (low gnus-level-killed) | |
5200 | (beg (point)) | |
5201 | pos found lev) | |
5202 | (if (and backward (progn (beginning-of-line)) (bobp)) | |
5203 | nil | |
5204 | (or first-too (forward-line way)) | |
231f989b | 5205 | (while (and |
41487370 | 5206 | (not (eobp)) |
231f989b LMI |
5207 | (not (setq |
5208 | found | |
41487370 LMI |
5209 | (and (or all |
5210 | (and | |
231f989b | 5211 | (let ((unread |
41487370 | 5212 | (get-text-property (point) 'gnus-unread))) |
231f989b | 5213 | (and (numberp unread) (> unread 0))) |
41487370 LMI |
5214 | (setq lev (get-text-property (point) |
5215 | 'gnus-level)) | |
5216 | (<= lev gnus-level-subscribed))) | |
5217 | (or (not level) | |
5218 | (and (setq lev (get-text-property (point) | |
5219 | 'gnus-level)) | |
5220 | (or (= lev level) | |
5221 | (and (< lev low) | |
5222 | (< level lev) | |
5223 | (progn | |
5224 | (setq low lev) | |
5225 | (setq pos (point)) | |
5226 | nil)))))))) | |
5227 | (zerop (forward-line way))))) | |
231f989b LMI |
5228 | (if found |
5229 | (progn (gnus-group-position-point) t) | |
41487370 LMI |
5230 | (goto-char (or pos beg)) |
5231 | (and pos t)))) | |
5232 | ||
5233 | ;;; Gnus group mode commands | |
5234 | ||
5235 | ;; Group marking. | |
5236 | ||
5237 | (defun gnus-group-mark-group (n &optional unmark no-advance) | |
5238 | "Mark the current group." | |
5239 | (interactive "p") | |
5240 | (let ((buffer-read-only nil) | |
5241 | group) | |
231f989b LMI |
5242 | (while (and (> n 0) |
5243 | (not (eobp))) | |
5244 | (when (setq group (gnus-group-group-name)) | |
5245 | ;; Update the mark. | |
5246 | (beginning-of-line) | |
5247 | (forward-char | |
5248 | (or (cdr (assq 'process gnus-group-mark-positions)) 2)) | |
5249 | (delete-char 1) | |
5250 | (if unmark | |
5251 | (progn | |
5252 | (insert " ") | |
5253 | (setq gnus-group-marked (delete group gnus-group-marked))) | |
5254 | (insert "#") | |
5255 | (setq gnus-group-marked | |
5256 | (cons group (delete group gnus-group-marked))))) | |
5257 | (or no-advance (gnus-group-next-group 1)) | |
5258 | (decf n)) | |
5259 | (gnus-summary-position-point) | |
41487370 LMI |
5260 | n)) |
5261 | ||
5262 | (defun gnus-group-unmark-group (n) | |
5263 | "Remove the mark from the current group." | |
5264 | (interactive "p") | |
231f989b LMI |
5265 | (gnus-group-mark-group n 'unmark) |
5266 | (gnus-group-position-point)) | |
5267 | ||
5268 | (defun gnus-group-unmark-all-groups () | |
5269 | "Unmark all groups." | |
5270 | (interactive) | |
5271 | (let ((groups gnus-group-marked)) | |
5272 | (save-excursion | |
5273 | (while groups | |
5274 | (gnus-group-remove-mark (pop groups))))) | |
5275 | (gnus-group-position-point)) | |
b027f415 | 5276 | |
41487370 LMI |
5277 | (defun gnus-group-mark-region (unmark beg end) |
5278 | "Mark all groups between point and mark. | |
5279 | If UNMARK, remove the mark instead." | |
5280 | (interactive "P\nr") | |
5281 | (let ((num (count-lines beg end))) | |
5282 | (save-excursion | |
5283 | (goto-char beg) | |
5284 | (- num (gnus-group-mark-group num unmark))))) | |
b027f415 | 5285 | |
231f989b LMI |
5286 | (defun gnus-group-mark-buffer (&optional unmark) |
5287 | "Mark all groups in the buffer. | |
5288 | If UNMARK, remove the mark instead." | |
5289 | (interactive "P") | |
5290 | (gnus-group-mark-region unmark (point-min) (point-max))) | |
5291 | ||
5292 | (defun gnus-group-mark-regexp (regexp) | |
5293 | "Mark all groups that match some regexp." | |
5294 | (interactive "sMark (regexp): ") | |
5295 | (let ((alist (cdr gnus-newsrc-alist)) | |
5296 | group) | |
5297 | (while alist | |
5298 | (when (string-match regexp (setq group (gnus-info-group (pop alist)))) | |
5299 | (gnus-group-set-mark group)))) | |
5300 | (gnus-group-position-point)) | |
5301 | ||
41487370 | 5302 | (defun gnus-group-remove-mark (group) |
231f989b LMI |
5303 | "Remove the process mark from GROUP and move point there. |
5304 | Return nil if the group isn't displayed." | |
5305 | (if (gnus-group-goto-group group) | |
5306 | (save-excursion | |
5307 | (gnus-group-mark-group 1 'unmark t) | |
5308 | t) | |
5309 | (setq gnus-group-marked | |
5310 | (delete group gnus-group-marked)) | |
5311 | nil)) | |
5312 | ||
5313 | (defun gnus-group-set-mark (group) | |
5314 | "Set the process mark on GROUP." | |
5315 | (if (gnus-group-goto-group group) | |
5316 | (save-excursion | |
5317 | (gnus-group-mark-group 1 nil t)) | |
5318 | (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) | |
5319 | ||
5320 | (defun gnus-group-universal-argument (arg &optional groups func) | |
5321 | "Perform any command on all groups accoring to the process/prefix convention." | |
5322 | (interactive "P") | |
5323 | (let ((groups (or groups (gnus-group-process-prefix arg))) | |
5324 | group func) | |
5325 | (if (eq (setq func (or func | |
5326 | (key-binding | |
5327 | (read-key-sequence | |
5328 | (substitute-command-keys | |
5329 | "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]"))))) | |
5330 | 'undefined) | |
5331 | (gnus-error 1 "Undefined key") | |
5332 | (while groups | |
5333 | (gnus-group-remove-mark (setq group (pop groups))) | |
5334 | (command-execute func)))) | |
5335 | (gnus-group-position-point)) | |
41487370 | 5336 | |
41487370 | 5337 | (defun gnus-group-process-prefix (n) |
231f989b LMI |
5338 | "Return a list of groups to work on. |
5339 | Take into consideration N (the prefix) and the list of marked groups." | |
5340 | (cond | |
5341 | (n | |
5342 | (setq n (prefix-numeric-value n)) | |
5343 | ;; There is a prefix, so we return a list of the N next | |
5344 | ;; groups. | |
5345 | (let ((way (if (< n 0) -1 1)) | |
5346 | (n (abs n)) | |
5347 | group groups) | |
5348 | (save-excursion | |
5349 | (while (and (> n 0) | |
5350 | (setq group (gnus-group-group-name))) | |
5351 | (setq groups (cons group groups)) | |
5352 | (setq n (1- n)) | |
5353 | (gnus-group-next-group way))) | |
5354 | (nreverse groups))) | |
5355 | ((and (boundp 'transient-mark-mode) | |
5356 | transient-mark-mode | |
5357 | (boundp 'mark-active) | |
5358 | mark-active) | |
5359 | ;; Work on the region between point and mark. | |
5360 | (let ((max (max (point) (mark))) | |
5361 | groups) | |
5362 | (save-excursion | |
5363 | (goto-char (min (point) (mark))) | |
5364 | (while | |
5365 | (and | |
5366 | (push (gnus-group-group-name) groups) | |
5367 | (zerop (gnus-group-next-group 1)) | |
5368 | (< (point) max))) | |
5369 | (nreverse groups)))) | |
5370 | (gnus-group-marked | |
5371 | ;; No prefix, but a list of marked articles. | |
5372 | (reverse gnus-group-marked)) | |
5373 | (t | |
5374 | ;; Neither marked articles or a prefix, so we return the | |
5375 | ;; current group. | |
5376 | (let ((group (gnus-group-group-name))) | |
5377 | (and group (list group)))))) | |
41487370 LMI |
5378 | |
5379 | ;; Selecting groups. | |
5380 | ||
5381 | (defun gnus-group-read-group (&optional all no-article group) | |
5382 | "Read news in this newsgroup. | |
5383 | If the prefix argument ALL is non-nil, already read articles become | |
231f989b LMI |
5384 | readable. IF ALL is a number, fetch this number of articles. If the |
5385 | optional argument NO-ARTICLE is non-nil, no article will be | |
5386 | auto-selected upon group entry. If GROUP is non-nil, fetch that | |
5387 | group." | |
41487370 LMI |
5388 | (interactive "P") |
5389 | (let ((group (or group (gnus-group-group-name))) | |
5390 | number active marked entry) | |
5391 | (or group (error "No group on current line")) | |
231f989b LMI |
5392 | (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash |
5393 | group gnus-newsrc-hashtb))))) | |
5394 | ;; This group might be a dead group. In that case we have to get | |
41487370 | 5395 | ;; the number of unread articles from `gnus-active-hashtb'. |
231f989b LMI |
5396 | (setq number |
5397 | (cond ((numberp all) all) | |
5398 | (entry (car entry)) | |
5399 | ((setq active (gnus-active group)) | |
5400 | (- (1+ (cdr active)) (car active))))) | |
5401 | (gnus-summary-read-group | |
5402 | group (or all (and (numberp number) | |
41487370 LMI |
5403 | (zerop (+ number (length (cdr (assq 'tick marked))) |
5404 | (length (cdr (assq 'dormant marked))))))) | |
5405 | no-article))) | |
5406 | ||
5407 | (defun gnus-group-select-group (&optional all) | |
5408 | "Select this newsgroup. | |
745bc783 | 5409 | No article is selected automatically. |
231f989b LMI |
5410 | If ALL is non-nil, already read articles become readable. |
5411 | If ALL is a number, fetch this number of articles." | |
745bc783 | 5412 | (interactive "P") |
b027f415 | 5413 | (gnus-group-read-group all t)) |
745bc783 | 5414 | |
231f989b LMI |
5415 | (defun gnus-group-quick-select-group (&optional all) |
5416 | "Select the current group \"quickly\". | |
5417 | This means that no highlighting or scoring will be performed." | |
5418 | (interactive "P") | |
5419 | (let (gnus-visual | |
5420 | gnus-score-find-score-files-function | |
5421 | gnus-apply-kill-hook | |
5422 | gnus-summary-expunge-below) | |
5423 | (gnus-group-read-group all t))) | |
5424 | ||
5425 | (defun gnus-group-visible-select-group (&optional all) | |
5426 | "Select the current group without hiding any articles." | |
5427 | (interactive "P") | |
5428 | (let ((gnus-inhibit-limiting t)) | |
5429 | (gnus-group-read-group all t))) | |
5430 | ||
5431 | ;;;###autoload | |
5432 | (defun gnus-fetch-group (group) | |
5433 | "Start Gnus if necessary and enter GROUP. | |
5434 | Returns whether the fetching was successful or not." | |
5435 | (interactive "sGroup name: ") | |
5436 | (or (get-buffer gnus-group-buffer) | |
5437 | (gnus)) | |
5438 | (gnus-group-read-group nil nil group)) | |
41487370 | 5439 | |
231f989b | 5440 | ;; Enter a group that is not in the group buffer. Non-nil is returned |
41487370 | 5441 | ;; if selection was successful. |
231f989b | 5442 | (defun gnus-group-read-ephemeral-group |
41487370 LMI |
5443 | (group method &optional activate quit-config) |
5444 | (let ((group (if (gnus-group-foreign-p group) group | |
5445 | (gnus-group-prefixed-name group method)))) | |
231f989b | 5446 | (gnus-sethash |
41487370 | 5447 | group |
231f989b LMI |
5448 | `(t nil (,group ,gnus-level-default-subscribed nil nil ,method |
5449 | ((quit-config . ,(if quit-config quit-config | |
5450 | (cons (current-buffer) 'summary)))))) | |
41487370 LMI |
5451 | gnus-newsrc-hashtb) |
5452 | (set-buffer gnus-group-buffer) | |
5453 | (or (gnus-check-server method) | |
5454 | (error "Unable to contact server: %s" (gnus-status-message method))) | |
5455 | (if activate (or (gnus-request-group group) | |
5456 | (error "Couldn't request group"))) | |
5457 | (condition-case () | |
5458 | (gnus-group-read-group t t group) | |
5459 | (error nil) | |
231f989b LMI |
5460 | (quit nil)))) |
5461 | ||
b027f415 | 5462 | (defun gnus-group-jump-to-group (group) |
745bc783 | 5463 | "Jump to newsgroup GROUP." |
231f989b LMI |
5464 | (interactive |
5465 | (list (completing-read | |
5466 | "Group: " gnus-active-hashtb nil | |
5467 | (gnus-read-active-file-p) | |
5468 | nil | |
5469 | 'gnus-group-history))) | |
5470 | ||
5471 | (when (equal group "") | |
5472 | (error "Empty group name")) | |
5473 | ||
5474 | (when (string-match "[\000-\032]" group) | |
5475 | (error "Control characters in group: %s" group)) | |
5476 | ||
5477 | (let ((b (text-property-any | |
5478 | (point-min) (point-max) | |
5479 | 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) | |
5480 | (unless (gnus-ephemeral-group-p group) | |
5481 | (if b | |
5482 | ;; Either go to the line in the group buffer... | |
5483 | (goto-char b) | |
5484 | ;; ... or insert the line. | |
5485 | (or | |
5486 | (gnus-active group) | |
5487 | (gnus-activate-group group) | |
5488 | (error "%s error: %s" group (gnus-status-message group))) | |
5489 | ||
5490 | (gnus-group-update-group group) | |
5491 | (goto-char (text-property-any | |
5492 | (point-min) (point-max) | |
5493 | 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) | |
5494 | ;; Adjust cursor point. | |
5495 | (gnus-group-position-point))) | |
41487370 LMI |
5496 | |
5497 | (defun gnus-group-goto-group (group) | |
5498 | "Goto to newsgroup GROUP." | |
231f989b LMI |
5499 | (when group |
5500 | (let ((b (text-property-any (point-min) (point-max) | |
5501 | 'gnus-group (gnus-intern-safe | |
5502 | group gnus-active-hashtb)))) | |
5503 | (and b (goto-char b))))) | |
745bc783 | 5504 | |
b027f415 | 5505 | (defun gnus-group-next-group (n) |
41487370 LMI |
5506 | "Go to next N'th newsgroup. |
5507 | If N is negative, search backward instead. | |
5508 | Returns the difference between N and the number of skips actually | |
5509 | done." | |
745bc783 | 5510 | (interactive "p") |
41487370 LMI |
5511 | (gnus-group-next-unread-group n t)) |
5512 | ||
5513 | (defun gnus-group-next-unread-group (n &optional all level) | |
5514 | "Go to next N'th unread newsgroup. | |
5515 | If N is negative, search backward instead. | |
5516 | If ALL is non-nil, choose any newsgroup, unread or not. | |
5517 | If LEVEL is non-nil, choose the next group with level LEVEL, or, if no | |
5518 | such group can be found, the next group with a level higher than | |
5519 | LEVEL. | |
5520 | Returns the difference between N and the number of skips actually | |
5521 | made." | |
745bc783 | 5522 | (interactive "p") |
41487370 LMI |
5523 | (let ((backward (< n 0)) |
5524 | (n (abs n))) | |
5525 | (while (and (> n 0) | |
231f989b | 5526 | (gnus-group-search-forward |
41487370 LMI |
5527 | backward (or (not gnus-group-goto-unread) all) level)) |
5528 | (setq n (1- n))) | |
5529 | (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") | |
5530 | (if level " on this level or higher" ""))) | |
5531 | n)) | |
745bc783 | 5532 | |
b027f415 | 5533 | (defun gnus-group-prev-group (n) |
41487370 LMI |
5534 | "Go to previous N'th newsgroup. |
5535 | Returns the difference between N and the number of skips actually | |
5536 | done." | |
745bc783 | 5537 | (interactive "p") |
41487370 | 5538 | (gnus-group-next-unread-group (- n) t)) |
745bc783 | 5539 | |
b027f415 | 5540 | (defun gnus-group-prev-unread-group (n) |
41487370 LMI |
5541 | "Go to previous N'th unread newsgroup. |
5542 | Returns the difference between N and the number of skips actually | |
231f989b | 5543 | done." |
745bc783 | 5544 | (interactive "p") |
41487370 | 5545 | (gnus-group-next-unread-group (- n))) |
745bc783 | 5546 | |
41487370 LMI |
5547 | (defun gnus-group-next-unread-group-same-level (n) |
5548 | "Go to next N'th unread newsgroup on the same level. | |
5549 | If N is negative, search backward instead. | |
5550 | Returns the difference between N and the number of skips actually | |
5551 | done." | |
5552 | (interactive "p") | |
5553 | (gnus-group-next-unread-group n t (gnus-group-group-level)) | |
231f989b | 5554 | (gnus-group-position-point)) |
41487370 LMI |
5555 | |
5556 | (defun gnus-group-prev-unread-group-same-level (n) | |
5557 | "Go to next N'th unread newsgroup on the same level. | |
5558 | Returns the difference between N and the number of skips actually | |
5559 | done." | |
5560 | (interactive "p") | |
5561 | (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) | |
231f989b | 5562 | (gnus-group-position-point)) |
41487370 LMI |
5563 | |
5564 | (defun gnus-group-best-unread-group (&optional exclude-group) | |
5565 | "Go to the group with the highest level. | |
5566 | If EXCLUDE-GROUP, do not go to that group." | |
5567 | (interactive) | |
5568 | (goto-char (point-min)) | |
5569 | (let ((best 100000) | |
5570 | unread best-point) | |
231f989b LMI |
5571 | (while (not (eobp)) |
5572 | (setq unread (get-text-property (point) 'gnus-unread)) | |
41487370 LMI |
5573 | (if (and (numberp unread) (> unread 0)) |
5574 | (progn | |
231f989b LMI |
5575 | (if (and (get-text-property (point) 'gnus-level) |
5576 | (< (get-text-property (point) 'gnus-level) best) | |
41487370 LMI |
5577 | (or (not exclude-group) |
5578 | (not (equal exclude-group (gnus-group-group-name))))) | |
231f989b | 5579 | (progn |
41487370 LMI |
5580 | (setq best (get-text-property (point) 'gnus-level)) |
5581 | (setq best-point (point)))))) | |
5582 | (forward-line 1)) | |
5583 | (if best-point (goto-char best-point)) | |
231f989b | 5584 | (gnus-summary-position-point) |
41487370 LMI |
5585 | (and best-point (gnus-group-group-name)))) |
5586 | ||
5587 | (defun gnus-group-first-unread-group () | |
5588 | "Go to the first group with unread articles." | |
5589 | (interactive) | |
5590 | (prog1 | |
5591 | (let ((opoint (point)) | |
5592 | unread) | |
5593 | (goto-char (point-min)) | |
5594 | (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. | |
231f989b LMI |
5595 | (and (numberp unread) ; Not a topic. |
5596 | (not (zerop unread))) ; Has unread articles. | |
41487370 LMI |
5597 | (zerop (gnus-group-next-unread-group 1))) ; Next unread group. |
5598 | (point) ; Success. | |
5599 | (goto-char opoint) | |
5600 | nil)) ; Not success. | |
231f989b | 5601 | (gnus-group-position-point))) |
41487370 LMI |
5602 | |
5603 | (defun gnus-group-enter-server-mode () | |
5604 | "Jump to the server buffer." | |
745bc783 | 5605 | (interactive) |
231f989b | 5606 | (gnus-enter-server-buffer)) |
41487370 LMI |
5607 | |
5608 | (defun gnus-group-make-group (name &optional method address) | |
5609 | "Add a new newsgroup. | |
5610 | The user will be prompted for a NAME, for a select METHOD, and an | |
5611 | ADDRESS." | |
5612 | (interactive | |
231f989b | 5613 | (cons |
41487370 LMI |
5614 | (read-string "Group name: ") |
5615 | (let ((method | |
231f989b | 5616 | (completing-read |
41487370 | 5617 | "Method: " (append gnus-valid-select-methods gnus-server-alist) |
231f989b LMI |
5618 | nil t nil 'gnus-method-history))) |
5619 | (cond ((assoc method gnus-valid-select-methods) | |
5620 | (list method | |
5621 | (if (memq 'prompt-address | |
5622 | (assoc method gnus-valid-select-methods)) | |
5623 | (read-string "Address: ") | |
5624 | ""))) | |
5625 | ((assoc method gnus-server-alist) | |
5626 | (list method)) | |
5627 | (t | |
5628 | (list method "")))))) | |
5629 | ||
5630 | (let* ((meth (and method (if address (list (intern method) address) | |
5631 | method))) | |
41487370 | 5632 | (nname (if method (gnus-group-prefixed-name name meth) name)) |
231f989b LMI |
5633 | backend info) |
5634 | (when (gnus-gethash nname gnus-newsrc-hashtb) | |
5635 | (error "Group %s already exists" nname)) | |
5636 | ;; Subscribe to the new group. | |
5637 | (gnus-group-change-level | |
41487370 | 5638 | (setq info (list t nname gnus-level-default-subscribed nil nil meth)) |
231f989b | 5639 | gnus-level-default-subscribed gnus-level-killed |
41487370 LMI |
5640 | (and (gnus-group-group-name) |
5641 | (gnus-gethash (gnus-group-group-name) | |
5642 | gnus-newsrc-hashtb)) | |
5643 | t) | |
231f989b LMI |
5644 | ;; Make it active. |
5645 | (gnus-set-active nname (cons 1 0)) | |
41487370 | 5646 | (or (gnus-ephemeral-group-p name) |
231f989b | 5647 | (gnus-dribble-enter |
41487370 | 5648 | (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) |
231f989b | 5649 | ;; Insert the line. |
41487370 | 5650 | (gnus-group-insert-group-line-info nname) |
231f989b LMI |
5651 | (forward-line -1) |
5652 | (gnus-group-position-point) | |
5653 | ||
5654 | ;; Load the backend and try to make the backend create | |
5655 | ;; the group as well. | |
5656 | (when (assoc (symbol-name (setq backend (car (gnus-server-get-method | |
5657 | nil meth)))) | |
5658 | gnus-valid-select-methods) | |
5659 | (require backend)) | |
5660 | (gnus-check-server meth) | |
41487370 | 5661 | (and (gnus-check-backend-function 'request-create-group nname) |
231f989b LMI |
5662 | (gnus-request-create-group nname)) |
5663 | t)) | |
5664 | ||
5665 | (defun gnus-group-delete-group (group &optional force) | |
5666 | "Delete the current group. Only meaningful with mail groups. | |
5667 | If FORCE (the prefix) is non-nil, all the articles in the group will | |
5668 | be deleted. This is \"deleted\" as in \"removed forever from the face | |
5669 | of the Earth\". There is no undo. The user will be prompted before | |
5670 | doing the deletion." | |
5671 | (interactive | |
5672 | (list (gnus-group-group-name) | |
5673 | current-prefix-arg)) | |
5674 | (or group (error "No group to rename")) | |
5675 | (or (gnus-check-backend-function 'request-delete-group group) | |
5676 | (error "This backend does not support group deletion")) | |
5677 | (prog1 | |
5678 | (if (not (gnus-yes-or-no-p | |
5679 | (format | |
5680 | "Do you really want to delete %s%s? " | |
5681 | group (if force " and all its contents" "")))) | |
5682 | () ; Whew! | |
5683 | (gnus-message 6 "Deleting group %s..." group) | |
5684 | (if (not (gnus-request-delete-group group force)) | |
5685 | (gnus-error 3 "Couldn't delete group %s" group) | |
5686 | (gnus-message 6 "Deleting group %s...done" group) | |
5687 | (gnus-group-goto-group group) | |
5688 | (gnus-group-kill-group 1 t) | |
5689 | (gnus-sethash group nil gnus-active-hashtb) | |
5690 | t)) | |
5691 | (gnus-group-position-point))) | |
5692 | ||
5693 | (defun gnus-group-rename-group (group new-name) | |
5694 | (interactive | |
5695 | (list | |
5696 | (gnus-group-group-name) | |
5697 | (progn | |
5698 | (or (gnus-check-backend-function | |
5699 | 'request-rename-group (gnus-group-group-name)) | |
5700 | (error "This backend does not support renaming groups")) | |
5701 | (read-string "New group name: ")))) | |
5702 | ||
5703 | (or (gnus-check-backend-function 'request-rename-group group) | |
5704 | (error "This backend does not support renaming groups")) | |
5705 | ||
5706 | (or group (error "No group to rename")) | |
5707 | (and (string-match "^[ \t]*$" new-name) | |
5708 | (error "Not a valid group name")) | |
5709 | ||
5710 | ;; We find the proper prefixed name. | |
5711 | (setq new-name | |
5712 | (gnus-group-prefixed-name | |
5713 | (gnus-group-real-name new-name) | |
5714 | (gnus-info-method (gnus-get-info group)))) | |
5715 | ||
5716 | (gnus-message 6 "Renaming group %s to %s..." group new-name) | |
5717 | (prog1 | |
5718 | (if (not (gnus-request-rename-group group new-name)) | |
5719 | (gnus-error 3 "Couldn't rename group %s to %s" group new-name) | |
5720 | ;; We rename the group internally by killing it... | |
5721 | (gnus-group-goto-group group) | |
5722 | (gnus-group-kill-group) | |
5723 | ;; ... changing its name ... | |
5724 | (setcar (cdar gnus-list-of-killed-groups) new-name) | |
5725 | ;; ... and then yanking it. Magic! | |
5726 | (gnus-group-yank-group) | |
5727 | (gnus-set-active new-name (gnus-active group)) | |
5728 | (gnus-message 6 "Renaming group %s to %s...done" group new-name) | |
5729 | new-name) | |
5730 | (gnus-group-position-point))) | |
41487370 LMI |
5731 | |
5732 | (defun gnus-group-edit-group (group &optional part) | |
5733 | "Edit the group on the current line." | |
5734 | (interactive (list (gnus-group-group-name))) | |
231f989b LMI |
5735 | (let* ((part (or part 'info)) |
5736 | (done-func `(lambda () | |
5737 | "Exit editing mode and update the information." | |
5738 | (interactive) | |
5739 | (gnus-group-edit-group-done ',part ,group))) | |
5740 | (winconf (current-window-configuration)) | |
5741 | info) | |
41487370 | 5742 | (or group (error "No group on current line")) |
231f989b | 5743 | (or (setq info (gnus-get-info group)) |
41487370 LMI |
5744 | (error "Killed group; can't be edited")) |
5745 | (set-buffer (get-buffer-create gnus-group-edit-buffer)) | |
5746 | (gnus-configure-windows 'edit-group) | |
5747 | (gnus-add-current-to-buffer-list) | |
5748 | (emacs-lisp-mode) | |
5749 | ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
5750 | (use-local-map (copy-keymap emacs-lisp-mode-map)) | |
5751 | (local-set-key "\C-c\C-c" done-func) | |
5752 | (make-local-variable 'gnus-prev-winconf) | |
5753 | (setq gnus-prev-winconf winconf) | |
41487370 LMI |
5754 | (erase-buffer) |
5755 | (insert | |
231f989b | 5756 | (cond |
41487370 LMI |
5757 | ((eq part 'method) |
5758 | ";; Type `C-c C-c' after editing the select method.\n\n") | |
5759 | ((eq part 'params) | |
5760 | ";; Type `C-c C-c' after editing the group parameters.\n\n") | |
5761 | ((eq part 'info) | |
5762 | ";; Type `C-c C-c' after editing the group info.\n\n"))) | |
231f989b LMI |
5763 | (insert |
5764 | (pp-to-string | |
5765 | (cond ((eq part 'method) | |
5766 | (or (gnus-info-method info) "native")) | |
5767 | ((eq part 'params) | |
5768 | (gnus-info-params info)) | |
5769 | (t info))) | |
5770 | "\n"))) | |
41487370 LMI |
5771 | |
5772 | (defun gnus-group-edit-group-method (group) | |
5773 | "Edit the select method of GROUP." | |
5774 | (interactive (list (gnus-group-group-name))) | |
5775 | (gnus-group-edit-group group 'method)) | |
5776 | ||
5777 | (defun gnus-group-edit-group-parameters (group) | |
5778 | "Edit the group parameters of GROUP." | |
5779 | (interactive (list (gnus-group-group-name))) | |
5780 | (gnus-group-edit-group group 'params)) | |
5781 | ||
5782 | (defun gnus-group-edit-group-done (part group) | |
5783 | "Get info from buffer, update variables and jump to the group buffer." | |
5784 | (set-buffer (get-buffer-create gnus-group-edit-buffer)) | |
5785 | (goto-char (point-min)) | |
231f989b LMI |
5786 | (let* ((form (read (current-buffer))) |
5787 | (winconf gnus-prev-winconf) | |
5788 | (method (cond ((eq part 'info) (nth 4 form)) | |
5789 | ((eq part 'method) form) | |
5790 | (t nil))) | |
5791 | (info (cond ((eq part 'info) form) | |
5792 | ((eq part 'method) (gnus-get-info group)) | |
5793 | (t nil))) | |
5794 | (new-group (if info | |
5795 | (if (or (not method) | |
5796 | (gnus-server-equal | |
5797 | gnus-select-method method)) | |
5798 | (gnus-group-real-name (car info)) | |
5799 | (gnus-group-prefixed-name | |
5800 | (gnus-group-real-name (car info)) method)) | |
5801 | nil))) | |
5802 | (when (and new-group | |
5803 | (not (equal new-group group))) | |
5804 | (when (gnus-group-goto-group group) | |
5805 | (gnus-group-kill-group 1)) | |
5806 | (gnus-activate-group new-group)) | |
5807 | ;; Set the info. | |
5808 | (if (and info new-group) | |
5809 | (progn | |
5810 | (setq info (gnus-copy-sequence info)) | |
5811 | (setcar info new-group) | |
5812 | (unless (gnus-server-equal method "native") | |
5813 | (unless (nthcdr 3 info) | |
5814 | (nconc info (list nil nil))) | |
5815 | (unless (nthcdr 4 info) | |
5816 | (nconc info (list nil))) | |
5817 | (gnus-info-set-method info method)) | |
5818 | (gnus-group-set-info info)) | |
5819 | (gnus-group-set-info form (or new-group group) part)) | |
41487370 LMI |
5820 | (kill-buffer (current-buffer)) |
5821 | (and winconf (set-window-configuration winconf)) | |
5822 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
5823 | (gnus-group-update-group (or new-group group)) |
5824 | (gnus-group-position-point))) | |
745bc783 | 5825 | |
41487370 LMI |
5826 | (defun gnus-group-make-help-group () |
5827 | "Create the Gnus documentation group." | |
745bc783 | 5828 | (interactive) |
231f989b | 5829 | (let ((path load-path) |
41487370 | 5830 | (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) |
231f989b | 5831 | file dir) |
41487370 LMI |
5832 | (and (gnus-gethash name gnus-newsrc-hashtb) |
5833 | (error "Documentation group already exists")) | |
231f989b LMI |
5834 | (while path |
5835 | (setq dir (file-name-as-directory (expand-file-name (pop path))) | |
5836 | file nil) | |
5837 | (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt"))) | |
5838 | (file-exists-p | |
5839 | (setq file (concat (file-name-directory | |
5840 | (directory-file-name dir)) | |
5841 | "etc/gnus-tut.txt")))) | |
5842 | (setq path nil))) | |
5843 | (if (not file) | |
5844 | (gnus-message 1 "Couldn't find doc group") | |
5845 | (gnus-group-make-group | |
41487370 | 5846 | (gnus-group-real-name name) |
231f989b | 5847 | (list 'nndoc "gnus-help" |
41487370 LMI |
5848 | (list 'nndoc-address file) |
5849 | (list 'nndoc-article-type 'mbox))))) | |
231f989b | 5850 | (gnus-group-position-point)) |
41487370 LMI |
5851 | |
5852 | (defun gnus-group-make-doc-group (file type) | |
5853 | "Create a group that uses a single file as the source." | |
231f989b LMI |
5854 | (interactive |
5855 | (list (read-file-name "File name: ") | |
5856 | (and current-prefix-arg 'ask))) | |
5857 | (when (eq type 'ask) | |
5858 | (let ((err "") | |
5859 | char found) | |
5860 | (while (not found) | |
5861 | (message | |
5862 | "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: " | |
5863 | err) | |
5864 | (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) | |
5865 | ((= char ?b) 'babyl) | |
5866 | ((= char ?d) 'digest) | |
5867 | ((= char ?f) 'forward) | |
5868 | ((= char ?a) 'mmfd) | |
5869 | (t (setq err (format "%c unknown. " char)) | |
5870 | nil)))) | |
5871 | (setq type found))) | |
41487370 LMI |
5872 | (let* ((file (expand-file-name file)) |
5873 | (name (gnus-generate-new-group-name | |
5874 | (gnus-group-prefixed-name | |
5875 | (file-name-nondirectory file) '(nndoc ""))))) | |
231f989b | 5876 | (gnus-group-make-group |
41487370 | 5877 | (gnus-group-real-name name) |
231f989b | 5878 | (list 'nndoc (file-name-nondirectory file) |
41487370 | 5879 | (list 'nndoc-address file) |
231f989b | 5880 | (list 'nndoc-article-type (or type 'guess)))))) |
41487370 LMI |
5881 | |
5882 | (defun gnus-group-make-archive-group (&optional all) | |
5883 | "Create the (ding) Gnus archive group of the most recent articles. | |
5884 | Given a prefix, create a full group." | |
5885 | (interactive "P") | |
231f989b | 5886 | (let ((group (gnus-group-prefixed-name |
41487370 LMI |
5887 | (if all "ding.archives" "ding.recent") '(nndir "")))) |
5888 | (and (gnus-gethash group gnus-newsrc-hashtb) | |
5889 | (error "Archive group already exists")) | |
5890 | (gnus-group-make-group | |
5891 | (gnus-group-real-name group) | |
231f989b LMI |
5892 | (list 'nndir (if all "hpc" "edu") |
5893 | (list 'nndir-directory | |
5894 | (if all gnus-group-archive-directory | |
5895 | gnus-group-recent-archive-directory)))))) | |
41487370 LMI |
5896 | |
5897 | (defun gnus-group-make-directory-group (dir) | |
5898 | "Create an nndir group. | |
231f989b LMI |
5899 | The user will be prompted for a directory. The contents of this |
5900 | directory will be used as a newsgroup. The directory should contain | |
41487370 LMI |
5901 | mail messages or news articles in files that have numeric names." |
5902 | (interactive | |
5903 | (list (read-file-name "Create group from directory: "))) | |
5904 | (or (file-exists-p dir) (error "No such directory")) | |
5905 | (or (file-directory-p dir) (error "Not a directory")) | |
231f989b LMI |
5906 | (let ((ext "") |
5907 | (i 0) | |
5908 | group) | |
5909 | (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) | |
5910 | (setq group | |
5911 | (gnus-group-prefixed-name | |
5912 | (concat (file-name-as-directory (directory-file-name dir)) | |
5913 | ext) | |
5914 | '(nndir ""))) | |
5915 | (setq ext (format "<%d>" (setq i (1+ i))))) | |
5916 | (gnus-group-make-group | |
5917 | (gnus-group-real-name group) | |
5918 | (list 'nndir group (list 'nndir-directory dir))))) | |
41487370 LMI |
5919 | |
5920 | (defun gnus-group-make-kiboze-group (group address scores) | |
5921 | "Create an nnkiboze group. | |
5922 | The user will be prompted for a name, a regexp to match groups, and | |
5923 | score file entries for articles to include in the group." | |
5924 | (interactive | |
5925 | (list | |
5926 | (read-string "nnkiboze group name: ") | |
5927 | (read-string "Source groups (regexp): ") | |
5928 | (let ((headers (mapcar (lambda (group) (list group)) | |
5929 | '("subject" "from" "number" "date" "message-id" | |
231f989b LMI |
5930 | "references" "chars" "lines" "xref" |
5931 | "followup" "all" "body" "head"))) | |
41487370 | 5932 | scores header regexp regexps) |
231f989b | 5933 | (while (not (equal "" (setq header (completing-read |
41487370 LMI |
5934 | "Match on header: " headers nil t)))) |
5935 | (setq regexps nil) | |
231f989b | 5936 | (while (not (equal "" (setq regexp (read-string |
41487370 LMI |
5937 | (format "Match on %s (string): " |
5938 | header))))) | |
5939 | (setq regexps (cons (list regexp nil nil 'r) regexps))) | |
5940 | (setq scores (cons (cons header regexps) scores))) | |
5941 | scores))) | |
5942 | (gnus-group-make-group group "nnkiboze" address) | |
231f989b | 5943 | (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) |
41487370 | 5944 | (let (emacs-lisp-mode-hook) |
231f989b | 5945 | (pp scores (current-buffer))))) |
41487370 LMI |
5946 | |
5947 | (defun gnus-group-add-to-virtual (n vgroup) | |
5948 | "Add the current group to a virtual group." | |
5949 | (interactive | |
5950 | (list current-prefix-arg | |
5951 | (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t | |
5952 | "nnvirtual:"))) | |
5953 | (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) | |
5954 | (error "%s is not an nnvirtual group" vgroup)) | |
5955 | (let* ((groups (gnus-group-process-prefix n)) | |
231f989b | 5956 | (method (gnus-info-method (gnus-get-info vgroup)))) |
41487370 | 5957 | (setcar (cdr method) |
231f989b | 5958 | (concat |
41487370 | 5959 | (nth 1 method) "\\|" |
231f989b LMI |
5960 | (mapconcat |
5961 | (lambda (s) | |
41487370 LMI |
5962 | (gnus-group-remove-mark s) |
5963 | (concat "\\(^" (regexp-quote s) "$\\)")) | |
5964 | groups "\\|")))) | |
231f989b | 5965 | (gnus-group-position-point)) |
41487370 LMI |
5966 | |
5967 | (defun gnus-group-make-empty-virtual (group) | |
5968 | "Create a new, fresh, empty virtual group." | |
5969 | (interactive "sCreate new, empty virtual group: ") | |
5970 | (let* ((method (list 'nnvirtual "^$")) | |
5971 | (pgroup (gnus-group-prefixed-name group method))) | |
5972 | ;; Check whether it exists already. | |
5973 | (and (gnus-gethash pgroup gnus-newsrc-hashtb) | |
5974 | (error "Group %s already exists." pgroup)) | |
5975 | ;; Subscribe the new group after the group on the current line. | |
5976 | (gnus-subscribe-group pgroup (gnus-group-group-name) method) | |
5977 | (gnus-group-update-group pgroup) | |
5978 | (forward-line -1) | |
231f989b | 5979 | (gnus-group-position-point))) |
41487370 LMI |
5980 | |
5981 | (defun gnus-group-enter-directory (dir) | |
5982 | "Enter an ephemeral nneething group." | |
5983 | (interactive "DDirectory to read: ") | |
5984 | (let* ((method (list 'nneething dir)) | |
5985 | (leaf (gnus-group-prefixed-name | |
5986 | (file-name-nondirectory (directory-file-name dir)) | |
5987 | method)) | |
5988 | (name (gnus-generate-new-group-name leaf))) | |
5989 | (let ((nneething-read-only t)) | |
231f989b | 5990 | (or (gnus-group-read-ephemeral-group |
41487370 LMI |
5991 | name method t |
5992 | (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) | |
5993 | 'summary 'group))) | |
5994 | (error "Couldn't enter %s" dir))))) | |
5995 | ||
5996 | ;; Group sorting commands | |
5997 | ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. | |
5998 | ||
231f989b LMI |
5999 | (defun gnus-group-sort-groups (func &optional reverse) |
6000 | "Sort the group buffer according to FUNC. | |
6001 | If REVERSE, reverse the sorting order." | |
6002 | (interactive (list gnus-group-sort-function | |
6003 | current-prefix-arg)) | |
6004 | (let ((func (cond | |
6005 | ((not (listp func)) func) | |
6006 | ((null func) func) | |
6007 | ((= 1 (length func)) (car func)) | |
6008 | (t `(lambda (t1 t2) | |
6009 | ,(gnus-make-sort-function | |
6010 | (reverse func))))))) | |
6011 | ;; We peel off the dummy group from the alist. | |
6012 | (when func | |
6013 | (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") | |
6014 | (pop gnus-newsrc-alist)) | |
6015 | ;; Do the sorting. | |
6016 | (setq gnus-newsrc-alist | |
6017 | (sort gnus-newsrc-alist func)) | |
6018 | (when reverse | |
6019 | (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) | |
6020 | ;; Regenerate the hash table. | |
6021 | (gnus-make-hashtable-from-newsrc-alist) | |
6022 | (gnus-group-list-groups)))) | |
6023 | ||
6024 | (defun gnus-group-sort-groups-by-alphabet (&optional reverse) | |
6025 | "Sort the group buffer alphabetically by group name. | |
6026 | If REVERSE, sort in reverse order." | |
6027 | (interactive "P") | |
6028 | (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) | |
6029 | ||
6030 | (defun gnus-group-sort-groups-by-unread (&optional reverse) | |
6031 | "Sort the group buffer by number of unread articles. | |
6032 | If REVERSE, sort in reverse order." | |
6033 | (interactive "P") | |
6034 | (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) | |
6035 | ||
6036 | (defun gnus-group-sort-groups-by-level (&optional reverse) | |
6037 | "Sort the group buffer by group level. | |
6038 | If REVERSE, sort in reverse order." | |
6039 | (interactive "P") | |
6040 | (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) | |
6041 | ||
6042 | (defun gnus-group-sort-groups-by-score (&optional reverse) | |
6043 | "Sort the group buffer by group score. | |
6044 | If REVERSE, sort in reverse order." | |
6045 | (interactive "P") | |
6046 | (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) | |
6047 | ||
6048 | (defun gnus-group-sort-groups-by-rank (&optional reverse) | |
6049 | "Sort the group buffer by group rank. | |
6050 | If REVERSE, sort in reverse order." | |
6051 | (interactive "P") | |
6052 | (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) | |
6053 | ||
6054 | (defun gnus-group-sort-groups-by-method (&optional reverse) | |
6055 | "Sort the group buffer alphabetically by backend name. | |
6056 | If REVERSE, sort in reverse order." | |
6057 | (interactive "P") | |
6058 | (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) | |
745bc783 | 6059 | |
41487370 | 6060 | (defun gnus-group-sort-by-alphabet (info1 info2) |
231f989b LMI |
6061 | "Sort alphabetically." |
6062 | (string< (gnus-info-group info1) (gnus-info-group info2))) | |
41487370 LMI |
6063 | |
6064 | (defun gnus-group-sort-by-unread (info1 info2) | |
231f989b LMI |
6065 | "Sort by number of unread articles." |
6066 | (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) | |
6067 | (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) | |
41487370 LMI |
6068 | (< (or (and (numberp n1) n1) 0) |
6069 | (or (and (numberp n2) n2) 0)))) | |
6070 | ||
6071 | (defun gnus-group-sort-by-level (info1 info2) | |
231f989b LMI |
6072 | "Sort by level." |
6073 | (< (gnus-info-level info1) (gnus-info-level info2))) | |
6074 | ||
6075 | (defun gnus-group-sort-by-method (info1 info2) | |
6076 | "Sort alphabetically by backend name." | |
6077 | (string< (symbol-name (car (gnus-find-method-for-group | |
6078 | (gnus-info-group info1) info1))) | |
6079 | (symbol-name (car (gnus-find-method-for-group | |
6080 | (gnus-info-group info2) info2))))) | |
6081 | ||
6082 | (defun gnus-group-sort-by-score (info1 info2) | |
6083 | "Sort by group score." | |
6084 | (< (gnus-info-score info1) (gnus-info-score info2))) | |
6085 | ||
6086 | (defun gnus-group-sort-by-rank (info1 info2) | |
6087 | "Sort by level and score." | |
6088 | (let ((level1 (gnus-info-level info1)) | |
6089 | (level2 (gnus-info-level info2))) | |
6090 | (or (< level1 level2) | |
6091 | (and (= level1 level2) | |
6092 | (> (gnus-info-score info1) (gnus-info-score info2)))))) | |
41487370 LMI |
6093 | |
6094 | ;; Group catching up. | |
6095 | ||
231f989b LMI |
6096 | (defun gnus-group-clear-data (n) |
6097 | "Clear all marks and read ranges from the current group." | |
6098 | (interactive "P") | |
6099 | (let ((groups (gnus-group-process-prefix n)) | |
6100 | group info) | |
6101 | (while (setq group (pop groups)) | |
6102 | (setq info (gnus-get-info group)) | |
6103 | (gnus-info-set-read info nil) | |
6104 | (when (gnus-info-marks info) | |
6105 | (gnus-info-set-marks info nil)) | |
6106 | (gnus-get-unread-articles-in-group info (gnus-active group) t) | |
6107 | (when (gnus-group-goto-group group) | |
6108 | (gnus-group-remove-mark group) | |
6109 | (gnus-group-update-group-line))))) | |
6110 | ||
41487370 LMI |
6111 | (defun gnus-group-catchup-current (&optional n all) |
6112 | "Mark all articles not marked as unread in current newsgroup as read. | |
6113 | If prefix argument N is numeric, the ARG next newsgroups will be | |
231f989b LMI |
6114 | caught up. If ALL is non-nil, marked articles will also be marked as |
6115 | read. Cross references (Xref: header) of articles are ignored. | |
41487370 LMI |
6116 | The difference between N and actual number of newsgroups that were |
6117 | caught up is returned." | |
6118 | (interactive "P") | |
231f989b LMI |
6119 | (unless (gnus-group-group-name) |
6120 | (error "No group on the current line")) | |
41487370 LMI |
6121 | (if (not (or (not gnus-interactive-catchup) ;Without confirmation? |
6122 | gnus-expert-user | |
6123 | (gnus-y-or-n-p | |
6124 | (if all | |
6125 | "Do you really want to mark all articles as read? " | |
6126 | "Mark all unread articles as read? ")))) | |
6127 | n | |
6128 | (let ((groups (gnus-group-process-prefix n)) | |
6129 | (ret 0)) | |
6130 | (while groups | |
231f989b | 6131 | ;; Virtual groups have to be given special treatment. |
41487370 LMI |
6132 | (let ((method (gnus-find-method-for-group (car groups)))) |
6133 | (if (eq 'nnvirtual (car method)) | |
6134 | (nnvirtual-catchup-group | |
6135 | (gnus-group-real-name (car groups)) (nth 1 method) all))) | |
6136 | (gnus-group-remove-mark (car groups)) | |
231f989b LMI |
6137 | (if (>= (gnus-group-group-level) gnus-level-zombie) |
6138 | (gnus-message 2 "Dead groups can't be caught up") | |
6139 | (if (prog1 | |
6140 | (gnus-group-goto-group (car groups)) | |
6141 | (gnus-group-catchup (car groups) all)) | |
6142 | (gnus-group-update-group-line) | |
6143 | (setq ret (1+ ret)))) | |
41487370 LMI |
6144 | (setq groups (cdr groups))) |
6145 | (gnus-group-next-unread-group 1) | |
6146 | ret))) | |
6147 | ||
6148 | (defun gnus-group-catchup-current-all (&optional n) | |
6149 | "Mark all articles in current newsgroup as read. | |
6150 | Cross references (Xref: header) of articles are ignored." | |
6151 | (interactive "P") | |
6152 | (gnus-group-catchup-current n 'all)) | |
6153 | ||
6154 | (defun gnus-group-catchup (group &optional all) | |
6155 | "Mark all articles in GROUP as read. | |
6156 | If ALL is non-nil, all articles are marked as read. | |
6157 | The return value is the number of articles that were marked as read, | |
6158 | or nil if no action could be taken." | |
6159 | (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) | |
231f989b LMI |
6160 | (num (car entry))) |
6161 | ;; Do the updating only if the newsgroup isn't killed. | |
41487370 LMI |
6162 | (if (not (numberp (car entry))) |
6163 | (gnus-message 1 "Can't catch up; non-active group") | |
231f989b LMI |
6164 | ;; Do auto-expirable marks if that's required. |
6165 | (when (gnus-group-auto-expirable-p group) | |
6166 | (gnus-add-marked-articles | |
6167 | group 'expire (gnus-list-of-unread-articles group)) | |
6168 | (when all | |
6169 | (let ((marks (nth 3 (nth 2 entry)))) | |
6170 | (gnus-add-marked-articles | |
6171 | group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) | |
6172 | (gnus-add-marked-articles | |
6173 | group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) | |
6174 | (when entry | |
6175 | (gnus-update-read-articles group nil) | |
6176 | ;; Also nix out the lists of marks and dormants. | |
6177 | (when all | |
6178 | (gnus-add-marked-articles group 'tick nil nil 'force) | |
6179 | (gnus-add-marked-articles group 'dormant nil nil 'force)) | |
6180 | (run-hooks 'gnus-group-catchup-group-hook) | |
6181 | num)))) | |
41487370 LMI |
6182 | |
6183 | (defun gnus-group-expire-articles (&optional n) | |
6184 | "Expire all expirable articles in the current newsgroup." | |
6185 | (interactive "P") | |
6186 | (let ((groups (gnus-group-process-prefix n)) | |
6187 | group) | |
231f989b LMI |
6188 | (unless groups |
6189 | (error "No groups to expire")) | |
6190 | (while (setq group (pop groups)) | |
41487370 | 6191 | (gnus-group-remove-mark group) |
231f989b LMI |
6192 | (when (gnus-check-backend-function 'request-expire-articles group) |
6193 | (gnus-message 6 "Expiring articles in %s..." group) | |
6194 | (let* ((info (gnus-get-info group)) | |
6195 | (expirable (if (gnus-group-total-expirable-p group) | |
41487370 | 6196 | (cons nil (gnus-list-of-read-articles group)) |
231f989b LMI |
6197 | (assq 'expire (gnus-info-marks info)))) |
6198 | (expiry-wait (gnus-group-get-parameter group 'expiry-wait))) | |
6199 | (when expirable | |
6200 | (setcdr | |
6201 | expirable | |
6202 | (gnus-compress-sequence | |
6203 | (if expiry-wait | |
6204 | ;; We set the expiry variables to the groupp | |
6205 | ;; parameter. | |
6206 | (let ((nnmail-expiry-wait-function nil) | |
6207 | (nnmail-expiry-wait expiry-wait)) | |
6208 | (gnus-request-expire-articles | |
6209 | (gnus-uncompress-sequence (cdr expirable)) group)) | |
6210 | ;; Just expire using the normal expiry values. | |
6211 | (gnus-request-expire-articles | |
6212 | (gnus-uncompress-sequence (cdr expirable)) group)))) | |
6213 | (gnus-close-group group)) | |
6214 | (gnus-message 6 "Expiring articles in %s...done" group))) | |
6215 | (gnus-group-position-point)))) | |
41487370 LMI |
6216 | |
6217 | (defun gnus-group-expire-all-groups () | |
6218 | "Expire all expirable articles in all newsgroups." | |
6219 | (interactive) | |
6220 | (save-excursion | |
6221 | (gnus-message 5 "Expiring...") | |
231f989b | 6222 | (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) |
41487370 LMI |
6223 | (cdr gnus-newsrc-alist)))) |
6224 | (gnus-group-expire-articles nil))) | |
231f989b | 6225 | (gnus-group-position-point) |
41487370 LMI |
6226 | (gnus-message 5 "Expiring...done")) |
6227 | ||
6228 | (defun gnus-group-set-current-level (n level) | |
6229 | "Set the level of the next N groups to LEVEL." | |
231f989b LMI |
6230 | (interactive |
6231 | (list | |
6232 | current-prefix-arg | |
6233 | (string-to-int | |
6234 | (let ((s (read-string | |
6235 | (format "Level (default %s): " | |
6236 | (or (gnus-group-group-level) | |
6237 | gnus-level-default-subscribed))))) | |
6238 | (if (string-match "^\\s-*$" s) | |
6239 | (int-to-string (or (gnus-group-group-level) | |
6240 | gnus-level-default-subscribed)) | |
6241 | s))))) | |
41487370 LMI |
6242 | (or (and (>= level 1) (<= level gnus-level-killed)) |
6243 | (error "Illegal level: %d" level)) | |
6244 | (let ((groups (gnus-group-process-prefix n)) | |
6245 | group) | |
231f989b | 6246 | (while (setq group (pop groups)) |
41487370 | 6247 | (gnus-group-remove-mark group) |
231f989b LMI |
6248 | (gnus-message 6 "Changed level of %s from %d to %d" |
6249 | group (or (gnus-group-group-level) gnus-level-killed) | |
6250 | level) | |
6251 | (gnus-group-change-level | |
6252 | group level (or (gnus-group-group-level) gnus-level-killed)) | |
41487370 | 6253 | (gnus-group-update-group-line))) |
231f989b | 6254 | (gnus-group-position-point)) |
41487370 LMI |
6255 | |
6256 | (defun gnus-group-unsubscribe-current-group (&optional n) | |
6257 | "Toggle subscription of the current group. | |
6258 | If given numerical prefix, toggle the N next groups." | |
6259 | (interactive "P") | |
6260 | (let ((groups (gnus-group-process-prefix n)) | |
6261 | group) | |
6262 | (while groups | |
6263 | (setq group (car groups) | |
6264 | groups (cdr groups)) | |
6265 | (gnus-group-remove-mark group) | |
6266 | (gnus-group-unsubscribe-group | |
6267 | group (if (<= (gnus-group-group-level) gnus-level-subscribed) | |
6268 | gnus-level-default-unsubscribed | |
231f989b | 6269 | gnus-level-default-subscribed) t) |
41487370 LMI |
6270 | (gnus-group-update-group-line)) |
6271 | (gnus-group-next-group 1))) | |
6272 | ||
231f989b LMI |
6273 | (defun gnus-group-unsubscribe-group (group &optional level silent) |
6274 | "Toggle subscription to GROUP. | |
6275 | Killed newsgroups are subscribed. If SILENT, don't try to update the | |
6276 | group line." | |
745bc783 | 6277 | (interactive |
41487370 | 6278 | (list (completing-read |
231f989b LMI |
6279 | "Group: " gnus-active-hashtb nil |
6280 | (gnus-read-active-file-p) | |
6281 | nil | |
6282 | 'gnus-group-history))) | |
b027f415 | 6283 | (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) |
41487370 LMI |
6284 | (cond |
6285 | ((string-match "^[ \t]$" group) | |
6286 | (error "Empty group name")) | |
6287 | (newsrc | |
6288 | ;; Toggle subscription flag. | |
231f989b LMI |
6289 | (gnus-group-change-level |
6290 | newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) | |
6291 | gnus-level-subscribed) | |
41487370 LMI |
6292 | (1+ gnus-level-subscribed) |
6293 | gnus-level-default-subscribed))) | |
231f989b LMI |
6294 | (unless silent |
6295 | (gnus-group-update-group group))) | |
41487370 | 6296 | ((and (stringp group) |
231f989b LMI |
6297 | (or (not (gnus-read-active-file-p)) |
6298 | (gnus-active group))) | |
41487370 | 6299 | ;; Add new newsgroup. |
231f989b LMI |
6300 | (gnus-group-change-level |
6301 | group | |
6302 | (if level level gnus-level-default-subscribed) | |
6303 | (or (and (member group gnus-zombie-list) | |
6304 | gnus-level-zombie) | |
41487370 LMI |
6305 | gnus-level-killed) |
6306 | (and (gnus-group-group-name) | |
6307 | (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) | |
231f989b LMI |
6308 | (unless silent |
6309 | (gnus-group-update-group group))) | |
41487370 | 6310 | (t (error "No such newsgroup: %s" group))) |
231f989b | 6311 | (gnus-group-position-point))) |
41487370 LMI |
6312 | |
6313 | (defun gnus-group-transpose-groups (n) | |
6314 | "Move the current newsgroup up N places. | |
231f989b LMI |
6315 | If given a negative prefix, move down instead. The difference between |
6316 | N and the number of steps taken is returned." | |
41487370 LMI |
6317 | (interactive "p") |
6318 | (or (gnus-group-group-name) | |
6319 | (error "No group on current line")) | |
6320 | (gnus-group-kill-group 1) | |
6321 | (prog1 | |
6322 | (forward-line (- n)) | |
6323 | (gnus-group-yank-group) | |
231f989b | 6324 | (gnus-group-position-point))) |
41487370 LMI |
6325 | |
6326 | (defun gnus-group-kill-all-zombies () | |
6327 | "Kill all zombie newsgroups." | |
745bc783 | 6328 | (interactive) |
41487370 LMI |
6329 | (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) |
6330 | (setq gnus-zombie-list nil) | |
6331 | (gnus-group-list-groups)) | |
745bc783 | 6332 | |
41487370 LMI |
6333 | (defun gnus-group-kill-region (begin end) |
6334 | "Kill newsgroups in current region (excluding current point). | |
6335 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." | |
6336 | (interactive "r") | |
6337 | (let ((lines | |
6338 | ;; Count lines. | |
6339 | (save-excursion | |
6340 | (count-lines | |
6341 | (progn | |
6342 | (goto-char begin) | |
6343 | (beginning-of-line) | |
6344 | (point)) | |
6345 | (progn | |
6346 | (goto-char end) | |
6347 | (beginning-of-line) | |
6348 | (point)))))) | |
6349 | (goto-char begin) | |
6350 | (beginning-of-line) ;Important when LINES < 1 | |
6351 | (gnus-group-kill-group lines))) | |
6352 | ||
231f989b LMI |
6353 | (defun gnus-group-kill-group (&optional n discard) |
6354 | "Kill the next N groups. | |
41487370 | 6355 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. |
231f989b | 6356 | However, only groups that were alive can be yanked; already killed |
41487370 | 6357 | groups or zombie groups can't be yanked. |
231f989b LMI |
6358 | The return value is the name of the group that was killed, or a list |
6359 | of groups killed." | |
41487370 LMI |
6360 | (interactive "P") |
6361 | (let ((buffer-read-only nil) | |
6362 | (groups (gnus-group-process-prefix n)) | |
231f989b LMI |
6363 | group entry level out) |
6364 | (if (< (length groups) 10) | |
6365 | ;; This is faster when there are few groups. | |
6366 | (while groups | |
6367 | (push (setq group (pop groups)) out) | |
6368 | (gnus-group-remove-mark group) | |
6369 | (setq level (gnus-group-group-level)) | |
6370 | (gnus-delete-line) | |
6371 | (when (and (not discard) | |
6372 | (setq entry (gnus-gethash group gnus-newsrc-hashtb))) | |
6373 | (push (cons (car entry) (nth 2 entry)) | |
6374 | gnus-list-of-killed-groups)) | |
6375 | (gnus-group-change-level | |
6376 | (if entry entry group) gnus-level-killed (if entry nil level))) | |
6377 | ;; If there are lots and lots of groups to be killed, we use | |
6378 | ;; this thing instead. | |
6379 | (let (entry) | |
6380 | (setq groups (nreverse groups)) | |
6381 | (while groups | |
6382 | (gnus-group-remove-mark (setq group (pop groups))) | |
6383 | (gnus-delete-line) | |
6384 | (push group gnus-killed-list) | |
6385 | (setq gnus-newsrc-alist | |
6386 | (delq (assoc group gnus-newsrc-alist) | |
6387 | gnus-newsrc-alist)) | |
6388 | (when gnus-group-change-level-function | |
6389 | (funcall gnus-group-change-level-function group 9 3)) | |
6390 | (cond | |
6391 | ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) | |
6392 | (push (cons (car entry) (nth 2 entry)) | |
6393 | gnus-list-of-killed-groups) | |
6394 | (setcdr (cdr entry) (cdddr entry))) | |
6395 | ((member group gnus-zombie-list) | |
6396 | (setq gnus-zombie-list (delete group gnus-zombie-list))))) | |
6397 | (gnus-make-hashtable-from-newsrc-alist))) | |
6398 | ||
6399 | (gnus-group-position-point) | |
6400 | (if (< (length out) 2) (car out) (nreverse out)))) | |
41487370 LMI |
6401 | |
6402 | (defun gnus-group-yank-group (&optional arg) | |
6403 | "Yank the last newsgroups killed with \\[gnus-group-kill-group], | |
6404 | inserting it before the current newsgroup. The numeric ARG specifies | |
231f989b LMI |
6405 | how many newsgroups are to be yanked. The name of the newsgroup yanked |
6406 | is returned, or (if several groups are yanked) a list of yanked groups | |
6407 | is returned." | |
41487370 | 6408 | (interactive "p") |
231f989b LMI |
6409 | (setq arg (or arg 1)) |
6410 | (let (info group prev out) | |
6411 | (while (>= (decf arg) 0) | |
6412 | (if (not (setq info (pop gnus-list-of-killed-groups))) | |
41487370 | 6413 | (error "No more newsgroups to yank")) |
231f989b | 6414 | (push (setq group (nth 1 info)) out) |
41487370 | 6415 | ;; Find which newsgroup to insert this one before - search |
231f989b | 6416 | ;; backward until something suitable is found. If there are no |
41487370 LMI |
6417 | ;; other newsgroups in this buffer, just make this newsgroup the |
6418 | ;; first newsgroup. | |
6419 | (setq prev (gnus-group-group-name)) | |
231f989b LMI |
6420 | (gnus-group-change-level |
6421 | info (gnus-info-level (cdr info)) gnus-level-killed | |
41487370 LMI |
6422 | (and prev (gnus-gethash prev gnus-newsrc-hashtb)) |
6423 | t) | |
231f989b | 6424 | (gnus-group-insert-group-line-info group)) |
41487370 | 6425 | (forward-line -1) |
231f989b LMI |
6426 | (gnus-group-position-point) |
6427 | (if (< (length out) 2) (car out) (nreverse out)))) | |
6428 | ||
6429 | (defun gnus-group-kill-level (level) | |
6430 | "Kill all groups that is on a certain LEVEL." | |
6431 | (interactive "nKill all groups on level: ") | |
6432 | (cond | |
6433 | ((= level gnus-level-zombie) | |
6434 | (setq gnus-killed-list | |
6435 | (nconc gnus-zombie-list gnus-killed-list)) | |
6436 | (setq gnus-zombie-list nil)) | |
6437 | ((and (< level gnus-level-zombie) | |
6438 | (> level 0) | |
6439 | (or gnus-expert-user | |
6440 | (gnus-yes-or-no-p | |
6441 | (format | |
6442 | "Do you really want to kill all groups on level %d? " | |
6443 | level)))) | |
6444 | (let* ((prev gnus-newsrc-alist) | |
6445 | (alist (cdr prev))) | |
6446 | (while alist | |
564b670b LMI |
6447 | (if (= (gnus-info-level (car alist)) level) |
6448 | (progn | |
6449 | (push (gnus-info-group (car alist)) gnus-killed-list) | |
6450 | (setcdr prev (cdr alist))) | |
231f989b LMI |
6451 | (setq prev alist)) |
6452 | (setq alist (cdr alist))) | |
6453 | (gnus-make-hashtable-from-newsrc-alist) | |
6454 | (gnus-group-list-groups))) | |
6455 | (t | |
6456 | (error "Can't kill; illegal level: %d" level)))) | |
6457 | ||
41487370 LMI |
6458 | (defun gnus-group-list-all-groups (&optional arg) |
6459 | "List all newsgroups with level ARG or lower. | |
6460 | Default is gnus-level-unsubscribed, which lists all subscribed and most | |
6461 | unsubscribed groups." | |
6462 | (interactive "P") | |
6463 | (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) | |
745bc783 | 6464 | |
231f989b LMI |
6465 | ;; Redefine this to list ALL killed groups if prefix arg used. |
6466 | ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). | |
6467 | (defun gnus-group-list-killed (&optional arg) | |
6468 | "List all killed newsgroups in the group buffer. | |
6469 | If ARG is non-nil, list ALL killed groups known to Gnus. This may | |
6470 | entail asking the server for the groups." | |
6471 | (interactive "P") | |
6472 | ;; Find all possible killed newsgroups if arg. | |
6473 | (when arg | |
6474 | (gnus-get-killed-groups)) | |
41487370 LMI |
6475 | (if (not gnus-killed-list) |
6476 | (gnus-message 6 "No killed groups") | |
6477 | (let (gnus-group-list-mode) | |
231f989b | 6478 | (funcall gnus-group-prepare-function |
41487370 LMI |
6479 | gnus-level-killed t gnus-level-killed)) |
6480 | (goto-char (point-min))) | |
231f989b | 6481 | (gnus-group-position-point)) |
41487370 LMI |
6482 | |
6483 | (defun gnus-group-list-zombies () | |
6484 | "List all zombie newsgroups in the group buffer." | |
6485 | (interactive) | |
6486 | (if (not gnus-zombie-list) | |
6487 | (gnus-message 6 "No zombie groups") | |
6488 | (let (gnus-group-list-mode) | |
6489 | (funcall gnus-group-prepare-function | |
6490 | gnus-level-zombie t gnus-level-zombie)) | |
6491 | (goto-char (point-min))) | |
231f989b | 6492 | (gnus-group-position-point)) |
41487370 | 6493 | |
231f989b LMI |
6494 | (defun gnus-group-list-active () |
6495 | "List all groups that are available from the server(s)." | |
6496 | (interactive) | |
6497 | ;; First we make sure that we have really read the active file. | |
6498 | (unless (gnus-read-active-file-p) | |
6499 | (let ((gnus-read-active-file t)) | |
6500 | (gnus-read-active-file))) | |
6501 | ;; Find all groups and sort them. | |
6502 | (let ((groups | |
6503 | (sort | |
6504 | (let (list) | |
6505 | (mapatoms | |
6506 | (lambda (sym) | |
6507 | (and (boundp sym) | |
6508 | (symbol-value sym) | |
6509 | (setq list (cons (symbol-name sym) list)))) | |
6510 | gnus-active-hashtb) | |
6511 | list) | |
6512 | 'string<)) | |
6513 | (buffer-read-only nil)) | |
6514 | (erase-buffer) | |
6515 | (while groups | |
6516 | (gnus-group-insert-group-line-info (pop groups))) | |
6517 | (goto-char (point-min)))) | |
6518 | ||
6519 | (defun gnus-activate-all-groups (level) | |
6520 | "Activate absolutely all groups." | |
6521 | (interactive (list 7)) | |
6522 | (let ((gnus-activate-level level) | |
6523 | (gnus-activate-foreign-newsgroups level)) | |
6524 | (gnus-group-get-new-news))) | |
6525 | ||
6526 | (defun gnus-group-get-new-news (&optional arg) | |
6527 | "Get newly arrived articles. | |
6528 | If ARG is a number, it specifies which levels you are interested in | |
6529 | re-scanning. If ARG is non-nil and not a number, this will force | |
6530 | \"hard\" re-reading of the active files from all servers." | |
41487370 LMI |
6531 | (interactive "P") |
6532 | (run-hooks 'gnus-get-new-news-hook) | |
231f989b LMI |
6533 | ;; We might read in new NoCeM messages here. |
6534 | (when (and gnus-use-nocem | |
6535 | (null arg)) | |
6536 | (gnus-nocem-scan-groups)) | |
6537 | ;; If ARG is not a number, then we read the active file. | |
6538 | (when (and arg (not (numberp arg))) | |
6539 | (let ((gnus-read-active-file t)) | |
6540 | (gnus-read-active-file)) | |
6541 | (setq arg nil)) | |
6542 | ||
41487370 LMI |
6543 | (setq arg (gnus-group-default-level arg t)) |
6544 | (if (and gnus-read-active-file (not arg)) | |
6545 | (progn | |
6546 | (gnus-read-active-file) | |
231f989b | 6547 | (gnus-get-unread-articles arg)) |
41487370 | 6548 | (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) |
231f989b LMI |
6549 | (gnus-get-unread-articles arg))) |
6550 | (run-hooks 'gnus-after-getting-new-news-hook) | |
41487370 LMI |
6551 | (gnus-group-list-groups)) |
6552 | ||
6553 | (defun gnus-group-get-new-news-this-group (&optional n) | |
6554 | "Check for newly arrived news in the current group (and the N-1 next groups). | |
6555 | The difference between N and the number of newsgroup checked is returned. | |
6556 | If N is negative, this group and the N-1 previous groups will be checked." | |
6557 | (interactive "P") | |
6558 | (let* ((groups (gnus-group-process-prefix n)) | |
6559 | (ret (if (numberp n) (- n (length groups)) 0)) | |
231f989b | 6560 | (beg (unless n (point))) |
41487370 | 6561 | group) |
231f989b | 6562 | (while (setq group (pop groups)) |
41487370 | 6563 | (gnus-group-remove-mark group) |
231f989b LMI |
6564 | (if (gnus-activate-group group 'scan) |
6565 | (progn | |
6566 | (gnus-get-unread-articles-in-group | |
6567 | (gnus-get-info group) (gnus-active group) t) | |
6568 | (unless (gnus-virtual-group-p group) | |
6569 | (gnus-close-group group)) | |
6570 | (gnus-group-update-group group)) | |
564b670b LMI |
6571 | (if (eq (gnus-server-status (gnus-find-method-for-group group)) |
6572 | 'denied) | |
6573 | (gnus-error "Server denied access") | |
6574 | (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) | |
231f989b LMI |
6575 | (when beg (goto-char beg)) |
6576 | (when gnus-goto-next-group-when-activating | |
6577 | (gnus-group-next-unread-group 1 t)) | |
6578 | (gnus-summary-position-point) | |
41487370 LMI |
6579 | ret)) |
6580 | ||
231f989b | 6581 | (defun gnus-group-fetch-faq (group &optional faq-dir) |
41487370 | 6582 | "Fetch the FAQ for the current group." |
231f989b LMI |
6583 | (interactive |
6584 | (list | |
6585 | (and (gnus-group-group-name) | |
6586 | (gnus-group-real-name (gnus-group-group-name))) | |
6587 | (cond (current-prefix-arg | |
6588 | (completing-read | |
6589 | "Faq dir: " (and (listp gnus-group-faq-directory) | |
6590 | (mapcar (lambda (file) (list file)) | |
6591 | gnus-group-faq-directory))))))) | |
6592 | (or faq-dir | |
6593 | (setq faq-dir (if (listp gnus-group-faq-directory) | |
6594 | (car gnus-group-faq-directory) | |
6595 | gnus-group-faq-directory))) | |
41487370 | 6596 | (or group (error "No group name given")) |
231f989b LMI |
6597 | (let ((file (concat (file-name-as-directory faq-dir) |
6598 | (gnus-group-real-name group)))) | |
41487370 LMI |
6599 | (if (not (file-exists-p file)) |
6600 | (error "No such file: %s" file) | |
6601 | (find-file file)))) | |
231f989b | 6602 | |
41487370 LMI |
6603 | (defun gnus-group-describe-group (force &optional group) |
6604 | "Display a description of the current newsgroup." | |
6605 | (interactive (list current-prefix-arg (gnus-group-group-name))) | |
564b670b LMI |
6606 | (let* ((method (gnus-find-method-for-group group)) |
6607 | (mname (gnus-group-prefixed-name "" method)) | |
6608 | desc) | |
6609 | (when (and force | |
6610 | gnus-description-hashtb) | |
6611 | (gnus-sethash mname nil gnus-description-hashtb)) | |
41487370 LMI |
6612 | (or group (error "No group name given")) |
6613 | (and (or (and gnus-description-hashtb | |
6614 | ;; We check whether this group's method has been | |
231f989b | 6615 | ;; queried for a description file. |
564b670b | 6616 | (gnus-gethash mname gnus-description-hashtb)) |
41487370 LMI |
6617 | (setq desc (gnus-group-get-description group)) |
6618 | (gnus-read-descriptions-file method)) | |
231f989b | 6619 | (gnus-message 1 |
41487370 LMI |
6620 | (or desc (gnus-gethash group gnus-description-hashtb) |
6621 | "No description available"))))) | |
6622 | ||
6623 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. | |
6624 | (defun gnus-group-describe-all-groups (&optional force) | |
6625 | "Pop up a buffer with descriptions of all newsgroups." | |
6626 | (interactive "P") | |
6627 | (and force (setq gnus-description-hashtb nil)) | |
6628 | (if (not (or gnus-description-hashtb | |
6629 | (gnus-read-all-descriptions-files))) | |
6630 | (error "Couldn't request descriptions file")) | |
6631 | (let ((buffer-read-only nil) | |
6632 | b) | |
6633 | (erase-buffer) | |
6634 | (mapatoms | |
6635 | (lambda (group) | |
6636 | (setq b (point)) | |
6637 | (insert (format " *: %-20s %s\n" (symbol-name group) | |
6638 | (symbol-value group))) | |
231f989b | 6639 | (gnus-add-text-properties |
41487370 LMI |
6640 | b (1+ b) (list 'gnus-group group |
6641 | 'gnus-unread t 'gnus-marked nil | |
6642 | 'gnus-level (1+ gnus-level-subscribed)))) | |
6643 | gnus-description-hashtb) | |
6644 | (goto-char (point-min)) | |
231f989b | 6645 | (gnus-group-position-point))) |
41487370 LMI |
6646 | |
6647 | ;; Suggested by by Daniel Quinlan <quinlan@best.com>. | |
6648 | (defun gnus-group-apropos (regexp &optional search-description) | |
6649 | "List all newsgroups that have names that match a regexp." | |
6650 | (interactive "sGnus apropos (regexp): ") | |
6651 | (let ((prev "") | |
6652 | (obuf (current-buffer)) | |
6653 | groups des) | |
6654 | ;; Go through all newsgroups that are known to Gnus. | |
231f989b | 6655 | (mapatoms |
41487370 LMI |
6656 | (lambda (group) |
6657 | (and (symbol-name group) | |
6658 | (string-match regexp (symbol-name group)) | |
6659 | (setq groups (cons (symbol-name group) groups)))) | |
6660 | gnus-active-hashtb) | |
231f989b LMI |
6661 | ;; Also go through all descriptions that are known to Gnus. |
6662 | (when search-description | |
6663 | (mapatoms | |
6664 | (lambda (group) | |
6665 | (and (string-match regexp (symbol-value group)) | |
6666 | (gnus-active (symbol-name group)) | |
6667 | (setq groups (cons (symbol-name group) groups)))) | |
6668 | gnus-description-hashtb)) | |
41487370 LMI |
6669 | (if (not groups) |
6670 | (gnus-message 3 "No groups matched \"%s\"." regexp) | |
6671 | ;; Print out all the groups. | |
6672 | (save-excursion | |
6673 | (pop-to-buffer "*Gnus Help*") | |
6674 | (buffer-disable-undo (current-buffer)) | |
6675 | (erase-buffer) | |
6676 | (setq groups (sort groups 'string<)) | |
6677 | (while groups | |
6678 | ;; Groups may be entered twice into the list of groups. | |
6679 | (if (not (string= (car groups) prev)) | |
6680 | (progn | |
6681 | (insert (setq prev (car groups)) "\n") | |
6682 | (if (and gnus-description-hashtb | |
231f989b | 6683 | (setq des (gnus-gethash (car groups) |
41487370 LMI |
6684 | gnus-description-hashtb))) |
6685 | (insert " " des "\n")))) | |
6686 | (setq groups (cdr groups))) | |
6687 | (goto-char (point-min)))) | |
6688 | (pop-to-buffer obuf))) | |
6689 | ||
6690 | (defun gnus-group-description-apropos (regexp) | |
6691 | "List all newsgroups that have names or descriptions that match a regexp." | |
6692 | (interactive "sGnus description apropos (regexp): ") | |
6693 | (if (not (or gnus-description-hashtb | |
6694 | (gnus-read-all-descriptions-files))) | |
6695 | (error "Couldn't request descriptions file")) | |
6696 | (gnus-group-apropos regexp t)) | |
6697 | ||
6698 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. | |
231f989b | 6699 | (defun gnus-group-list-matching (level regexp &optional all lowest) |
41487370 LMI |
6700 | "List all groups with unread articles that match REGEXP. |
6701 | If the prefix LEVEL is non-nil, it should be a number that says which | |
231f989b | 6702 | level to cut off listing groups. |
41487370 | 6703 | If ALL, also list groups with no unread articles. |
231f989b LMI |
6704 | If LOWEST, don't list groups with level lower than LOWEST. |
6705 | ||
6706 | This command may read the active file." | |
41487370 | 6707 | (interactive "P\nsList newsgroups matching: ") |
231f989b LMI |
6708 | ;; First make sure active file has been read. |
6709 | (when (and level | |
6710 | (> (prefix-numeric-value level) gnus-level-killed)) | |
6711 | (gnus-get-killed-groups)) | |
41487370 LMI |
6712 | (gnus-group-prepare-flat (or level gnus-level-subscribed) |
6713 | all (or lowest 1) regexp) | |
6714 | (goto-char (point-min)) | |
231f989b | 6715 | (gnus-group-position-point)) |
41487370 | 6716 | |
231f989b | 6717 | (defun gnus-group-list-all-matching (level regexp &optional lowest) |
41487370 LMI |
6718 | "List all groups that match REGEXP. |
6719 | If the prefix LEVEL is non-nil, it should be a number that says which | |
231f989b | 6720 | level to cut off listing groups. |
41487370 LMI |
6721 | If LOWEST, don't list groups with level lower than LOWEST." |
6722 | (interactive "P\nsList newsgroups matching: ") | |
6723 | (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) | |
6724 | ||
6725 | ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. | |
231f989b LMI |
6726 | (defun gnus-group-save-newsrc (&optional force) |
6727 | "Save the Gnus startup files. | |
6728 | If FORCE, force saving whether it is necessary or not." | |
6729 | (interactive "P") | |
6730 | (gnus-save-newsrc-file force)) | |
41487370 LMI |
6731 | |
6732 | (defun gnus-group-restart (&optional arg) | |
6733 | "Force Gnus to read the .newsrc file." | |
6734 | (interactive "P") | |
231f989b LMI |
6735 | (when (gnus-yes-or-no-p |
6736 | (format "Are you sure you want to read %s? " | |
6737 | gnus-current-startup-file)) | |
6738 | (gnus-save-newsrc-file) | |
6739 | (gnus-setup-news 'force) | |
6740 | (gnus-group-list-groups arg))) | |
745bc783 | 6741 | |
41487370 LMI |
6742 | (defun gnus-group-read-init-file () |
6743 | "Read the Gnus elisp init file." | |
745bc783 | 6744 | (interactive) |
41487370 | 6745 | (gnus-read-init-file)) |
745bc783 | 6746 | |
41487370 LMI |
6747 | (defun gnus-group-check-bogus-groups (&optional silent) |
6748 | "Check bogus newsgroups. | |
6749 | If given a prefix, don't ask for confirmation before removing a bogus | |
6750 | group." | |
6751 | (interactive "P") | |
6752 | (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) | |
6753 | (gnus-group-list-groups)) | |
745bc783 | 6754 | |
41487370 LMI |
6755 | (defun gnus-group-edit-global-kill (&optional article group) |
6756 | "Edit the global kill file. | |
6757 | If GROUP, edit that local kill file instead." | |
6758 | (interactive "P") | |
6759 | (setq gnus-current-kill-article article) | |
6760 | (gnus-kill-file-edit-file group) | |
231f989b | 6761 | (gnus-message |
41487370 | 6762 | 6 |
745bc783 | 6763 | (substitute-command-keys |
231f989b LMI |
6764 | (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" |
6765 | (if group "local" "global"))))) | |
745bc783 | 6766 | |
41487370 LMI |
6767 | (defun gnus-group-edit-local-kill (article group) |
6768 | "Edit a local kill file." | |
6769 | (interactive (list nil (gnus-group-group-name))) | |
6770 | (gnus-group-edit-global-kill article group)) | |
745bc783 | 6771 | |
b027f415 | 6772 | (defun gnus-group-force-update () |
ef97d5a2 | 6773 | "Update `.newsrc' file." |
745bc783 JB |
6774 | (interactive) |
6775 | (gnus-save-newsrc-file)) | |
6776 | ||
b027f415 | 6777 | (defun gnus-group-suspend () |
41487370 LMI |
6778 | "Suspend the current Gnus session. |
6779 | In fact, cleanup buffers except for group mode buffer. | |
6780 | The hook gnus-suspend-gnus-hook is called before actually suspending." | |
745bc783 | 6781 | (interactive) |
b027f415 | 6782 | (run-hooks 'gnus-suspend-gnus-hook) |
41487370 | 6783 | ;; Kill Gnus buffers except for group mode buffer. |
231f989b LMI |
6784 | (let* ((group-buf (get-buffer gnus-group-buffer)) |
6785 | ;; Do this on a separate list in case the user does a ^G before we finish | |
6786 | (gnus-buffer-list | |
6787 | (delete group-buf (delete gnus-dribble-buffer | |
6788 | (append gnus-buffer-list nil))))) | |
6789 | (while gnus-buffer-list | |
6790 | (gnus-kill-buffer (pop gnus-buffer-list))) | |
6791 | (gnus-kill-gnus-frames) | |
6792 | (when group-buf | |
6793 | (setq gnus-buffer-list (list group-buf)) | |
6794 | (bury-buffer group-buf) | |
6795 | (delete-windows-on group-buf t)))) | |
41487370 LMI |
6796 | |
6797 | (defun gnus-group-clear-dribble () | |
6798 | "Clear all information from the dribble buffer." | |
6799 | (interactive) | |
231f989b LMI |
6800 | (gnus-dribble-clear) |
6801 | (gnus-message 7 "Cleared dribble buffer")) | |
745bc783 | 6802 | |
b027f415 | 6803 | (defun gnus-group-exit () |
41487370 LMI |
6804 | "Quit reading news after updating .newsrc.eld and .newsrc. |
6805 | The hook `gnus-exit-gnus-hook' is called before actually exiting." | |
745bc783 | 6806 | (interactive) |
231f989b LMI |
6807 | (when |
6808 | (or noninteractive ;For gnus-batch-kill | |
b027f415 | 6809 | (not gnus-interactive-exit) ;Without confirmation |
41487370 LMI |
6810 | gnus-expert-user |
6811 | (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) | |
231f989b LMI |
6812 | (run-hooks 'gnus-exit-gnus-hook) |
6813 | ;; Offer to save data from non-quitted summary buffers. | |
6814 | (gnus-offer-save-summaries) | |
6815 | ;; Save the newsrc file(s). | |
6816 | (gnus-save-newsrc-file) | |
6817 | ;; Kill-em-all. | |
6818 | (gnus-close-backends) | |
6819 | ;; Reset everything. | |
6820 | (gnus-clear-system) | |
6821 | ;; Allow the user to do things after cleaning up. | |
6822 | (run-hooks 'gnus-after-exiting-gnus-hook))) | |
41487370 LMI |
6823 | |
6824 | (defun gnus-close-backends () | |
231f989b | 6825 | ;; Send a close request to all backends that support such a request. |
41487370 LMI |
6826 | (let ((methods gnus-valid-select-methods) |
6827 | func) | |
6828 | (while methods | |
231f989b | 6829 | (if (fboundp (setq func (intern (concat (caar methods) |
41487370 LMI |
6830 | "-request-close")))) |
6831 | (funcall func)) | |
6832 | (setq methods (cdr methods))))) | |
745bc783 | 6833 | |
b027f415 | 6834 | (defun gnus-group-quit () |
41487370 LMI |
6835 | "Quit reading news without updating .newsrc.eld or .newsrc. |
6836 | The hook `gnus-exit-gnus-hook' is called before actually exiting." | |
745bc783 | 6837 | (interactive) |
231f989b LMI |
6838 | (when (or noninteractive ;For gnus-batch-kill |
6839 | (zerop (buffer-size)) | |
6840 | (not (gnus-server-opened gnus-select-method)) | |
6841 | gnus-expert-user | |
6842 | (not gnus-current-startup-file) | |
6843 | (gnus-yes-or-no-p | |
6844 | (format "Quit reading news without saving %s? " | |
6845 | (file-name-nondirectory gnus-current-startup-file)))) | |
6846 | (run-hooks 'gnus-exit-gnus-hook) | |
6847 | (if gnus-use-full-window | |
6848 | (delete-other-windows) | |
6849 | (gnus-remove-some-windows)) | |
6850 | (gnus-dribble-save) | |
6851 | (gnus-close-backends) | |
6852 | (gnus-clear-system) | |
6853 | ;; Allow the user to do things after cleaning up. | |
6854 | (run-hooks 'gnus-after-exiting-gnus-hook))) | |
41487370 LMI |
6855 | |
6856 | (defun gnus-offer-save-summaries () | |
231f989b | 6857 | "Offer to save all active summary buffers." |
41487370 | 6858 | (save-excursion |
231f989b | 6859 | (let ((buflist (buffer-list)) |
41487370 | 6860 | buffers bufname) |
231f989b | 6861 | ;; Go through all buffers and find all summaries. |
41487370 LMI |
6862 | (while buflist |
6863 | (and (setq bufname (buffer-name (car buflist))) | |
6864 | (string-match "Summary" bufname) | |
6865 | (save-excursion | |
6866 | (set-buffer bufname) | |
6867 | ;; We check that this is, indeed, a summary buffer. | |
231f989b LMI |
6868 | (and (eq major-mode 'gnus-summary-mode) |
6869 | ;; Also make sure this isn't bogus. | |
6870 | gnus-newsgroup-prepared)) | |
6871 | (push bufname buffers)) | |
41487370 | 6872 | (setq buflist (cdr buflist))) |
231f989b LMI |
6873 | ;; Go through all these summary buffers and offer to save them. |
6874 | (when buffers | |
6875 | (map-y-or-n-p | |
6876 | "Update summary buffer %s? " | |
6877 | (lambda (buf) (set-buffer buf) (gnus-summary-exit)) | |
6878 | buffers))))) | |
745bc783 | 6879 | |
b027f415 | 6880 | (defun gnus-group-describe-briefly () |
41487370 LMI |
6881 | "Give a one line description of the group mode commands." |
6882 | (interactive) | |
6883 | (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) | |
6884 | ||
6885 | (defun gnus-group-browse-foreign-server (method) | |
6886 | "Browse a foreign news server. | |
6887 | If called interactively, this function will ask for a select method | |
231f989b | 6888 | (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). |
41487370 LMI |
6889 | If not, METHOD should be a list where the first element is the method |
6890 | and the second element is the address." | |
6891 | (interactive | |
231f989b | 6892 | (list (let ((how (completing-read |
41487370 LMI |
6893 | "Which backend: " |
6894 | (append gnus-valid-select-methods gnus-server-alist) | |
231f989b | 6895 | nil t (cons "nntp" 0) 'gnus-method-history))) |
41487370 LMI |
6896 | ;; We either got a backend name or a virtual server name. |
6897 | ;; If the first, we also need an address. | |
6898 | (if (assoc how gnus-valid-select-methods) | |
6899 | (list (intern how) | |
6900 | ;; Suggested by mapjph@bath.ac.uk. | |
231f989b LMI |
6901 | (completing-read |
6902 | "Address: " | |
41487370 LMI |
6903 | (mapcar (lambda (server) (list server)) |
6904 | gnus-secondary-servers))) | |
6905 | ;; We got a server name, so we find the method. | |
6906 | (gnus-server-to-method how))))) | |
6907 | (gnus-browse-foreign-server method)) | |
6908 | ||
6909 | \f | |
745bc783 | 6910 | ;;; |
41487370 | 6911 | ;;; Gnus summary mode |
745bc783 JB |
6912 | ;;; |
6913 | ||
41487370 | 6914 | (defvar gnus-summary-mode-map nil) |
41487370 LMI |
6915 | |
6916 | (put 'gnus-summary-mode 'mode-class 'special) | |
6917 | ||
231f989b | 6918 | (unless gnus-summary-mode-map |
b027f415 RS |
6919 | (setq gnus-summary-mode-map (make-keymap)) |
6920 | (suppress-keymap gnus-summary-mode-map) | |
41487370 LMI |
6921 | |
6922 | ;; Non-orthogonal keys | |
6923 | ||
231f989b LMI |
6924 | (gnus-define-keys gnus-summary-mode-map |
6925 | " " gnus-summary-next-page | |
6926 | "\177" gnus-summary-prev-page | |
6927 | [delete] gnus-summary-prev-page | |
6928 | "\r" gnus-summary-scroll-up | |
6929 | "n" gnus-summary-next-unread-article | |
6930 | "p" gnus-summary-prev-unread-article | |
6931 | "N" gnus-summary-next-article | |
6932 | "P" gnus-summary-prev-article | |
6933 | "\M-\C-n" gnus-summary-next-same-subject | |
6934 | "\M-\C-p" gnus-summary-prev-same-subject | |
6935 | "\M-n" gnus-summary-next-unread-subject | |
6936 | "\M-p" gnus-summary-prev-unread-subject | |
6937 | "." gnus-summary-first-unread-article | |
6938 | "," gnus-summary-best-unread-article | |
6939 | "\M-s" gnus-summary-search-article-forward | |
6940 | "\M-r" gnus-summary-search-article-backward | |
6941 | "<" gnus-summary-beginning-of-article | |
6942 | ">" gnus-summary-end-of-article | |
6943 | "j" gnus-summary-goto-article | |
6944 | "^" gnus-summary-refer-parent-article | |
6945 | "\M-^" gnus-summary-refer-article | |
6946 | "u" gnus-summary-tick-article-forward | |
6947 | "!" gnus-summary-tick-article-forward | |
6948 | "U" gnus-summary-tick-article-backward | |
6949 | "d" gnus-summary-mark-as-read-forward | |
6950 | "D" gnus-summary-mark-as-read-backward | |
6951 | "E" gnus-summary-mark-as-expirable | |
6952 | "\M-u" gnus-summary-clear-mark-forward | |
6953 | "\M-U" gnus-summary-clear-mark-backward | |
6954 | "k" gnus-summary-kill-same-subject-and-select | |
6955 | "\C-k" gnus-summary-kill-same-subject | |
6956 | "\M-\C-k" gnus-summary-kill-thread | |
6957 | "\M-\C-l" gnus-summary-lower-thread | |
6958 | "e" gnus-summary-edit-article | |
6959 | "#" gnus-summary-mark-as-processable | |
6960 | "\M-#" gnus-summary-unmark-as-processable | |
6961 | "\M-\C-t" gnus-summary-toggle-threads | |
6962 | "\M-\C-s" gnus-summary-show-thread | |
6963 | "\M-\C-h" gnus-summary-hide-thread | |
6964 | "\M-\C-f" gnus-summary-next-thread | |
6965 | "\M-\C-b" gnus-summary-prev-thread | |
6966 | "\M-\C-u" gnus-summary-up-thread | |
6967 | "\M-\C-d" gnus-summary-down-thread | |
6968 | "&" gnus-summary-execute-command | |
6969 | "c" gnus-summary-catchup-and-exit | |
6970 | "\C-w" gnus-summary-mark-region-as-read | |
6971 | "\C-t" gnus-summary-toggle-truncation | |
6972 | "?" gnus-summary-mark-as-dormant | |
6973 | "\C-c\M-\C-s" gnus-summary-limit-include-expunged | |
6974 | "\C-c\C-s\C-n" gnus-summary-sort-by-number | |
6975 | "\C-c\C-s\C-a" gnus-summary-sort-by-author | |
6976 | "\C-c\C-s\C-s" gnus-summary-sort-by-subject | |
6977 | "\C-c\C-s\C-d" gnus-summary-sort-by-date | |
6978 | "\C-c\C-s\C-i" gnus-summary-sort-by-score | |
6979 | "=" gnus-summary-expand-window | |
6980 | "\C-x\C-s" gnus-summary-reselect-current-group | |
6981 | "\M-g" gnus-summary-rescan-group | |
6982 | "w" gnus-summary-stop-page-breaking | |
6983 | "\C-c\C-r" gnus-summary-caesar-message | |
6984 | "\M-t" gnus-summary-toggle-mime | |
6985 | "f" gnus-summary-followup | |
6986 | "F" gnus-summary-followup-with-original | |
6987 | "C" gnus-summary-cancel-article | |
6988 | "r" gnus-summary-reply | |
6989 | "R" gnus-summary-reply-with-original | |
6990 | "\C-c\C-f" gnus-summary-mail-forward | |
6991 | "o" gnus-summary-save-article | |
6992 | "\C-o" gnus-summary-save-article-mail | |
6993 | "|" gnus-summary-pipe-output | |
6994 | "\M-k" gnus-summary-edit-local-kill | |
6995 | "\M-K" gnus-summary-edit-global-kill | |
6996 | "V" gnus-version | |
6997 | "\C-c\C-d" gnus-summary-describe-group | |
6998 | "q" gnus-summary-exit | |
6999 | "Q" gnus-summary-exit-no-update | |
7000 | "\C-c\C-i" gnus-info-find-node | |
7001 | gnus-mouse-2 gnus-mouse-pick-article | |
7002 | "m" gnus-summary-mail-other-window | |
7003 | "a" gnus-summary-post-news | |
7004 | "x" gnus-summary-limit-to-unread | |
7005 | "s" gnus-summary-isearch-article | |
7006 | "t" gnus-article-hide-headers | |
7007 | "g" gnus-summary-show-article | |
7008 | "l" gnus-summary-goto-last-article | |
7009 | "\C-c\C-v\C-v" gnus-uu-decode-uu-view | |
7010 | "\C-d" gnus-summary-enter-digest-group | |
7011 | "\C-c\C-b" gnus-bug | |
7012 | "*" gnus-cache-enter-article | |
7013 | "\M-*" gnus-cache-remove-article | |
7014 | "\M-&" gnus-summary-universal-argument | |
7015 | "\C-l" gnus-recenter | |
7016 | "I" gnus-summary-increase-score | |
7017 | "L" gnus-summary-lower-score | |
7018 | ||
7019 | "V" gnus-summary-score-map | |
7020 | "X" gnus-uu-extract-map | |
7021 | "S" gnus-summary-send-map) | |
41487370 LMI |
7022 | |
7023 | ;; Sort of orthogonal keymap | |
231f989b LMI |
7024 | (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) |
7025 | "t" gnus-summary-tick-article-forward | |
7026 | "!" gnus-summary-tick-article-forward | |
7027 | "d" gnus-summary-mark-as-read-forward | |
7028 | "r" gnus-summary-mark-as-read-forward | |
7029 | "c" gnus-summary-clear-mark-forward | |
7030 | " " gnus-summary-clear-mark-forward | |
7031 | "e" gnus-summary-mark-as-expirable | |
7032 | "x" gnus-summary-mark-as-expirable | |
7033 | "?" gnus-summary-mark-as-dormant | |
7034 | "b" gnus-summary-set-bookmark | |
7035 | "B" gnus-summary-remove-bookmark | |
7036 | "#" gnus-summary-mark-as-processable | |
7037 | "\M-#" gnus-summary-unmark-as-processable | |
7038 | "S" gnus-summary-limit-include-expunged | |
7039 | "C" gnus-summary-catchup | |
7040 | "H" gnus-summary-catchup-to-here | |
7041 | "\C-c" gnus-summary-catchup-all | |
7042 | "k" gnus-summary-kill-same-subject-and-select | |
7043 | "K" gnus-summary-kill-same-subject | |
7044 | "P" gnus-uu-mark-map) | |
7045 | ||
7046 | (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map) | |
7047 | "c" gnus-summary-clear-above | |
7048 | "u" gnus-summary-tick-above | |
7049 | "m" gnus-summary-mark-above | |
7050 | "k" gnus-summary-kill-below) | |
7051 | ||
7052 | (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) | |
7053 | "/" gnus-summary-limit-to-subject | |
7054 | "n" gnus-summary-limit-to-articles | |
7055 | "w" gnus-summary-pop-limit | |
7056 | "s" gnus-summary-limit-to-subject | |
7057 | "a" gnus-summary-limit-to-author | |
7058 | "u" gnus-summary-limit-to-unread | |
7059 | "m" gnus-summary-limit-to-marks | |
7060 | "v" gnus-summary-limit-to-score | |
7061 | "D" gnus-summary-limit-include-dormant | |
7062 | "d" gnus-summary-limit-exclude-dormant | |
7063 | ;; "t" gnus-summary-limit-exclude-thread | |
7064 | "E" gnus-summary-limit-include-expunged | |
7065 | "c" gnus-summary-limit-exclude-childless-dormant | |
7066 | "C" gnus-summary-limit-mark-excluded-as-read) | |
7067 | ||
7068 | (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) | |
7069 | "n" gnus-summary-next-unread-article | |
7070 | "p" gnus-summary-prev-unread-article | |
7071 | "N" gnus-summary-next-article | |
7072 | "P" gnus-summary-prev-article | |
7073 | "\C-n" gnus-summary-next-same-subject | |
7074 | "\C-p" gnus-summary-prev-same-subject | |
7075 | "\M-n" gnus-summary-next-unread-subject | |
7076 | "\M-p" gnus-summary-prev-unread-subject | |
7077 | "f" gnus-summary-first-unread-article | |
7078 | "b" gnus-summary-best-unread-article | |
7079 | "j" gnus-summary-goto-article | |
7080 | "g" gnus-summary-goto-subject | |
7081 | "l" gnus-summary-goto-last-article | |
7082 | "p" gnus-summary-pop-article) | |
7083 | ||
7084 | (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) | |
7085 | "k" gnus-summary-kill-thread | |
7086 | "l" gnus-summary-lower-thread | |
7087 | "i" gnus-summary-raise-thread | |
7088 | "T" gnus-summary-toggle-threads | |
7089 | "t" gnus-summary-rethread-current | |
7090 | "^" gnus-summary-reparent-thread | |
7091 | "s" gnus-summary-show-thread | |
7092 | "S" gnus-summary-show-all-threads | |
7093 | "h" gnus-summary-hide-thread | |
7094 | "H" gnus-summary-hide-all-threads | |
7095 | "n" gnus-summary-next-thread | |
7096 | "p" gnus-summary-prev-thread | |
7097 | "u" gnus-summary-up-thread | |
7098 | "o" gnus-summary-top-thread | |
7099 | "d" gnus-summary-down-thread | |
7100 | "#" gnus-uu-mark-thread | |
7101 | "\M-#" gnus-uu-unmark-thread) | |
7102 | ||
7103 | (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) | |
7104 | "c" gnus-summary-catchup-and-exit | |
7105 | "C" gnus-summary-catchup-all-and-exit | |
7106 | "E" gnus-summary-exit-no-update | |
7107 | "Q" gnus-summary-exit | |
7108 | "Z" gnus-summary-exit | |
7109 | "n" gnus-summary-catchup-and-goto-next-group | |
7110 | "R" gnus-summary-reselect-current-group | |
7111 | "G" gnus-summary-rescan-group | |
7112 | "N" gnus-summary-next-group | |
7113 | "P" gnus-summary-prev-group) | |
7114 | ||
7115 | (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) | |
7116 | " " gnus-summary-next-page | |
7117 | "n" gnus-summary-next-page | |
7118 | "\177" gnus-summary-prev-page | |
7119 | [delete] gnus-summary-prev-page | |
7120 | "p" gnus-summary-prev-page | |
7121 | "\r" gnus-summary-scroll-up | |
7122 | "<" gnus-summary-beginning-of-article | |
7123 | ">" gnus-summary-end-of-article | |
7124 | "b" gnus-summary-beginning-of-article | |
7125 | "e" gnus-summary-end-of-article | |
7126 | "^" gnus-summary-refer-parent-article | |
7127 | "r" gnus-summary-refer-parent-article | |
7128 | "R" gnus-summary-refer-references | |
7129 | "g" gnus-summary-show-article | |
7130 | "s" gnus-summary-isearch-article) | |
7131 | ||
7132 | (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) | |
7133 | "b" gnus-article-add-buttons | |
7134 | "B" gnus-article-add-buttons-to-head | |
7135 | "o" gnus-article-treat-overstrike | |
7136 | ;; "w" gnus-article-word-wrap | |
7137 | "w" gnus-article-fill-cited-article | |
7138 | "c" gnus-article-remove-cr | |
7139 | "L" gnus-article-remove-trailing-blank-lines | |
7140 | "q" gnus-article-de-quoted-unreadable | |
7141 | "f" gnus-article-display-x-face | |
7142 | "l" gnus-summary-stop-page-breaking | |
7143 | "r" gnus-summary-caesar-message | |
7144 | "t" gnus-article-hide-headers | |
7145 | "v" gnus-summary-verbose-headers | |
7146 | "m" gnus-summary-toggle-mime) | |
7147 | ||
7148 | (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) | |
7149 | "a" gnus-article-hide | |
7150 | "h" gnus-article-hide-headers | |
7151 | "b" gnus-article-hide-boring-headers | |
7152 | "s" gnus-article-hide-signature | |
7153 | "c" gnus-article-hide-citation | |
7154 | "p" gnus-article-hide-pgp | |
7155 | "\C-c" gnus-article-hide-citation-maybe) | |
7156 | ||
7157 | (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) | |
7158 | "a" gnus-article-highlight | |
7159 | "h" gnus-article-highlight-headers | |
7160 | "c" gnus-article-highlight-citation | |
7161 | "s" gnus-article-highlight-signature) | |
7162 | ||
7163 | (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) | |
7164 | "z" gnus-article-date-ut | |
7165 | "u" gnus-article-date-ut | |
7166 | "l" gnus-article-date-local | |
7167 | "e" gnus-article-date-lapsed | |
7168 | "o" gnus-article-date-original) | |
7169 | ||
7170 | (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) | |
7171 | "v" gnus-version | |
7172 | "f" gnus-summary-fetch-faq | |
7173 | "d" gnus-summary-describe-group | |
7174 | "h" gnus-summary-describe-briefly | |
7175 | "i" gnus-info-find-node) | |
7176 | ||
7177 | (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) | |
7178 | "e" gnus-summary-expire-articles | |
7179 | "\M-\C-e" gnus-summary-expire-articles-now | |
7180 | "\177" gnus-summary-delete-article | |
7181 | [delete] gnus-summary-delete-article | |
7182 | "m" gnus-summary-move-article | |
7183 | "r" gnus-summary-respool-article | |
7184 | "w" gnus-summary-edit-article | |
7185 | "c" gnus-summary-copy-article | |
7186 | "B" gnus-summary-crosspost-article | |
7187 | "q" gnus-summary-respool-query | |
7188 | "i" gnus-summary-import-article) | |
7189 | ||
7190 | (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) | |
7191 | "o" gnus-summary-save-article | |
7192 | "m" gnus-summary-save-article-mail | |
7193 | "r" gnus-summary-save-article-rmail | |
7194 | "f" gnus-summary-save-article-file | |
7195 | "b" gnus-summary-save-article-body-file | |
7196 | "h" gnus-summary-save-article-folder | |
7197 | "v" gnus-summary-save-article-vm | |
7198 | "p" gnus-summary-pipe-output | |
7199 | "s" gnus-soup-add-article) | |
ef97d5a2 | 7200 | ) |
41487370 | 7201 | |
ef97d5a2 | 7202 | \f |
b027f415 | 7203 | |
41487370 LMI |
7204 | (defun gnus-summary-mode (&optional group) |
7205 | "Major mode for reading articles. | |
7206 | ||
7207 | All normal editing commands are switched off. | |
7208 | \\<gnus-summary-mode-map> | |
7209 | Each line in this buffer represents one article. To read an | |
7210 | article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards | |
231f989b | 7211 | and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', |
41487370 LMI |
7212 | respectively. |
7213 | ||
231f989b LMI |
7214 | You can also post articles and send mail from this buffer. To |
7215 | follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author | |
41487370 LMI |
7216 | of an article, type `\\[gnus-summary-reply]'. |
7217 | ||
231f989b LMI |
7218 | There are approx. one gazillion commands you can execute in this |
7219 | buffer; read the info pages for more information (`\\[gnus-info-find-node]'). | |
41487370 LMI |
7220 | |
7221 | The following commands are available: | |
7222 | ||
7223 | \\{gnus-summary-mode-map}" | |
745bc783 | 7224 | (interactive) |
231f989b LMI |
7225 | (when (and menu-bar-mode |
7226 | (gnus-visual-p 'summary-menu 'menu)) | |
7227 | (gnus-summary-make-menu-bar)) | |
745bc783 | 7228 | (kill-all-local-variables) |
231f989b | 7229 | (gnus-summary-make-local-variables) |
41487370 | 7230 | (gnus-make-thread-indent-array) |
a828a776 | 7231 | (gnus-simplify-mode-line) |
b027f415 RS |
7232 | (setq major-mode 'gnus-summary-mode) |
7233 | (setq mode-name "Summary") | |
745bc783 | 7234 | (make-local-variable 'minor-mode-alist) |
b027f415 | 7235 | (use-local-map gnus-summary-mode-map) |
41487370 | 7236 | (buffer-disable-undo (current-buffer)) |
745bc783 | 7237 | (setq buffer-read-only t) ;Disable modification |
41487370 | 7238 | (setq truncate-lines t) |
745bc783 JB |
7239 | (setq selective-display t) |
7240 | (setq selective-display-ellipses t) ;Display `...' | |
41487370 LMI |
7241 | (setq buffer-display-table gnus-summary-display-table) |
7242 | (setq gnus-newsgroup-name group) | |
231f989b LMI |
7243 | (make-local-variable 'gnus-summary-line-format) |
7244 | (make-local-variable 'gnus-summary-line-format-spec) | |
7245 | (make-local-variable 'gnus-summary-mark-positions) | |
564b670b LMI |
7246 | (gnus-make-local-hook 'post-command-hook) |
7247 | (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) | |
b027f415 RS |
7248 | (run-hooks 'gnus-summary-mode-hook)) |
7249 | ||
231f989b LMI |
7250 | (defun gnus-summary-make-local-variables () |
7251 | "Make all the local summary buffer variables." | |
7252 | (let ((locals gnus-summary-local-variables) | |
7253 | global local) | |
7254 | (while (setq local (pop locals)) | |
7255 | (if (consp local) | |
7256 | (progn | |
7257 | (if (eq (cdr local) 'global) | |
7258 | ;; Copy the global value of the variable. | |
7259 | (setq global (symbol-value (car local))) | |
7260 | ;; Use the value from the list. | |
7261 | (setq global (eval (cdr local)))) | |
7262 | (make-local-variable (car local)) | |
7263 | (set (car local) global)) | |
7264 | ;; Simple nil-valued local variable. | |
7265 | (make-local-variable local) | |
7266 | (set local nil))))) | |
7267 | ||
41487370 | 7268 | (defun gnus-summary-make-display-table () |
231f989b | 7269 | ;; Change the display table. Odd characters have a tendency to mess |
41487370 LMI |
7270 | ;; up nicely formatted displays - we make all possible glyphs |
7271 | ;; display only a single character. | |
7272 | ||
7273 | ;; We start from the standard display table, if any. | |
231f989b | 7274 | (setq gnus-summary-display-table |
41487370 LMI |
7275 | (or (copy-sequence standard-display-table) |
7276 | (make-display-table))) | |
7277 | ;; Nix out all the control chars... | |
7278 | (let ((i 32)) | |
7279 | (while (>= (setq i (1- i)) 0) | |
7280 | (aset gnus-summary-display-table i [??]))) | |
7281 | ;; ... but not newline and cr, of course. (cr is necessary for the | |
231f989b | 7282 | ;; selective display). |
41487370 LMI |
7283 | (aset gnus-summary-display-table ?\n nil) |
7284 | (aset gnus-summary-display-table ?\r nil) | |
231f989b | 7285 | ;; We nix out any glyphs over 126 that are not set already. |
41487370 LMI |
7286 | (let ((i 256)) |
7287 | (while (>= (setq i (1- i)) 127) | |
7288 | ;; Only modify if the entry is nil. | |
231f989b | 7289 | (or (aref gnus-summary-display-table i) |
41487370 LMI |
7290 | (aset gnus-summary-display-table i [??]))))) |
7291 | ||
7292 | (defun gnus-summary-clear-local-variables () | |
7293 | (let ((locals gnus-summary-local-variables)) | |
7294 | (while locals | |
7295 | (if (consp (car locals)) | |
231f989b LMI |
7296 | (and (vectorp (caar locals)) |
7297 | (set (caar locals) nil)) | |
41487370 LMI |
7298 | (and (vectorp (car locals)) |
7299 | (set (car locals) nil))) | |
7300 | (setq locals (cdr locals))))) | |
7301 | ||
231f989b LMI |
7302 | ;; Summary data functions. |
7303 | ||
7304 | (defmacro gnus-data-number (data) | |
7305 | `(car ,data)) | |
7306 | ||
7307 | (defmacro gnus-data-set-number (data number) | |
7308 | `(setcar ,data ,number)) | |
7309 | ||
7310 | (defmacro gnus-data-mark (data) | |
7311 | `(nth 1 ,data)) | |
7312 | ||
7313 | (defmacro gnus-data-set-mark (data mark) | |
7314 | `(setcar (nthcdr 1 ,data) ,mark)) | |
7315 | ||
7316 | (defmacro gnus-data-pos (data) | |
7317 | `(nth 2 ,data)) | |
7318 | ||
7319 | (defmacro gnus-data-set-pos (data pos) | |
7320 | `(setcar (nthcdr 2 ,data) ,pos)) | |
7321 | ||
7322 | (defmacro gnus-data-header (data) | |
7323 | `(nth 3 ,data)) | |
7324 | ||
7325 | (defmacro gnus-data-level (data) | |
7326 | `(nth 4 ,data)) | |
7327 | ||
7328 | (defmacro gnus-data-unread-p (data) | |
7329 | `(= (nth 1 ,data) gnus-unread-mark)) | |
7330 | ||
7331 | (defmacro gnus-data-pseudo-p (data) | |
7332 | `(consp (nth 3 ,data))) | |
7333 | ||
7334 | (defmacro gnus-data-find (number) | |
7335 | `(assq ,number gnus-newsgroup-data)) | |
7336 | ||
7337 | (defmacro gnus-data-find-list (number &optional data) | |
7338 | `(let ((bdata ,(or data 'gnus-newsgroup-data))) | |
7339 | (memq (assq ,number bdata) | |
7340 | bdata))) | |
7341 | ||
7342 | (defmacro gnus-data-make (number mark pos header level) | |
7343 | `(list ,number ,mark ,pos ,header ,level)) | |
7344 | ||
7345 | (defun gnus-data-enter (after-article number mark pos header level offset) | |
7346 | (let ((data (gnus-data-find-list after-article))) | |
7347 | (or data (error "No such article: %d" after-article)) | |
7348 | (setcdr data (cons (gnus-data-make number mark pos header level) | |
7349 | (cdr data))) | |
7350 | (setq gnus-newsgroup-data-reverse nil) | |
7351 | (gnus-data-update-list (cddr data) offset))) | |
7352 | ||
7353 | (defun gnus-data-enter-list (after-article list &optional offset) | |
7354 | (when list | |
7355 | (let ((data (and after-article (gnus-data-find-list after-article))) | |
7356 | (ilist list)) | |
7357 | (or data (not after-article) (error "No such article: %d" after-article)) | |
7358 | ;; Find the last element in the list to be spliced into the main | |
7359 | ;; list. | |
7360 | (while (cdr list) | |
7361 | (setq list (cdr list))) | |
7362 | (if (not data) | |
7363 | (progn | |
7364 | (setcdr list gnus-newsgroup-data) | |
7365 | (setq gnus-newsgroup-data ilist) | |
7366 | (and offset (gnus-data-update-list (cdr list) offset))) | |
7367 | (setcdr list (cdr data)) | |
7368 | (setcdr data ilist) | |
7369 | (and offset (gnus-data-update-list (cdr data) offset))) | |
7370 | (setq gnus-newsgroup-data-reverse nil)))) | |
7371 | ||
7372 | (defun gnus-data-remove (article &optional offset) | |
7373 | (let ((data gnus-newsgroup-data)) | |
7374 | (if (= (gnus-data-number (car data)) article) | |
7375 | (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) | |
7376 | gnus-newsgroup-data-reverse nil) | |
7377 | (while (cdr data) | |
7378 | (and (= (gnus-data-number (cadr data)) article) | |
7379 | (progn | |
7380 | (setcdr data (cddr data)) | |
7381 | (and offset (gnus-data-update-list (cdr data) offset)) | |
7382 | (setq data nil | |
7383 | gnus-newsgroup-data-reverse nil))) | |
7384 | (setq data (cdr data)))))) | |
7385 | ||
7386 | (defmacro gnus-data-list (backward) | |
7387 | `(if ,backward | |
7388 | (or gnus-newsgroup-data-reverse | |
7389 | (setq gnus-newsgroup-data-reverse | |
7390 | (reverse gnus-newsgroup-data))) | |
7391 | gnus-newsgroup-data)) | |
7392 | ||
7393 | (defun gnus-data-update-list (data offset) | |
7394 | "Add OFFSET to the POS of all data entries in DATA." | |
7395 | (while data | |
7396 | (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) | |
7397 | (setq data (cdr data)))) | |
7398 | ||
7399 | (defun gnus-data-compute-positions () | |
7400 | "Compute the positions of all articles." | |
7401 | (let ((data gnus-newsgroup-data) | |
7402 | pos) | |
7403 | (while data | |
7404 | (when (setq pos (text-property-any | |
7405 | (point-min) (point-max) | |
7406 | 'gnus-number (gnus-data-number (car data)))) | |
7407 | (gnus-data-set-pos (car data) (+ pos 3))) | |
7408 | (setq data (cdr data))))) | |
7409 | ||
7410 | (defun gnus-summary-article-pseudo-p (article) | |
7411 | "Say whether this article is a pseudo article or not." | |
7412 | (not (vectorp (gnus-data-header (gnus-data-find article))))) | |
7413 | ||
7414 | (defun gnus-article-parent-p (number) | |
7415 | "Say whether this article is a parent or not." | |
7416 | (let ((data (gnus-data-find-list number))) | |
7417 | (and (cdr data) ; There has to be an article after... | |
7418 | (< (gnus-data-level (car data)) ; And it has to have a higher level. | |
7419 | (gnus-data-level (nth 1 data)))))) | |
7420 | ||
7421 | (defun gnus-article-children (number) | |
7422 | "Return a list of all children to NUMBER." | |
7423 | (let* ((data (gnus-data-find-list number)) | |
7424 | (level (gnus-data-level (car data))) | |
7425 | children) | |
7426 | (setq data (cdr data)) | |
7427 | (while (and data | |
7428 | (= (gnus-data-level (car data)) (1+ level))) | |
7429 | (push (gnus-data-number (car data)) children) | |
7430 | (setq data (cdr data))) | |
7431 | children)) | |
7432 | ||
7433 | (defmacro gnus-summary-skip-intangible () | |
7434 | "If the current article is intangible, then jump to a different article." | |
7435 | '(let ((to (get-text-property (point) 'gnus-intangible))) | |
7436 | (and to (gnus-summary-goto-subject to)))) | |
7437 | ||
7438 | (defmacro gnus-summary-article-intangible-p () | |
7439 | "Say whether this article is intangible or not." | |
7440 | '(get-text-property (point) 'gnus-intangible)) | |
7441 | ||
41487370 LMI |
7442 | ;; Some summary mode macros. |
7443 | ||
231f989b | 7444 | (defmacro gnus-summary-article-number () |
41487370 LMI |
7445 | "The article number of the article on the current line. |
7446 | If there isn's an article number here, then we return the current | |
7447 | article number." | |
231f989b LMI |
7448 | '(progn |
7449 | (gnus-summary-skip-intangible) | |
7450 | (or (get-text-property (point) 'gnus-number) | |
7451 | (gnus-summary-last-subject)))) | |
7452 | ||
7453 | (defmacro gnus-summary-article-header (&optional number) | |
7454 | `(gnus-data-header (gnus-data-find | |
7455 | ,(or number '(gnus-summary-article-number))))) | |
7456 | ||
7457 | (defmacro gnus-summary-thread-level (&optional number) | |
7458 | `(if (and (eq gnus-summary-make-false-root 'dummy) | |
7459 | (get-text-property (point) 'gnus-intangible)) | |
7460 | 0 | |
7461 | (gnus-data-level (gnus-data-find | |
7462 | ,(or number '(gnus-summary-article-number)))))) | |
7463 | ||
7464 | (defmacro gnus-summary-article-mark (&optional number) | |
7465 | `(gnus-data-mark (gnus-data-find | |
7466 | ,(or number '(gnus-summary-article-number))))) | |
7467 | ||
7468 | (defmacro gnus-summary-article-pos (&optional number) | |
7469 | `(gnus-data-pos (gnus-data-find | |
7470 | ,(or number '(gnus-summary-article-number))))) | |
7471 | ||
7472 | (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) | |
7473 | (defmacro gnus-summary-article-subject (&optional number) | |
745bc783 | 7474 | "Return current subject string or nil if nothing." |
231f989b LMI |
7475 | `(let ((headers |
7476 | ,(if number | |
7477 | `(gnus-data-header (assq ,number gnus-newsgroup-data)) | |
7478 | '(gnus-data-header (assq (gnus-summary-article-number) | |
7479 | gnus-newsgroup-data))))) | |
7480 | (and headers | |
7481 | (vectorp headers) | |
7482 | (mail-header-subject headers)))) | |
7483 | ||
7484 | (defmacro gnus-summary-article-score (&optional number) | |
7485 | "Return current article score." | |
7486 | `(or (cdr (assq ,(or number '(gnus-summary-article-number)) | |
7487 | gnus-newsgroup-scored)) | |
7488 | gnus-summary-default-score 0)) | |
7489 | ||
7490 | (defun gnus-summary-article-children (&optional number) | |
7491 | (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) | |
7492 | (level (gnus-data-level (car data))) | |
7493 | l children) | |
7494 | (while (and (setq data (cdr data)) | |
7495 | (> (setq l (gnus-data-level (car data))) level)) | |
7496 | (and (= (1+ level) l) | |
7497 | (setq children (cons (gnus-data-number (car data)) | |
7498 | children)))) | |
7499 | (nreverse children))) | |
7500 | ||
7501 | (defun gnus-summary-article-parent (&optional number) | |
7502 | (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) | |
7503 | (gnus-data-list t))) | |
7504 | (level (gnus-data-level (car data)))) | |
7505 | (if (zerop level) | |
7506 | () ; This is a root. | |
7507 | ;; We search until we find an article with a level less than | |
7508 | ;; this one. That function has to be the parent. | |
7509 | (while (and (setq data (cdr data)) | |
7510 | (not (< (gnus-data-level (car data)) level)))) | |
7511 | (and data (gnus-data-number (car data)))))) | |
7512 | ||
7513 | (defun gnus-unread-mark-p (mark) | |
7514 | "Say whether MARK is the unread mark." | |
7515 | (= mark gnus-unread-mark)) | |
7516 | ||
7517 | (defun gnus-read-mark-p (mark) | |
7518 | "Say whether MARK is one of the marks that mark as read. | |
7519 | This is all marks except unread, ticked, dormant, and expirable." | |
7520 | (not (or (= mark gnus-unread-mark) | |
7521 | (= mark gnus-ticked-mark) | |
7522 | (= mark gnus-dormant-mark) | |
7523 | (= mark gnus-expirable-mark)))) | |
7524 | ||
7525 | ;; Saving hidden threads. | |
7526 | ||
7527 | (put 'gnus-save-hidden-threads 'lisp-indent-function 0) | |
7528 | (put 'gnus-save-hidden-threads 'lisp-indent-hook 0) | |
7529 | (put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) | |
7530 | ||
7531 | (defmacro gnus-save-hidden-threads (&rest forms) | |
7532 | "Save hidden threads, eval FORMS, and restore the hidden threads." | |
7533 | (let ((config (make-symbol "config"))) | |
7534 | `(let ((,config (gnus-hidden-threads-configuration))) | |
7535 | (unwind-protect | |
7536 | (progn | |
7537 | ,@forms) | |
7538 | (gnus-restore-hidden-threads-configuration ,config))))) | |
7539 | ||
7540 | (defun gnus-hidden-threads-configuration () | |
7541 | "Return the current hidden threads configuration." | |
7542 | (save-excursion | |
7543 | (let (config) | |
7544 | (goto-char (point-min)) | |
7545 | (while (search-forward "\r" nil t) | |
7546 | (push (1- (point)) config)) | |
7547 | config))) | |
7548 | ||
7549 | (defun gnus-restore-hidden-threads-configuration (config) | |
7550 | "Restore hidden threads configuration from CONFIG." | |
7551 | (let (point buffer-read-only) | |
7552 | (while (setq point (pop config)) | |
7553 | (when (and (< point (point-max)) | |
7554 | (goto-char point) | |
7555 | (= (following-char) ?\n)) | |
7556 | (subst-char-in-region point (1+ point) ?\n ?\r))))) | |
745bc783 | 7557 | |
41487370 | 7558 | ;; Various summary mode internalish functions. |
745bc783 | 7559 | |
41487370 LMI |
7560 | (defun gnus-mouse-pick-article (e) |
7561 | (interactive "e") | |
7562 | (mouse-set-point e) | |
7563 | (gnus-summary-next-page nil t)) | |
745bc783 | 7564 | |
41487370 LMI |
7565 | (defun gnus-summary-setup-buffer (group) |
7566 | "Initialize summary buffer." | |
7567 | (let ((buffer (concat "*Summary " group "*"))) | |
7568 | (if (get-buffer buffer) | |
745bc783 | 7569 | (progn |
41487370 | 7570 | (set-buffer buffer) |
231f989b LMI |
7571 | (setq gnus-summary-buffer (current-buffer)) |
7572 | (not gnus-newsgroup-prepared)) | |
41487370 LMI |
7573 | ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> |
7574 | (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) | |
7575 | (gnus-add-current-to-buffer-list) | |
7576 | (gnus-summary-mode group) | |
231f989b LMI |
7577 | (when gnus-carpal |
7578 | (gnus-carpal-setup-buffer 'summary)) | |
7579 | (unless gnus-single-article-buffer | |
7580 | (make-local-variable 'gnus-article-buffer) | |
7581 | (make-local-variable 'gnus-article-current) | |
7582 | (make-local-variable 'gnus-original-article-buffer)) | |
41487370 LMI |
7583 | (setq gnus-newsgroup-name group) |
7584 | t))) | |
7585 | ||
7586 | (defun gnus-set-global-variables () | |
7587 | ;; Set the global equivalents of the summary buffer-local variables | |
231f989b | 7588 | ;; to the latest values they had. These reflect the summary buffer |
41487370 | 7589 | ;; that was in action when the last article was fetched. |
231f989b LMI |
7590 | (when (eq major-mode 'gnus-summary-mode) |
7591 | (setq gnus-summary-buffer (current-buffer)) | |
7592 | (let ((name gnus-newsgroup-name) | |
7593 | (marked gnus-newsgroup-marked) | |
7594 | (unread gnus-newsgroup-unreads) | |
7595 | (headers gnus-current-headers) | |
7596 | (data gnus-newsgroup-data) | |
7597 | (summary gnus-summary-buffer) | |
7598 | (article-buffer gnus-article-buffer) | |
7599 | (original gnus-original-article-buffer) | |
7600 | (gac gnus-article-current) | |
7601 | (score-file gnus-current-score-file)) | |
7602 | (save-excursion | |
7603 | (set-buffer gnus-group-buffer) | |
7604 | (setq gnus-newsgroup-name name) | |
7605 | (setq gnus-newsgroup-marked marked) | |
7606 | (setq gnus-newsgroup-unreads unread) | |
7607 | (setq gnus-current-headers headers) | |
7608 | (setq gnus-newsgroup-data data) | |
7609 | (setq gnus-article-current gac) | |
7610 | (setq gnus-summary-buffer summary) | |
7611 | (setq gnus-article-buffer article-buffer) | |
7612 | (setq gnus-original-article-buffer original) | |
7613 | (setq gnus-current-score-file score-file))))) | |
7614 | ||
7615 | (defun gnus-summary-last-article-p (&optional article) | |
7616 | "Return whether ARTICLE is the last article in the buffer." | |
7617 | (if (not (setq article (or article (gnus-summary-article-number)))) | |
7618 | t ; All non-existant numbers are the last article. :-) | |
7619 | (not (cdr (gnus-data-find-list article))))) | |
7620 | ||
7621 | (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) | |
7622 | "Insert a dummy root in the summary buffer." | |
7623 | (beginning-of-line) | |
7624 | (gnus-add-text-properties | |
7625 | (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) | |
7626 | (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) | |
41487370 | 7627 | |
41487370 LMI |
7628 | (defun gnus-make-thread-indent-array () |
7629 | (let ((n 200)) | |
231f989b LMI |
7630 | (unless (and gnus-thread-indent-array |
7631 | (= gnus-thread-indent-level gnus-thread-indent-array-level)) | |
41487370 LMI |
7632 | (setq gnus-thread-indent-array (make-vector 201 "") |
7633 | gnus-thread-indent-array-level gnus-thread-indent-level) | |
7634 | (while (>= n 0) | |
7635 | (aset gnus-thread-indent-array n | |
7636 | (make-string (* n gnus-thread-indent-level) ? )) | |
7637 | (setq n (1- n)))))) | |
7638 | ||
231f989b LMI |
7639 | (defun gnus-summary-insert-line |
7640 | (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread | |
7641 | gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil | |
7642 | &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) | |
7643 | (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) | |
7644 | (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) | |
7645 | (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) | |
7646 | (gnus-tmp-score-char | |
41487370 | 7647 | (if (or (null gnus-summary-default-score) |
231f989b | 7648 | (<= (abs (- gnus-tmp-score gnus-summary-default-score)) |
41487370 | 7649 | gnus-summary-zcore-fuzz)) ? |
231f989b | 7650 | (if (< gnus-tmp-score gnus-summary-default-score) |
41487370 | 7651 | gnus-score-below-mark gnus-score-over-mark))) |
231f989b LMI |
7652 | (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) |
7653 | ((memq gnus-tmp-current gnus-newsgroup-cached) | |
7654 | gnus-cached-mark) | |
7655 | (gnus-tmp-replied gnus-replied-mark) | |
7656 | ((memq gnus-tmp-current gnus-newsgroup-saved) | |
7657 | gnus-saved-mark) | |
7658 | (t gnus-unread-mark))) | |
7659 | (gnus-tmp-from (mail-header-from gnus-tmp-header)) | |
7660 | (gnus-tmp-name | |
7661 | (cond | |
7662 | ((string-match "(.+)" gnus-tmp-from) | |
7663 | (substring gnus-tmp-from | |
7664 | (1+ (match-beginning 0)) (1- (match-end 0)))) | |
7665 | ((string-match "<[^>]+> *$" gnus-tmp-from) | |
7666 | (let ((beg (match-beginning 0))) | |
7667 | (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) | |
7668 | (substring gnus-tmp-from (1+ (match-beginning 0)) | |
7669 | (1- (match-end 0)))) | |
7670 | (substring gnus-tmp-from 0 beg)))) | |
7671 | (t gnus-tmp-from))) | |
7672 | (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) | |
7673 | (gnus-tmp-number (mail-header-number gnus-tmp-header)) | |
7674 | (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) | |
7675 | (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) | |
7676 | (buffer-read-only nil)) | |
7677 | (when (string= gnus-tmp-name "") | |
7678 | (setq gnus-tmp-name gnus-tmp-from)) | |
7679 | (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) | |
7680 | (gnus-put-text-property | |
7681 | (point) | |
7682 | (progn (eval gnus-summary-line-format-spec) (point)) | |
7683 | 'gnus-number gnus-tmp-number) | |
7684 | (when (gnus-visual-p 'summary-highlight 'highlight) | |
7685 | (forward-line -1) | |
7686 | (run-hooks 'gnus-summary-update-hook) | |
7687 | (forward-line 1)))) | |
41487370 LMI |
7688 | |
7689 | (defun gnus-summary-update-line (&optional dont-update) | |
7690 | ;; Update summary line after change. | |
231f989b LMI |
7691 | (when (and gnus-summary-default-score |
7692 | (not gnus-summary-inhibit-highlight)) | |
7693 | (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. | |
7694 | (article (gnus-summary-article-number)) | |
7695 | (score (gnus-summary-article-score article))) | |
7696 | (unless dont-update | |
7697 | (if (and gnus-summary-mark-below | |
7698 | (< (gnus-summary-article-score) | |
7699 | gnus-summary-mark-below)) | |
7700 | ;; This article has a low score, so we mark it as read. | |
7701 | (when (memq article gnus-newsgroup-unreads) | |
7702 | (gnus-summary-mark-article-as-read gnus-low-score-mark)) | |
7703 | (when (eq (gnus-summary-article-mark) gnus-low-score-mark) | |
7704 | ;; This article was previously marked as read on account | |
7705 | ;; of a low score, but now it has risen, so we mark it as | |
7706 | ;; unread. | |
7707 | (gnus-summary-mark-article-as-unread gnus-unread-mark))) | |
7708 | (gnus-summary-update-mark | |
7709 | (if (or (null gnus-summary-default-score) | |
7710 | (<= (abs (- score gnus-summary-default-score)) | |
7711 | gnus-summary-zcore-fuzz)) ? | |
7712 | (if (< score gnus-summary-default-score) | |
7713 | gnus-score-below-mark gnus-score-over-mark)) 'score)) | |
7714 | ;; Do visual highlighting. | |
7715 | (when (gnus-visual-p 'summary-highlight 'highlight) | |
7716 | (run-hooks 'gnus-summary-update-hook))))) | |
7717 | ||
7718 | (defvar gnus-tmp-new-adopts nil) | |
7719 | ||
7720 | (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) | |
41487370 LMI |
7721 | ;; Sum up all elements (and sub-elements) in a list. |
7722 | (let* ((number | |
7723 | ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>. | |
231f989b LMI |
7724 | (cond |
7725 | ((and (consp thread) (cdr thread)) | |
7726 | (apply | |
7727 | '+ 1 (mapcar | |
7728 | 'gnus-summary-number-of-articles-in-thread (cdr thread)))) | |
7729 | ((null thread) | |
7730 | 1) | |
7731 | ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) | |
7732 | 1) | |
7733 | (t 0)))) | |
7734 | (when (and level (zerop level) gnus-tmp-new-adopts) | |
7735 | (incf number | |
7736 | (apply '+ (mapcar | |
7737 | 'gnus-summary-number-of-articles-in-thread | |
7738 | gnus-tmp-new-adopts)))) | |
7739 | (if char | |
41487370 LMI |
7740 | (if (> number 1) gnus-not-empty-thread-mark |
7741 | gnus-empty-thread-mark) | |
7742 | number))) | |
7743 | ||
231f989b LMI |
7744 | (defun gnus-summary-set-local-parameters (group) |
7745 | "Go through the local params of GROUP and set all variable specs in that list." | |
7746 | (let ((params (gnus-info-params (gnus-get-info group))) | |
7747 | elem) | |
7748 | (while params | |
7749 | (setq elem (car params) | |
7750 | params (cdr params)) | |
7751 | (and (consp elem) ; Has to be a cons. | |
7752 | (consp (cdr elem)) ; The cdr has to be a list. | |
7753 | (symbolp (car elem)) ; Has to be a symbol in there. | |
7754 | (not (memq (car elem) | |
7755 | '(quit-config to-address to-list to-group))) | |
7756 | (progn ; So we set it. | |
7757 | (make-local-variable (car elem)) | |
7758 | (set (car elem) (eval (nth 1 elem)))))))) | |
7759 | ||
7760 | (defun gnus-summary-read-group (group &optional show-all no-article | |
7761 | kill-buffer no-display) | |
41487370 LMI |
7762 | "Start reading news in newsgroup GROUP. |
7763 | If SHOW-ALL is non-nil, already read articles are also listed. | |
231f989b LMI |
7764 | If NO-ARTICLE is non-nil, no article is selected initially. |
7765 | If NO-DISPLAY, don't generate a summary buffer." | |
41487370 LMI |
7766 | (gnus-message 5 "Retrieving newsgroup: %s..." group) |
7767 | (let* ((new-group (gnus-summary-setup-buffer group)) | |
7768 | (quit-config (gnus-group-quit-config group)) | |
7769 | (did-select (and new-group (gnus-select-newsgroup group show-all)))) | |
231f989b LMI |
7770 | (cond |
7771 | ;; This summary buffer exists already, so we just select it. | |
41487370 LMI |
7772 | ((not new-group) |
7773 | (gnus-set-global-variables) | |
231f989b LMI |
7774 | (when kill-buffer |
7775 | (gnus-kill-or-deaden-summary kill-buffer)) | |
41487370 LMI |
7776 | (gnus-configure-windows 'summary 'force) |
7777 | (gnus-set-mode-line 'summary) | |
231f989b | 7778 | (gnus-summary-position-point) |
41487370 LMI |
7779 | (message "") |
7780 | t) | |
231f989b LMI |
7781 | ;; We couldn't select this group. |
7782 | ((null did-select) | |
7783 | (when (and (eq major-mode 'gnus-summary-mode) | |
7784 | (not (equal (current-buffer) kill-buffer))) | |
7785 | (kill-buffer (current-buffer)) | |
7786 | (if (not quit-config) | |
7787 | (progn | |
7788 | (set-buffer gnus-group-buffer) | |
7789 | (gnus-group-jump-to-group group) | |
7790 | (gnus-group-next-unread-group 1)) | |
7791 | (if (not (buffer-name (car quit-config))) | |
7792 | (gnus-configure-windows 'group 'force) | |
7793 | (set-buffer (car quit-config)) | |
7794 | (and (eq major-mode 'gnus-summary-mode) | |
7795 | (gnus-set-global-variables)) | |
7796 | (gnus-configure-windows (cdr quit-config))))) | |
7797 | (gnus-message 3 "Can't select group") | |
41487370 | 7798 | nil) |
231f989b LMI |
7799 | ;; The user did a `C-g' while prompting for number of articles, |
7800 | ;; so we exit this group. | |
41487370 LMI |
7801 | ((eq did-select 'quit) |
7802 | (and (eq major-mode 'gnus-summary-mode) | |
7803 | (not (equal (current-buffer) kill-buffer)) | |
7804 | (kill-buffer (current-buffer))) | |
231f989b LMI |
7805 | (when kill-buffer |
7806 | (gnus-kill-or-deaden-summary kill-buffer)) | |
41487370 LMI |
7807 | (if (not quit-config) |
7808 | (progn | |
7809 | (set-buffer gnus-group-buffer) | |
7810 | (gnus-group-jump-to-group group) | |
7811 | (gnus-group-next-unread-group 1) | |
7812 | (gnus-configure-windows 'group 'force)) | |
7813 | (if (not (buffer-name (car quit-config))) | |
7814 | (gnus-configure-windows 'group 'force) | |
7815 | (set-buffer (car quit-config)) | |
7816 | (and (eq major-mode 'gnus-summary-mode) | |
7817 | (gnus-set-global-variables)) | |
7818 | (gnus-configure-windows (cdr quit-config)))) | |
231f989b | 7819 | ;; Finally signal the quit. |
41487370 | 7820 | (signal 'quit nil)) |
231f989b | 7821 | ;; The group was successfully selected. |
41487370 LMI |
7822 | (t |
7823 | (gnus-set-global-variables) | |
7824 | ;; Save the active value in effect when the group was entered. | |
231f989b | 7825 | (setq gnus-newsgroup-active |
41487370 | 7826 | (gnus-copy-sequence |
231f989b LMI |
7827 | (gnus-active gnus-newsgroup-name))) |
7828 | ;; You can change the summary buffer in some way with this hook. | |
41487370 | 7829 | (run-hooks 'gnus-select-group-hook) |
231f989b LMI |
7830 | ;; Set any local variables in the group parameters. |
7831 | (gnus-summary-set-local-parameters gnus-newsgroup-name) | |
41487370 | 7832 | (gnus-update-format-specifications) |
231f989b LMI |
7833 | ;; Do score processing. |
7834 | (when gnus-use-scoring | |
7835 | (gnus-possibly-score-headers)) | |
7836 | ;; Check whether to fill in the gaps in the threads. | |
7837 | (when gnus-build-sparse-threads | |
7838 | (gnus-build-sparse-threads)) | |
7839 | ;; Find the initial limit. | |
7840 | (if gnus-show-threads | |
7841 | (if show-all | |
7842 | (let ((gnus-newsgroup-dormant nil)) | |
7843 | (gnus-summary-initial-limit show-all)) | |
7844 | (gnus-summary-initial-limit show-all)) | |
7845 | (setq gnus-newsgroup-limit | |
7846 | (mapcar | |
7847 | (lambda (header) (mail-header-number header)) | |
7848 | gnus-newsgroup-headers))) | |
41487370 | 7849 | ;; Generate the summary buffer. |
231f989b LMI |
7850 | (unless no-display |
7851 | (gnus-summary-prepare)) | |
7852 | (when gnus-use-trees | |
7853 | (gnus-tree-open group) | |
7854 | (setq gnus-summary-highlight-line-function | |
7855 | 'gnus-tree-highlight-article)) | |
7856 | ;; If the summary buffer is empty, but there are some low-scored | |
7857 | ;; articles or some excluded dormants, we include these in the | |
7858 | ;; buffer. | |
7859 | (when (and (zerop (buffer-size)) | |
7860 | (not no-display)) | |
7861 | (cond (gnus-newsgroup-dormant | |
7862 | (gnus-summary-limit-include-dormant)) | |
7863 | ((and gnus-newsgroup-scored show-all) | |
7864 | (gnus-summary-limit-include-expunged)))) | |
41487370 LMI |
7865 | ;; Function `gnus-apply-kill-file' must be called in this hook. |
7866 | (run-hooks 'gnus-apply-kill-hook) | |
231f989b LMI |
7867 | (if (and (zerop (buffer-size)) |
7868 | (not no-display)) | |
41487370 LMI |
7869 | (progn |
7870 | ;; This newsgroup is empty. | |
7871 | (gnus-summary-catchup-and-exit nil t) ;Without confirmations. | |
7872 | (gnus-message 6 "No unread news") | |
231f989b LMI |
7873 | (when kill-buffer |
7874 | (gnus-kill-or-deaden-summary kill-buffer)) | |
7875 | ;; Return nil from this function. | |
41487370 | 7876 | nil) |
41487370 LMI |
7877 | ;; Hide conversation thread subtrees. We cannot do this in |
7878 | ;; gnus-summary-prepare-hook since kill processing may not | |
7879 | ;; work with hidden articles. | |
7880 | (and gnus-show-threads | |
7881 | gnus-thread-hide-subtree | |
7882 | (gnus-summary-hide-all-threads)) | |
7883 | ;; Show first unread article if requested. | |
41487370 | 7884 | (if (and (not no-article) |
231f989b LMI |
7885 | (not no-display) |
7886 | gnus-newsgroup-unreads | |
7887 | gnus-auto-select-first) | |
7888 | (unless (if (eq gnus-auto-select-first 'best) | |
7889 | (gnus-summary-best-unread-article) | |
7890 | (gnus-summary-first-unread-article)) | |
7891 | (gnus-configure-windows 'summary)) | |
7892 | ;; Don't select any articles, just move point to the first | |
7893 | ;; article in the group. | |
7894 | (goto-char (point-min)) | |
7895 | (gnus-summary-position-point) | |
7896 | (gnus-set-mode-line 'summary) | |
41487370 | 7897 | (gnus-configure-windows 'summary 'force)) |
231f989b LMI |
7898 | ;; If we are in async mode, we send some info to the backend. |
7899 | (when gnus-newsgroup-async | |
7900 | (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data)) | |
7901 | (when kill-buffer | |
7902 | (gnus-kill-or-deaden-summary kill-buffer)) | |
7903 | (when (get-buffer-window gnus-group-buffer t) | |
7904 | ;; Gotta use windows, because recenter does wierd stuff if | |
41487370 | 7905 | ;; the current buffer ain't the displayed window. |
231f989b LMI |
7906 | (let ((owin (selected-window))) |
7907 | (select-window (get-buffer-window gnus-group-buffer t)) | |
7908 | (when (gnus-group-goto-group group) | |
7909 | (recenter)) | |
7910 | (select-window owin)))) | |
7911 | ;; Mark this buffer as "prepared". | |
7912 | (setq gnus-newsgroup-prepared t) | |
41487370 LMI |
7913 | t)))) |
7914 | ||
7915 | (defun gnus-summary-prepare () | |
231f989b | 7916 | "Generate the summary buffer." |
41487370 LMI |
7917 | (let ((buffer-read-only nil)) |
7918 | (erase-buffer) | |
231f989b LMI |
7919 | (setq gnus-newsgroup-data nil |
7920 | gnus-newsgroup-data-reverse nil) | |
7921 | (run-hooks 'gnus-summary-generate-hook) | |
7922 | ;; Generate the buffer, either with threads or without. | |
7923 | (when gnus-newsgroup-headers | |
7924 | (gnus-summary-prepare-threads | |
7925 | (if gnus-show-threads | |
7926 | (gnus-sort-gathered-threads | |
7927 | (funcall gnus-summary-thread-gathering-function | |
7928 | (gnus-sort-threads | |
7929 | (gnus-cut-threads (gnus-make-threads))))) | |
7930 | ;; Unthreaded display. | |
7931 | (gnus-sort-articles gnus-newsgroup-headers)))) | |
7932 | (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) | |
41487370 | 7933 | ;; Call hooks for modifying summary buffer. |
41487370 LMI |
7934 | (goto-char (point-min)) |
7935 | (run-hooks 'gnus-summary-prepare-hook))) | |
7936 | ||
231f989b LMI |
7937 | (defun gnus-gather-threads-by-subject (threads) |
7938 | "Gather threads by looking at Subject headers." | |
41487370 | 7939 | (if (not gnus-summary-make-false-root) |
231f989b | 7940 | threads |
41487370 LMI |
7941 | (let ((hashtb (gnus-make-hashtable 1023)) |
7942 | (prev threads) | |
7943 | (result threads) | |
7944 | subject hthread whole-subject) | |
7945 | (while threads | |
231f989b LMI |
7946 | (setq whole-subject (mail-header-subject (caar threads))) |
7947 | (setq subject | |
7948 | (cond | |
7949 | ;; Truncate the subject. | |
7950 | ((numberp gnus-summary-gather-subject-limit) | |
7951 | (setq subject (gnus-simplify-subject-re whole-subject)) | |
7952 | (if (> (length subject) gnus-summary-gather-subject-limit) | |
7953 | (substring subject 0 gnus-summary-gather-subject-limit) | |
7954 | subject)) | |
7955 | ;; Fuzzily simplify it. | |
7956 | ((eq 'fuzzy gnus-summary-gather-subject-limit) | |
7957 | (gnus-simplify-subject-fuzzy whole-subject)) | |
7958 | ;; Just remove the leading "Re:". | |
7959 | (t | |
7960 | (gnus-simplify-subject-re whole-subject)))) | |
7961 | ||
7962 | (if (and gnus-summary-gather-exclude-subject | |
7963 | (string-match gnus-summary-gather-exclude-subject | |
7964 | subject)) | |
7965 | () ; We don't want to do anything with this article. | |
7966 | ;; We simplify the subject before looking it up in the | |
7967 | ;; hash table. | |
7968 | ||
7969 | (if (setq hthread (gnus-gethash subject hashtb)) | |
7970 | (progn | |
7971 | ;; We enter a dummy root into the thread, if we | |
7972 | ;; haven't done that already. | |
7973 | (unless (stringp (caar hthread)) | |
41487370 | 7974 | (setcar hthread (list whole-subject (car hthread)))) |
231f989b LMI |
7975 | ;; We add this new gathered thread to this gathered |
7976 | ;; thread. | |
7977 | (setcdr (car hthread) | |
7978 | (nconc (cdar hthread) (list (car threads)))) | |
7979 | ;; Remove it from the list of threads. | |
7980 | (setcdr prev (cdr threads)) | |
7981 | (setq threads prev)) | |
7982 | ;; Enter this thread into the hash table. | |
7983 | (gnus-sethash subject threads hashtb))) | |
41487370 LMI |
7984 | (setq prev threads) |
7985 | (setq threads (cdr threads))) | |
7986 | result))) | |
7987 | ||
231f989b LMI |
7988 | (defun gnus-gather-threads-by-references (threads) |
7989 | "Gather threads by looking at References headers." | |
7990 | (let ((idhashtb (gnus-make-hashtable 1023)) | |
7991 | (thhashtb (gnus-make-hashtable 1023)) | |
7992 | (prev threads) | |
7993 | (result threads) | |
7994 | ids references id gthread gid entered) | |
7995 | (while threads | |
7996 | (when (setq references (mail-header-references (caar threads))) | |
7997 | (setq id (mail-header-id (caar threads))) | |
7998 | (setq ids (gnus-split-references references)) | |
7999 | (setq entered nil) | |
8000 | (while ids | |
8001 | (if (not (setq gid (gnus-gethash (car ids) idhashtb))) | |
8002 | (progn | |
8003 | (gnus-sethash (car ids) id idhashtb) | |
8004 | (gnus-sethash id threads thhashtb)) | |
8005 | (setq gthread (gnus-gethash gid thhashtb)) | |
8006 | (unless entered | |
8007 | ;; We enter a dummy root into the thread, if we | |
8008 | ;; haven't done that already. | |
8009 | (unless (stringp (caar gthread)) | |
8010 | (setcar gthread (list (mail-header-subject (caar gthread)) | |
8011 | (car gthread)))) | |
8012 | ;; We add this new gathered thread to this gathered | |
8013 | ;; thread. | |
8014 | (setcdr (car gthread) | |
8015 | (nconc (cdar gthread) (list (car threads))))) | |
8016 | ;; Add it into the thread hash table. | |
8017 | (gnus-sethash id gthread thhashtb) | |
8018 | (setq entered t) | |
8019 | ;; Remove it from the list of threads. | |
8020 | (setcdr prev (cdr threads)) | |
8021 | (setq threads prev)) | |
8022 | (setq ids (cdr ids)))) | |
8023 | (setq prev threads) | |
8024 | (setq threads (cdr threads))) | |
8025 | result)) | |
41487370 | 8026 | |
231f989b LMI |
8027 | (defun gnus-sort-gathered-threads (threads) |
8028 | "Sort subtreads inside each gathered thread by article number." | |
8029 | (let ((result threads)) | |
8030 | (while threads | |
8031 | (when (stringp (caar threads)) | |
8032 | (setcdr (car threads) | |
8033 | (sort (cdar threads) 'gnus-thread-sort-by-number))) | |
8034 | (setq threads (cdr threads))) | |
8035 | result)) | |
41487370 | 8036 | |
231f989b LMI |
8037 | (defun gnus-make-threads () |
8038 | "Go through the dependency hashtb and find the roots. Return all threads." | |
8039 | (let (threads) | |
41487370 LMI |
8040 | (mapatoms |
8041 | (lambda (refs) | |
231f989b LMI |
8042 | (unless (car (symbol-value refs)) |
8043 | ;; These threads do not refer back to any other articles, | |
8044 | ;; so they're roots. | |
8045 | (setq threads (append (cdr (symbol-value refs)) threads)))) | |
41487370 | 8046 | gnus-newsgroup-dependencies) |
231f989b LMI |
8047 | threads)) |
8048 | ||
8049 | (defun gnus-build-sparse-threads () | |
8050 | (let ((headers gnus-newsgroup-headers) | |
8051 | (deps gnus-newsgroup-dependencies) | |
8052 | header references generation relations | |
8053 | cthread subject child end pthread relation) | |
8054 | ;; First we create an alist of generations/relations, where | |
8055 | ;; generations is how much we trust the ralation, and the relation | |
8056 | ;; is parent/child. | |
8057 | (gnus-message 7 "Making sparse threads...") | |
8058 | (save-excursion | |
8059 | (nnheader-set-temp-buffer " *gnus sparse threads*") | |
8060 | (while (setq header (pop headers)) | |
8061 | (when (and (setq references (mail-header-references header)) | |
8062 | (not (string= references ""))) | |
8063 | (insert references) | |
8064 | (setq child (mail-header-id header) | |
8065 | subject (mail-header-subject header)) | |
8066 | (setq generation 0) | |
8067 | (while (search-backward ">" nil t) | |
8068 | (setq end (1+ (point))) | |
8069 | (when (search-backward "<" nil t) | |
8070 | (push (list (incf generation) | |
8071 | child (setq child (buffer-substring (point) end)) | |
8072 | subject) | |
8073 | relations))) | |
8074 | (push (list (1+ generation) child nil subject) relations) | |
8075 | (erase-buffer))) | |
8076 | (kill-buffer (current-buffer))) | |
8077 | ;; Sort over trustworthiness. | |
8078 | (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2))))) | |
8079 | (while (setq relation (pop relations)) | |
8080 | (when (if (boundp (setq cthread (intern (cadr relation) deps))) | |
8081 | (unless (car (symbol-value cthread)) | |
8082 | ;; Make this article the parent of these threads. | |
8083 | (setcar (symbol-value cthread) | |
8084 | (vector gnus-reffed-article-number | |
8085 | (cadddr relation) | |
8086 | "" "" | |
8087 | (cadr relation) | |
8088 | (or (caddr relation) "") 0 0 ""))) | |
8089 | (set cthread (list (vector gnus-reffed-article-number | |
8090 | (cadddr relation) | |
8091 | "" "" (cadr relation) | |
8092 | (or (caddr relation) "") 0 0 "")))) | |
8093 | (push gnus-reffed-article-number gnus-newsgroup-limit) | |
8094 | (push gnus-reffed-article-number gnus-newsgroup-sparse) | |
8095 | (push (cons gnus-reffed-article-number gnus-sparse-mark) | |
8096 | gnus-newsgroup-reads) | |
8097 | (decf gnus-reffed-article-number) | |
8098 | ;; Make this new thread the child of its parent. | |
8099 | (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) | |
8100 | (setcdr (symbol-value pthread) | |
8101 | (nconc (cdr (symbol-value pthread)) | |
8102 | (list (symbol-value cthread)))) | |
8103 | (set pthread (list nil (symbol-value cthread)))))) | |
8104 | (gnus-message 7 "Making sparse threads...done"))) | |
41487370 LMI |
8105 | |
8106 | (defun gnus-build-old-threads () | |
8107 | ;; Look at all the articles that refer back to old articles, and | |
231f989b | 8108 | ;; fetch the headers for the articles that aren't there. This will |
41487370 LMI |
8109 | ;; build complete threads - if the roots haven't been expired by the |
8110 | ;; server, that is. | |
8111 | (let (id heads) | |
8112 | (mapatoms | |
8113 | (lambda (refs) | |
231f989b LMI |
8114 | (when (not (car (symbol-value refs))) |
8115 | (setq heads (cdr (symbol-value refs))) | |
8116 | (while heads | |
8117 | (if (memq (mail-header-number (caar heads)) | |
8118 | gnus-newsgroup-dormant) | |
8119 | (setq heads (cdr heads)) | |
8120 | (setq id (symbol-name refs)) | |
8121 | (while (and (setq id (gnus-build-get-header id)) | |
8122 | (not (car (gnus-gethash | |
8123 | id gnus-newsgroup-dependencies))))) | |
8124 | (setq heads nil))))) | |
41487370 LMI |
8125 | gnus-newsgroup-dependencies))) |
8126 | ||
8127 | (defun gnus-build-get-header (id) | |
8128 | ;; Look through the buffer of NOV lines and find the header to | |
231f989b | 8129 | ;; ID. Enter this line into the dependencies hash table, and return |
41487370 LMI |
8130 | ;; the id of the parent article (if any). |
8131 | (let ((deps gnus-newsgroup-dependencies) | |
8132 | found header) | |
8133 | (prog1 | |
8134 | (save-excursion | |
8135 | (set-buffer nntp-server-buffer) | |
8136 | (goto-char (point-min)) | |
8137 | (while (and (not found) (search-forward id nil t)) | |
8138 | (beginning-of-line) | |
231f989b | 8139 | (setq found (looking-at |
41487370 LMI |
8140 | (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" |
8141 | (regexp-quote id)))) | |
8142 | (or found (beginning-of-line 2))) | |
231f989b LMI |
8143 | (when found |
8144 | (beginning-of-line) | |
8145 | (and | |
8146 | (setq header (gnus-nov-parse-line | |
8147 | (read (current-buffer)) deps)) | |
8148 | (gnus-parent-id (mail-header-references header))))) | |
8149 | (when header | |
8150 | (let ((number (mail-header-number header))) | |
8151 | (push number gnus-newsgroup-limit) | |
8152 | (push header gnus-newsgroup-headers) | |
8153 | (if (memq number gnus-newsgroup-unselected) | |
8154 | (progn | |
8155 | (push number gnus-newsgroup-unreads) | |
8156 | (setq gnus-newsgroup-unselected | |
8157 | (delq number gnus-newsgroup-unselected))) | |
8158 | (push number gnus-newsgroup-ancient))))))) | |
8159 | ||
8160 | (defun gnus-summary-update-article (article &optional iheader) | |
8161 | "Update ARTICLE in the summary buffer." | |
8162 | (set-buffer gnus-summary-buffer) | |
8163 | (let* ((header (or iheader (gnus-summary-article-header article))) | |
8164 | (id (mail-header-id header)) | |
8165 | (data (gnus-data-find article)) | |
8166 | (thread (gnus-id-to-thread id)) | |
8167 | (references (mail-header-references header)) | |
8168 | (parent | |
8169 | (gnus-id-to-thread | |
8170 | (or (gnus-parent-id | |
8171 | (if (and references | |
8172 | (not (equal "" references))) | |
8173 | references)) | |
8174 | "none"))) | |
8175 | (buffer-read-only nil) | |
8176 | (old (car thread)) | |
8177 | (number (mail-header-number header)) | |
8178 | pos) | |
8179 | (when thread | |
8180 | ;; !!! Should this be in or not? | |
8181 | (unless iheader | |
8182 | (setcar thread nil)) | |
8183 | (when parent | |
8184 | (delq thread parent)) | |
8185 | (if (gnus-summary-insert-subject id header iheader) | |
8186 | ;; Set the (possibly) new article number in the data structure. | |
8187 | (gnus-data-set-number data (gnus-id-to-article id)) | |
8188 | (setcar thread old) | |
8189 | nil)))) | |
8190 | ||
41487370 | 8191 | (defun gnus-rebuild-thread (id) |
231f989b LMI |
8192 | "Rebuild the thread containing ID." |
8193 | (let ((buffer-read-only nil) | |
8194 | current thread data) | |
8195 | (if (not gnus-show-threads) | |
8196 | (setq thread (list (car (gnus-id-to-thread id)))) | |
8197 | ;; Get the thread this article is part of. | |
8198 | (setq thread (gnus-remove-thread id))) | |
8199 | (setq current (save-excursion | |
8200 | (and (zerop (forward-line -1)) | |
8201 | (gnus-summary-article-number)))) | |
8202 | ;; If this is a gathered thread, we have to go some re-gathering. | |
8203 | (when (stringp (car thread)) | |
8204 | (let ((subject (car thread)) | |
8205 | roots thr) | |
8206 | (setq thread (cdr thread)) | |
8207 | (while thread | |
8208 | (unless (memq (setq thr (gnus-id-to-thread | |
8209 | (gnus-root-id | |
8210 | (mail-header-id (caar thread))))) | |
8211 | roots) | |
8212 | (push thr roots)) | |
8213 | (setq thread (cdr thread))) | |
8214 | ;; We now have all (unique) roots. | |
8215 | (if (= (length roots) 1) | |
8216 | ;; All the loose roots are now one solid root. | |
8217 | (setq thread (car roots)) | |
8218 | (setq thread (cons subject (gnus-sort-threads roots)))))) | |
8219 | (let (threads) | |
8220 | ;; We then insert this thread into the summary buffer. | |
8221 | (let (gnus-newsgroup-data gnus-newsgroup-threads) | |
8222 | (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) | |
8223 | (setq data (nreverse gnus-newsgroup-data)) | |
8224 | (setq threads gnus-newsgroup-threads)) | |
8225 | ;; We splice the new data into the data structure. | |
8226 | (gnus-data-enter-list current data) | |
8227 | (gnus-data-compute-positions) | |
8228 | (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) | |
8229 | ||
8230 | (defun gnus-number-to-header (number) | |
8231 | "Return the header for article NUMBER." | |
8232 | (let ((headers gnus-newsgroup-headers)) | |
8233 | (while (and headers | |
8234 | (not (= number (mail-header-number (car headers))))) | |
8235 | (pop headers)) | |
8236 | (when headers | |
8237 | (car headers)))) | |
8238 | ||
8239 | (defun gnus-id-to-thread (id) | |
8240 | "Return the (sub-)thread where ID appears." | |
8241 | (gnus-gethash id gnus-newsgroup-dependencies)) | |
8242 | ||
8243 | (defun gnus-id-to-article (id) | |
8244 | "Return the article number of ID." | |
8245 | (let ((thread (gnus-id-to-thread id))) | |
8246 | (when (and thread | |
8247 | (car thread)) | |
8248 | (mail-header-number (car thread))))) | |
8249 | ||
8250 | (defun gnus-id-to-header (id) | |
8251 | "Return the article headers of ID." | |
8252 | (car (gnus-id-to-thread id))) | |
8253 | ||
8254 | (defun gnus-article-displayed-root-p (article) | |
8255 | "Say whether ARTICLE is a root(ish) article." | |
8256 | (let ((level (gnus-summary-thread-level article)) | |
8257 | (refs (mail-header-references (gnus-summary-article-header article))) | |
8258 | particle) | |
8259 | (cond | |
8260 | ((null level) nil) | |
8261 | ((zerop level) t) | |
8262 | ((null refs) t) | |
8263 | ((null (gnus-parent-id refs)) t) | |
8264 | ((and (= 1 level) | |
8265 | (null (setq particle (gnus-id-to-article | |
8266 | (gnus-parent-id refs)))) | |
8267 | (null (gnus-summary-thread-level particle))))))) | |
8268 | ||
8269 | (defun gnus-root-id (id) | |
8270 | "Return the id of the root of the thread where ID appears." | |
8271 | (let (last-id prev) | |
8272 | (while (and id (setq prev (car (gnus-gethash | |
8273 | id gnus-newsgroup-dependencies)))) | |
8274 | (setq last-id id | |
8275 | id (gnus-parent-id (mail-header-references prev)))) | |
8276 | last-id)) | |
8277 | ||
8278 | (defun gnus-remove-thread (id &optional dont-remove) | |
8279 | "Remove the thread that has ID in it." | |
41487370 | 8280 | (let ((dep gnus-newsgroup-dependencies) |
231f989b LMI |
8281 | headers thread last-id) |
8282 | ;; First go up in this thread until we find the root. | |
8283 | (setq last-id (gnus-root-id id)) | |
8284 | (setq headers (list (car (gnus-id-to-thread last-id)) | |
8285 | (caadr (gnus-id-to-thread last-id)))) | |
8286 | ;; We have now found the real root of this thread. It might have | |
8287 | ;; been gathered into some loose thread, so we have to search | |
8288 | ;; through the threads to find the thread we wanted. | |
8289 | (let ((threads gnus-newsgroup-threads) | |
8290 | sub) | |
8291 | (while threads | |
8292 | (setq sub (car threads)) | |
8293 | (if (stringp (car sub)) | |
8294 | ;; This is a gathered threads, so we look at the roots | |
8295 | ;; below it to find whether this article in in this | |
8296 | ;; gathered root. | |
8297 | (progn | |
8298 | (setq sub (cdr sub)) | |
8299 | (while sub | |
8300 | (when (member (caar sub) headers) | |
8301 | (setq thread (car threads) | |
8302 | threads nil | |
8303 | sub nil)) | |
8304 | (setq sub (cdr sub)))) | |
8305 | ;; It's an ordinary thread, so we check it. | |
8306 | (when (eq (car sub) (car headers)) | |
8307 | (setq thread sub | |
8308 | threads nil))) | |
8309 | (setq threads (cdr threads))) | |
8310 | ;; If this article is in no thread, then it's a root. | |
8311 | (if thread | |
8312 | (unless dont-remove | |
8313 | (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) | |
8314 | (setq thread (gnus-gethash last-id dep))) | |
8315 | (when thread | |
8316 | (prog1 | |
8317 | thread ; We return this thread. | |
8318 | (unless dont-remove | |
8319 | (if (stringp (car thread)) | |
8320 | (progn | |
8321 | ;; If we use dummy roots, then we have to remove the | |
8322 | ;; dummy root as well. | |
8323 | (when (eq gnus-summary-make-false-root 'dummy) | |
8324 | ;; Uhm. | |
8325 | ) | |
8326 | (setq thread (cdr thread)) | |
8327 | (while thread | |
8328 | (gnus-remove-thread-1 (car thread)) | |
8329 | (setq thread (cdr thread)))) | |
8330 | (gnus-remove-thread-1 thread)))))))) | |
8331 | ||
8332 | (defun gnus-remove-thread-1 (thread) | |
8333 | "Remove the thread THREAD recursively." | |
8334 | (let ((number (mail-header-number (car thread))) | |
8335 | pos) | |
8336 | (when (setq pos (text-property-any | |
8337 | (point-min) (point-max) 'gnus-number number)) | |
8338 | (goto-char pos) | |
8339 | (gnus-delete-line) | |
8340 | (gnus-data-remove number)) | |
8341 | (setq thread (cdr thread)) | |
8342 | (while thread | |
8343 | (gnus-remove-thread-1 (pop thread))))) | |
41487370 LMI |
8344 | |
8345 | (defun gnus-sort-threads (threads) | |
231f989b LMI |
8346 | "Sort THREADS." |
8347 | (if (not gnus-thread-sort-functions) | |
8348 | threads | |
8349 | (let ((func (if (= 1 (length gnus-thread-sort-functions)) | |
8350 | (car gnus-thread-sort-functions) | |
8351 | `(lambda (t1 t2) | |
8352 | ,(gnus-make-sort-function | |
8353 | (reverse gnus-thread-sort-functions)))))) | |
8354 | (gnus-message 7 "Sorting threads...") | |
8355 | (prog1 | |
8356 | (sort threads func) | |
8357 | (gnus-message 7 "Sorting threads...done"))))) | |
8358 | ||
8359 | (defun gnus-sort-articles (articles) | |
8360 | "Sort ARTICLES." | |
8361 | (when gnus-article-sort-functions | |
8362 | (let ((func (if (= 1 (length gnus-article-sort-functions)) | |
8363 | (car gnus-article-sort-functions) | |
8364 | `(lambda (t1 t2) | |
8365 | ,(gnus-make-sort-function | |
8366 | (reverse gnus-article-sort-functions)))))) | |
8367 | (gnus-message 7 "Sorting articles...") | |
8368 | (prog1 | |
8369 | (setq gnus-newsgroup-headers (sort articles func)) | |
8370 | (gnus-message 7 "Sorting articles...done"))))) | |
8371 | ||
8372 | (defun gnus-make-sort-function (funs) | |
8373 | "Return a composite sort condition based on the functions in FUNC." | |
8374 | (if (cdr funs) | |
8375 | `(or (,(car funs) t1 t2) | |
8376 | (and (not (,(car funs) t2 t1)) | |
8377 | ,(gnus-make-sort-function (cdr funs)))) | |
8378 | `(,(car funs) t1 t2))) | |
8379 | ||
41487370 LMI |
8380 | ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. |
8381 | (defmacro gnus-thread-header (thread) | |
8382 | ;; Return header of first article in THREAD. | |
231f989b | 8383 | ;; Note that THREAD must never, ever be anything else than a variable - |
41487370 LMI |
8384 | ;; using some other form will lead to serious barfage. |
8385 | (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) | |
8386 | ;; (8% speedup to gnus-summary-prepare, just for fun :-) | |
231f989b | 8387 | (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; |
41487370 LMI |
8388 | (vector thread) 2)) |
8389 | ||
231f989b LMI |
8390 | (defsubst gnus-article-sort-by-number (h1 h2) |
8391 | "Sort articles by article number." | |
8392 | (< (mail-header-number h1) | |
8393 | (mail-header-number h2))) | |
8394 | ||
41487370 LMI |
8395 | (defun gnus-thread-sort-by-number (h1 h2) |
8396 | "Sort threads by root article number." | |
231f989b LMI |
8397 | (gnus-article-sort-by-number |
8398 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
41487370 | 8399 | |
231f989b LMI |
8400 | (defsubst gnus-article-sort-by-author (h1 h2) |
8401 | "Sort articles by root author." | |
41487370 | 8402 | (string-lessp |
231f989b | 8403 | (let ((extract (funcall |
41487370 | 8404 | gnus-extract-address-components |
231f989b | 8405 | (mail-header-from h1)))) |
41487370 LMI |
8406 | (or (car extract) (cdr extract))) |
8407 | (let ((extract (funcall | |
231f989b LMI |
8408 | gnus-extract-address-components |
8409 | (mail-header-from h2)))) | |
41487370 LMI |
8410 | (or (car extract) (cdr extract))))) |
8411 | ||
231f989b LMI |
8412 | (defun gnus-thread-sort-by-author (h1 h2) |
8413 | "Sort threads by root author." | |
8414 | (gnus-article-sort-by-author | |
8415 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
8416 | ||
8417 | (defsubst gnus-article-sort-by-subject (h1 h2) | |
8418 | "Sort articles by root subject." | |
8419 | (string-lessp | |
8420 | (downcase (gnus-simplify-subject-re (mail-header-subject h1))) | |
8421 | (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) | |
8422 | ||
41487370 LMI |
8423 | (defun gnus-thread-sort-by-subject (h1 h2) |
8424 | "Sort threads by root subject." | |
231f989b LMI |
8425 | (gnus-article-sort-by-subject |
8426 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
8427 | ||
8428 | (defsubst gnus-article-sort-by-date (h1 h2) | |
8429 | "Sort articles by root article date." | |
41487370 | 8430 | (string-lessp |
231f989b LMI |
8431 | (inline (gnus-sortable-date (mail-header-date h1))) |
8432 | (inline (gnus-sortable-date (mail-header-date h2))))) | |
41487370 LMI |
8433 | |
8434 | (defun gnus-thread-sort-by-date (h1 h2) | |
8435 | "Sort threads by root article date." | |
231f989b LMI |
8436 | (gnus-article-sort-by-date |
8437 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
41487370 | 8438 | |
231f989b LMI |
8439 | (defsubst gnus-article-sort-by-score (h1 h2) |
8440 | "Sort articles by root article score. | |
41487370 | 8441 | Unscored articles will be counted as having a score of zero." |
231f989b | 8442 | (> (or (cdr (assq (mail-header-number h1) |
41487370 LMI |
8443 | gnus-newsgroup-scored)) |
8444 | gnus-summary-default-score 0) | |
231f989b | 8445 | (or (cdr (assq (mail-header-number h2) |
41487370 LMI |
8446 | gnus-newsgroup-scored)) |
8447 | gnus-summary-default-score 0))) | |
8448 | ||
231f989b LMI |
8449 | (defun gnus-thread-sort-by-score (h1 h2) |
8450 | "Sort threads by root article score." | |
8451 | (gnus-article-sort-by-score | |
8452 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
8453 | ||
41487370 LMI |
8454 | (defun gnus-thread-sort-by-total-score (h1 h2) |
8455 | "Sort threads by the sum of all scores in the thread. | |
8456 | Unscored articles will be counted as having a score of zero." | |
8457 | (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) | |
8458 | ||
8459 | (defun gnus-thread-total-score (thread) | |
8460 | ;; This function find the total score of THREAD. | |
231f989b LMI |
8461 | (cond ((null thread) |
8462 | 0) | |
8463 | ((consp thread) | |
8464 | (if (stringp (car thread)) | |
8465 | (apply gnus-thread-score-function 0 | |
8466 | (mapcar 'gnus-thread-total-score-1 (cdr thread))) | |
8467 | (gnus-thread-total-score-1 thread))) | |
8468 | (t | |
8469 | (gnus-thread-total-score-1 (list thread))))) | |
41487370 LMI |
8470 | |
8471 | (defun gnus-thread-total-score-1 (root) | |
8472 | ;; This function find the total score of the thread below ROOT. | |
8473 | (setq root (car root)) | |
8474 | (apply gnus-thread-score-function | |
564b670b LMI |
8475 | (or (append |
8476 | (mapcar 'gnus-thread-total-score | |
8477 | (cdr (gnus-gethash (mail-header-id root) | |
8478 | gnus-newsgroup-dependencies))) | |
8479 | (if (> (mail-header-number root) 0) | |
8480 | (list (or (cdr (assq (mail-header-number root) | |
8481 | gnus-newsgroup-scored)) | |
8482 | gnus-summary-default-score 0)))) | |
8483 | (list gnus-summary-default-score) | |
8484 | '(0)))) | |
41487370 LMI |
8485 | |
8486 | ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. | |
231f989b LMI |
8487 | (defvar gnus-tmp-prev-subject nil) |
8488 | (defvar gnus-tmp-false-parent nil) | |
8489 | (defvar gnus-tmp-root-expunged nil) | |
8490 | (defvar gnus-tmp-dummy-line nil) | |
8491 | ||
8492 | (defun gnus-summary-prepare-threads (threads) | |
8493 | "Prepare summary buffer from THREADS and indentation LEVEL. | |
8494 | THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' | |
41487370 | 8495 | or a straight list of headers." |
231f989b LMI |
8496 | (gnus-message 7 "Generating summary...") |
8497 | ||
8498 | (setq gnus-newsgroup-threads threads) | |
8499 | (beginning-of-line) | |
8500 | ||
8501 | (let ((gnus-tmp-level 0) | |
8502 | (default-score (or gnus-summary-default-score 0)) | |
8503 | (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) | |
8504 | thread number subject stack state gnus-tmp-gathered beg-match | |
8505 | new-roots gnus-tmp-new-adopts thread-end | |
8506 | gnus-tmp-header gnus-tmp-unread | |
8507 | gnus-tmp-replied gnus-tmp-subject-or-nil | |
8508 | gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score | |
8509 | gnus-tmp-score-char gnus-tmp-from gnus-tmp-name | |
8510 | gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) | |
8511 | ||
8512 | (setq gnus-tmp-prev-subject nil) | |
8513 | ||
41487370 LMI |
8514 | (if (vectorp (car threads)) |
8515 | ;; If this is a straight (sic) list of headers, then a | |
8516 | ;; threaded summary display isn't required, so we just create | |
8517 | ;; an unthreaded one. | |
231f989b | 8518 | (gnus-summary-prepare-unthreaded threads) |
41487370 LMI |
8519 | |
8520 | ;; Do the threaded display. | |
8521 | ||
231f989b LMI |
8522 | (while (or threads stack gnus-tmp-new-adopts new-roots) |
8523 | ||
8524 | (if (and (= gnus-tmp-level 0) | |
8525 | (not (setq gnus-tmp-dummy-line nil)) | |
8526 | (or (not stack) | |
8527 | (= (caar stack) 0)) | |
8528 | (not gnus-tmp-false-parent) | |
8529 | (or gnus-tmp-new-adopts new-roots)) | |
8530 | (if gnus-tmp-new-adopts | |
8531 | (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) | |
8532 | thread (list (car gnus-tmp-new-adopts)) | |
8533 | gnus-tmp-header (caar thread) | |
8534 | gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) | |
8535 | (if new-roots | |
8536 | (setq thread (list (car new-roots)) | |
8537 | gnus-tmp-header (caar thread) | |
8538 | new-roots (cdr new-roots)))) | |
8539 | ||
8540 | (if threads | |
8541 | ;; If there are some threads, we do them before the | |
8542 | ;; threads on the stack. | |
8543 | (setq thread threads | |
8544 | gnus-tmp-header (caar thread)) | |
8545 | ;; There were no current threads, so we pop something off | |
8546 | ;; the stack. | |
8547 | (setq state (car stack) | |
8548 | gnus-tmp-level (car state) | |
8549 | thread (cdr state) | |
8550 | stack (cdr stack) | |
8551 | gnus-tmp-header (caar thread)))) | |
8552 | ||
8553 | (setq gnus-tmp-false-parent nil) | |
8554 | (setq gnus-tmp-root-expunged nil) | |
8555 | (setq thread-end nil) | |
8556 | ||
8557 | (if (stringp gnus-tmp-header) | |
8558 | ;; The header is a dummy root. | |
8559 | (cond | |
8560 | ((eq gnus-summary-make-false-root 'adopt) | |
8561 | ;; We let the first article adopt the rest. | |
8562 | (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts | |
8563 | (cddar thread))) | |
8564 | (setq gnus-tmp-gathered | |
8565 | (nconc (mapcar | |
8566 | (lambda (h) (mail-header-number (car h))) | |
8567 | (cddar thread)) | |
8568 | gnus-tmp-gathered)) | |
8569 | (setq thread (cons (list (caar thread) | |
8570 | (cadar thread)) | |
8571 | (cdr thread))) | |
8572 | (setq gnus-tmp-level -1 | |
8573 | gnus-tmp-false-parent t)) | |
8574 | ((eq gnus-summary-make-false-root 'empty) | |
8575 | ;; We print adopted articles with empty subject fields. | |
8576 | (setq gnus-tmp-gathered | |
8577 | (nconc (mapcar | |
8578 | (lambda (h) (mail-header-number (car h))) | |
8579 | (cddar thread)) | |
8580 | gnus-tmp-gathered)) | |
8581 | (setq gnus-tmp-level -1)) | |
8582 | ((eq gnus-summary-make-false-root 'dummy) | |
8583 | ;; We remember that we probably want to output a dummy | |
8584 | ;; root. | |
8585 | (setq gnus-tmp-dummy-line gnus-tmp-header) | |
8586 | (setq gnus-tmp-prev-subject gnus-tmp-header)) | |
8587 | (t | |
8588 | ;; We do not make a root for the gathered | |
8589 | ;; sub-threads at all. | |
8590 | (setq gnus-tmp-level -1))) | |
8591 | ||
8592 | (setq number (mail-header-number gnus-tmp-header) | |
8593 | subject (mail-header-subject gnus-tmp-header)) | |
8594 | ||
8595 | (cond | |
8596 | ;; If the thread has changed subject, we might want to make | |
8597 | ;; this subthread into a root. | |
8598 | ((and (null gnus-thread-ignore-subject) | |
8599 | (not (zerop gnus-tmp-level)) | |
8600 | gnus-tmp-prev-subject | |
8601 | (not (inline | |
8602 | (gnus-subject-equal gnus-tmp-prev-subject subject)))) | |
8603 | (setq new-roots (nconc new-roots (list (car thread))) | |
8604 | thread-end t | |
8605 | gnus-tmp-header nil)) | |
8606 | ;; If the article lies outside the current limit, | |
8607 | ;; then we do not display it. | |
8608 | ((and (not (memq number gnus-newsgroup-limit)) | |
564b670b LMI |
8609 | ;(not gnus-tmp-dummy-line) |
8610 | ) | |
231f989b LMI |
8611 | (setq gnus-tmp-gathered |
8612 | (nconc (mapcar | |
8613 | (lambda (h) (mail-header-number (car h))) | |
8614 | (cdar thread)) | |
8615 | gnus-tmp-gathered)) | |
8616 | (setq gnus-tmp-new-adopts (if (cdar thread) | |
8617 | (append gnus-tmp-new-adopts | |
8618 | (cdar thread)) | |
8619 | gnus-tmp-new-adopts) | |
8620 | thread-end t | |
8621 | gnus-tmp-header nil) | |
8622 | (when (zerop gnus-tmp-level) | |
8623 | (setq gnus-tmp-root-expunged t))) | |
8624 | ;; Perhaps this article is to be marked as read? | |
8625 | ((and gnus-summary-mark-below | |
8626 | (< (or (cdr (assq number gnus-newsgroup-scored)) | |
8627 | default-score) | |
8628 | gnus-summary-mark-below) | |
8629 | ;; Don't touch sparse articles. | |
8630 | (not (memq number gnus-newsgroup-sparse)) | |
8631 | (not (memq number gnus-newsgroup-ancient))) | |
8632 | (setq gnus-newsgroup-unreads | |
8633 | (delq number gnus-newsgroup-unreads)) | |
8634 | (if gnus-newsgroup-auto-expire | |
8635 | (push number gnus-newsgroup-expirable) | |
8636 | (push (cons number gnus-low-score-mark) | |
8637 | gnus-newsgroup-reads)))) | |
8638 | ||
8639 | (when gnus-tmp-header | |
8640 | ;; We may have an old dummy line to output before this | |
8641 | ;; article. | |
8642 | (when gnus-tmp-dummy-line | |
8643 | (gnus-summary-insert-dummy-line | |
8644 | gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) | |
8645 | (setq gnus-tmp-dummy-line nil)) | |
8646 | ||
8647 | ;; Compute the mark. | |
8648 | (setq | |
8649 | gnus-tmp-unread | |
8650 | (cond | |
8651 | ((memq number gnus-newsgroup-unreads) gnus-unread-mark) | |
8652 | ((memq number gnus-newsgroup-marked) gnus-ticked-mark) | |
8653 | ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) | |
8654 | ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) | |
8655 | (t (or (cdr (assq number gnus-newsgroup-reads)) | |
8656 | gnus-ancient-mark)))) | |
8657 | ||
8658 | (push (gnus-data-make number gnus-tmp-unread (1+ (point)) | |
8659 | gnus-tmp-header gnus-tmp-level) | |
8660 | gnus-newsgroup-data) | |
8661 | ||
8662 | ;; Actually insert the line. | |
8663 | (setq | |
8664 | gnus-tmp-subject-or-nil | |
8665 | (cond | |
8666 | ((and gnus-thread-ignore-subject | |
8667 | gnus-tmp-prev-subject | |
8668 | (not (inline (gnus-subject-equal | |
8669 | gnus-tmp-prev-subject subject)))) | |
8670 | subject) | |
8671 | ((zerop gnus-tmp-level) | |
8672 | (if (and (eq gnus-summary-make-false-root 'empty) | |
8673 | (memq number gnus-tmp-gathered) | |
8674 | gnus-tmp-prev-subject | |
8675 | (inline (gnus-subject-equal | |
8676 | gnus-tmp-prev-subject subject))) | |
8677 | gnus-summary-same-subject | |
8678 | subject)) | |
8679 | (t gnus-summary-same-subject))) | |
8680 | (if (and (eq gnus-summary-make-false-root 'adopt) | |
8681 | (= gnus-tmp-level 1) | |
41487370 | 8682 | (memq number gnus-tmp-gathered)) |
231f989b LMI |
8683 | (setq gnus-tmp-opening-bracket ?\< |
8684 | gnus-tmp-closing-bracket ?\>) | |
8685 | (setq gnus-tmp-opening-bracket ?\[ | |
8686 | gnus-tmp-closing-bracket ?\])) | |
8687 | (setq | |
8688 | gnus-tmp-indentation | |
8689 | (aref gnus-thread-indent-array gnus-tmp-level) | |
8690 | gnus-tmp-lines (mail-header-lines gnus-tmp-header) | |
8691 | gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) | |
8692 | gnus-summary-default-score 0) | |
8693 | gnus-tmp-score-char | |
8694 | (if (or (null gnus-summary-default-score) | |
8695 | (<= (abs (- gnus-tmp-score gnus-summary-default-score)) | |
8696 | gnus-summary-zcore-fuzz)) ? | |
8697 | (if (< gnus-tmp-score gnus-summary-default-score) | |
8698 | gnus-score-below-mark gnus-score-over-mark)) | |
8699 | gnus-tmp-replied | |
8700 | (cond ((memq number gnus-newsgroup-processable) | |
8701 | gnus-process-mark) | |
8702 | ((memq number gnus-newsgroup-cached) | |
8703 | gnus-cached-mark) | |
8704 | ((memq number gnus-newsgroup-replied) | |
8705 | gnus-replied-mark) | |
8706 | ((memq number gnus-newsgroup-saved) | |
8707 | gnus-saved-mark) | |
8708 | (t gnus-unread-mark)) | |
8709 | gnus-tmp-from (mail-header-from gnus-tmp-header) | |
8710 | gnus-tmp-name | |
8711 | (cond | |
8712 | ((string-match "(.+)" gnus-tmp-from) | |
8713 | (substring gnus-tmp-from | |
8714 | (1+ (match-beginning 0)) (1- (match-end 0)))) | |
8715 | ((string-match "<[^>]+> *$" gnus-tmp-from) | |
8716 | (setq beg-match (match-beginning 0)) | |
8717 | (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) | |
8718 | (substring gnus-tmp-from (1+ (match-beginning 0)) | |
8719 | (1- (match-end 0)))) | |
8720 | (substring gnus-tmp-from 0 beg-match))) | |
8721 | (t gnus-tmp-from))) | |
8722 | (when (string= gnus-tmp-name "") | |
8723 | (setq gnus-tmp-name gnus-tmp-from)) | |
8724 | (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) | |
8725 | (gnus-put-text-property | |
8726 | (point) | |
8727 | (progn (eval gnus-summary-line-format-spec) (point)) | |
8728 | 'gnus-number number) | |
8729 | (when gnus-visual-p | |
8730 | (forward-line -1) | |
8731 | (run-hooks 'gnus-summary-update-hook) | |
8732 | (forward-line 1)) | |
8733 | ||
8734 | (setq gnus-tmp-prev-subject subject))) | |
8735 | ||
8736 | (when (nth 1 thread) | |
8737 | (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) | |
8738 | (incf gnus-tmp-level) | |
8739 | (setq threads (if thread-end nil (cdar thread))) | |
8740 | (unless threads | |
8741 | (setq gnus-tmp-level 0))))) | |
8742 | (gnus-message 7 "Generating summary...done")) | |
8743 | ||
8744 | (defun gnus-summary-prepare-unthreaded (headers) | |
8745 | "Generate an unthreaded summary buffer based on HEADERS." | |
8746 | (let (header number mark) | |
41487370 LMI |
8747 | |
8748 | (while headers | |
41487370 | 8749 | ;; We may have to root out some bad articles... |
231f989b LMI |
8750 | (when (memq (setq number (mail-header-number |
8751 | (setq header (pop headers)))) | |
8752 | gnus-newsgroup-limit) | |
8753 | ;; Mark article as read when it has a low score. | |
8754 | (when (and gnus-summary-mark-below | |
8755 | (< (or (cdr (assq number gnus-newsgroup-scored)) | |
8756 | gnus-summary-default-score 0) | |
8757 | gnus-summary-mark-below) | |
8758 | (not (memq number gnus-newsgroup-ancient))) | |
8759 | (setq gnus-newsgroup-unreads | |
8760 | (delq number gnus-newsgroup-unreads)) | |
8761 | (if gnus-newsgroup-auto-expire | |
8762 | (push number gnus-newsgroup-expirable) | |
8763 | (push (cons number gnus-low-score-mark) | |
8764 | gnus-newsgroup-reads))) | |
8765 | ||
8766 | (setq mark | |
8767 | (cond | |
8768 | ((memq number gnus-newsgroup-marked) gnus-ticked-mark) | |
41487370 LMI |
8769 | ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) |
8770 | ((memq number gnus-newsgroup-unreads) gnus-unread-mark) | |
8771 | ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) | |
8772 | (t (or (cdr (assq number gnus-newsgroup-reads)) | |
231f989b LMI |
8773 | gnus-ancient-mark)))) |
8774 | (setq gnus-newsgroup-data | |
8775 | (cons (gnus-data-make number mark (1+ (point)) header 0) | |
8776 | gnus-newsgroup-data)) | |
8777 | (gnus-summary-insert-line | |
8778 | header 0 nil mark (memq number gnus-newsgroup-replied) | |
41487370 LMI |
8779 | (memq number gnus-newsgroup-expirable) |
8780 | (mail-header-subject header) nil | |
8781 | (cdr (assq number gnus-newsgroup-scored)) | |
231f989b | 8782 | (memq number gnus-newsgroup-processable)))))) |
41487370 LMI |
8783 | |
8784 | (defun gnus-select-newsgroup (group &optional read-all) | |
8785 | "Select newsgroup GROUP. | |
8786 | If READ-ALL is non-nil, all articles in the group are selected." | |
8787 | (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) | |
8788 | (info (nth 2 entry)) | |
231f989b | 8789 | articles fetched-articles cached) |
41487370 LMI |
8790 | |
8791 | (or (gnus-check-server | |
8792 | (setq gnus-current-select-method (gnus-find-method-for-group group))) | |
8793 | (error "Couldn't open server")) | |
231f989b | 8794 | |
41487370 | 8795 | (or (and entry (not (eq (car entry) t))) ; Either it's active... |
231f989b LMI |
8796 | (gnus-activate-group group) ; Or we can activate it... |
8797 | (progn ; Or we bug out. | |
8798 | (when (equal major-mode 'gnus-summary-mode) | |
8799 | (kill-buffer (current-buffer))) | |
8800 | (error "Couldn't request group %s: %s" | |
41487370 LMI |
8801 | group (gnus-status-message group)))) |
8802 | ||
231f989b LMI |
8803 | (unless (gnus-request-group group t) |
8804 | (when (equal major-mode 'gnus-summary-mode) | |
8805 | (kill-buffer (current-buffer))) | |
8806 | (error "Couldn't request group %s: %s" | |
8807 | group (gnus-status-message group))) | |
8808 | ||
41487370 LMI |
8809 | (setq gnus-newsgroup-name group) |
8810 | (setq gnus-newsgroup-unselected nil) | |
8811 | (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) | |
8812 | ||
8813 | (and gnus-asynchronous | |
231f989b | 8814 | (gnus-check-backend-function |
41487370 LMI |
8815 | 'request-asynchronous gnus-newsgroup-name) |
8816 | (setq gnus-newsgroup-async | |
8817 | (gnus-request-asynchronous gnus-newsgroup-name))) | |
8818 | ||
231f989b LMI |
8819 | ;; Adjust and set lists of article marks. |
8820 | (when info | |
8821 | (gnus-adjust-marked-articles info)) | |
8822 | ||
8823 | ;; Kludge to avoid having cached articles nixed out in virtual groups. | |
8824 | (when (gnus-virtual-group-p group) | |
8825 | (setq cached gnus-newsgroup-cached)) | |
8826 | ||
8827 | (setq gnus-newsgroup-unreads | |
8828 | (gnus-set-difference | |
8829 | (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) | |
8830 | gnus-newsgroup-dormant)) | |
8831 | ||
8832 | (setq gnus-newsgroup-processable nil) | |
8833 | ||
41487370 LMI |
8834 | (setq articles (gnus-articles-to-read group read-all)) |
8835 | ||
231f989b LMI |
8836 | (cond |
8837 | ((null articles) | |
8838 | ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") | |
41487370 LMI |
8839 | 'quit) |
8840 | ((eq articles 0) nil) | |
8841 | (t | |
8842 | ;; Init the dependencies hash table. | |
231f989b | 8843 | (setq gnus-newsgroup-dependencies |
41487370 LMI |
8844 | (gnus-make-hashtable (length articles))) |
8845 | ;; Retrieve the headers and read them in. | |
231f989b LMI |
8846 | (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) |
8847 | (setq gnus-newsgroup-headers | |
8848 | (if (eq 'nov | |
8849 | (setq gnus-headers-retrieved-by | |
8850 | (gnus-retrieve-headers | |
8851 | articles gnus-newsgroup-name | |
8852 | ;; We might want to fetch old headers, but | |
8853 | ;; not if there is only 1 article. | |
8854 | (and gnus-fetch-old-headers | |
8855 | (or (and | |
8856 | (not (eq gnus-fetch-old-headers 'some)) | |
8857 | (not (numberp gnus-fetch-old-headers))) | |
8858 | (> (length articles) 1)))))) | |
8859 | (gnus-get-newsgroup-headers-xover articles) | |
41487370 | 8860 | (gnus-get-newsgroup-headers))) |
231f989b LMI |
8861 | (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) |
8862 | ||
8863 | ;; Kludge to avoid having cached articles nixed out in virtual groups. | |
8864 | (when cached | |
8865 | (setq gnus-newsgroup-cached cached)) | |
8866 | ||
8867 | ;; Set the initial limit. | |
8868 | (setq gnus-newsgroup-limit (copy-sequence articles)) | |
41487370 LMI |
8869 | ;; Remove canceled articles from the list of unread articles. |
8870 | (setq gnus-newsgroup-unreads | |
231f989b | 8871 | (gnus-set-sorted-intersection |
41487370 | 8872 | gnus-newsgroup-unreads |
231f989b LMI |
8873 | (setq fetched-articles |
8874 | (mapcar (lambda (headers) (mail-header-number headers)) | |
8875 | gnus-newsgroup-headers)))) | |
8876 | ;; Removed marked articles that do not exist. | |
8877 | (gnus-update-missing-marks | |
8878 | (gnus-sorted-complement fetched-articles articles)) | |
8879 | ;; We might want to build some more threads first. | |
8880 | (and gnus-fetch-old-headers | |
8881 | (eq gnus-headers-retrieved-by 'nov) | |
8882 | (gnus-build-old-threads)) | |
41487370 LMI |
8883 | ;; Check whether auto-expire is to be done in this group. |
8884 | (setq gnus-newsgroup-auto-expire | |
231f989b LMI |
8885 | (gnus-group-auto-expirable-p group)) |
8886 | ;; Set up the article buffer now, if necessary. | |
8887 | (unless gnus-single-article-buffer | |
8888 | (gnus-article-setup-buffer)) | |
41487370 | 8889 | ;; First and last article in this newsgroup. |
231f989b LMI |
8890 | (when gnus-newsgroup-headers |
8891 | (setq gnus-newsgroup-begin | |
8892 | (mail-header-number (car gnus-newsgroup-headers)) | |
8893 | gnus-newsgroup-end | |
8894 | (mail-header-number | |
8895 | (gnus-last-element gnus-newsgroup-headers)))) | |
41487370 LMI |
8896 | (setq gnus-reffed-article-number -1) |
8897 | ;; GROUP is successfully selected. | |
8898 | (or gnus-newsgroup-headers t))))) | |
8899 | ||
8900 | (defun gnus-articles-to-read (group read-all) | |
8901 | ;; Find out what articles the user wants to read. | |
8902 | (let* ((articles | |
231f989b LMI |
8903 | ;; Select all articles if `read-all' is non-nil, or if there |
8904 | ;; are no unread articles. | |
41487370 | 8905 | (if (or read-all |
231f989b LMI |
8906 | (and (zerop (length gnus-newsgroup-marked)) |
8907 | (zerop (length gnus-newsgroup-unreads)))) | |
8908 | (gnus-uncompress-range (gnus-active group)) | |
8909 | (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked | |
8910 | (copy-sequence gnus-newsgroup-unreads)) | |
8911 | '<))) | |
41487370 LMI |
8912 | (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) |
8913 | (scored (length scored-list)) | |
8914 | (number (length articles)) | |
8915 | (marked (+ (length gnus-newsgroup-marked) | |
8916 | (length gnus-newsgroup-dormant))) | |
8917 | (select | |
231f989b | 8918 | (cond |
41487370 LMI |
8919 | ((numberp read-all) |
8920 | read-all) | |
8921 | (t | |
8922 | (condition-case () | |
231f989b LMI |
8923 | (cond |
8924 | ((and (or (<= scored marked) (= scored number)) | |
8925 | (numberp gnus-large-newsgroup) | |
8926 | (> number gnus-large-newsgroup)) | |
8927 | (let ((input | |
8928 | (read-string | |
8929 | (format | |
8930 | "How many articles from %s (default %d): " | |
8931 | gnus-newsgroup-name number)))) | |
8932 | (if (string-match "^[ \t]*$" input) number input))) | |
8933 | ((and (> scored marked) (< scored number) | |
8934 | (> (- scored number) 20)) | |
8935 | (let ((input | |
8936 | (read-string | |
8937 | (format "%s %s (%d scored, %d total): " | |
8938 | "How many articles from" | |
8939 | group scored number)))) | |
8940 | (if (string-match "^[ \t]*$" input) | |
8941 | number input))) | |
8942 | (t number)) | |
41487370 LMI |
8943 | (quit nil)))))) |
8944 | (setq select (if (stringp select) (string-to-number select) select)) | |
8945 | (if (or (null select) (zerop select)) | |
8946 | select | |
8947 | (if (and (not (zerop scored)) (<= (abs select) scored)) | |
8948 | (progn | |
8949 | (setq articles (sort scored-list '<)) | |
8950 | (setq number (length articles))) | |
8951 | (setq articles (copy-sequence articles))) | |
8952 | ||
8953 | (if (< (abs select) number) | |
231f989b | 8954 | (if (< select 0) |
41487370 LMI |
8955 | ;; Select the N oldest articles. |
8956 | (setcdr (nthcdr (1- (abs select)) articles) nil) | |
8957 | ;; Select the N most recent articles. | |
8958 | (setq articles (nthcdr (- number select) articles)))) | |
8959 | (setq gnus-newsgroup-unselected | |
8960 | (gnus-sorted-intersection | |
8961 | gnus-newsgroup-unreads | |
8962 | (gnus-sorted-complement gnus-newsgroup-unreads articles))) | |
8963 | articles))) | |
8964 | ||
8965 | (defun gnus-killed-articles (killed articles) | |
8966 | (let (out) | |
8967 | (while articles | |
8968 | (if (inline (gnus-member-of-range (car articles) killed)) | |
8969 | (setq out (cons (car articles) out))) | |
8970 | (setq articles (cdr articles))) | |
8971 | out)) | |
8972 | ||
231f989b LMI |
8973 | (defun gnus-uncompress-marks (marks) |
8974 | "Uncompress the mark ranges in MARKS." | |
8975 | (let ((uncompressed '(score bookmark)) | |
8976 | out) | |
8977 | (while marks | |
8978 | (if (memq (caar marks) uncompressed) | |
8979 | (push (car marks) out) | |
8980 | (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) | |
8981 | (setq marks (cdr marks))) | |
8982 | out)) | |
8983 | ||
8984 | (defun gnus-adjust-marked-articles (info) | |
8985 | "Set all article lists and remove all marks that are no longer legal." | |
8986 | (let* ((marked-lists (gnus-info-marks info)) | |
8987 | (active (gnus-active (gnus-info-group info))) | |
8988 | (min (car active)) | |
8989 | (max (cdr active)) | |
8990 | (types gnus-article-mark-lists) | |
564b670b | 8991 | (uncompressed '(score bookmark killed)) |
231f989b LMI |
8992 | marks var articles article mark) |
8993 | ||
41487370 | 8994 | (while marked-lists |
231f989b LMI |
8995 | (setq marks (pop marked-lists)) |
8996 | (set (setq var (intern (format "gnus-newsgroup-%s" | |
8997 | (car (rassq (setq mark (car marks)) | |
8998 | types))))) | |
8999 | (if (memq (car marks) uncompressed) (cdr marks) | |
9000 | (gnus-uncompress-range (cdr marks)))) | |
9001 | ||
9002 | (setq articles (symbol-value var)) | |
9003 | ||
9004 | ;; All articles have to be subsets of the active articles. | |
9005 | (cond | |
9006 | ;; Adjust "simple" lists. | |
564b670b | 9007 | ((memq mark '(tick dormant expirable reply save)) |
231f989b LMI |
9008 | (while articles |
9009 | (when (or (< (setq article (pop articles)) min) (> article max)) | |
9010 | (set var (delq article (symbol-value var)))))) | |
9011 | ;; Adjust assocs. | |
564b670b | 9012 | ((memq mark uncompressed) |
231f989b LMI |
9013 | (while articles |
9014 | (when (or (not (consp (setq article (pop articles)))) | |
9015 | (< (car article) min) | |
9016 | (> (car article) max)) | |
9017 | (set var (delq article (symbol-value var)))))))))) | |
9018 | ||
9019 | (defun gnus-update-missing-marks (missing) | |
9020 | "Go through the list of MISSING articles and remove them mark lists." | |
9021 | (when missing | |
9022 | (let ((types gnus-article-mark-lists) | |
9023 | var m) | |
9024 | ;; Go through all types. | |
9025 | (while types | |
9026 | (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) | |
9027 | (when (symbol-value var) | |
9028 | ;; This list has articles. So we delete all missing articles | |
9029 | ;; from it. | |
9030 | (setq m missing) | |
41487370 | 9031 | (while m |
231f989b LMI |
9032 | (set var (delq (pop m) (symbol-value var))))))))) |
9033 | ||
9034 | (defun gnus-update-marks () | |
41487370 | 9035 | "Enter the various lists of marked articles into the newsgroup info list." |
231f989b LMI |
9036 | (let ((types gnus-article-mark-lists) |
9037 | (info (gnus-get-info gnus-newsgroup-name)) | |
9038 | (uncompressed '(score bookmark killed)) | |
9039 | type list newmarked symbol) | |
9040 | (when info | |
9041 | ;; Add all marks lists that are non-nil to the list of marks lists. | |
9042 | (while types | |
9043 | (setq type (pop types)) | |
9044 | (when (setq list (symbol-value | |
9045 | (setq symbol | |
9046 | (intern (format "gnus-newsgroup-%s" | |
9047 | (car type)))))) | |
9048 | (push (cons (cdr type) | |
9049 | (if (memq (cdr type) uncompressed) list | |
9050 | (gnus-compress-sequence | |
9051 | (set symbol (sort list '<)) t))) | |
9052 | newmarked))) | |
9053 | ||
9054 | ;; Enter these new marks into the info of the group. | |
9055 | (if (nthcdr 3 info) | |
41487370 | 9056 | (setcar (nthcdr 3 info) newmarked) |
231f989b LMI |
9057 | ;; Add the marks lists to the end of the info. |
9058 | (when newmarked | |
9059 | (setcdr (nthcdr 2 info) (list newmarked)))) | |
9060 | ||
9061 | ;; Cut off the end of the info if there's nothing else there. | |
9062 | (let ((i 5)) | |
9063 | (while (and (> i 2) | |
9064 | (not (nth i info))) | |
9065 | (when (nthcdr (decf i) info) | |
9066 | (setcdr (nthcdr i info) nil))))))) | |
41487370 LMI |
9067 | |
9068 | (defun gnus-add-marked-articles (group type articles &optional info force) | |
9069 | ;; Add ARTICLES of TYPE to the info of GROUP. | |
231f989b | 9070 | ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't |
41487370 | 9071 | ;; add, but replace marked articles of TYPE with ARTICLES. |
231f989b LMI |
9072 | (let ((info (or info (gnus-get-info group))) |
9073 | (uncompressed '(score bookmark killed)) | |
41487370 LMI |
9074 | marked m) |
9075 | (or (not info) | |
9076 | (and (not (setq marked (nthcdr 3 info))) | |
231f989b LMI |
9077 | (or (null articles) |
9078 | (setcdr (nthcdr 2 info) | |
9079 | (list (list (cons type (gnus-compress-sequence | |
9080 | articles t))))))) | |
41487370 | 9081 | (and (not (setq m (assq type (car marked)))) |
231f989b LMI |
9082 | (or (null articles) |
9083 | (setcar marked | |
9084 | (cons (cons type (gnus-compress-sequence articles t) ) | |
9085 | (car marked))))) | |
41487370 | 9086 | (if force |
231f989b LMI |
9087 | (if (null articles) |
9088 | (setcar (nthcdr 3 info) | |
9089 | (delq (assq type (car marked)) (car marked))) | |
9090 | (setcdr m (gnus-compress-sequence articles t))) | |
9091 | (setcdr m (gnus-compress-sequence | |
9092 | (sort (nconc (gnus-uncompress-range (cdr m)) | |
9093 | (copy-sequence articles)) '<) t)))))) | |
9094 | ||
41487370 LMI |
9095 | (defun gnus-set-mode-line (where) |
9096 | "This function sets the mode line of the article or summary buffers. | |
9097 | If WHERE is `summary', the summary mode line format will be used." | |
231f989b LMI |
9098 | ;; Is this mode line one we keep updated? |
9099 | (when (memq where gnus-updated-mode-lines) | |
9100 | (let (mode-string) | |
9101 | (save-excursion | |
9102 | ;; We evaluate this in the summary buffer since these | |
9103 | ;; variables are buffer-local to that buffer. | |
9104 | (set-buffer gnus-summary-buffer) | |
9105 | ;; We bind all these variables that are used in the `eval' form | |
9106 | ;; below. | |
9107 | (let* ((mformat (symbol-value | |
9108 | (intern | |
9109 | (format "gnus-%s-mode-line-format-spec" where)))) | |
9110 | (gnus-tmp-group-name gnus-newsgroup-name) | |
9111 | (gnus-tmp-article-number (or gnus-current-article 0)) | |
9112 | (gnus-tmp-unread gnus-newsgroup-unreads) | |
9113 | (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) | |
9114 | (gnus-tmp-unselected (length gnus-newsgroup-unselected)) | |
9115 | (gnus-tmp-unread-and-unselected | |
9116 | (cond ((and (zerop gnus-tmp-unread-and-unticked) | |
9117 | (zerop gnus-tmp-unselected)) "") | |
9118 | ((zerop gnus-tmp-unselected) | |
9119 | (format "{%d more}" gnus-tmp-unread-and-unticked)) | |
9120 | (t (format "{%d(+%d) more}" | |
9121 | gnus-tmp-unread-and-unticked | |
9122 | gnus-tmp-unselected)))) | |
9123 | (gnus-tmp-subject | |
9124 | (if (and gnus-current-headers | |
9125 | (vectorp gnus-current-headers)) | |
9126 | (gnus-mode-string-quote | |
9127 | (mail-header-subject gnus-current-headers)) "")) | |
9128 | max-len | |
9129 | gnus-tmp-header);; passed as argument to any user-format-funcs | |
9130 | (setq mode-string (eval mformat)) | |
9131 | (setq max-len (max 4 (if gnus-mode-non-string-length | |
9132 | (- (window-width) | |
9133 | gnus-mode-non-string-length) | |
9134 | (length mode-string)))) | |
9135 | ;; We might have to chop a bit of the string off... | |
9136 | (when (> (length mode-string) max-len) | |
9137 | (setq mode-string | |
9138 | (concat (gnus-truncate-string mode-string (- max-len 3)) | |
9139 | "..."))) | |
9140 | ;; Pad the mode string a bit. | |
9141 | (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) | |
9142 | ;; Update the mode line. | |
9143 | (setq mode-line-buffer-identification | |
9144 | (gnus-mode-line-buffer-identification | |
9145 | (list mode-string))) | |
9146 | (set-buffer-modified-p t)))) | |
41487370 LMI |
9147 | |
9148 | (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) | |
9149 | "Go through the HEADERS list and add all Xrefs to a hash table. | |
9150 | The resulting hash table is returned, or nil if no Xrefs were found." | |
231f989b LMI |
9151 | (let* ((virtual (gnus-virtual-group-p from-newsgroup)) |
9152 | (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) | |
41487370 LMI |
9153 | (xref-hashtb (make-vector 63 0)) |
9154 | start group entry number xrefs header) | |
9155 | (while headers | |
231f989b LMI |
9156 | (setq header (pop headers)) |
9157 | (when (and (setq xrefs (mail-header-xref header)) | |
9158 | (not (memq (setq number (mail-header-number header)) | |
9159 | unreads))) | |
9160 | (setq start 0) | |
9161 | (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) | |
9162 | (setq start (match-end 0)) | |
9163 | (setq group (if prefix | |
9164 | (concat prefix (substring xrefs (match-beginning 1) | |
9165 | (match-end 1))) | |
9166 | (substring xrefs (match-beginning 1) (match-end 1)))) | |
9167 | (setq number | |
9168 | (string-to-int (substring xrefs (match-beginning 2) | |
9169 | (match-end 2)))) | |
9170 | (if (setq entry (gnus-gethash group xref-hashtb)) | |
9171 | (setcdr entry (cons number (cdr entry))) | |
9172 | (gnus-sethash group (cons number nil) xref-hashtb))))) | |
9173 | (and start xref-hashtb))) | |
9174 | ||
9175 | (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) | |
41487370 | 9176 | "Look through all the headers and mark the Xrefs as read." |
231f989b LMI |
9177 | (let ((virtual (gnus-virtual-group-p from-newsgroup)) |
9178 | name entry info xref-hashtb idlist method nth4) | |
41487370 LMI |
9179 | (save-excursion |
9180 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
9181 | (when (setq xref-hashtb |
9182 | (gnus-create-xref-hashtb from-newsgroup headers unreads)) | |
9183 | (mapatoms | |
9184 | (lambda (group) | |
9185 | (unless (string= from-newsgroup (setq name (symbol-name group))) | |
9186 | (setq idlist (symbol-value group)) | |
9187 | ;; Dead groups are not updated. | |
9188 | (and (prog1 | |
9189 | (setq entry (gnus-gethash name gnus-newsrc-hashtb) | |
9190 | info (nth 2 entry)) | |
9191 | (if (stringp (setq nth4 (gnus-info-method info))) | |
9192 | (setq nth4 (gnus-server-to-method nth4)))) | |
9193 | ;; Only do the xrefs if the group has the same | |
9194 | ;; select method as the group we have just read. | |
9195 | (or (gnus-methods-equal-p | |
9196 | nth4 (gnus-find-method-for-group from-newsgroup)) | |
9197 | virtual | |
9198 | (equal nth4 (setq method (gnus-find-method-for-group | |
9199 | from-newsgroup))) | |
9200 | (and (equal (car nth4) (car method)) | |
9201 | (equal (nth 1 nth4) (nth 1 method)))) | |
9202 | gnus-use-cross-reference | |
9203 | (or (not (eq gnus-use-cross-reference t)) | |
9204 | virtual | |
9205 | ;; Only do cross-references on subscribed | |
9206 | ;; groups, if that is what is wanted. | |
9207 | (<= (gnus-info-level info) gnus-level-subscribed)) | |
9208 | (gnus-group-make-articles-read name idlist)))) | |
9209 | xref-hashtb))))) | |
9210 | ||
9211 | (defun gnus-group-make-articles-read (group articles) | |
41487370 LMI |
9212 | (let* ((num 0) |
9213 | (entry (gnus-gethash group gnus-newsrc-hashtb)) | |
9214 | (info (nth 2 entry)) | |
231f989b LMI |
9215 | (active (gnus-active group)) |
9216 | range) | |
41487370 LMI |
9217 | ;; First peel off all illegal article numbers. |
9218 | (if active | |
9219 | (let ((ids articles) | |
41487370 | 9220 | id first) |
41487370 LMI |
9221 | (while ids |
9222 | (setq id (car ids)) | |
9223 | (if (and first (> id (cdr active))) | |
9224 | (progn | |
9225 | ;; We'll end up in this situation in one particular | |
231f989b | 9226 | ;; obscure situation. If you re-scan a group and get |
41487370 LMI |
9227 | ;; a new article that is cross-posted to a different |
9228 | ;; group that has not been re-scanned, you might get | |
9229 | ;; crossposted article that has a higher number than | |
231f989b LMI |
9230 | ;; Gnus believes possible. So we re-activate this |
9231 | ;; group as well. This might mean doing the | |
b94ae5f7 | 9232 | ;; crossposting thingy will *increase* the number |
231f989b | 9233 | ;; of articles in some groups. Tsk, tsk. |
41487370 LMI |
9234 | (setq active (or (gnus-activate-group group) active)))) |
9235 | (if (or (> id (cdr active)) | |
231f989b | 9236 | (< id (car active))) |
41487370 | 9237 | (setq articles (delq id articles))) |
41487370 | 9238 | (setq ids (cdr ids))))) |
231f989b | 9239 | ;; If the read list is nil, we init it. |
41487370 | 9240 | (and active |
231f989b | 9241 | (null (gnus-info-read info)) |
41487370 | 9242 | (> (car active) 1) |
231f989b LMI |
9243 | (gnus-info-set-read info (cons 1 (1- (car active))))) |
9244 | ;; Then we add the read articles to the range. | |
9245 | (gnus-info-set-read | |
9246 | info | |
9247 | (setq range | |
9248 | (gnus-add-to-range | |
9249 | (gnus-info-read info) (setq articles (sort articles '<))))) | |
41487370 LMI |
9250 | ;; Then we have to re-compute how many unread |
9251 | ;; articles there are in this group. | |
9252 | (if active | |
9253 | (progn | |
231f989b | 9254 | (cond |
41487370 LMI |
9255 | ((not range) |
9256 | (setq num (- (1+ (cdr active)) (car active)))) | |
9257 | ((not (listp (cdr range))) | |
231f989b | 9258 | (setq num (- (cdr active) (- (1+ (cdr range)) |
41487370 LMI |
9259 | (car range))))) |
9260 | (t | |
9261 | (while range | |
9262 | (if (numberp (car range)) | |
9263 | (setq num (1+ num)) | |
231f989b | 9264 | (setq num (+ num (- (1+ (cdar range)) (caar range))))) |
41487370 LMI |
9265 | (setq range (cdr range))) |
9266 | (setq num (- (cdr active) num)))) | |
9267 | ;; Update the number of unread articles. | |
231f989b | 9268 | (setcar entry num) |
41487370 LMI |
9269 | ;; Update the group buffer. |
9270 | (gnus-group-update-group group t))))) | |
9271 | ||
9272 | (defun gnus-methods-equal-p (m1 m2) | |
9273 | (let ((m1 (or m1 gnus-select-method)) | |
9274 | (m2 (or m2 gnus-select-method))) | |
9275 | (or (equal m1 m2) | |
9276 | (and (eq (car m1) (car m2)) | |
9277 | (or (not (memq 'address (assoc (symbol-name (car m1)) | |
9278 | gnus-valid-select-methods))) | |
9279 | (equal (nth 1 m1) (nth 1 m2))))))) | |
9280 | ||
9281 | (defsubst gnus-header-value () | |
9282 | (buffer-substring (match-end 0) (gnus-point-at-eol))) | |
9283 | ||
9284 | (defvar gnus-newsgroup-none-id 0) | |
9285 | ||
231f989b | 9286 | (defun gnus-get-newsgroup-headers (&optional dependencies force-new) |
41487370 | 9287 | (let ((cur nntp-server-buffer) |
231f989b LMI |
9288 | (dependencies |
9289 | (or dependencies | |
9290 | (save-excursion (set-buffer gnus-summary-buffer) | |
9291 | gnus-newsgroup-dependencies))) | |
9292 | headers id id-dep ref-dep end ref) | |
41487370 LMI |
9293 | (save-excursion |
9294 | (set-buffer nntp-server-buffer) | |
7e988fb6 | 9295 | (run-hooks 'gnus-parse-headers-hook) |
231f989b LMI |
9296 | (let ((case-fold-search t) |
9297 | in-reply-to header p lines) | |
9298 | (goto-char (point-min)) | |
9299 | ;; Search to the beginning of the next header. Error messages | |
9300 | ;; do not begin with 2 or 3. | |
9301 | (while (re-search-forward "^[23][0-9]+ " nil t) | |
41487370 LMI |
9302 | (setq id nil |
9303 | ref nil) | |
41487370 LMI |
9304 | ;; This implementation of this function, with nine |
9305 | ;; search-forwards instead of the one re-search-forward and | |
9306 | ;; a case (which basically was the old function) is actually | |
231f989b LMI |
9307 | ;; about twice as fast, even though it looks messier. You |
9308 | ;; can't have everything, I guess. Speed and elegance | |
9309 | ;; doesn't always go hand in hand. | |
9310 | (setq | |
9311 | header | |
9312 | (vector | |
9313 | ;; Number. | |
9314 | (prog1 | |
9315 | (read cur) | |
9316 | (end-of-line) | |
9317 | (setq p (point)) | |
9318 | (narrow-to-region (point) | |
9319 | (or (and (search-forward "\n.\n" nil t) | |
9320 | (- (point) 2)) | |
9321 | (point)))) | |
9322 | ;; Subject. | |
9323 | (progn | |
9324 | (goto-char p) | |
9325 | (if (search-forward "\nsubject: " nil t) | |
9326 | (gnus-header-value) "(none)")) | |
9327 | ;; From. | |
9328 | (progn | |
9329 | (goto-char p) | |
9330 | (if (search-forward "\nfrom: " nil t) | |
9331 | (gnus-header-value) "(nobody)")) | |
9332 | ;; Date. | |
9333 | (progn | |
9334 | (goto-char p) | |
9335 | (if (search-forward "\ndate: " nil t) | |
9336 | (gnus-header-value) "")) | |
9337 | ;; Message-ID. | |
9338 | (progn | |
9339 | (goto-char p) | |
9340 | (if (search-forward "\nmessage-id: " nil t) | |
9341 | (setq id (gnus-header-value)) | |
9342 | ;; If there was no message-id, we just fake one to make | |
9343 | ;; subsequent routines simpler. | |
9344 | (setq id (concat "none+" | |
9345 | (int-to-string | |
9346 | (setq gnus-newsgroup-none-id | |
9347 | (1+ gnus-newsgroup-none-id))))))) | |
9348 | ;; References. | |
9349 | (progn | |
9350 | (goto-char p) | |
9351 | (if (search-forward "\nreferences: " nil t) | |
41487370 | 9352 | (progn |
231f989b LMI |
9353 | (setq end (point)) |
9354 | (prog1 | |
9355 | (gnus-header-value) | |
9356 | (setq ref | |
9357 | (buffer-substring | |
9358 | (progn | |
9359 | (end-of-line) | |
9360 | (search-backward ">" end t) | |
9361 | (1+ (point))) | |
9362 | (progn | |
9363 | (search-backward "<" end t) | |
9364 | (point)))))) | |
9365 | ;; Get the references from the in-reply-to header if there | |
9366 | ;; were no references and the in-reply-to header looks | |
9367 | ;; promising. | |
9368 | (if (and (search-forward "\nin-reply-to: " nil t) | |
9369 | (setq in-reply-to (gnus-header-value)) | |
9370 | (string-match "<[^>]+>" in-reply-to)) | |
9371 | (setq ref (substring in-reply-to (match-beginning 0) | |
9372 | (match-end 0))) | |
9373 | (setq ref "")))) | |
9374 | ;; Chars. | |
9375 | 0 | |
9376 | ;; Lines. | |
9377 | (progn | |
9378 | (goto-char p) | |
9379 | (if (search-forward "\nlines: " nil t) | |
9380 | (if (numberp (setq lines (read cur))) | |
9381 | lines 0) | |
9382 | 0)) | |
9383 | ;; Xref. | |
9384 | (progn | |
9385 | (goto-char p) | |
9386 | (and (search-forward "\nxref: " nil t) | |
9387 | (gnus-header-value))))) | |
9388 | ;; We do the threading while we read the headers. The | |
9389 | ;; message-id and the last reference are both entered into | |
9390 | ;; the same hash table. Some tippy-toeing around has to be | |
9391 | ;; done in case an article has arrived before the article | |
9392 | ;; which it refers to. | |
9393 | (if (boundp (setq id-dep (intern id dependencies))) | |
9394 | (if (and (car (symbol-value id-dep)) | |
9395 | (not force-new)) | |
9396 | ;; An article with this Message-ID has already | |
9397 | ;; been seen, so we ignore this one, except we add | |
9398 | ;; any additional Xrefs (in case the two articles | |
9399 | ;; came from different servers). | |
9400 | (progn | |
9401 | (mail-header-set-xref | |
9402 | (car (symbol-value id-dep)) | |
9403 | (concat (or (mail-header-xref | |
9404 | (car (symbol-value id-dep))) "") | |
9405 | (or (mail-header-xref header) ""))) | |
9406 | (setq header nil)) | |
9407 | (setcar (symbol-value id-dep) header)) | |
9408 | (set id-dep (list header))) | |
9409 | (when header | |
9410 | (if (boundp (setq ref-dep (intern ref dependencies))) | |
9411 | (setcdr (symbol-value ref-dep) | |
9412 | (nconc (cdr (symbol-value ref-dep)) | |
9413 | (list (symbol-value id-dep)))) | |
9414 | (set ref-dep (list nil (symbol-value id-dep)))) | |
9415 | (setq headers (cons header headers))) | |
9416 | (goto-char (point-max)) | |
9417 | (widen)) | |
9418 | (nreverse headers))))) | |
41487370 LMI |
9419 | |
9420 | ;; The following macros and functions were written by Felix Lee | |
231f989b | 9421 | ;; <flee@cse.psu.edu>. |
41487370 LMI |
9422 | |
9423 | (defmacro gnus-nov-read-integer () | |
9424 | '(prog1 | |
9425 | (if (= (following-char) ?\t) | |
9426 | 0 | |
9427 | (let ((num (condition-case nil (read buffer) (error nil)))) | |
9428 | (if (numberp num) num 0))) | |
9429 | (or (eobp) (forward-char 1)))) | |
9430 | ||
9431 | (defmacro gnus-nov-skip-field () | |
9432 | '(search-forward "\t" eol 'move)) | |
9433 | ||
9434 | (defmacro gnus-nov-field () | |
9435 | '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) | |
9436 | ||
9437 | ;; Goes through the xover lines and returns a list of vectors | |
231f989b LMI |
9438 | (defun gnus-get-newsgroup-headers-xover (sequence &optional |
9439 | force-new dependencies) | |
41487370 LMI |
9440 | "Parse the news overview data in the server buffer, and return a |
9441 | list of headers that match SEQUENCE (see `nntp-retrieve-headers')." | |
9442 | ;; Get the Xref when the users reads the articles since most/some | |
9443 | ;; NNTP servers do not include Xrefs when using XOVER. | |
9444 | (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) | |
9445 | (let ((cur nntp-server-buffer) | |
231f989b | 9446 | (dependencies (or dependencies gnus-newsgroup-dependencies)) |
41487370 LMI |
9447 | number headers header) |
9448 | (save-excursion | |
9449 | (set-buffer nntp-server-buffer) | |
7e988fb6 LMI |
9450 | ;; Allow the user to mangle the headers before parsing them. |
9451 | (run-hooks 'gnus-parse-headers-hook) | |
41487370 LMI |
9452 | (goto-char (point-min)) |
9453 | (while (and sequence (not (eobp))) | |
9454 | (setq number (read cur)) | |
9455 | (while (and sequence (< (car sequence) number)) | |
9456 | (setq sequence (cdr sequence))) | |
231f989b | 9457 | (and sequence |
41487370 LMI |
9458 | (eq number (car sequence)) |
9459 | (progn | |
9460 | (setq sequence (cdr sequence)) | |
231f989b LMI |
9461 | (if (setq header |
9462 | (inline (gnus-nov-parse-line | |
9463 | number dependencies force-new))) | |
41487370 LMI |
9464 | (setq headers (cons header headers))))) |
9465 | (forward-line 1)) | |
9466 | (setq headers (nreverse headers))) | |
9467 | headers)) | |
9468 | ||
9469 | ;; This function has to be called with point after the article number | |
9470 | ;; on the beginning of the line. | |
231f989b | 9471 | (defun gnus-nov-parse-line (number dependencies &optional force-new) |
41487370 | 9472 | (let ((none 0) |
231f989b | 9473 | (eol (gnus-point-at-eol)) |
41487370 | 9474 | (buffer (current-buffer)) |
231f989b | 9475 | header ref id id-dep ref-dep) |
41487370 LMI |
9476 | |
9477 | ;; overview: [num subject from date id refs chars lines misc] | |
9478 | (narrow-to-region (point) eol) | |
9479 | (or (eobp) (forward-char)) | |
9480 | ||
9481 | (condition-case nil | |
9482 | (setq header | |
231f989b | 9483 | (vector |
41487370 | 9484 | number ; number |
231f989b LMI |
9485 | (gnus-nov-field) ; subject |
9486 | (gnus-nov-field) ; from | |
41487370 LMI |
9487 | (gnus-nov-field) ; date |
9488 | (setq id (or (gnus-nov-field) | |
9489 | (concat "none+" | |
231f989b | 9490 | (int-to-string |
41487370 LMI |
9491 | (setq none (1+ none)))))) ; id |
9492 | (progn | |
9493 | (save-excursion | |
9494 | (let ((beg (point))) | |
9495 | (search-forward "\t" eol) | |
9496 | (if (search-backward ">" beg t) | |
231f989b LMI |
9497 | (setq ref |
9498 | (buffer-substring | |
9499 | (1+ (point)) | |
9500 | (search-backward "<" beg t))) | |
41487370 LMI |
9501 | (setq ref nil)))) |
9502 | (gnus-nov-field)) ; refs | |
9503 | (gnus-nov-read-integer) ; chars | |
9504 | (gnus-nov-read-integer) ; lines | |
9505 | (if (= (following-char) ?\n) | |
9506 | nil | |
9507 | (gnus-nov-field)) ; misc | |
9508 | )) | |
231f989b LMI |
9509 | (error (progn |
9510 | (gnus-error 4 "Strange nov line") | |
41487370 LMI |
9511 | (setq header nil) |
9512 | (goto-char eol)))) | |
9513 | ||
9514 | (widen) | |
9515 | ||
9516 | ;; We build the thread tree. | |
231f989b LMI |
9517 | (when header |
9518 | (if (boundp (setq id-dep (intern id dependencies))) | |
9519 | (if (and (car (symbol-value id-dep)) | |
9520 | (not force-new)) | |
9521 | ;; An article with this Message-ID has already been seen, | |
9522 | ;; so we ignore this one, except we add any additional | |
9523 | ;; Xrefs (in case the two articles came from different | |
9524 | ;; servers. | |
9525 | (progn | |
9526 | (mail-header-set-xref | |
9527 | (car (symbol-value id-dep)) | |
9528 | (concat (or (mail-header-xref | |
9529 | (car (symbol-value id-dep))) "") | |
9530 | (or (mail-header-xref header) ""))) | |
9531 | (setq header nil)) | |
9532 | (setcar (symbol-value id-dep) header)) | |
9533 | (set id-dep (list header)))) | |
9534 | (when header | |
9535 | (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) | |
9536 | (setcdr (symbol-value ref-dep) | |
9537 | (nconc (cdr (symbol-value ref-dep)) | |
9538 | (list (symbol-value id-dep)))) | |
9539 | (set ref-dep (list nil (symbol-value id-dep))))) | |
41487370 LMI |
9540 | header)) |
9541 | ||
9542 | (defun gnus-article-get-xrefs () | |
9543 | "Fill in the Xref value in `gnus-current-headers', if necessary. | |
9544 | This is meant to be called in `gnus-article-internal-prepare-hook'." | |
9545 | (let ((headers (save-excursion (set-buffer gnus-summary-buffer) | |
9546 | gnus-current-headers))) | |
9547 | (or (not gnus-use-cross-reference) | |
9548 | (not headers) | |
9549 | (and (mail-header-xref headers) | |
9550 | (not (string= (mail-header-xref headers) ""))) | |
9551 | (let ((case-fold-search t) | |
9552 | xref) | |
9553 | (save-restriction | |
231f989b | 9554 | (nnheader-narrow-to-headers) |
41487370 LMI |
9555 | (goto-char (point-min)) |
9556 | (if (or (and (eq (downcase (following-char)) ?x) | |
9557 | (looking-at "Xref:")) | |
9558 | (search-forward "\nXref:" nil t)) | |
9559 | (progn | |
9560 | (goto-char (1+ (match-end 0))) | |
231f989b | 9561 | (setq xref (buffer-substring (point) |
41487370 LMI |
9562 | (progn (end-of-line) (point)))) |
9563 | (mail-header-set-xref headers xref)))))))) | |
9564 | ||
231f989b LMI |
9565 | (defun gnus-summary-insert-subject (id &optional old-header use-old-header) |
9566 | "Find article ID and insert the summary line for that article." | |
9567 | (let ((header (if (and old-header use-old-header) | |
9568 | old-header (gnus-read-header id))) | |
9569 | (number (and (numberp id) id)) | |
9570 | pos) | |
9571 | (when header | |
9572 | ;; Rebuild the thread that this article is part of and go to the | |
9573 | ;; article we have fetched. | |
9574 | (when (and (not gnus-show-threads) | |
9575 | old-header) | |
9576 | (when (setq pos (text-property-any | |
9577 | (point-min) (point-max) 'gnus-number | |
9578 | (mail-header-number old-header))) | |
9579 | (goto-char pos) | |
9580 | (gnus-delete-line) | |
9581 | (gnus-data-remove (mail-header-number old-header)))) | |
9582 | (when old-header | |
9583 | (mail-header-set-number header (mail-header-number old-header))) | |
9584 | (setq gnus-newsgroup-sparse | |
9585 | (delq (setq number (mail-header-number header)) | |
9586 | gnus-newsgroup-sparse)) | |
9587 | (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) | |
9588 | (gnus-rebuild-thread (mail-header-id header)) | |
9589 | (gnus-summary-goto-subject number nil t)) | |
9590 | (when (and (numberp number) | |
9591 | (> number 0)) | |
9592 | ;; We have to update the boundaries even if we can't fetch the | |
9593 | ;; article if ID is a number -- so that the next `P' or `N' | |
9594 | ;; command will fetch the previous (or next) article even | |
9595 | ;; if the one we tried to fetch this time has been canceled. | |
9596 | (and (> number gnus-newsgroup-end) | |
9597 | (setq gnus-newsgroup-end number)) | |
9598 | (and (< number gnus-newsgroup-begin) | |
9599 | (setq gnus-newsgroup-begin number)) | |
9600 | (setq gnus-newsgroup-unselected | |
9601 | (delq number gnus-newsgroup-unselected))) | |
9602 | ;; Report back a success? | |
9603 | (and header (mail-header-number header)))) | |
41487370 LMI |
9604 | |
9605 | (defun gnus-summary-work-articles (n) | |
231f989b | 9606 | "Return a list of articles to be worked upon. The prefix argument, |
41487370 LMI |
9607 | the list of process marked articles, and the current article will be |
9608 | taken into consideration." | |
231f989b LMI |
9609 | (cond |
9610 | (n | |
9611 | ;; A numerical prefix has been given. | |
9612 | (let ((backward (< n 0)) | |
9613 | (n (abs (prefix-numeric-value n))) | |
9614 | articles article) | |
9615 | (save-excursion | |
9616 | (while | |
9617 | (and (> n 0) | |
9618 | (push (setq article (gnus-summary-article-number)) | |
9619 | articles) | |
9620 | (if backward | |
9621 | (gnus-summary-find-prev nil article) | |
9622 | (gnus-summary-find-next nil article))) | |
9623 | (decf n))) | |
9624 | (nreverse articles))) | |
9625 | ((and (boundp 'transient-mark-mode) | |
9626 | transient-mark-mode | |
9627 | mark-active) | |
9628 | ;; Work on the region between point and mark. | |
9629 | (let ((max (max (point) (mark))) | |
9630 | articles article) | |
9631 | (save-excursion | |
9632 | (goto-char (min (point) (mark))) | |
9633 | (while | |
9634 | (and | |
9635 | (push (setq article (gnus-summary-article-number)) articles) | |
9636 | (gnus-summary-find-next nil article) | |
9637 | (< (point) max))) | |
9638 | (nreverse articles)))) | |
9639 | (gnus-newsgroup-processable | |
9640 | ;; There are process-marked articles present. | |
9641 | (reverse gnus-newsgroup-processable)) | |
9642 | (t | |
9643 | ;; Just return the current article. | |
9644 | (list (gnus-summary-article-number))))) | |
41487370 LMI |
9645 | |
9646 | (defun gnus-summary-search-group (&optional backward use-level) | |
9647 | "Search for next unread newsgroup. | |
9648 | If optional argument BACKWARD is non-nil, search backward instead." | |
9649 | (save-excursion | |
9650 | (set-buffer gnus-group-buffer) | |
231f989b | 9651 | (if (gnus-group-search-forward |
41487370 LMI |
9652 | backward nil (if use-level (gnus-group-group-level) nil)) |
9653 | (gnus-group-group-name)))) | |
9654 | ||
9655 | (defun gnus-summary-best-group (&optional exclude-group) | |
9656 | "Find the name of the best unread group. | |
9657 | If EXCLUDE-GROUP, do not go to this group." | |
9658 | (save-excursion | |
9659 | (set-buffer gnus-group-buffer) | |
9660 | (save-excursion | |
9661 | (gnus-group-best-unread-group exclude-group)))) | |
9662 | ||
231f989b LMI |
9663 | (defun gnus-summary-find-next (&optional unread article backward) |
9664 | (if backward (gnus-summary-find-prev) | |
9665 | (let* ((dummy (gnus-summary-article-intangible-p)) | |
9666 | (article (or article (gnus-summary-article-number))) | |
9667 | (arts (gnus-data-find-list article)) | |
9668 | result) | |
9669 | (when (and (not dummy) | |
9670 | (or (not gnus-summary-check-current) | |
9671 | (not unread) | |
9672 | (not (gnus-data-unread-p (car arts))))) | |
9673 | (setq arts (cdr arts))) | |
9674 | (when (setq result | |
9675 | (if unread | |
9676 | (progn | |
9677 | (while arts | |
9678 | (when (gnus-data-unread-p (car arts)) | |
9679 | (setq result (car arts) | |
9680 | arts nil)) | |
9681 | (setq arts (cdr arts))) | |
9682 | result) | |
9683 | (car arts))) | |
9684 | (goto-char (gnus-data-pos result)) | |
9685 | (gnus-data-number result))))) | |
9686 | ||
9687 | (defun gnus-summary-find-prev (&optional unread article) | |
9688 | (let* ((eobp (eobp)) | |
9689 | (article (or article (gnus-summary-article-number))) | |
9690 | (arts (gnus-data-find-list article (gnus-data-list 'rev))) | |
9691 | result) | |
9692 | (when (and (not eobp) | |
9693 | (or (not gnus-summary-check-current) | |
9694 | (not unread) | |
9695 | (not (gnus-data-unread-p (car arts))))) | |
9696 | (setq arts (cdr arts))) | |
9697 | (if (setq result | |
9698 | (if unread | |
9699 | (progn | |
9700 | (while arts | |
9701 | (and (gnus-data-unread-p (car arts)) | |
9702 | (setq result (car arts) | |
9703 | arts nil)) | |
9704 | (setq arts (cdr arts))) | |
9705 | result) | |
9706 | (car arts))) | |
9707 | (progn | |
9708 | (goto-char (gnus-data-pos result)) | |
9709 | (gnus-data-number result))))) | |
9710 | ||
9711 | (defun gnus-summary-find-subject (subject &optional unread backward article) | |
9712 | (let* ((simp-subject (gnus-simplify-subject-fully subject)) | |
9713 | (article (or article (gnus-summary-article-number))) | |
9714 | (articles (gnus-data-list backward)) | |
9715 | (arts (gnus-data-find-list article articles)) | |
9716 | result) | |
9717 | (when (or (not gnus-summary-check-current) | |
9718 | (not unread) | |
9719 | (not (gnus-data-unread-p (car arts)))) | |
9720 | (setq arts (cdr arts))) | |
9721 | (while arts | |
9722 | (and (or (not unread) | |
9723 | (gnus-data-unread-p (car arts))) | |
9724 | (vectorp (gnus-data-header (car arts))) | |
9725 | (gnus-subject-equal | |
9726 | simp-subject (mail-header-subject (gnus-data-header (car arts))) t) | |
9727 | (setq result (car arts) | |
9728 | arts nil)) | |
9729 | (setq arts (cdr arts))) | |
9730 | (and result | |
9731 | (goto-char (gnus-data-pos result)) | |
9732 | (gnus-data-number result)))) | |
9733 | ||
9734 | (defun gnus-summary-search-forward (&optional unread subject backward) | |
9735 | "Search forward for an article. | |
9736 | If UNREAD, look for unread articles. If SUBJECT, look for | |
9737 | articles with that subject. If BACKWARD, search backward instead." | |
9738 | (cond (subject (gnus-summary-find-subject subject unread backward)) | |
9739 | (backward (gnus-summary-find-prev unread)) | |
9740 | (t (gnus-summary-find-next unread)))) | |
9741 | ||
9742 | (defun gnus-recenter (&optional n) | |
9743 | "Center point in window and redisplay frame. | |
9744 | Also do horizontal recentering." | |
9745 | (interactive "P") | |
9746 | (when (and gnus-auto-center-summary | |
9747 | (not (eq gnus-auto-center-summary 'vertical))) | |
9748 | (gnus-horizontal-recenter)) | |
9749 | (recenter n)) | |
41487370 LMI |
9750 | |
9751 | (defun gnus-summary-recenter () | |
9752 | "Center point in the summary window. | |
9753 | If `gnus-auto-center-summary' is nil, or the article buffer isn't | |
231f989b | 9754 | displayed, no centering will be performed." |
41487370 | 9755 | ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). |
231f989b | 9756 | ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. |
41487370 LMI |
9757 | (let* ((top (cond ((< (window-height) 4) 0) |
9758 | ((< (window-height) 7) 1) | |
9759 | (t 2))) | |
9760 | (height (1- (window-height))) | |
9761 | (bottom (save-excursion (goto-char (point-max)) | |
9762 | (forward-line (- height)) | |
9763 | (point))) | |
9764 | (window (get-buffer-window (current-buffer)))) | |
231f989b LMI |
9765 | ;; The user has to want it. |
9766 | (when gnus-auto-center-summary | |
9767 | (when (get-buffer-window gnus-article-buffer) | |
9768 | ;; Only do recentering when the article buffer is displayed, | |
9769 | ;; Set the window start to either `bottom', which is the biggest | |
9770 | ;; possible valid number, or the second line from the top, | |
9771 | ;; whichever is the least. | |
9772 | (set-window-start | |
9773 | window (min bottom (save-excursion | |
9774 | (forward-line (- top)) (point))))) | |
9775 | ;; Do horizontal recentering while we're at it. | |
9776 | (when (and (get-buffer-window (current-buffer) t) | |
9777 | (not (eq gnus-auto-center-summary 'vertical))) | |
9778 | (let ((selected (selected-window))) | |
9779 | (select-window (get-buffer-window (current-buffer) t)) | |
9780 | (gnus-summary-position-point) | |
9781 | (gnus-horizontal-recenter) | |
9782 | (select-window selected)))))) | |
9783 | ||
9784 | (defun gnus-horizontal-recenter () | |
9785 | "Recenter the current buffer horizontally." | |
9786 | (if (< (current-column) (/ (window-width) 2)) | |
9787 | (set-window-hscroll (get-buffer-window (current-buffer) t) 0) | |
9788 | (let* ((orig (point)) | |
9789 | (end (window-end (get-buffer-window (current-buffer) t))) | |
9790 | (max 0)) | |
9791 | ;; Find the longest line currently displayed in the window. | |
9792 | (goto-char (window-start)) | |
9793 | (while (and (not (eobp)) | |
9794 | (< (point) end)) | |
9795 | (end-of-line) | |
9796 | (setq max (max max (current-column))) | |
9797 | (forward-line 1)) | |
9798 | (goto-char orig) | |
9799 | ;; Scroll horizontally to center (sort of) the point. | |
9800 | (if (> max (window-width)) | |
9801 | (set-window-hscroll | |
9802 | (get-buffer-window (current-buffer) t) | |
9803 | (min (- (current-column) (/ (window-width) 3)) | |
9804 | (+ 2 (- max (window-width))))) | |
9805 | (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) | |
9806 | max))) | |
41487370 LMI |
9807 | |
9808 | ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>. | |
9809 | (defun gnus-short-group-name (group &optional levels) | |
9810 | "Collapse GROUP name LEVELS." | |
231f989b LMI |
9811 | (let* ((name "") |
9812 | (foreign "") | |
9813 | (depth 0) | |
9814 | (skip 1) | |
41487370 LMI |
9815 | (levels (or levels |
9816 | (progn | |
9817 | (while (string-match "\\." group skip) | |
9818 | (setq skip (match-end 0) | |
9819 | depth (+ depth 1))) | |
9820 | depth)))) | |
9821 | (if (string-match ":" group) | |
9822 | (setq foreign (substring group 0 (match-end 0)) | |
9823 | group (substring group (match-end 0)))) | |
9824 | (while group | |
231f989b LMI |
9825 | (if (and (string-match "\\." group) |
9826 | (> levels (- gnus-group-uncollapsed-levels 1))) | |
41487370 LMI |
9827 | (setq name (concat name (substring group 0 1)) |
9828 | group (substring group (match-end 0)) | |
9829 | levels (- levels 1) | |
9830 | name (concat name ".")) | |
9831 | (setq name (concat foreign name group) | |
9832 | group nil))) | |
9833 | name)) | |
9834 | ||
9835 | (defun gnus-summary-jump-to-group (newsgroup) | |
9836 | "Move point to NEWSGROUP in group mode buffer." | |
9837 | ;; Keep update point of group mode buffer if visible. | |
9838 | (if (eq (current-buffer) (get-buffer gnus-group-buffer)) | |
9839 | (save-window-excursion | |
9840 | ;; Take care of tree window mode. | |
9841 | (if (get-buffer-window gnus-group-buffer) | |
9842 | (pop-to-buffer gnus-group-buffer)) | |
9843 | (gnus-group-jump-to-group newsgroup)) | |
9844 | (save-excursion | |
9845 | ;; Take care of tree window mode. | |
9846 | (if (get-buffer-window gnus-group-buffer) | |
9847 | (pop-to-buffer gnus-group-buffer) | |
9848 | (set-buffer gnus-group-buffer)) | |
9849 | (gnus-group-jump-to-group newsgroup)))) | |
9850 | ||
9851 | ;; This function returns a list of article numbers based on the | |
9852 | ;; difference between the ranges of read articles in this group and | |
9853 | ;; the range of active articles. | |
9854 | (defun gnus-list-of-unread-articles (group) | |
231f989b LMI |
9855 | (let* ((read (gnus-info-read (gnus-get-info group))) |
9856 | (active (gnus-active group)) | |
41487370 LMI |
9857 | (last (cdr active)) |
9858 | first nlast unread) | |
231f989b | 9859 | ;; If none are read, then all are unread. |
41487370 LMI |
9860 | (if (not read) |
9861 | (setq first (car active)) | |
9862 | ;; If the range of read articles is a single range, then the | |
9863 | ;; first unread article is the article after the last read | |
231f989b | 9864 | ;; article. Sounds logical, doesn't it? |
41487370 LMI |
9865 | (if (not (listp (cdr read))) |
9866 | (setq first (1+ (cdr read))) | |
9867 | ;; `read' is a list of ranges. | |
231f989b LMI |
9868 | (if (/= (setq nlast (or (and (numberp (car read)) (car read)) |
9869 | (caar read))) 1) | |
41487370 LMI |
9870 | (setq first 1)) |
9871 | (while read | |
231f989b | 9872 | (if first |
41487370 LMI |
9873 | (while (< first nlast) |
9874 | (setq unread (cons first unread)) | |
9875 | (setq first (1+ first)))) | |
231f989b LMI |
9876 | (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) |
9877 | (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) | |
41487370 LMI |
9878 | (setq read (cdr read))))) |
9879 | ;; And add the last unread articles. | |
9880 | (while (<= first last) | |
9881 | (setq unread (cons first unread)) | |
9882 | (setq first (1+ first))) | |
9883 | ;; Return the list of unread articles. | |
9884 | (nreverse unread))) | |
9885 | ||
9886 | (defun gnus-list-of-read-articles (group) | |
231f989b LMI |
9887 | "Return a list of unread, unticked and non-dormant articles." |
9888 | (let* ((info (gnus-get-info group)) | |
9889 | (marked (gnus-info-marks info)) | |
9890 | (active (gnus-active group))) | |
41487370 | 9891 | (and info active |
231f989b LMI |
9892 | (gnus-set-difference |
9893 | (gnus-sorted-complement | |
9894 | (gnus-uncompress-range active) | |
9895 | (gnus-list-of-unread-articles group)) | |
9896 | (append | |
9897 | (gnus-uncompress-range (cdr (assq 'dormant marked))) | |
9898 | (gnus-uncompress-range (cdr (assq 'tick marked)))))))) | |
41487370 LMI |
9899 | |
9900 | ;; Various summary commands | |
9901 | ||
231f989b LMI |
9902 | (defun gnus-summary-universal-argument (arg) |
9903 | "Perform any operation on all articles that are process/prefixed." | |
9904 | (interactive "P") | |
41487370 | 9905 | (gnus-set-global-variables) |
231f989b LMI |
9906 | (let ((articles (gnus-summary-work-articles arg)) |
9907 | func article) | |
9908 | (if (eq | |
9909 | (setq | |
9910 | func | |
9911 | (key-binding | |
9912 | (read-key-sequence | |
9913 | (substitute-command-keys | |
9914 | "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]" | |
9915 | )))) | |
9916 | 'undefined) | |
9917 | (gnus-error 1 "Undefined key") | |
9918 | (save-excursion | |
9919 | (while articles | |
9920 | (gnus-summary-goto-subject (setq article (pop articles))) | |
9921 | (command-execute func) | |
9922 | (gnus-summary-remove-process-mark article))))) | |
9923 | (gnus-summary-position-point)) | |
41487370 LMI |
9924 | |
9925 | (defun gnus-summary-toggle-truncation (&optional arg) | |
9926 | "Toggle truncation of summary lines. | |
9927 | With arg, turn line truncation on iff arg is positive." | |
9928 | (interactive "P") | |
9929 | (setq truncate-lines | |
9930 | (if (null arg) (not truncate-lines) | |
9931 | (> (prefix-numeric-value arg) 0))) | |
9932 | (redraw-display)) | |
9933 | ||
231f989b LMI |
9934 | (defun gnus-summary-reselect-current-group (&optional all rescan) |
9935 | "Exit and then reselect the current newsgroup. | |
41487370 LMI |
9936 | The prefix argument ALL means to select all articles." |
9937 | (interactive "P") | |
9938 | (gnus-set-global-variables) | |
231f989b LMI |
9939 | (when (gnus-ephemeral-group-p gnus-newsgroup-name) |
9940 | (error "Ephemeral groups can't be reselected")) | |
41487370 LMI |
9941 | (let ((current-subject (gnus-summary-article-number)) |
9942 | (group gnus-newsgroup-name)) | |
9943 | (setq gnus-newsgroup-begin nil) | |
231f989b | 9944 | (gnus-summary-exit) |
41487370 LMI |
9945 | ;; We have to adjust the point of group mode buffer because the |
9946 | ;; current point was moved to the next unread newsgroup by | |
9947 | ;; exiting. | |
9948 | (gnus-summary-jump-to-group group) | |
231f989b LMI |
9949 | (when rescan |
9950 | (save-excursion | |
9951 | (gnus-group-get-new-news-this-group 1))) | |
41487370 | 9952 | (gnus-group-read-group all t) |
231f989b | 9953 | (gnus-summary-goto-subject current-subject nil t))) |
41487370 LMI |
9954 | |
9955 | (defun gnus-summary-rescan-group (&optional all) | |
9956 | "Exit the newsgroup, ask for new articles, and select the newsgroup." | |
9957 | (interactive "P") | |
231f989b | 9958 | (gnus-summary-reselect-current-group all t)) |
41487370 LMI |
9959 | |
9960 | (defun gnus-summary-update-info () | |
9961 | (let* ((group gnus-newsgroup-name)) | |
231f989b LMI |
9962 | (when gnus-newsgroup-kill-headers |
9963 | (setq gnus-newsgroup-killed | |
9964 | (gnus-compress-sequence | |
9965 | (nconc | |
9966 | (gnus-set-sorted-intersection | |
9967 | (gnus-uncompress-range gnus-newsgroup-killed) | |
9968 | (setq gnus-newsgroup-unselected | |
9969 | (sort gnus-newsgroup-unselected '<))) | |
9970 | (setq gnus-newsgroup-unreads | |
9971 | (sort gnus-newsgroup-unreads '<))) t))) | |
9972 | (unless (listp (cdr gnus-newsgroup-killed)) | |
9973 | (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) | |
41487370 | 9974 | (let ((headers gnus-newsgroup-headers)) |
41487370 | 9975 | (run-hooks 'gnus-exit-group-hook) |
231f989b LMI |
9976 | (unless gnus-save-score |
9977 | (setq gnus-newsgroup-scored nil)) | |
9978 | ;; Set the new ranges of read articles. | |
9979 | (gnus-update-read-articles | |
9980 | group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) | |
9981 | ;; Set the current article marks. | |
9982 | (gnus-update-marks) | |
9983 | ;; Do the cross-ref thing. | |
9984 | (when gnus-use-cross-reference | |
9985 | (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) | |
41487370 | 9986 | ;; Do adaptive scoring, and possibly save score files. |
231f989b LMI |
9987 | (when gnus-newsgroup-adaptive |
9988 | (gnus-score-adaptive)) | |
9989 | (when gnus-use-scoring | |
9990 | (gnus-score-save)) | |
41487370 LMI |
9991 | ;; Do not switch windows but change the buffer to work. |
9992 | (set-buffer gnus-group-buffer) | |
9993 | (or (gnus-ephemeral-group-p gnus-newsgroup-name) | |
9994 | (gnus-group-update-group group))))) | |
231f989b | 9995 | |
41487370 LMI |
9996 | (defun gnus-summary-exit (&optional temporary) |
9997 | "Exit reading current newsgroup, and then return to group selection mode. | |
9998 | gnus-exit-group-hook is called with no arguments if that value is non-nil." | |
9999 | (interactive) | |
10000 | (gnus-set-global-variables) | |
10001 | (gnus-kill-save-kill-buffer) | |
10002 | (let* ((group gnus-newsgroup-name) | |
10003 | (quit-config (gnus-group-quit-config gnus-newsgroup-name)) | |
10004 | (mode major-mode) | |
10005 | (buf (current-buffer))) | |
10006 | (run-hooks 'gnus-summary-prepare-exit-hook) | |
231f989b LMI |
10007 | ;; If we have several article buffers, we kill them at exit. |
10008 | (unless gnus-single-article-buffer | |
10009 | (gnus-kill-buffer gnus-original-article-buffer) | |
10010 | (setq gnus-article-current nil)) | |
10011 | (when gnus-use-cache | |
10012 | (gnus-cache-possibly-remove-articles) | |
10013 | (gnus-cache-save-buffers)) | |
10014 | (when gnus-use-trees | |
10015 | (gnus-tree-close group)) | |
41487370 | 10016 | ;; Make all changes in this group permanent. |
231f989b LMI |
10017 | (unless quit-config |
10018 | (gnus-summary-update-info)) | |
10019 | (gnus-close-group group) | |
41487370 LMI |
10020 | ;; Make sure where I was, and go to next newsgroup. |
10021 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
10022 | (unless quit-config |
10023 | (gnus-group-jump-to-group group)) | |
10024 | (run-hooks 'gnus-summary-exit-hook) | |
10025 | (unless quit-config | |
10026 | (gnus-group-next-unread-group 1)) | |
41487370 LMI |
10027 | (if temporary |
10028 | nil ;Nothing to do. | |
231f989b LMI |
10029 | ;; If we have several article buffers, we kill them at exit. |
10030 | (unless gnus-single-article-buffer | |
10031 | (gnus-kill-buffer gnus-article-buffer) | |
10032 | (gnus-kill-buffer gnus-original-article-buffer) | |
10033 | (setq gnus-article-current nil)) | |
41487370 | 10034 | (set-buffer buf) |
231f989b LMI |
10035 | (if (not gnus-kill-summary-on-exit) |
10036 | (gnus-deaden-summary) | |
10037 | ;; We set all buffer-local variables to nil. It is unclear why | |
10038 | ;; this is needed, but if we don't, buffer-local variables are | |
10039 | ;; not garbage-collected, it seems. This would the lead to en | |
10040 | ;; ever-growing Emacs. | |
10041 | (gnus-summary-clear-local-variables) | |
10042 | (when (get-buffer gnus-article-buffer) | |
41487370 | 10043 | (bury-buffer gnus-article-buffer)) |
231f989b LMI |
10044 | ;; We clear the global counterparts of the buffer-local |
10045 | ;; variables as well, just to be on the safe side. | |
10046 | (gnus-configure-windows 'group 'force) | |
10047 | (gnus-summary-clear-local-variables) | |
10048 | ;; Return to group mode buffer. | |
10049 | (if (eq mode 'gnus-summary-mode) | |
10050 | (gnus-kill-buffer buf))) | |
41487370 LMI |
10051 | (setq gnus-current-select-method gnus-select-method) |
10052 | (pop-to-buffer gnus-group-buffer) | |
231f989b | 10053 | ;; Clear the current group name. |
41487370 LMI |
10054 | (if (not quit-config) |
10055 | (progn | |
10056 | (gnus-group-jump-to-group group) | |
231f989b LMI |
10057 | (gnus-group-next-unread-group 1) |
10058 | (gnus-configure-windows 'group 'force)) | |
41487370 LMI |
10059 | (if (not (buffer-name (car quit-config))) |
10060 | (gnus-configure-windows 'group 'force) | |
10061 | (set-buffer (car quit-config)) | |
10062 | (and (eq major-mode 'gnus-summary-mode) | |
10063 | (gnus-set-global-variables)) | |
10064 | (gnus-configure-windows (cdr quit-config)))) | |
231f989b LMI |
10065 | (unless quit-config |
10066 | (setq gnus-newsgroup-name nil))))) | |
41487370 LMI |
10067 | |
10068 | (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) | |
10069 | (defun gnus-summary-exit-no-update (&optional no-questions) | |
10070 | "Quit reading current newsgroup without updating read article info." | |
10071 | (interactive) | |
10072 | (gnus-set-global-variables) | |
10073 | (let* ((group gnus-newsgroup-name) | |
10074 | (quit-config (gnus-group-quit-config group))) | |
231f989b LMI |
10075 | (when (or no-questions |
10076 | gnus-expert-user | |
10077 | (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) | |
10078 | ;; If we have several article buffers, we kill them at exit. | |
10079 | (unless gnus-single-article-buffer | |
10080 | (gnus-kill-buffer gnus-article-buffer) | |
10081 | (gnus-kill-buffer gnus-original-article-buffer) | |
10082 | (setq gnus-article-current nil)) | |
10083 | (if (not gnus-kill-summary-on-exit) | |
10084 | (gnus-deaden-summary) | |
10085 | (gnus-close-group group) | |
10086 | (gnus-summary-clear-local-variables) | |
10087 | (set-buffer gnus-group-buffer) | |
10088 | (gnus-summary-clear-local-variables) | |
10089 | (when (get-buffer gnus-summary-buffer) | |
10090 | (kill-buffer gnus-summary-buffer))) | |
10091 | (unless gnus-single-article-buffer | |
10092 | (setq gnus-article-current nil)) | |
10093 | (when gnus-use-trees | |
10094 | (gnus-tree-close group)) | |
10095 | (when (get-buffer gnus-article-buffer) | |
10096 | (bury-buffer gnus-article-buffer)) | |
10097 | ;; Return to the group buffer. | |
10098 | (gnus-configure-windows 'group 'force) | |
10099 | ;; Clear the current group name. | |
10100 | (setq gnus-newsgroup-name nil) | |
10101 | (when (equal (gnus-group-group-name) group) | |
10102 | (gnus-group-next-unread-group 1)) | |
10103 | (when quit-config | |
10104 | (if (not (buffer-name (car quit-config))) | |
10105 | (gnus-configure-windows 'group 'force) | |
10106 | (set-buffer (car quit-config)) | |
10107 | (when (eq major-mode 'gnus-summary-mode) | |
10108 | (gnus-set-global-variables)) | |
10109 | (gnus-configure-windows (cdr quit-config))))))) | |
10110 | ||
10111 | ;;; Dead summaries. | |
10112 | ||
10113 | (defvar gnus-dead-summary-mode-map nil) | |
10114 | ||
10115 | (if gnus-dead-summary-mode-map | |
10116 | nil | |
10117 | (setq gnus-dead-summary-mode-map (make-keymap)) | |
10118 | (suppress-keymap gnus-dead-summary-mode-map) | |
10119 | (substitute-key-definition | |
10120 | 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) | |
10121 | (let ((keys '("\C-d" "\r" "\177"))) | |
10122 | (while keys | |
10123 | (define-key gnus-dead-summary-mode-map | |
10124 | (pop keys) 'gnus-summary-wake-up-the-dead)))) | |
10125 | ||
10126 | (defvar gnus-dead-summary-mode nil | |
10127 | "Minor mode for Gnus summary buffers.") | |
10128 | ||
10129 | (defun gnus-dead-summary-mode (&optional arg) | |
10130 | "Minor mode for Gnus summary buffers." | |
10131 | (interactive "P") | |
10132 | (when (eq major-mode 'gnus-summary-mode) | |
10133 | (make-local-variable 'gnus-dead-summary-mode) | |
10134 | (setq gnus-dead-summary-mode | |
10135 | (if (null arg) (not gnus-dead-summary-mode) | |
10136 | (> (prefix-numeric-value arg) 0))) | |
10137 | (when gnus-dead-summary-mode | |
10138 | (unless (assq 'gnus-dead-summary-mode minor-mode-alist) | |
10139 | (push '(gnus-dead-summary-mode " Dead") minor-mode-alist)) | |
10140 | (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist) | |
10141 | (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map) | |
10142 | minor-mode-map-alist))))) | |
10143 | ||
10144 | (defun gnus-deaden-summary () | |
10145 | "Make the current summary buffer into a dead summary buffer." | |
10146 | ;; Kill any previous dead summary buffer. | |
10147 | (when (and gnus-dead-summary | |
10148 | (buffer-name gnus-dead-summary)) | |
10149 | (save-excursion | |
10150 | (set-buffer gnus-dead-summary) | |
10151 | (when gnus-dead-summary-mode | |
10152 | (kill-buffer (current-buffer))))) | |
10153 | ;; Make this the current dead summary. | |
10154 | (setq gnus-dead-summary (current-buffer)) | |
10155 | (gnus-dead-summary-mode 1) | |
10156 | (let ((name (buffer-name))) | |
10157 | (when (string-match "Summary" name) | |
10158 | (rename-buffer | |
10159 | (concat (substring name 0 (match-beginning 0)) "Dead " | |
10160 | (substring name (match-beginning 0))) t)))) | |
10161 | ||
10162 | (defun gnus-kill-or-deaden-summary (buffer) | |
10163 | "Kill or deaden the summary BUFFER." | |
10164 | (when (and (buffer-name buffer) | |
10165 | (not gnus-single-article-buffer)) | |
10166 | (save-excursion | |
10167 | (set-buffer buffer) | |
10168 | (gnus-kill-buffer gnus-article-buffer) | |
10169 | (gnus-kill-buffer gnus-original-article-buffer))) | |
10170 | (cond (gnus-kill-summary-on-exit | |
10171 | (when (and gnus-use-trees | |
10172 | (and (get-buffer buffer) | |
10173 | (buffer-name (get-buffer buffer)))) | |
10174 | (save-excursion | |
10175 | (set-buffer (get-buffer buffer)) | |
10176 | (gnus-tree-close gnus-newsgroup-name))) | |
10177 | (gnus-kill-buffer buffer)) | |
10178 | ((and (get-buffer buffer) | |
10179 | (buffer-name (get-buffer buffer))) | |
10180 | (save-excursion | |
10181 | (set-buffer buffer) | |
10182 | (gnus-deaden-summary))))) | |
10183 | ||
10184 | (defun gnus-summary-wake-up-the-dead (&rest args) | |
10185 | "Wake up the dead summary buffer." | |
10186 | (interactive) | |
10187 | (gnus-dead-summary-mode -1) | |
10188 | (let ((name (buffer-name))) | |
10189 | (when (string-match "Dead " name) | |
10190 | (rename-buffer | |
10191 | (concat (substring name 0 (match-beginning 0)) | |
10192 | (substring name (match-end 0))) t))) | |
10193 | (gnus-message 3 "This dead summary is now alive again")) | |
41487370 LMI |
10194 | |
10195 | ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>. | |
231f989b LMI |
10196 | (defun gnus-summary-fetch-faq (&optional faq-dir) |
10197 | "Fetch the FAQ for the current group. | |
10198 | If FAQ-DIR (the prefix), prompt for a directory to search for the faq | |
10199 | in." | |
10200 | (interactive | |
10201 | (list | |
10202 | (if current-prefix-arg | |
10203 | (completing-read | |
10204 | "Faq dir: " (and (listp gnus-group-faq-directory) | |
10205 | gnus-group-faq-directory))))) | |
41487370 | 10206 | (let (gnus-faq-buffer) |
231f989b LMI |
10207 | (and (setq gnus-faq-buffer |
10208 | (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) | |
41487370 LMI |
10209 | (gnus-configure-windows 'summary-faq)))) |
10210 | ||
10211 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. | |
10212 | (defun gnus-summary-describe-group (&optional force) | |
10213 | "Describe the current newsgroup." | |
10214 | (interactive "P") | |
10215 | (gnus-group-describe-group force gnus-newsgroup-name)) | |
10216 | ||
10217 | (defun gnus-summary-describe-briefly () | |
10218 | "Describe summary mode commands briefly." | |
10219 | (interactive) | |
10220 | (gnus-message 6 | |
231f989b | 10221 | (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) |
41487370 LMI |
10222 | |
10223 | ;; Walking around group mode buffer from summary mode. | |
10224 | ||
10225 | (defun gnus-summary-next-group (&optional no-article target-group backward) | |
10226 | "Exit current newsgroup and then select next unread newsgroup. | |
10227 | If prefix argument NO-ARTICLE is non-nil, no article is selected | |
231f989b | 10228 | initially. If NEXT-GROUP, go to this group. If BACKWARD, go to |
41487370 LMI |
10229 | previous group instead." |
10230 | (interactive "P") | |
10231 | (gnus-set-global-variables) | |
10232 | (let ((current-group gnus-newsgroup-name) | |
10233 | (current-buffer (current-buffer)) | |
10234 | entered) | |
10235 | ;; First we semi-exit this group to update Xrefs and all variables. | |
10236 | ;; We can't do a real exit, because the window conf must remain | |
10237 | ;; the same in case the user is prompted for info, and we don't | |
10238 | ;; want the window conf to change before that... | |
10239 | (gnus-summary-exit t) | |
10240 | (while (not entered) | |
10241 | ;; Then we find what group we are supposed to enter. | |
10242 | (set-buffer gnus-group-buffer) | |
10243 | (gnus-group-jump-to-group current-group) | |
231f989b LMI |
10244 | (setq target-group |
10245 | (or target-group | |
10246 | (if (eq gnus-keep-same-level 'best) | |
41487370 LMI |
10247 | (gnus-summary-best-group gnus-newsgroup-name) |
10248 | (gnus-summary-search-group backward gnus-keep-same-level)))) | |
10249 | (if (not target-group) | |
10250 | ;; There are no further groups, so we return to the group | |
10251 | ;; buffer. | |
10252 | (progn | |
10253 | (gnus-message 5 "Returning to the group buffer") | |
10254 | (setq entered t) | |
10255 | (set-buffer current-buffer) | |
10256 | (gnus-summary-exit)) | |
10257 | ;; We try to enter the target group. | |
10258 | (gnus-group-jump-to-group target-group) | |
10259 | (let ((unreads (gnus-group-group-unread))) | |
10260 | (if (and (or (eq t unreads) | |
10261 | (and unreads (not (zerop unreads)))) | |
10262 | (gnus-summary-read-group | |
10263 | target-group nil no-article current-buffer)) | |
10264 | (setq entered t) | |
10265 | (setq current-group target-group | |
10266 | target-group nil))))))) | |
10267 | ||
41487370 LMI |
10268 | (defun gnus-summary-prev-group (&optional no-article) |
10269 | "Exit current newsgroup and then select previous unread newsgroup. | |
10270 | If prefix argument NO-ARTICLE is non-nil, no article is selected initially." | |
10271 | (interactive "P") | |
10272 | (gnus-summary-next-group no-article nil t)) | |
10273 | ||
10274 | ;; Walking around summary lines. | |
10275 | ||
10276 | (defun gnus-summary-first-subject (&optional unread) | |
10277 | "Go to the first unread subject. | |
10278 | If UNREAD is non-nil, go to the first unread article. | |
231f989b | 10279 | Returns the article selected or nil if there are no unread articles." |
41487370 LMI |
10280 | (interactive "P") |
10281 | (prog1 | |
231f989b LMI |
10282 | (cond |
10283 | ;; Empty summary. | |
10284 | ((null gnus-newsgroup-data) | |
10285 | (gnus-message 3 "No articles in the group") | |
10286 | nil) | |
10287 | ;; Pick the first article. | |
10288 | ((not unread) | |
10289 | (goto-char (gnus-data-pos (car gnus-newsgroup-data))) | |
10290 | (gnus-data-number (car gnus-newsgroup-data))) | |
10291 | ;; No unread articles. | |
10292 | ((null gnus-newsgroup-unreads) | |
10293 | (gnus-message 3 "No more unread articles") | |
10294 | nil) | |
10295 | ;; Find the first unread article. | |
10296 | (t | |
10297 | (let ((data gnus-newsgroup-data)) | |
10298 | (while (and data | |
10299 | (not (gnus-data-unread-p (car data)))) | |
10300 | (setq data (cdr data))) | |
10301 | (if data | |
10302 | (progn | |
10303 | (goto-char (gnus-data-pos (car data))) | |
10304 | (gnus-data-number (car data))))))) | |
10305 | (gnus-summary-position-point))) | |
41487370 LMI |
10306 | |
10307 | (defun gnus-summary-next-subject (n &optional unread dont-display) | |
10308 | "Go to next N'th summary line. | |
10309 | If N is negative, go to the previous N'th subject line. | |
10310 | If UNREAD is non-nil, only unread articles are selected. | |
10311 | The difference between N and the actual number of steps taken is | |
10312 | returned." | |
745bc783 | 10313 | (interactive "p") |
41487370 LMI |
10314 | (let ((backward (< n 0)) |
10315 | (n (abs n))) | |
10316 | (while (and (> n 0) | |
231f989b LMI |
10317 | (if backward |
10318 | (gnus-summary-find-prev unread) | |
10319 | (gnus-summary-find-next unread))) | |
41487370 LMI |
10320 | (setq n (1- n))) |
10321 | (if (/= 0 n) (gnus-message 7 "No more%s articles" | |
10322 | (if unread " unread" ""))) | |
231f989b LMI |
10323 | (unless dont-display |
10324 | (gnus-summary-recenter) | |
10325 | (gnus-summary-position-point)) | |
41487370 | 10326 | n)) |
745bc783 | 10327 | |
b027f415 | 10328 | (defun gnus-summary-next-unread-subject (n) |
41487370 | 10329 | "Go to next N'th unread summary line." |
745bc783 | 10330 | (interactive "p") |
b027f415 | 10331 | (gnus-summary-next-subject n t)) |
745bc783 | 10332 | |
b027f415 | 10333 | (defun gnus-summary-prev-subject (n &optional unread) |
41487370 | 10334 | "Go to previous N'th summary line. |
745bc783 JB |
10335 | If optional argument UNREAD is non-nil, only unread article is selected." |
10336 | (interactive "p") | |
41487370 | 10337 | (gnus-summary-next-subject (- n) unread)) |
745bc783 | 10338 | |
b027f415 | 10339 | (defun gnus-summary-prev-unread-subject (n) |
41487370 | 10340 | "Go to previous N'th unread summary line." |
745bc783 | 10341 | (interactive "p") |
41487370 LMI |
10342 | (gnus-summary-next-subject (- n) t)) |
10343 | ||
231f989b LMI |
10344 | (defun gnus-summary-goto-subject (article &optional force silent) |
10345 | "Go the subject line of ARTICLE. | |
10346 | If FORCE, also allow jumping to articles not currently shown." | |
10347 | (let ((b (point)) | |
10348 | (data (gnus-data-find article))) | |
10349 | ;; We read in the article if we have to. | |
10350 | (and (not data) | |
10351 | force | |
10352 | (gnus-summary-insert-subject article (and (vectorp force) force) t) | |
10353 | (setq data (gnus-data-find article))) | |
10354 | (goto-char b) | |
10355 | (if (not data) | |
10356 | (progn | |
10357 | (unless silent | |
10358 | (gnus-message 3 "Can't find article %d" article)) | |
10359 | nil) | |
10360 | (goto-char (gnus-data-pos data)) | |
10361 | article))) | |
745bc783 | 10362 | |
b027f415 | 10363 | ;; Walking around summary lines with displaying articles. |
745bc783 | 10364 | |
41487370 LMI |
10365 | (defun gnus-summary-expand-window (&optional arg) |
10366 | "Make the summary buffer take up the entire Emacs frame. | |
10367 | Given a prefix, will force an `article' buffer configuration." | |
10368 | (interactive "P") | |
10369 | (gnus-set-global-variables) | |
10370 | (if arg | |
10371 | (gnus-configure-windows 'article 'force) | |
10372 | (gnus-configure-windows 'summary 'force))) | |
745bc783 | 10373 | |
b027f415 | 10374 | (defun gnus-summary-display-article (article &optional all-header) |
41487370 LMI |
10375 | "Display ARTICLE in article buffer." |
10376 | (gnus-set-global-variables) | |
745bc783 JB |
10377 | (if (null article) |
10378 | nil | |
41487370 | 10379 | (prog1 |
231f989b LMI |
10380 | (if gnus-summary-display-article-function |
10381 | (funcall gnus-summary-display-article-function article all-header) | |
10382 | (gnus-article-prepare article all-header)) | |
41487370 | 10383 | (run-hooks 'gnus-select-article-hook) |
231f989b LMI |
10384 | (unless (zerop gnus-current-article) |
10385 | (gnus-summary-goto-subject gnus-current-article)) | |
41487370 | 10386 | (gnus-summary-recenter) |
231f989b LMI |
10387 | (when gnus-use-trees |
10388 | (gnus-possibly-generate-tree article) | |
10389 | (gnus-highlight-selected-tree article)) | |
41487370 | 10390 | ;; Successfully display article. |
231f989b LMI |
10391 | (gnus-article-set-window-start |
10392 | (cdr (assq article gnus-newsgroup-bookmarks)))))) | |
41487370 LMI |
10393 | |
10394 | (defun gnus-summary-select-article (&optional all-headers force pseudo article) | |
745bc783 | 10395 | "Select the current article. |
41487370 LMI |
10396 | If ALL-HEADERS is non-nil, show all header fields. If FORCE is |
10397 | non-nil, the article will be re-fetched even if it already present in | |
10398 | the article buffer. If PSEUDO is non-nil, pseudo-articles will also | |
10399 | be displayed." | |
231f989b LMI |
10400 | ;; Make sure we are in the summary buffer to work around bbdb bug. |
10401 | (unless (eq major-mode 'gnus-summary-mode) | |
10402 | (set-buffer gnus-summary-buffer)) | |
41487370 LMI |
10403 | (let ((article (or article (gnus-summary-article-number))) |
10404 | (all-headers (not (not all-headers))) ;Must be T or NIL. | |
231f989b LMI |
10405 | gnus-summary-display-article-function |
10406 | did) | |
10407 | (and (not pseudo) | |
10408 | (gnus-summary-article-pseudo-p article) | |
10409 | (error "This is a pseudo-article.")) | |
41487370 LMI |
10410 | (prog1 |
10411 | (save-excursion | |
10412 | (set-buffer gnus-summary-buffer) | |
231f989b LMI |
10413 | (if (or (and gnus-single-article-buffer |
10414 | (or (null gnus-current-article) | |
10415 | (null gnus-article-current) | |
10416 | (null (get-buffer gnus-article-buffer)) | |
10417 | (not (eq article (cdr gnus-article-current))) | |
10418 | (not (equal (car gnus-article-current) | |
10419 | gnus-newsgroup-name)))) | |
10420 | (and (not gnus-single-article-buffer) | |
10421 | (or (null gnus-current-article) | |
10422 | (not (eq gnus-current-article article)))) | |
41487370 LMI |
10423 | force) |
10424 | ;; The requested article is different from the current article. | |
231f989b LMI |
10425 | (prog1 |
10426 | (gnus-summary-display-article article all-headers) | |
41487370 | 10427 | (setq did article)) |
231f989b | 10428 | (if (or all-headers gnus-show-all-headers) |
41487370 | 10429 | (gnus-article-show-all-headers)) |
231f989b LMI |
10430 | 'old)) |
10431 | (if did | |
10432 | (gnus-article-set-window-start | |
41487370 | 10433 | (cdr (assq article gnus-newsgroup-bookmarks))))))) |
745bc783 | 10434 | |
b027f415 | 10435 | (defun gnus-summary-set-current-mark (&optional current-mark) |
41487370 LMI |
10436 | "Obsolete function." |
10437 | nil) | |
10438 | ||
231f989b | 10439 | (defun gnus-summary-next-article (&optional unread subject backward push) |
41487370 LMI |
10440 | "Select the next article. |
10441 | If UNREAD, only unread articles are selected. | |
10442 | If SUBJECT, only articles with SUBJECT are selected. | |
10443 | If BACKWARD, the previous article is selected instead of the next." | |
745bc783 | 10444 | (interactive "P") |
41487370 | 10445 | (gnus-set-global-variables) |
231f989b LMI |
10446 | (cond |
10447 | ;; Is there such an article? | |
10448 | ((and (gnus-summary-search-forward unread subject backward) | |
10449 | (or (gnus-summary-display-article (gnus-summary-article-number)) | |
10450 | (eq (gnus-summary-article-mark) gnus-canceled-mark))) | |
10451 | (gnus-summary-position-point)) | |
10452 | ;; If not, we try the first unread, if that is wanted. | |
10453 | ((and subject | |
10454 | gnus-auto-select-same | |
564b670b | 10455 | (gnus-summary-first-unread-article)) |
231f989b LMI |
10456 | (gnus-summary-position-point) |
10457 | (gnus-message 6 "Wrapped")) | |
10458 | ;; Try to get next/previous article not displayed in this group. | |
10459 | ((and gnus-auto-extend-newsgroup | |
10460 | (not unread) (not subject)) | |
10461 | (gnus-summary-goto-article | |
10462 | (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) | |
10463 | nil t)) | |
10464 | ;; Go to next/previous group. | |
10465 | (t | |
10466 | (or (gnus-ephemeral-group-p gnus-newsgroup-name) | |
10467 | (gnus-summary-jump-to-group gnus-newsgroup-name)) | |
10468 | (let ((cmd last-command-char) | |
10469 | (group | |
10470 | (if (eq gnus-keep-same-level 'best) | |
10471 | (gnus-summary-best-group gnus-newsgroup-name) | |
10472 | (gnus-summary-search-group backward gnus-keep-same-level)))) | |
10473 | ;; For some reason, the group window gets selected. We change | |
10474 | ;; it back. | |
10475 | (select-window (get-buffer-window (current-buffer))) | |
10476 | ;; Select next unread newsgroup automagically. | |
10477 | (cond | |
10478 | ((or (not gnus-auto-select-next) | |
10479 | (not cmd)) | |
10480 | (gnus-message 7 "No more%s articles" (if unread " unread" ""))) | |
10481 | ((or (eq gnus-auto-select-next 'quietly) | |
10482 | (and (eq gnus-auto-select-next 'slightly-quietly) | |
10483 | push) | |
10484 | (and (eq gnus-auto-select-next 'almost-quietly) | |
10485 | (gnus-summary-last-article-p))) | |
10486 | ;; Select quietly. | |
10487 | (if (gnus-ephemeral-group-p gnus-newsgroup-name) | |
10488 | (gnus-summary-exit) | |
10489 | (gnus-message 7 "No more%s articles (%s)..." | |
10490 | (if unread " unread" "") | |
10491 | (if group (concat "selecting " group) | |
10492 | "exiting")) | |
10493 | (gnus-summary-next-group nil group backward))) | |
10494 | (t | |
10495 | (gnus-summary-walk-group-buffer | |
10496 | gnus-newsgroup-name cmd unread backward))))))) | |
10497 | ||
10498 | (defun gnus-summary-walk-group-buffer (from-group cmd unread backward) | |
10499 | (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) | |
10500 | (?\C-p (gnus-group-prev-unread-group 1)))) | |
10501 | keve key group ended) | |
10502 | (save-excursion | |
10503 | (set-buffer gnus-group-buffer) | |
10504 | (gnus-summary-jump-to-group from-group) | |
10505 | (setq group | |
10506 | (if (eq gnus-keep-same-level 'best) | |
10507 | (gnus-summary-best-group gnus-newsgroup-name) | |
10508 | (gnus-summary-search-group backward gnus-keep-same-level)))) | |
10509 | (while (not ended) | |
10510 | (gnus-message | |
10511 | 5 "No more%s articles%s" (if unread " unread" "") | |
10512 | (if (and group | |
10513 | (not (gnus-ephemeral-group-p gnus-newsgroup-name))) | |
10514 | (format " (Type %s for %s [%s])" | |
10515 | (single-key-description cmd) group | |
10516 | (car (gnus-gethash group gnus-newsrc-hashtb))) | |
10517 | (format " (Type %s to exit %s)" | |
10518 | (single-key-description cmd) | |
10519 | gnus-newsgroup-name))) | |
10520 | ;; Confirm auto selection. | |
10521 | (setq key (car (setq keve (gnus-read-event-char)))) | |
10522 | (setq ended t) | |
10523 | (cond | |
10524 | ((assq key keystrokes) | |
10525 | (let ((obuf (current-buffer))) | |
10526 | (switch-to-buffer gnus-group-buffer) | |
10527 | (and group | |
10528 | (gnus-group-jump-to-group group)) | |
10529 | (eval (cadr (assq key keystrokes))) | |
10530 | (setq group (gnus-group-group-name)) | |
10531 | (switch-to-buffer obuf)) | |
10532 | (setq ended nil)) | |
10533 | ((equal key cmd) | |
10534 | (if (or (not group) | |
10535 | (gnus-ephemeral-group-p gnus-newsgroup-name)) | |
10536 | (gnus-summary-exit) | |
10537 | (gnus-summary-next-group nil group backward))) | |
10538 | (t | |
10539 | (push (cdr keve) unread-command-events)))))) | |
10540 | ||
10541 | (defun gnus-read-event-char () | |
10542 | "Get the next event." | |
10543 | (let ((event (read-event))) | |
10544 | (cons (and (numberp event) event) event))) | |
745bc783 | 10545 | |
b027f415 | 10546 | (defun gnus-summary-next-unread-article () |
745bc783 JB |
10547 | "Select unread article after current one." |
10548 | (interactive) | |
b027f415 | 10549 | (gnus-summary-next-article t (and gnus-auto-select-same |
231f989b | 10550 | (gnus-summary-article-subject)))) |
745bc783 | 10551 | |
41487370 LMI |
10552 | (defun gnus-summary-prev-article (&optional unread subject) |
10553 | "Select the article after the current one. | |
10554 | If UNREAD is non-nil, only unread articles are selected." | |
745bc783 | 10555 | (interactive "P") |
41487370 | 10556 | (gnus-summary-next-article unread subject t)) |
745bc783 | 10557 | |
b027f415 | 10558 | (defun gnus-summary-prev-unread-article () |
41487370 | 10559 | "Select unred article before current one." |
745bc783 | 10560 | (interactive) |
b027f415 | 10561 | (gnus-summary-prev-article t (and gnus-auto-select-same |
231f989b | 10562 | (gnus-summary-article-subject)))) |
745bc783 | 10563 | |
41487370 | 10564 | (defun gnus-summary-next-page (&optional lines circular) |
231f989b LMI |
10565 | "Show next page of the selected article. |
10566 | If at the end of the current article, select the next article. | |
10567 | LINES says how many lines should be scrolled up. | |
10568 | ||
10569 | If CIRCULAR is non-nil, go to the start of the article instead of | |
10570 | selecting the next article when reaching the end of the current | |
10571 | article." | |
745bc783 | 10572 | (interactive "P") |
41487370 LMI |
10573 | (setq gnus-summary-buffer (current-buffer)) |
10574 | (gnus-set-global-variables) | |
b027f415 | 10575 | (let ((article (gnus-summary-article-number)) |
745bc783 | 10576 | (endp nil)) |
41487370 | 10577 | (gnus-configure-windows 'article) |
231f989b LMI |
10578 | (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) |
10579 | (if (and (eq gnus-summary-goto-unread 'never) | |
10580 | (not (gnus-summary-last-article-p article))) | |
10581 | (gnus-summary-next-article) | |
10582 | (gnus-summary-next-unread-article)) | |
10583 | (if (or (null gnus-current-article) | |
10584 | (null gnus-article-current) | |
10585 | (/= article (cdr gnus-article-current)) | |
10586 | (not (equal (car gnus-article-current) gnus-newsgroup-name))) | |
10587 | ;; Selected subject is different from current article's. | |
10588 | (gnus-summary-display-article article) | |
10589 | (gnus-eval-in-buffer-window gnus-article-buffer | |
10590 | (setq endp (gnus-article-next-page lines))) | |
10591 | (if endp | |
10592 | (cond (circular | |
10593 | (gnus-summary-beginning-of-article)) | |
10594 | (lines | |
10595 | (gnus-message 3 "End of message")) | |
10596 | ((null lines) | |
10597 | (if (and (eq gnus-summary-goto-unread 'never) | |
10598 | (not (gnus-summary-last-article-p article))) | |
10599 | (gnus-summary-next-article) | |
10600 | (gnus-summary-next-unread-article))))))) | |
41487370 | 10601 | (gnus-summary-recenter) |
231f989b | 10602 | (gnus-summary-position-point))) |
41487370 LMI |
10603 | |
10604 | (defun gnus-summary-prev-page (&optional lines) | |
745bc783 JB |
10605 | "Show previous page of selected article. |
10606 | Argument LINES specifies lines to be scrolled down." | |
10607 | (interactive "P") | |
41487370 | 10608 | (gnus-set-global-variables) |
b027f415 | 10609 | (let ((article (gnus-summary-article-number))) |
41487370 | 10610 | (gnus-configure-windows 'article) |
745bc783 | 10611 | (if (or (null gnus-current-article) |
41487370 LMI |
10612 | (null gnus-article-current) |
10613 | (/= article (cdr gnus-article-current)) | |
10614 | (not (equal (car gnus-article-current) gnus-newsgroup-name))) | |
745bc783 | 10615 | ;; Selected subject is different from current article's. |
b027f415 | 10616 | (gnus-summary-display-article article) |
41487370 | 10617 | (gnus-summary-recenter) |
b027f415 | 10618 | (gnus-eval-in-buffer-window gnus-article-buffer |
231f989b LMI |
10619 | (gnus-article-prev-page lines)))) |
10620 | (gnus-summary-position-point)) | |
745bc783 | 10621 | |
b027f415 | 10622 | (defun gnus-summary-scroll-up (lines) |
745bc783 JB |
10623 | "Scroll up (or down) one line current article. |
10624 | Argument LINES specifies lines to be scrolled up (or down if negative)." | |
10625 | (interactive "p") | |
41487370 LMI |
10626 | (gnus-set-global-variables) |
10627 | (gnus-configure-windows 'article) | |
231f989b LMI |
10628 | (gnus-summary-show-thread) |
10629 | (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) | |
10630 | (gnus-eval-in-buffer-window gnus-article-buffer | |
10631 | (cond ((> lines 0) | |
10632 | (if (gnus-article-next-page lines) | |
10633 | (gnus-message 3 "End of message"))) | |
10634 | ((< lines 0) | |
10635 | (gnus-article-prev-page (- lines)))))) | |
41487370 | 10636 | (gnus-summary-recenter) |
231f989b | 10637 | (gnus-summary-position-point)) |
745bc783 | 10638 | |
b027f415 | 10639 | (defun gnus-summary-next-same-subject () |
745bc783 JB |
10640 | "Select next article which has the same subject as current one." |
10641 | (interactive) | |
41487370 | 10642 | (gnus-set-global-variables) |
231f989b | 10643 | (gnus-summary-next-article nil (gnus-summary-article-subject))) |
745bc783 | 10644 | |
b027f415 | 10645 | (defun gnus-summary-prev-same-subject () |
745bc783 JB |
10646 | "Select previous article which has the same subject as current one." |
10647 | (interactive) | |
41487370 | 10648 | (gnus-set-global-variables) |
231f989b | 10649 | (gnus-summary-prev-article nil (gnus-summary-article-subject))) |
745bc783 | 10650 | |
b027f415 | 10651 | (defun gnus-summary-next-unread-same-subject () |
745bc783 JB |
10652 | "Select next unread article which has the same subject as current one." |
10653 | (interactive) | |
41487370 | 10654 | (gnus-set-global-variables) |
231f989b | 10655 | (gnus-summary-next-article t (gnus-summary-article-subject))) |
745bc783 | 10656 | |
b027f415 | 10657 | (defun gnus-summary-prev-unread-same-subject () |
745bc783 JB |
10658 | "Select previous unread article which has the same subject as current one." |
10659 | (interactive) | |
41487370 | 10660 | (gnus-set-global-variables) |
231f989b | 10661 | (gnus-summary-prev-article t (gnus-summary-article-subject))) |
745bc783 | 10662 | |
41487370 | 10663 | (defun gnus-summary-first-unread-article () |
231f989b | 10664 | "Select the first unread article. |
41487370 LMI |
10665 | Return nil if there are no unread articles." |
10666 | (interactive) | |
10667 | (gnus-set-global-variables) | |
10668 | (prog1 | |
10669 | (if (gnus-summary-first-subject t) | |
10670 | (progn | |
10671 | (gnus-summary-show-thread) | |
10672 | (gnus-summary-first-subject t) | |
10673 | (gnus-summary-display-article (gnus-summary-article-number)))) | |
231f989b | 10674 | (gnus-summary-position-point))) |
745bc783 | 10675 | |
41487370 LMI |
10676 | (defun gnus-summary-best-unread-article () |
10677 | "Select the unread article with the highest score." | |
10678 | (interactive) | |
10679 | (gnus-set-global-variables) | |
10680 | (let ((best -1000000) | |
231f989b | 10681 | (data gnus-newsgroup-data) |
41487370 | 10682 | article score) |
231f989b LMI |
10683 | (while data |
10684 | (and (gnus-data-unread-p (car data)) | |
10685 | (> (setq score | |
10686 | (gnus-summary-article-score (gnus-data-number (car data)))) | |
10687 | best) | |
10688 | (setq best score | |
10689 | article (gnus-data-number (car data)))) | |
10690 | (setq data (cdr data))) | |
10691 | (prog1 | |
10692 | (if article | |
10693 | (gnus-summary-goto-article article) | |
41487370 | 10694 | (error "No unread articles")) |
231f989b | 10695 | (gnus-summary-position-point)))) |
745bc783 | 10696 | |
231f989b LMI |
10697 | (defun gnus-summary-last-subject () |
10698 | "Go to the last displayed subject line in the group." | |
10699 | (let ((article (gnus-data-number (car (gnus-data-list t))))) | |
10700 | (when article | |
10701 | (gnus-summary-goto-subject article)))) | |
10702 | ||
10703 | (defun gnus-summary-goto-article (article &optional all-headers force) | |
41487370 LMI |
10704 | "Fetch ARTICLE and display it if it exists. |
10705 | If ALL-HEADERS is non-nil, no header lines are hidden." | |
10706 | (interactive | |
10707 | (list | |
10708 | (string-to-int | |
231f989b | 10709 | (completing-read |
41487370 | 10710 | "Article number: " |
231f989b LMI |
10711 | (mapcar (lambda (number) (list (int-to-string number))) |
10712 | gnus-newsgroup-limit))) | |
10713 | current-prefix-arg | |
10714 | t)) | |
41487370 | 10715 | (prog1 |
231f989b LMI |
10716 | (if (gnus-summary-goto-subject article force) |
10717 | (gnus-summary-display-article article all-headers) | |
10718 | (gnus-message 4 "Couldn't go to article %s" article) nil) | |
10719 | (gnus-summary-position-point))) | |
745bc783 | 10720 | |
41487370 LMI |
10721 | (defun gnus-summary-goto-last-article () |
10722 | "Go to the previously read article." | |
10723 | (interactive) | |
10724 | (prog1 | |
10725 | (and gnus-last-article | |
10726 | (gnus-summary-goto-article gnus-last-article)) | |
231f989b | 10727 | (gnus-summary-position-point))) |
41487370 LMI |
10728 | |
10729 | (defun gnus-summary-pop-article (number) | |
10730 | "Pop one article off the history and go to the previous. | |
10731 | NUMBER articles will be popped off." | |
745bc783 | 10732 | (interactive "p") |
41487370 LMI |
10733 | (let (to) |
10734 | (setq gnus-newsgroup-history | |
10735 | (cdr (setq to (nthcdr number gnus-newsgroup-history)))) | |
10736 | (if to | |
10737 | (gnus-summary-goto-article (car to)) | |
10738 | (error "Article history empty"))) | |
231f989b LMI |
10739 | (gnus-summary-position-point)) |
10740 | ||
10741 | ;; Summary commands and functions for limiting the summary buffer. | |
10742 | ||
10743 | (defun gnus-summary-limit-to-articles (n) | |
10744 | "Limit the summary buffer to the next N articles. | |
10745 | If not given a prefix, use the process marked articles instead." | |
10746 | (interactive "P") | |
10747 | (gnus-set-global-variables) | |
10748 | (prog1 | |
10749 | (let ((articles (gnus-summary-work-articles n))) | |
10750 | (setq gnus-newsgroup-processable nil) | |
10751 | (gnus-summary-limit articles)) | |
10752 | (gnus-summary-position-point))) | |
10753 | ||
10754 | (defun gnus-summary-pop-limit (&optional total) | |
10755 | "Restore the previous limit. | |
10756 | If given a prefix, remove all limits." | |
10757 | (interactive "P") | |
10758 | (gnus-set-global-variables) | |
10759 | (when total | |
10760 | (setq gnus-newsgroup-limits | |
10761 | (list (mapcar (lambda (h) (mail-header-number h)) | |
10762 | gnus-newsgroup-headers)))) | |
10763 | (unless gnus-newsgroup-limits | |
10764 | (error "No limit to pop")) | |
10765 | (prog1 | |
10766 | (gnus-summary-limit nil 'pop) | |
10767 | (gnus-summary-position-point))) | |
10768 | ||
10769 | (defun gnus-summary-limit-to-subject (subject &optional header) | |
10770 | "Limit the summary buffer to articles that have subjects that match a regexp." | |
10771 | (interactive "sRegexp: ") | |
10772 | (unless header | |
10773 | (setq header "subject")) | |
10774 | (when (not (equal "" subject)) | |
10775 | (prog1 | |
10776 | (let ((articles (gnus-summary-find-matching | |
10777 | (or header "subject") subject 'all))) | |
10778 | (or articles (error "Found no matches for \"%s\"" subject)) | |
10779 | (gnus-summary-limit articles)) | |
10780 | (gnus-summary-position-point)))) | |
10781 | ||
10782 | (defun gnus-summary-limit-to-author (from) | |
10783 | "Limit the summary buffer to articles that have authors that match a regexp." | |
10784 | (interactive "sRegexp: ") | |
10785 | (gnus-summary-limit-to-subject from "from")) | |
10786 | ||
10787 | (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) | |
10788 | (make-obsolete | |
10789 | 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) | |
10790 | ||
10791 | (defun gnus-summary-limit-to-unread (&optional all) | |
10792 | "Limit the summary buffer to articles that are not marked as read. | |
10793 | If ALL is non-nil, limit strictly to unread articles." | |
10794 | (interactive "P") | |
10795 | (if all | |
10796 | (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) | |
10797 | (gnus-summary-limit-to-marks | |
10798 | ;; Concat all the marks that say that an article is read and have | |
10799 | ;; those removed. | |
10800 | (list gnus-del-mark gnus-read-mark gnus-ancient-mark | |
10801 | gnus-killed-mark gnus-kill-file-mark | |
10802 | gnus-low-score-mark gnus-expirable-mark | |
10803 | gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark) | |
10804 | 'reverse))) | |
10805 | ||
10806 | (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) | |
10807 | (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) | |
10808 | ||
10809 | (defun gnus-summary-limit-to-marks (marks &optional reverse) | |
10810 | "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). | |
10811 | If REVERSE, limit the summary buffer to articles that are not marked | |
10812 | with MARKS. MARKS can either be a string of marks or a list of marks. | |
10813 | Returns how many articles were removed." | |
10814 | (interactive "sMarks: ") | |
10815 | (gnus-set-global-variables) | |
10816 | (prog1 | |
10817 | (let ((data gnus-newsgroup-data) | |
10818 | (marks (if (listp marks) marks | |
10819 | (append marks nil))) ; Transform to list. | |
10820 | articles) | |
10821 | (while data | |
10822 | (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) | |
10823 | (memq (gnus-data-mark (car data)) marks)) | |
10824 | (setq articles (cons (gnus-data-number (car data)) articles))) | |
10825 | (setq data (cdr data))) | |
10826 | (gnus-summary-limit articles)) | |
10827 | (gnus-summary-position-point))) | |
10828 | ||
10829 | (defun gnus-summary-limit-to-score (&optional score) | |
10830 | "Limit to articles with score at or above SCORE." | |
10831 | (interactive "P") | |
10832 | (gnus-set-global-variables) | |
10833 | (setq score (if score | |
10834 | (prefix-numeric-value score) | |
10835 | (or gnus-summary-default-score 0))) | |
10836 | (let ((data gnus-newsgroup-data) | |
10837 | articles) | |
10838 | (while data | |
10839 | (when (>= (gnus-summary-article-score (gnus-data-number (car data))) | |
10840 | score) | |
10841 | (push (gnus-data-number (car data)) articles)) | |
10842 | (setq data (cdr data))) | |
10843 | (prog1 | |
10844 | (gnus-summary-limit articles) | |
10845 | (gnus-summary-position-point)))) | |
10846 | ||
10847 | (defun gnus-summary-limit-include-dormant () | |
10848 | "Display all the hidden articles that are marked as dormant." | |
10849 | (interactive) | |
10850 | (gnus-set-global-variables) | |
10851 | (or gnus-newsgroup-dormant | |
10852 | (error "There are no dormant articles in this group")) | |
10853 | (prog1 | |
10854 | (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) | |
10855 | (gnus-summary-position-point))) | |
10856 | ||
10857 | (defun gnus-summary-limit-exclude-dormant () | |
10858 | "Hide all dormant articles." | |
10859 | (interactive) | |
10860 | (gnus-set-global-variables) | |
10861 | (prog1 | |
10862 | (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) | |
10863 | (gnus-summary-position-point))) | |
10864 | ||
10865 | (defun gnus-summary-limit-exclude-childless-dormant () | |
10866 | "Hide all dormant articles that have no children." | |
10867 | (interactive) | |
10868 | (gnus-set-global-variables) | |
10869 | (let ((data (gnus-data-list t)) | |
10870 | articles d children) | |
10871 | ;; Find all articles that are either not dormant or have | |
10872 | ;; children. | |
10873 | (while (setq d (pop data)) | |
10874 | (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) | |
10875 | (and (setq children | |
10876 | (gnus-article-children (gnus-data-number d))) | |
10877 | (let (found) | |
10878 | (while children | |
10879 | (when (memq (car children) articles) | |
10880 | (setq children nil | |
10881 | found t)) | |
10882 | (pop children)) | |
10883 | found))) | |
10884 | (push (gnus-data-number d) articles))) | |
10885 | ;; Do the limiting. | |
10886 | (prog1 | |
10887 | (gnus-summary-limit articles) | |
10888 | (gnus-summary-position-point)))) | |
10889 | ||
10890 | (defun gnus-summary-limit-mark-excluded-as-read (&optional all) | |
10891 | "Mark all unread excluded articles as read. | |
10892 | If ALL, mark even excluded ticked and dormants as read." | |
10893 | (interactive "P") | |
10894 | (let ((articles (gnus-sorted-complement | |
10895 | (sort | |
10896 | (mapcar (lambda (h) (mail-header-number h)) | |
10897 | gnus-newsgroup-headers) | |
10898 | '<) | |
10899 | (sort gnus-newsgroup-limit '<))) | |
10900 | article) | |
10901 | (setq gnus-newsgroup-unreads nil) | |
10902 | (if all | |
10903 | (setq gnus-newsgroup-dormant nil | |
10904 | gnus-newsgroup-marked nil | |
10905 | gnus-newsgroup-reads | |
10906 | (nconc | |
10907 | (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) | |
10908 | gnus-newsgroup-reads)) | |
10909 | (while (setq article (pop articles)) | |
10910 | (unless (or (memq article gnus-newsgroup-dormant) | |
10911 | (memq article gnus-newsgroup-marked)) | |
10912 | (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) | |
10913 | ||
10914 | (defun gnus-summary-limit (articles &optional pop) | |
10915 | (if pop | |
10916 | ;; We pop the previous limit off the stack and use that. | |
10917 | (setq articles (car gnus-newsgroup-limits) | |
10918 | gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) | |
10919 | ;; We use the new limit, so we push the old limit on the stack. | |
10920 | (setq gnus-newsgroup-limits | |
10921 | (cons gnus-newsgroup-limit gnus-newsgroup-limits))) | |
10922 | ;; Set the limit. | |
10923 | (setq gnus-newsgroup-limit articles) | |
10924 | (let ((total (length gnus-newsgroup-data)) | |
10925 | (data (gnus-data-find-list (gnus-summary-article-number))) | |
564b670b | 10926 | (gnus-summary-mark-below nil) ; Inhibit this. |
231f989b LMI |
10927 | found) |
10928 | ;; This will do all the work of generating the new summary buffer | |
10929 | ;; according to the new limit. | |
10930 | (gnus-summary-prepare) | |
10931 | ;; Hide any threads, possibly. | |
10932 | (and gnus-show-threads | |
10933 | gnus-thread-hide-subtree | |
10934 | (gnus-summary-hide-all-threads)) | |
10935 | ;; Try to return to the article you were at, or one in the | |
10936 | ;; neighborhood. | |
10937 | (if data | |
10938 | ;; We try to find some article after the current one. | |
10939 | (while data | |
10940 | (and (gnus-summary-goto-subject | |
10941 | (gnus-data-number (car data)) nil t) | |
10942 | (setq data nil | |
10943 | found t)) | |
10944 | (setq data (cdr data)))) | |
10945 | (or found | |
10946 | ;; If there is no data, that means that we were after the last | |
10947 | ;; article. The same goes when we can't find any articles | |
10948 | ;; after the current one. | |
10949 | (progn | |
10950 | (goto-char (point-max)) | |
10951 | (gnus-summary-find-prev))) | |
10952 | ;; We return how many articles were removed from the summary | |
10953 | ;; buffer as a result of the new limit. | |
10954 | (- total (length gnus-newsgroup-data)))) | |
10955 | ||
10956 | (defsubst gnus-invisible-cut-children (threads) | |
10957 | (let ((num 0)) | |
10958 | (while threads | |
10959 | (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) | |
10960 | (incf num)) | |
10961 | (pop threads)) | |
10962 | (< num 2))) | |
10963 | ||
10964 | (defsubst gnus-cut-thread (thread) | |
10965 | "Go forwards in the thread until we find an article that we want to display." | |
10966 | (when (or (eq gnus-fetch-old-headers 'some) | |
10967 | (eq gnus-build-sparse-threads 'some) | |
10968 | (eq gnus-build-sparse-threads 'more)) | |
10969 | ;; Deal with old-fetched headers and sparse threads. | |
10970 | (while (and | |
10971 | thread | |
10972 | (or | |
10973 | (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) | |
10974 | (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)) | |
10975 | (or (<= (length (cdr thread)) 1) | |
10976 | (gnus-invisible-cut-children (cdr thread)))) | |
10977 | (setq thread (cadr thread)))) | |
10978 | thread) | |
10979 | ||
10980 | (defun gnus-cut-threads (threads) | |
10981 | "Cut off all uninteresting articles from the beginning of threads." | |
10982 | (when (or (eq gnus-fetch-old-headers 'some) | |
10983 | (eq gnus-build-sparse-threads 'some) | |
10984 | (eq gnus-build-sparse-threads 'more)) | |
10985 | (let ((th threads)) | |
10986 | (while th | |
10987 | (setcar th (gnus-cut-thread (car th))) | |
10988 | (setq th (cdr th))))) | |
10989 | ;; Remove nixed out threads. | |
10990 | (delq nil threads)) | |
10991 | ||
10992 | (defun gnus-summary-initial-limit (&optional show-if-empty) | |
10993 | "Figure out what the initial limit is supposed to be on group entry. | |
10994 | This entails weeding out unwanted dormants, low-scored articles, | |
10995 | fetch-old-headers verbiage, and so on." | |
10996 | ;; Most groups have nothing to remove. | |
10997 | (if (or gnus-inhibit-limiting | |
10998 | (and (null gnus-newsgroup-dormant) | |
10999 | (not (eq gnus-fetch-old-headers 'some)) | |
11000 | (null gnus-summary-expunge-below) | |
11001 | (not (eq gnus-build-sparse-threads 'some)) | |
11002 | (not (eq gnus-build-sparse-threads 'more)) | |
11003 | (null gnus-thread-expunge-below) | |
11004 | (not gnus-use-nocem))) | |
11005 | () ; Do nothing. | |
11006 | (push gnus-newsgroup-limit gnus-newsgroup-limits) | |
11007 | (setq gnus-newsgroup-limit nil) | |
11008 | (mapatoms | |
11009 | (lambda (node) | |
11010 | (unless (car (symbol-value node)) | |
11011 | ;; These threads have no parents -- they are roots. | |
11012 | (let ((nodes (cdr (symbol-value node))) | |
11013 | thread) | |
11014 | (while nodes | |
11015 | (if (and gnus-thread-expunge-below | |
11016 | (< (gnus-thread-total-score (car nodes)) | |
11017 | gnus-thread-expunge-below)) | |
11018 | (gnus-expunge-thread (pop nodes)) | |
11019 | (setq thread (pop nodes)) | |
11020 | (gnus-summary-limit-children thread)))))) | |
11021 | gnus-newsgroup-dependencies) | |
11022 | ;; If this limitation resulted in an empty group, we might | |
11023 | ;; pop the previous limit and use it instead. | |
11024 | (when (and (not gnus-newsgroup-limit) | |
11025 | show-if-empty) | |
11026 | (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) | |
11027 | gnus-newsgroup-limit)) | |
11028 | ||
11029 | (defun gnus-summary-limit-children (thread) | |
11030 | "Return 1 if this subthread is visible and 0 if it is not." | |
11031 | ;; First we get the number of visible children to this thread. This | |
11032 | ;; is done by recursing down the thread using this function, so this | |
11033 | ;; will really go down to a leaf article first, before slowly | |
11034 | ;; working its way up towards the root. | |
11035 | (when thread | |
11036 | (let ((children | |
11037 | (if (cdr thread) | |
11038 | (apply '+ (mapcar 'gnus-summary-limit-children | |
11039 | (cdr thread))) | |
11040 | 0)) | |
11041 | (number (mail-header-number (car thread))) | |
11042 | score) | |
11043 | (if (or | |
11044 | ;; If this article is dormant and has absolutely no visible | |
11045 | ;; children, then this article isn't visible. | |
11046 | (and (memq number gnus-newsgroup-dormant) | |
11047 | (= children 0)) | |
11048 | ;; If this is "fetch-old-headered" and there is only one | |
11049 | ;; visible child (or less), then we don't want this article. | |
11050 | (and (eq gnus-fetch-old-headers 'some) | |
11051 | (memq number gnus-newsgroup-ancient) | |
11052 | (zerop children)) | |
11053 | ;; If this is a sparsely inserted article with no children, | |
11054 | ;; we don't want it. | |
11055 | (and (eq gnus-build-sparse-threads 'some) | |
11056 | (memq number gnus-newsgroup-sparse) | |
11057 | (zerop children)) | |
11058 | ;; If we use expunging, and this article is really | |
11059 | ;; low-scored, then we don't want this article. | |
11060 | (when (and gnus-summary-expunge-below | |
11061 | (< (setq score | |
11062 | (or (cdr (assq number gnus-newsgroup-scored)) | |
11063 | gnus-summary-default-score)) | |
11064 | gnus-summary-expunge-below)) | |
11065 | ;; We increase the expunge-tally here, but that has | |
11066 | ;; nothing to do with the limits, really. | |
11067 | (incf gnus-newsgroup-expunged-tally) | |
11068 | ;; We also mark as read here, if that's wanted. | |
11069 | (when (and gnus-summary-mark-below | |
11070 | (< score gnus-summary-mark-below)) | |
11071 | (setq gnus-newsgroup-unreads | |
11072 | (delq number gnus-newsgroup-unreads)) | |
11073 | (if gnus-newsgroup-auto-expire | |
11074 | (push number gnus-newsgroup-expirable) | |
11075 | (push (cons number gnus-low-score-mark) | |
11076 | gnus-newsgroup-reads))) | |
11077 | t) | |
11078 | (and gnus-use-nocem | |
11079 | (gnus-nocem-unwanted-article-p (mail-header-id (car thread))))) | |
11080 | ;; Nope, invisible article. | |
11081 | 0 | |
11082 | ;; Ok, this article is to be visible, so we add it to the limit | |
11083 | ;; and return 1. | |
11084 | (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit)) | |
11085 | 1)))) | |
11086 | ||
11087 | (defun gnus-expunge-thread (thread) | |
11088 | "Mark all articles in THREAD as read." | |
11089 | (let* ((number (mail-header-number (car thread)))) | |
11090 | (incf gnus-newsgroup-expunged-tally) | |
11091 | ;; We also mark as read here, if that's wanted. | |
11092 | (setq gnus-newsgroup-unreads | |
11093 | (delq number gnus-newsgroup-unreads)) | |
11094 | (if gnus-newsgroup-auto-expire | |
11095 | (push number gnus-newsgroup-expirable) | |
11096 | (push (cons number gnus-low-score-mark) | |
11097 | gnus-newsgroup-reads))) | |
11098 | ;; Go recursively through all subthreads. | |
11099 | (mapcar 'gnus-expunge-thread (cdr thread))) | |
41487370 LMI |
11100 | |
11101 | ;; Summary article oriented commands | |
11102 | ||
11103 | (defun gnus-summary-refer-parent-article (n) | |
11104 | "Refer parent article N times. | |
11105 | The difference between N and the number of articles fetched is returned." | |
11106 | (interactive "p") | |
11107 | (gnus-set-global-variables) | |
231f989b LMI |
11108 | (while |
11109 | (and | |
41487370 | 11110 | (> n 0) |
231f989b LMI |
11111 | (let* ((header (gnus-summary-article-header)) |
11112 | (ref | |
11113 | ;; If we try to find the parent of the currently | |
11114 | ;; displayed article, then we take a look at the actual | |
11115 | ;; References header, since this is slightly more | |
11116 | ;; reliable than the References field we got from the | |
11117 | ;; server. | |
11118 | (if (and (eq (mail-header-number header) | |
11119 | (cdr gnus-article-current)) | |
11120 | (equal gnus-newsgroup-name | |
11121 | (car gnus-article-current))) | |
11122 | (save-excursion | |
11123 | (set-buffer gnus-original-article-buffer) | |
11124 | (nnheader-narrow-to-headers) | |
11125 | (prog1 | |
11126 | (message-fetch-field "references") | |
11127 | (widen))) | |
11128 | ;; It's not the current article, so we take a bet on | |
11129 | ;; the value we got from the server. | |
11130 | (mail-header-references header)))) | |
11131 | (if (setq ref (or ref (mail-header-references header))) | |
11132 | (or (gnus-summary-refer-article (gnus-parent-id ref)) | |
11133 | (gnus-message 1 "Couldn't find parent")) | |
41487370 LMI |
11134 | (gnus-message 1 "No references in article %d" |
11135 | (gnus-summary-article-number)) | |
11136 | nil))) | |
11137 | (setq n (1- n))) | |
231f989b | 11138 | (gnus-summary-position-point) |
41487370 | 11139 | n) |
231f989b LMI |
11140 | |
11141 | (defun gnus-summary-refer-references () | |
11142 | "Fetch all articles mentioned in the References header. | |
11143 | Return how many articles were fetched." | |
11144 | (interactive) | |
11145 | (gnus-set-global-variables) | |
11146 | (let ((ref (mail-header-references (gnus-summary-article-header))) | |
11147 | (current (gnus-summary-article-number)) | |
11148 | (n 0)) | |
11149 | ;; For each Message-ID in the References header... | |
11150 | (while (string-match "<[^>]*>" ref) | |
11151 | (incf n) | |
11152 | ;; ... fetch that article. | |
11153 | (gnus-summary-refer-article | |
11154 | (prog1 (match-string 0 ref) | |
11155 | (setq ref (substring ref (match-end 0)))))) | |
11156 | (gnus-summary-goto-subject current) | |
11157 | (gnus-summary-position-point) | |
11158 | n)) | |
11159 | ||
41487370 | 11160 | (defun gnus-summary-refer-article (message-id) |
231f989b | 11161 | "Fetch an article specified by MESSAGE-ID." |
41487370 | 11162 | (interactive "sMessage-ID: ") |
231f989b LMI |
11163 | (when (and (stringp message-id) |
11164 | (not (zerop (length message-id)))) | |
41487370 LMI |
11165 | ;; Construct the correct Message-ID if necessary. |
11166 | ;; Suggested by tale@pawl.rpi.edu. | |
231f989b LMI |
11167 | (unless (string-match "^<" message-id) |
11168 | (setq message-id (concat "<" message-id))) | |
11169 | (unless (string-match ">$" message-id) | |
11170 | (setq message-id (concat message-id ">"))) | |
11171 | (let* ((header (gnus-id-to-header message-id)) | |
11172 | (sparse (and header | |
11173 | (memq (mail-header-number header) | |
11174 | gnus-newsgroup-sparse)))) | |
41487370 | 11175 | (if header |
41487370 | 11176 | (prog1 |
231f989b LMI |
11177 | ;; The article is present in the buffer, to we just go to it. |
11178 | (gnus-summary-goto-article | |
11179 | (mail-header-number header) nil header) | |
11180 | (when sparse | |
11181 | (gnus-summary-update-article (mail-header-number header)))) | |
11182 | ;; We fetch the article | |
11183 | (let ((gnus-override-method | |
11184 | (and (gnus-news-group-p gnus-newsgroup-name) | |
11185 | gnus-refer-article-method)) | |
11186 | number) | |
11187 | ;; Start the special refer-article method, if necessary. | |
11188 | (when (and gnus-refer-article-method | |
11189 | (gnus-news-group-p gnus-newsgroup-name)) | |
11190 | (gnus-check-server gnus-refer-article-method)) | |
11191 | ;; Fetch the header, and display the article. | |
11192 | (if (setq number (gnus-summary-insert-subject message-id)) | |
11193 | (gnus-summary-select-article nil nil nil number) | |
11194 | (gnus-message 3 "Couldn't fetch article %s" message-id))))))) | |
11195 | ||
11196 | (defun gnus-summary-enter-digest-group (&optional force) | |
41487370 | 11197 | "Enter a digest group based on the current article." |
231f989b | 11198 | (interactive "P") |
41487370 LMI |
11199 | (gnus-set-global-variables) |
11200 | (gnus-summary-select-article) | |
231f989b LMI |
11201 | (let ((name (format "%s-%d" |
11202 | (gnus-group-prefixed-name | |
11203 | gnus-newsgroup-name (list 'nndoc "")) | |
41487370 LMI |
11204 | gnus-current-article)) |
11205 | (ogroup gnus-newsgroup-name) | |
231f989b LMI |
11206 | (case-fold-search t) |
11207 | (buf (current-buffer)) | |
11208 | dig) | |
11209 | (save-excursion | |
11210 | (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) | |
11211 | (insert-buffer-substring gnus-original-article-buffer) | |
11212 | (narrow-to-region | |
11213 | (goto-char (point-min)) | |
11214 | (or (search-forward "\n\n" nil t) (point))) | |
11215 | (goto-char (point-min)) | |
11216 | (delete-matching-lines "^\\(Path\\):\\|^From ") | |
11217 | (widen)) | |
11218 | (unwind-protect | |
11219 | (if (gnus-group-read-ephemeral-group | |
11220 | name `(nndoc ,name (nndoc-address | |
11221 | ,(get-buffer dig)) | |
11222 | (nndoc-article-type ,(if force 'digest 'guess))) t) | |
11223 | ;; Make all postings to this group go to the parent group. | |
11224 | (nconc (gnus-info-params (gnus-get-info name)) | |
11225 | (list (cons 'to-group ogroup))) | |
11226 | ;; Couldn't select this doc group. | |
11227 | (switch-to-buffer buf) | |
11228 | (gnus-set-global-variables) | |
11229 | (gnus-configure-windows 'summary) | |
11230 | (gnus-message 3 "Article couldn't be entered?")) | |
11231 | (kill-buffer dig)))) | |
11232 | ||
11233 | (defun gnus-summary-isearch-article (&optional regexp-p) | |
11234 | "Do incremental search forward on the current article. | |
11235 | If REGEXP-P (the prefix) is non-nil, do regexp isearch." | |
11236 | (interactive "P") | |
41487370 | 11237 | (gnus-set-global-variables) |
b027f415 | 11238 | (gnus-summary-select-article) |
231f989b LMI |
11239 | (gnus-configure-windows 'article) |
11240 | (gnus-eval-in-buffer-window gnus-article-buffer | |
11241 | (goto-char (point-min)) | |
11242 | (isearch-forward regexp-p))) | |
745bc783 | 11243 | |
41487370 | 11244 | (defun gnus-summary-search-article-forward (regexp &optional backward) |
745bc783 | 11245 | "Search for an article containing REGEXP forward. |
41487370 | 11246 | If BACKWARD, search backward instead." |
745bc783 JB |
11247 | (interactive |
11248 | (list (read-string | |
41487370 LMI |
11249 | (format "Search article %s (regexp%s): " |
11250 | (if current-prefix-arg "backward" "forward") | |
745bc783 | 11251 | (if gnus-last-search-regexp |
41487370 LMI |
11252 | (concat ", default " gnus-last-search-regexp) |
11253 | ""))) | |
11254 | current-prefix-arg)) | |
11255 | (gnus-set-global-variables) | |
745bc783 JB |
11256 | (if (string-equal regexp "") |
11257 | (setq regexp (or gnus-last-search-regexp "")) | |
11258 | (setq gnus-last-search-regexp regexp)) | |
231f989b | 11259 | (unless (gnus-summary-search-article regexp backward) |
41487370 | 11260 | (error "Search failed: \"%s\"" regexp))) |
745bc783 | 11261 | |
b027f415 | 11262 | (defun gnus-summary-search-article-backward (regexp) |
41487370 | 11263 | "Search for an article containing REGEXP backward." |
745bc783 JB |
11264 | (interactive |
11265 | (list (read-string | |
41487370 | 11266 | (format "Search article backward (regexp%s): " |
745bc783 | 11267 | (if gnus-last-search-regexp |
41487370 LMI |
11268 | (concat ", default " gnus-last-search-regexp) |
11269 | ""))))) | |
11270 | (gnus-summary-search-article-forward regexp 'backward)) | |
745bc783 | 11271 | |
b027f415 | 11272 | (defun gnus-summary-search-article (regexp &optional backward) |
745bc783 JB |
11273 | "Search for an article containing REGEXP. |
11274 | Optional argument BACKWARD means do search for backward. | |
231f989b | 11275 | `gnus-select-article-hook' is not called during the search." |
b027f415 | 11276 | (let ((gnus-select-article-hook nil) ;Disable hook. |
231f989b | 11277 | (gnus-article-display-hook nil) |
b027f415 | 11278 | (gnus-mark-article-hook nil) ;Inhibit marking as read. |
745bc783 JB |
11279 | (re-search |
11280 | (if backward | |
231f989b LMI |
11281 | 're-search-backward 're-search-forward)) |
11282 | (sum (current-buffer)) | |
11283 | (found nil)) | |
11284 | (gnus-save-hidden-threads | |
11285 | (gnus-summary-select-article) | |
11286 | (set-buffer gnus-article-buffer) | |
11287 | (when backward | |
11288 | (forward-line -1)) | |
11289 | (while (not found) | |
11290 | (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) | |
11291 | (if (if backward | |
11292 | (re-search-backward regexp nil t) | |
11293 | (re-search-forward regexp nil t)) | |
11294 | ;; We found the regexp. | |
11295 | (progn | |
11296 | (setq found 'found) | |
11297 | (beginning-of-line) | |
11298 | (set-window-start | |
11299 | (get-buffer-window (current-buffer)) | |
11300 | (point)) | |
11301 | (forward-line 1) | |
11302 | (set-buffer sum)) | |
11303 | ;; We didn't find it, so we go to the next article. | |
11304 | (set-buffer sum) | |
11305 | (if (not (if backward (gnus-summary-find-prev) | |
11306 | (gnus-summary-find-next))) | |
11307 | ;; No more articles. | |
11308 | (setq found t) | |
11309 | ;; Select the next article and adjust point. | |
11310 | (gnus-summary-select-article) | |
11311 | (set-buffer gnus-article-buffer) | |
11312 | (widen) | |
11313 | (goto-char (if backward (point-max) (point-min)))))) | |
11314 | (gnus-message 7 "")) | |
11315 | ;; Return whether we found the regexp. | |
11316 | (when (eq found 'found) | |
11317 | (gnus-summary-show-thread) | |
11318 | (gnus-summary-goto-subject gnus-current-article) | |
11319 | (gnus-summary-position-point) | |
11320 | t))) | |
11321 | ||
11322 | (defun gnus-summary-find-matching (header regexp &optional backward unread | |
11323 | not-case-fold) | |
11324 | "Return a list of all articles that match REGEXP on HEADER. | |
11325 | The search stars on the current article and goes forwards unless | |
11326 | BACKWARD is non-nil. If BACKWARD is `all', do all articles. | |
11327 | If UNREAD is non-nil, only unread articles will | |
11328 | be taken into consideration. If NOT-CASE-FOLD, case won't be folded | |
11329 | in the comparisons." | |
11330 | (let ((data (if (eq backward 'all) gnus-newsgroup-data | |
11331 | (gnus-data-find-list | |
11332 | (gnus-summary-article-number) (gnus-data-list backward)))) | |
11333 | (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) | |
11334 | (case-fold-search (not not-case-fold)) | |
11335 | articles d) | |
11336 | (or (fboundp (intern (concat "mail-header-" header))) | |
11337 | (error "%s is not a valid header" header)) | |
11338 | (while data | |
11339 | (setq d (car data)) | |
11340 | (and (or (not unread) ; We want all articles... | |
11341 | (gnus-data-unread-p d)) ; Or just unreads. | |
11342 | (vectorp (gnus-data-header d)) ; It's not a pseudo. | |
11343 | (string-match regexp (funcall func (gnus-data-header d))) ; Match. | |
11344 | (setq articles (cons (gnus-data-number d) articles))) ; Success! | |
11345 | (setq data (cdr data))) | |
11346 | (nreverse articles))) | |
745bc783 | 11347 | |
41487370 LMI |
11348 | (defun gnus-summary-execute-command (header regexp command &optional backward) |
11349 | "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. | |
11350 | If HEADER is an empty string (or nil), the match is done on the entire | |
231f989b | 11351 | article. If BACKWARD (the prefix) is non-nil, search backward instead." |
745bc783 JB |
11352 | (interactive |
11353 | (list (let ((completion-ignore-case t)) | |
231f989b | 11354 | (completing-read |
41487370 LMI |
11355 | "Header name: " |
11356 | (mapcar (lambda (string) (list string)) | |
11357 | '("Number" "Subject" "From" "Lines" "Date" | |
231f989b | 11358 | "Message-ID" "Xref" "References" "Body")) |
41487370 | 11359 | nil 'require-match)) |
745bc783 JB |
11360 | (read-string "Regexp: ") |
11361 | (read-key-sequence "Command: ") | |
11362 | current-prefix-arg)) | |
231f989b LMI |
11363 | (when (equal header "Body") |
11364 | (setq header "")) | |
41487370 LMI |
11365 | (gnus-set-global-variables) |
11366 | ;; Hidden thread subtrees must be searched as well. | |
b027f415 | 11367 | (gnus-summary-show-all-threads) |
745bc783 JB |
11368 | ;; We don't want to change current point nor window configuration. |
11369 | (save-excursion | |
11370 | (save-window-excursion | |
41487370 | 11371 | (gnus-message 6 "Executing %s..." (key-description command)) |
745bc783 | 11372 | ;; We'd like to execute COMMAND interactively so as to give arguments. |
41487370 | 11373 | (gnus-execute header regexp |
231f989b | 11374 | `(lambda () (call-interactively ',(key-binding command))) |
745bc783 | 11375 | backward) |
41487370 | 11376 | (gnus-message 6 "Executing %s...done" (key-description command))))) |
745bc783 | 11377 | |
b027f415 | 11378 | (defun gnus-summary-beginning-of-article () |
41487370 | 11379 | "Scroll the article back to the beginning." |
745bc783 | 11380 | (interactive) |
41487370 | 11381 | (gnus-set-global-variables) |
b027f415 | 11382 | (gnus-summary-select-article) |
41487370 | 11383 | (gnus-configure-windows 'article) |
231f989b LMI |
11384 | (gnus-eval-in-buffer-window gnus-article-buffer |
11385 | (widen) | |
11386 | (goto-char (point-min)) | |
11387 | (and gnus-break-pages (gnus-narrow-to-page)))) | |
745bc783 | 11388 | |
b027f415 | 11389 | (defun gnus-summary-end-of-article () |
41487370 | 11390 | "Scroll to the end of the article." |
745bc783 | 11391 | (interactive) |
41487370 | 11392 | (gnus-set-global-variables) |
b027f415 | 11393 | (gnus-summary-select-article) |
41487370 | 11394 | (gnus-configure-windows 'article) |
231f989b LMI |
11395 | (gnus-eval-in-buffer-window gnus-article-buffer |
11396 | (widen) | |
11397 | (goto-char (point-max)) | |
11398 | (recenter -3) | |
11399 | (and gnus-break-pages (gnus-narrow-to-page)))) | |
11400 | ||
11401 | (defun gnus-summary-show-article (&optional arg) | |
11402 | "Force re-fetching of the current article. | |
11403 | If ARG (the prefix) is non-nil, show the raw article without any | |
11404 | article massaging functions being run." | |
11405 | (interactive "P") | |
41487370 | 11406 | (gnus-set-global-variables) |
231f989b LMI |
11407 | (if (not arg) |
11408 | ;; Select the article the normal way. | |
11409 | (gnus-summary-select-article nil 'force) | |
11410 | ;; Bind the article treatment functions to nil. | |
11411 | (let ((gnus-have-all-headers t) | |
11412 | gnus-article-display-hook | |
11413 | gnus-article-prepare-hook | |
11414 | gnus-break-pages | |
11415 | gnus-visual) | |
11416 | (gnus-summary-select-article nil 'force))) | |
11417 | (gnus-summary-goto-subject gnus-current-article) | |
11418 | ; (gnus-configure-windows 'article) | |
11419 | (gnus-summary-position-point)) | |
745bc783 | 11420 | |
41487370 LMI |
11421 | (defun gnus-summary-verbose-headers (&optional arg) |
11422 | "Toggle permanent full header display. | |
11423 | If ARG is a positive number, turn header display on. | |
11424 | If ARG is a negative number, turn header display off." | |
11425 | (interactive "P") | |
11426 | (gnus-set-global-variables) | |
11427 | (gnus-summary-toggle-header arg) | |
11428 | (setq gnus-show-all-headers | |
11429 | (cond ((or (not (numberp arg)) | |
11430 | (zerop arg)) | |
11431 | (not gnus-show-all-headers)) | |
11432 | ((natnump arg) | |
11433 | t)))) | |
11434 | ||
11435 | (defun gnus-summary-toggle-header (&optional arg) | |
11436 | "Show the headers if they are hidden, or hide them if they are shown. | |
11437 | If ARG is a positive number, show the entire header. | |
11438 | If ARG is a negative number, hide the unwanted header lines." | |
745bc783 | 11439 | (interactive "P") |
41487370 LMI |
11440 | (gnus-set-global-variables) |
11441 | (save-excursion | |
11442 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
11443 | (let* ((buffer-read-only nil) |
11444 | (inhibit-point-motion-hooks t) | |
11445 | (hidden (text-property-any | |
11446 | (goto-char (point-min)) (search-forward "\n\n") | |
11447 | 'invisible t)) | |
11448 | e) | |
11449 | (goto-char (point-min)) | |
11450 | (when (search-forward "\n\n" nil t) | |
11451 | (delete-region (point-min) (1- (point)))) | |
11452 | (goto-char (point-min)) | |
11453 | (save-excursion | |
11454 | (set-buffer gnus-original-article-buffer) | |
11455 | (goto-char (point-min)) | |
11456 | (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) | |
11457 | (insert-buffer-substring gnus-original-article-buffer 1 e) | |
11458 | (let ((gnus-inhibit-hiding t)) | |
11459 | (run-hooks 'gnus-article-display-hook)) | |
11460 | (if (or (not hidden) (and (numberp arg) (< arg 0))) | |
11461 | (gnus-article-hide-headers))))) | |
745bc783 | 11462 | |
b027f415 | 11463 | (defun gnus-summary-show-all-headers () |
41487370 | 11464 | "Make all header lines visible." |
745bc783 | 11465 | (interactive) |
41487370 LMI |
11466 | (gnus-set-global-variables) |
11467 | (gnus-article-show-all-headers)) | |
b027f415 | 11468 | |
41487370 | 11469 | (defun gnus-summary-toggle-mime (&optional arg) |
b027f415 | 11470 | "Toggle MIME processing. |
41487370 | 11471 | If ARG is a positive number, turn MIME processing on." |
b027f415 | 11472 | (interactive "P") |
41487370 | 11473 | (gnus-set-global-variables) |
b027f415 RS |
11474 | (setq gnus-show-mime |
11475 | (if (null arg) (not gnus-show-mime) | |
11476 | (> (prefix-numeric-value arg) 0))) | |
41487370 LMI |
11477 | (gnus-summary-select-article t 'force)) |
11478 | ||
11479 | (defun gnus-summary-caesar-message (&optional arg) | |
11480 | "Caesar rotate the current article by 13. | |
11481 | The numerical prefix specifies how manu places to rotate each letter | |
11482 | forward." | |
11483 | (interactive "P") | |
11484 | (gnus-set-global-variables) | |
11485 | (gnus-summary-select-article) | |
11486 | (let ((mail-header-separator "")) | |
231f989b LMI |
11487 | (gnus-eval-in-buffer-window gnus-article-buffer |
11488 | (save-restriction | |
11489 | (widen) | |
11490 | (let ((start (window-start)) | |
11491 | buffer-read-only) | |
11492 | (message-caesar-buffer-body arg) | |
11493 | (set-window-start (get-buffer-window (current-buffer)) start)))))) | |
745bc783 | 11494 | |
b027f415 | 11495 | (defun gnus-summary-stop-page-breaking () |
41487370 | 11496 | "Stop page breaking in the current article." |
745bc783 | 11497 | (interactive) |
41487370 | 11498 | (gnus-set-global-variables) |
b027f415 | 11499 | (gnus-summary-select-article) |
231f989b LMI |
11500 | (gnus-eval-in-buffer-window gnus-article-buffer |
11501 | (widen))) | |
41487370 | 11502 | |
231f989b | 11503 | (defun gnus-summary-move-article (&optional n to-newsgroup select-method action) |
41487370 LMI |
11504 | "Move the current article to a different newsgroup. |
11505 | If N is a positive number, move the N next articles. | |
11506 | If N is a negative number, move the N previous articles. | |
11507 | If N is nil and any articles have been marked with the process mark, | |
11508 | move those articles instead. | |
231f989b LMI |
11509 | If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. |
11510 | If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but | |
41487370 | 11511 | re-spool using this method. |
231f989b | 11512 | |
41487370 LMI |
11513 | For this function to work, both the current newsgroup and the |
11514 | newsgroup that you want to move to have to support the `request-move' | |
231f989b | 11515 | and `request-accept' functions." |
41487370 | 11516 | (interactive "P") |
231f989b | 11517 | (unless action (setq action 'move)) |
41487370 | 11518 | (gnus-set-global-variables) |
231f989b LMI |
11519 | ;; Check whether the source group supports the required functions. |
11520 | (cond ((and (eq action 'move) | |
11521 | (not (gnus-check-backend-function | |
11522 | 'request-move-article gnus-newsgroup-name))) | |
11523 | (error "The current group does not support article moving")) | |
11524 | ((and (eq action 'crosspost) | |
11525 | (not (gnus-check-backend-function | |
11526 | 'request-replace-article gnus-newsgroup-name))) | |
11527 | (error "The current group does not support article editing"))) | |
41487370 LMI |
11528 | (let ((articles (gnus-summary-work-articles n)) |
11529 | (prefix (gnus-group-real-prefix gnus-newsgroup-name)) | |
231f989b LMI |
11530 | (names '((move "Move" "Moving") |
11531 | (copy "Copy" "Copying") | |
11532 | (crosspost "Crosspost" "Crossposting"))) | |
11533 | (copy-buf (save-excursion | |
11534 | (nnheader-set-temp-buffer " *copy article*"))) | |
11535 | art-group to-method new-xref article to-groups) | |
11536 | (unless (assq action names) | |
11537 | (error "Unknown action %s" action)) | |
11538 | ;; Read the newsgroup name. | |
11539 | (when (and (not to-newsgroup) | |
11540 | (not select-method)) | |
11541 | (setq to-newsgroup | |
11542 | (gnus-read-move-group-name | |
11543 | (cadr (assq action names)) | |
11544 | (symbol-value (intern (format "gnus-current-%s-group" action))) | |
11545 | articles prefix)) | |
11546 | (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) | |
11547 | (setq to-method (or select-method | |
11548 | (gnus-group-name-to-method to-newsgroup))) | |
11549 | ;; Check the method we are to move this article to... | |
41487370 LMI |
11550 | (or (gnus-check-backend-function 'request-accept-article (car to-method)) |
11551 | (error "%s does not support article copying" (car to-method))) | |
11552 | (or (gnus-check-server to-method) | |
11553 | (error "Can't open server %s" (car to-method))) | |
231f989b LMI |
11554 | (gnus-message 6 "%s to %s: %s..." |
11555 | (caddr (assq action names)) | |
11556 | (or (car select-method) to-newsgroup) articles) | |
41487370 | 11557 | (while articles |
231f989b LMI |
11558 | (setq article (pop articles)) |
11559 | (setq | |
11560 | art-group | |
11561 | (cond | |
11562 | ;; Move the article. | |
11563 | ((eq action 'move) | |
11564 | (gnus-request-move-article | |
11565 | article ; Article to move | |
11566 | gnus-newsgroup-name ; From newsgrouo | |
11567 | (nth 1 (gnus-find-method-for-group | |
11568 | gnus-newsgroup-name)) ; Server | |
11569 | (list 'gnus-request-accept-article | |
11570 | to-newsgroup (list 'quote select-method) | |
11571 | (not articles)) ; Accept form | |
11572 | (not articles))) ; Only save nov last time | |
11573 | ;; Copy the article. | |
11574 | ((eq action 'copy) | |
11575 | (save-excursion | |
11576 | (set-buffer copy-buf) | |
11577 | (gnus-request-article-this-buffer article gnus-newsgroup-name) | |
11578 | (gnus-request-accept-article | |
11579 | to-newsgroup select-method (not articles)))) | |
11580 | ;; Crosspost the article. | |
11581 | ((eq action 'crosspost) | |
11582 | (let ((xref (mail-header-xref (gnus-summary-article-header article)))) | |
11583 | (setq new-xref (concat gnus-newsgroup-name ":" article)) | |
11584 | (if (and xref (not (string= xref ""))) | |
11585 | (progn | |
11586 | (when (string-match "^Xref: " xref) | |
11587 | (setq xref (substring xref (match-end 0)))) | |
11588 | (setq new-xref (concat xref " " new-xref))) | |
11589 | (setq new-xref (concat (system-name) " " new-xref))) | |
11590 | (save-excursion | |
11591 | (set-buffer copy-buf) | |
11592 | (gnus-request-article-this-buffer article gnus-newsgroup-name) | |
11593 | (nnheader-replace-header "xref" new-xref) | |
11594 | (gnus-request-accept-article | |
11595 | to-newsgroup select-method (not articles))))))) | |
11596 | (if (not art-group) | |
11597 | (gnus-message 1 "Couldn't %s article %s" | |
11598 | (cadr (assq action names)) article) | |
11599 | (let* ((entry | |
11600 | (or | |
11601 | (gnus-gethash (car art-group) gnus-newsrc-hashtb) | |
11602 | (gnus-gethash | |
11603 | (gnus-group-prefixed-name | |
11604 | (car art-group) | |
11605 | (or select-method | |
41487370 | 11606 | (gnus-find-method-for-group to-newsgroup))) |
231f989b LMI |
11607 | gnus-newsrc-hashtb))) |
11608 | (info (nth 2 entry)) | |
11609 | (to-group (gnus-info-group info))) | |
11610 | ;; Update the group that has been moved to. | |
11611 | (when (and info | |
11612 | (memq action '(move copy))) | |
11613 | (unless (member to-group to-groups) | |
11614 | (push to-group to-groups)) | |
11615 | ||
11616 | (unless (memq article gnus-newsgroup-unreads) | |
11617 | (gnus-info-set-read | |
11618 | info (gnus-add-to-range (gnus-info-read info) | |
11619 | (list (cdr art-group))))) | |
11620 | ||
11621 | ;; Copy any marks over to the new group. | |
11622 | (let ((marks gnus-article-mark-lists) | |
11623 | (to-article (cdr art-group))) | |
11624 | ||
11625 | ;; See whether the article is to be put in the cache. | |
11626 | (when gnus-use-cache | |
11627 | (gnus-cache-possibly-enter-article | |
11628 | to-group to-article | |
11629 | (let ((header (copy-sequence | |
11630 | (gnus-summary-article-header article)))) | |
11631 | (mail-header-set-number header to-article) | |
11632 | header) | |
11633 | (memq article gnus-newsgroup-marked) | |
11634 | (memq article gnus-newsgroup-dormant) | |
11635 | (memq article gnus-newsgroup-unreads))) | |
11636 | ||
11637 | (while marks | |
11638 | (when (memq article (symbol-value | |
11639 | (intern (format "gnus-newsgroup-%s" | |
11640 | (caar marks))))) | |
11641 | ;; If the other group is the same as this group, | |
11642 | ;; then we have to add the mark to the list. | |
11643 | (when (equal to-group gnus-newsgroup-name) | |
11644 | (set (intern (format "gnus-newsgroup-%s" (caar marks))) | |
11645 | (cons to-article | |
11646 | (symbol-value | |
11647 | (intern (format "gnus-newsgroup-%s" | |
11648 | (caar marks))))))) | |
11649 | ;; Copy mark to other group. | |
11650 | (gnus-add-marked-articles | |
11651 | to-group (cdar marks) (list to-article) info)) | |
11652 | (setq marks (cdr marks))))) | |
11653 | ||
11654 | ;; Update the Xref header in this article to point to | |
11655 | ;; the new crossposted article we have just created. | |
11656 | (when (eq action 'crosspost) | |
11657 | (save-excursion | |
11658 | (set-buffer copy-buf) | |
11659 | (gnus-request-article-this-buffer article gnus-newsgroup-name) | |
11660 | (nnheader-replace-header | |
11661 | "xref" (concat new-xref " " (gnus-group-prefixed-name | |
11662 | (car art-group) to-method) | |
11663 | ":" (cdr art-group))) | |
11664 | (gnus-request-replace-article | |
11665 | article gnus-newsgroup-name (current-buffer))))) | |
11666 | ||
11667 | (gnus-summary-goto-subject article) | |
11668 | (when (eq action 'move) | |
11669 | (gnus-summary-mark-article article gnus-canceled-mark))) | |
11670 | (gnus-summary-remove-process-mark article)) | |
11671 | ;; Re-activate all groups that have been moved to. | |
11672 | (while to-groups | |
11673 | (gnus-activate-group (pop to-groups))) | |
11674 | ||
11675 | (gnus-kill-buffer copy-buf) | |
11676 | (gnus-summary-position-point) | |
41487370 LMI |
11677 | (gnus-set-mode-line 'summary))) |
11678 | ||
231f989b LMI |
11679 | (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) |
11680 | "Move the current article to a different newsgroup. | |
11681 | If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. | |
11682 | If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but | |
11683 | re-spool using this method." | |
11684 | (interactive "P") | |
11685 | (gnus-summary-move-article n nil select-method 'copy)) | |
11686 | ||
11687 | (defun gnus-summary-crosspost-article (&optional n) | |
11688 | "Crosspost the current article to some other group." | |
11689 | (interactive "P") | |
11690 | (gnus-summary-move-article n nil nil 'crosspost)) | |
11691 | ||
11692 | (defvar gnus-summary-respool-default-method nil | |
11693 | "Default method for respooling an article. | |
11694 | If nil, use to the current newsgroup method.") | |
11695 | ||
11696 | (defun gnus-summary-respool-article (&optional n method) | |
41487370 LMI |
11697 | "Respool the current article. |
11698 | The article will be squeezed through the mail spooling process again, | |
11699 | which means that it will be put in some mail newsgroup or other | |
11700 | depending on `nnmail-split-methods'. | |
11701 | If N is a positive number, respool the N next articles. | |
11702 | If N is a negative number, respool the N previous articles. | |
11703 | If N is nil and any articles have been marked with the process mark, | |
11704 | respool those articles instead. | |
11705 | ||
11706 | Respooling can be done both from mail groups and \"real\" newsgroups. | |
11707 | In the former case, the articles in question will be moved from the | |
11708 | current group into whatever groups they are destined to. In the | |
11709 | latter case, they will be copied into the relevant groups." | |
231f989b LMI |
11710 | (interactive |
11711 | (list current-prefix-arg | |
11712 | (let* ((methods (gnus-methods-using 'respool)) | |
11713 | (methname | |
11714 | (symbol-name (or gnus-summary-respool-default-method | |
11715 | (car (gnus-find-method-for-group | |
11716 | gnus-newsgroup-name))))) | |
11717 | (method | |
11718 | (gnus-completing-read | |
11719 | methname "What backend do you want to use when respooling?" | |
11720 | methods nil t nil 'gnus-method-history)) | |
11721 | ms) | |
11722 | (cond | |
11723 | ((zerop (length (setq ms (gnus-servers-using-backend method)))) | |
11724 | (list (intern method) "")) | |
11725 | ((= 1 (length ms)) | |
11726 | (car ms)) | |
11727 | (t | |
11728 | (cdr (completing-read | |
11729 | "Server name: " | |
11730 | (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t))))))) | |
41487370 | 11731 | (gnus-set-global-variables) |
231f989b LMI |
11732 | (unless method |
11733 | (error "No method given for respooling")) | |
11734 | (if (assoc (symbol-name | |
11735 | (car (gnus-find-method-for-group gnus-newsgroup-name))) | |
11736 | (gnus-methods-using 'respool)) | |
11737 | (gnus-summary-move-article n nil method) | |
11738 | (gnus-summary-copy-article n nil method))) | |
41487370 LMI |
11739 | |
11740 | (defun gnus-summary-import-article (file) | |
11741 | "Import a random file into a mail newsgroup." | |
11742 | (interactive "fImport file: ") | |
231f989b | 11743 | (gnus-set-global-variables) |
41487370 | 11744 | (let ((group gnus-newsgroup-name) |
231f989b LMI |
11745 | (now (current-time)) |
11746 | atts lines) | |
41487370 LMI |
11747 | (or (gnus-check-backend-function 'request-accept-article group) |
11748 | (error "%s does not support article importing" group)) | |
11749 | (or (file-readable-p file) | |
11750 | (not (file-regular-p file)) | |
11751 | (error "Can't read %s" file)) | |
11752 | (save-excursion | |
11753 | (set-buffer (get-buffer-create " *import file*")) | |
11754 | (buffer-disable-undo (current-buffer)) | |
11755 | (erase-buffer) | |
11756 | (insert-file-contents file) | |
11757 | (goto-char (point-min)) | |
231f989b LMI |
11758 | (unless (nnheader-article-p) |
11759 | ;; This doesn't look like an article, so we fudge some headers. | |
11760 | (setq atts (file-attributes file) | |
11761 | lines (count-lines (point-min) (point-max))) | |
41487370 LMI |
11762 | (insert "From: " (read-string "From: ") "\n" |
11763 | "Subject: " (read-string "Subject: ") "\n" | |
231f989b LMI |
11764 | "Date: " (timezone-make-date-arpa-standard |
11765 | (current-time-string (nth 5 atts)) | |
11766 | (current-time-zone now) | |
11767 | (current-time-zone now)) "\n" | |
11768 | "Message-ID: " (message-make-message-id) "\n" | |
11769 | "Lines: " (int-to-string lines) "\n" | |
41487370 | 11770 | "Chars: " (int-to-string (nth 7 atts)) "\n\n")) |
231f989b | 11771 | (gnus-request-accept-article group nil t) |
41487370 LMI |
11772 | (kill-buffer (current-buffer))))) |
11773 | ||
231f989b | 11774 | (defun gnus-summary-expire-articles (&optional now) |
41487370 LMI |
11775 | "Expire all articles that are marked as expirable in the current group." |
11776 | (interactive) | |
231f989b LMI |
11777 | (gnus-set-global-variables) |
11778 | (when (gnus-check-backend-function | |
11779 | 'request-expire-articles gnus-newsgroup-name) | |
11780 | ;; This backend supports expiry. | |
11781 | (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) | |
41487370 LMI |
11782 | (expirable (if total |
11783 | (gnus-list-of-read-articles gnus-newsgroup-name) | |
11784 | (setq gnus-newsgroup-expirable | |
11785 | (sort gnus-newsgroup-expirable '<)))) | |
231f989b LMI |
11786 | (expiry-wait (if now 'immediate |
11787 | (gnus-group-get-parameter | |
11788 | gnus-newsgroup-name 'expiry-wait))) | |
41487370 | 11789 | es) |
231f989b LMI |
11790 | (when expirable |
11791 | ;; There are expirable articles in this group, so we run them | |
11792 | ;; through the expiry process. | |
41487370 LMI |
11793 | (gnus-message 6 "Expiring articles...") |
11794 | ;; The list of articles that weren't expired is returned. | |
231f989b LMI |
11795 | (if expiry-wait |
11796 | (let ((nnmail-expiry-wait-function nil) | |
11797 | (nnmail-expiry-wait expiry-wait)) | |
11798 | (setq es (gnus-request-expire-articles | |
11799 | expirable gnus-newsgroup-name))) | |
11800 | (setq es (gnus-request-expire-articles | |
11801 | expirable gnus-newsgroup-name))) | |
41487370 LMI |
11802 | (or total (setq gnus-newsgroup-expirable es)) |
11803 | ;; We go through the old list of expirable, and mark all | |
b94ae5f7 | 11804 | ;; really expired articles as nonexistent. |
231f989b LMI |
11805 | (unless (eq es expirable) ;If nothing was expired, we don't mark. |
11806 | (let ((gnus-use-cache nil)) | |
11807 | (while expirable | |
11808 | (unless (memq (car expirable) es) | |
11809 | (when (gnus-data-find (car expirable)) | |
11810 | (gnus-summary-mark-article | |
11811 | (car expirable) gnus-canceled-mark))) | |
11812 | (setq expirable (cdr expirable))))) | |
41487370 LMI |
11813 | (gnus-message 6 "Expiring articles...done"))))) |
11814 | ||
11815 | (defun gnus-summary-expire-articles-now () | |
11816 | "Expunge all expirable articles in the current group. | |
11817 | This means that *all* articles that are marked as expirable will be | |
11818 | deleted forever, right now." | |
11819 | (interactive) | |
231f989b | 11820 | (gnus-set-global-variables) |
41487370 LMI |
11821 | (or gnus-expert-user |
11822 | (gnus-y-or-n-p | |
231f989b | 11823 | "Are you really, really, really sure you want to delete all these messages? ") |
41487370 | 11824 | (error "Phew!")) |
231f989b | 11825 | (gnus-summary-expire-articles t)) |
41487370 LMI |
11826 | |
11827 | ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. | |
11828 | (defun gnus-summary-delete-article (&optional n) | |
11829 | "Delete the N next (mail) articles. | |
231f989b LMI |
11830 | This command actually deletes articles. This is not a marking |
11831 | command. The article will disappear forever from your life, never to | |
11832 | return. | |
41487370 LMI |
11833 | If N is negative, delete backwards. |
11834 | If N is nil and articles have been marked with the process mark, | |
11835 | delete these instead." | |
11836 | (interactive "P") | |
231f989b LMI |
11837 | (gnus-set-global-variables) |
11838 | (or (gnus-check-backend-function 'request-expire-articles | |
41487370 LMI |
11839 | gnus-newsgroup-name) |
11840 | (error "The current newsgroup does not support article deletion.")) | |
11841 | ;; Compute the list of articles to delete. | |
11842 | (let ((articles (gnus-summary-work-articles n)) | |
11843 | not-deleted) | |
11844 | (if (and gnus-novice-user | |
231f989b | 11845 | (not (gnus-y-or-n-p |
41487370 | 11846 | (format "Do you really want to delete %s forever? " |
231f989b LMI |
11847 | (if (> (length articles) 1) |
11848 | (format "these %s articles" (length articles)) | |
41487370 LMI |
11849 | "this article"))))) |
11850 | () | |
11851 | ;; Delete the articles. | |
231f989b | 11852 | (setq not-deleted (gnus-request-expire-articles |
41487370 LMI |
11853 | articles gnus-newsgroup-name 'force)) |
11854 | (while articles | |
231f989b | 11855 | (gnus-summary-remove-process-mark (car articles)) |
41487370 | 11856 | ;; The backend might not have been able to delete the article |
231f989b | 11857 | ;; after all. |
41487370 LMI |
11858 | (or (memq (car articles) not-deleted) |
11859 | (gnus-summary-mark-article (car articles) gnus-canceled-mark)) | |
11860 | (setq articles (cdr articles)))) | |
231f989b | 11861 | (gnus-summary-position-point) |
41487370 LMI |
11862 | (gnus-set-mode-line 'summary) |
11863 | not-deleted)) | |
11864 | ||
11865 | (defun gnus-summary-edit-article (&optional force) | |
11866 | "Enter into a buffer and edit the current article. | |
11867 | This will have permanent effect only in mail groups. | |
11868 | If FORCE is non-nil, allow editing of articles even in read-only | |
11869 | groups." | |
11870 | (interactive "P") | |
231f989b LMI |
11871 | (save-excursion |
11872 | (set-buffer gnus-summary-buffer) | |
11873 | (gnus-set-global-variables) | |
11874 | (when (and (not force) | |
11875 | (gnus-group-read-only-p)) | |
41487370 | 11876 | (error "The current newsgroup does not support article editing.")) |
231f989b LMI |
11877 | (gnus-summary-select-article t nil t) |
11878 | (gnus-configure-windows 'article) | |
11879 | (select-window (get-buffer-window gnus-article-buffer)) | |
11880 | (gnus-message 6 "C-c C-c to end edits") | |
11881 | (setq buffer-read-only nil) | |
11882 | (text-mode) | |
11883 | (use-local-map (copy-keymap (current-local-map))) | |
11884 | (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) | |
11885 | (buffer-enable-undo) | |
11886 | (widen) | |
11887 | (goto-char (point-min)) | |
11888 | (search-forward "\n\n" nil t))) | |
41487370 LMI |
11889 | |
11890 | (defun gnus-summary-edit-article-done () | |
11891 | "Make edits to the current article permanent." | |
11892 | (interactive) | |
11893 | (if (gnus-group-read-only-p) | |
11894 | (progn | |
564b670b LMI |
11895 | (let ((beep (not (eq major-mode 'text-mode)))) |
11896 | (gnus-summary-edit-article-postpone) | |
11897 | (when beep | |
11898 | (gnus-error | |
11899 | 3 "The current newsgroup does not support article editing.")))) | |
231f989b | 11900 | (let ((buf (format "%s" (buffer-string)))) |
41487370 LMI |
11901 | (erase-buffer) |
11902 | (insert buf) | |
231f989b LMI |
11903 | (if (not (gnus-request-replace-article |
11904 | (cdr gnus-article-current) (car gnus-article-current) | |
41487370 LMI |
11905 | (current-buffer))) |
11906 | (error "Couldn't replace article.") | |
11907 | (gnus-article-mode) | |
11908 | (use-local-map gnus-article-mode-map) | |
11909 | (setq buffer-read-only t) | |
11910 | (buffer-disable-undo (current-buffer)) | |
231f989b LMI |
11911 | (gnus-configure-windows 'summary) |
11912 | (gnus-summary-update-article (cdr gnus-article-current)) | |
11913 | (when gnus-use-cache | |
11914 | (gnus-cache-update-article | |
11915 | (car gnus-article-current) (cdr gnus-article-current))) | |
11916 | (when gnus-keep-backlog | |
11917 | (gnus-backlog-remove-article | |
11918 | (car gnus-article-current) (cdr gnus-article-current)))) | |
11919 | (save-excursion | |
11920 | (when (get-buffer gnus-original-article-buffer) | |
11921 | (set-buffer gnus-original-article-buffer) | |
11922 | (setq gnus-original-article nil))) | |
11923 | (setq gnus-article-current nil | |
11924 | gnus-current-article nil) | |
11925 | (run-hooks 'gnus-article-display-hook) | |
11926 | (and (gnus-visual-p 'summary-highlight 'highlight) | |
11927 | (run-hooks 'gnus-visual-mark-article-hook))))) | |
41487370 LMI |
11928 | |
11929 | (defun gnus-summary-edit-article-postpone () | |
11930 | "Postpone changes to the current article." | |
11931 | (interactive) | |
11932 | (gnus-article-mode) | |
11933 | (use-local-map gnus-article-mode-map) | |
11934 | (setq buffer-read-only t) | |
11935 | (buffer-disable-undo (current-buffer)) | |
11936 | (gnus-configure-windows 'summary) | |
231f989b LMI |
11937 | (and (gnus-visual-p 'summary-highlight 'highlight) |
11938 | (run-hooks 'gnus-visual-mark-article-hook))) | |
41487370 | 11939 | |
231f989b LMI |
11940 | (defun gnus-summary-respool-query () |
11941 | "Query where the respool algorithm would put this article." | |
41487370 | 11942 | (interactive) |
231f989b | 11943 | (gnus-set-global-variables) |
41487370 LMI |
11944 | (gnus-summary-select-article) |
11945 | (save-excursion | |
11946 | (set-buffer gnus-article-buffer) | |
11947 | (save-restriction | |
11948 | (goto-char (point-min)) | |
11949 | (search-forward "\n\n") | |
11950 | (narrow-to-region (point-min) (point)) | |
231f989b LMI |
11951 | (pp-eval-expression |
11952 | (list 'quote (mapcar 'car (nnmail-article-group 'identity))))))) | |
41487370 LMI |
11953 | |
11954 | ;; Summary marking commands. | |
11955 | ||
41487370 LMI |
11956 | (defun gnus-summary-kill-same-subject-and-select (&optional unmark) |
11957 | "Mark articles which has the same subject as read, and then select the next. | |
11958 | If UNMARK is positive, remove any kind of mark. | |
11959 | If UNMARK is negative, tick articles." | |
745bc783 | 11960 | (interactive "P") |
231f989b | 11961 | (gnus-set-global-variables) |
745bc783 JB |
11962 | (if unmark |
11963 | (setq unmark (prefix-numeric-value unmark))) | |
11964 | (let ((count | |
b027f415 | 11965 | (gnus-summary-mark-same-subject |
231f989b LMI |
11966 | (gnus-summary-article-subject) unmark))) |
11967 | ;; Select next unread article. If auto-select-same mode, should | |
745bc783 | 11968 | ;; select the first unread article. |
b027f415 | 11969 | (gnus-summary-next-article t (and gnus-auto-select-same |
231f989b | 11970 | (gnus-summary-article-subject))) |
41487370 LMI |
11971 | (gnus-message 7 "%d article%s marked as %s" |
11972 | count (if (= count 1) " is" "s are") | |
11973 | (if unmark "unread" "read")))) | |
745bc783 | 11974 | |
41487370 | 11975 | (defun gnus-summary-kill-same-subject (&optional unmark) |
231f989b | 11976 | "Mark articles which has the same subject as read. |
41487370 LMI |
11977 | If UNMARK is positive, remove any kind of mark. |
11978 | If UNMARK is negative, tick articles." | |
745bc783 | 11979 | (interactive "P") |
231f989b | 11980 | (gnus-set-global-variables) |
745bc783 JB |
11981 | (if unmark |
11982 | (setq unmark (prefix-numeric-value unmark))) | |
11983 | (let ((count | |
b027f415 | 11984 | (gnus-summary-mark-same-subject |
231f989b | 11985 | (gnus-summary-article-subject) unmark))) |
745bc783 JB |
11986 | ;; If marked as read, go to next unread subject. |
11987 | (if (null unmark) | |
11988 | ;; Go to next unread subject. | |
b027f415 | 11989 | (gnus-summary-next-subject 1 t)) |
41487370 LMI |
11990 | (gnus-message 7 "%d articles are marked as %s" |
11991 | count (if unmark "unread" "read")))) | |
745bc783 | 11992 | |
b027f415 | 11993 | (defun gnus-summary-mark-same-subject (subject &optional unmark) |
745bc783 JB |
11994 | "Mark articles with same SUBJECT as read, and return marked number. |
11995 | If optional argument UNMARK is positive, remove any kinds of marks. | |
11996 | If optional argument UNMARK is negative, mark articles as unread instead." | |
11997 | (let ((count 1)) | |
11998 | (save-excursion | |
231f989b | 11999 | (cond |
41487370 | 12000 | ((null unmark) ; Mark as read. |
231f989b | 12001 | (while (and |
41487370 LMI |
12002 | (progn |
12003 | (gnus-summary-mark-article-as-read gnus-killed-mark) | |
12004 | (gnus-summary-show-thread) t) | |
231f989b | 12005 | (gnus-summary-find-subject subject)) |
41487370 LMI |
12006 | (setq count (1+ count)))) |
12007 | ((> unmark 0) ; Tick. | |
12008 | (while (and | |
12009 | (progn | |
12010 | (gnus-summary-mark-article-as-unread gnus-ticked-mark) | |
12011 | (gnus-summary-show-thread) t) | |
231f989b | 12012 | (gnus-summary-find-subject subject)) |
41487370 LMI |
12013 | (setq count (1+ count)))) |
12014 | (t ; Mark as unread. | |
12015 | (while (and | |
12016 | (progn | |
12017 | (gnus-summary-mark-article-as-unread gnus-unread-mark) | |
12018 | (gnus-summary-show-thread) t) | |
231f989b | 12019 | (gnus-summary-find-subject subject)) |
41487370 LMI |
12020 | (setq count (1+ count))))) |
12021 | (gnus-set-mode-line 'summary) | |
12022 | ;; Return the number of marked articles. | |
12023 | count))) | |
12024 | ||
12025 | (defun gnus-summary-mark-as-processable (n &optional unmark) | |
12026 | "Set the process mark on the next N articles. | |
12027 | If N is negative, mark backward instead. If UNMARK is non-nil, remove | |
12028 | the process mark instead. The difference between N and the actual | |
12029 | number of articles marked is returned." | |
12030 | (interactive "p") | |
231f989b | 12031 | (gnus-set-global-variables) |
41487370 LMI |
12032 | (let ((backward (< n 0)) |
12033 | (n (abs n))) | |
231f989b | 12034 | (while (and |
41487370 LMI |
12035 | (> n 0) |
12036 | (if unmark | |
12037 | (gnus-summary-remove-process-mark | |
12038 | (gnus-summary-article-number)) | |
12039 | (gnus-summary-set-process-mark (gnus-summary-article-number))) | |
12040 | (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) | |
12041 | (setq n (1- n))) | |
12042 | (if (/= 0 n) (gnus-message 7 "No more articles")) | |
12043 | (gnus-summary-recenter) | |
231f989b | 12044 | (gnus-summary-position-point) |
41487370 LMI |
12045 | n)) |
12046 | ||
12047 | (defun gnus-summary-unmark-as-processable (n) | |
12048 | "Remove the process mark from the next N articles. | |
12049 | If N is negative, mark backward instead. The difference between N and | |
12050 | the actual number of articles marked is returned." | |
12051 | (interactive "p") | |
231f989b | 12052 | (gnus-set-global-variables) |
41487370 LMI |
12053 | (gnus-summary-mark-as-processable n t)) |
12054 | ||
12055 | (defun gnus-summary-unmark-all-processable () | |
12056 | "Remove the process mark from all articles." | |
12057 | (interactive) | |
231f989b | 12058 | (gnus-set-global-variables) |
41487370 LMI |
12059 | (save-excursion |
12060 | (while gnus-newsgroup-processable | |
12061 | (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) | |
231f989b | 12062 | (gnus-summary-position-point)) |
41487370 LMI |
12063 | |
12064 | (defun gnus-summary-mark-as-expirable (n) | |
12065 | "Mark N articles forward as expirable. | |
231f989b | 12066 | If N is negative, mark backward instead. The difference between N and |
41487370 | 12067 | the actual number of articles marked is returned." |
745bc783 | 12068 | (interactive "p") |
231f989b | 12069 | (gnus-set-global-variables) |
41487370 LMI |
12070 | (gnus-summary-mark-forward n gnus-expirable-mark)) |
12071 | ||
12072 | (defun gnus-summary-mark-article-as-replied (article) | |
12073 | "Mark ARTICLE replied and update the summary line." | |
12074 | (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) | |
12075 | (let ((buffer-read-only nil)) | |
231f989b LMI |
12076 | (when (gnus-summary-goto-subject article) |
12077 | (gnus-summary-update-secondary-mark article)))) | |
41487370 LMI |
12078 | |
12079 | (defun gnus-summary-set-bookmark (article) | |
12080 | "Set a bookmark in current article." | |
12081 | (interactive (list (gnus-summary-article-number))) | |
231f989b | 12082 | (gnus-set-global-variables) |
41487370 LMI |
12083 | (if (or (not (get-buffer gnus-article-buffer)) |
12084 | (not gnus-current-article) | |
12085 | (not gnus-article-current) | |
12086 | (not (equal gnus-newsgroup-name (car gnus-article-current)))) | |
12087 | (error "No current article selected")) | |
12088 | ;; Remove old bookmark, if one exists. | |
12089 | (let ((old (assq article gnus-newsgroup-bookmarks))) | |
231f989b | 12090 | (if old (setq gnus-newsgroup-bookmarks |
41487370 | 12091 | (delq old gnus-newsgroup-bookmarks)))) |
231f989b | 12092 | ;; Set the new bookmark, which is on the form |
41487370 | 12093 | ;; (article-number . line-number-in-body). |
231f989b LMI |
12094 | (setq gnus-newsgroup-bookmarks |
12095 | (cons | |
12096 | (cons article | |
41487370 LMI |
12097 | (save-excursion |
12098 | (set-buffer gnus-article-buffer) | |
12099 | (count-lines | |
12100 | (min (point) | |
12101 | (save-excursion | |
12102 | (goto-char (point-min)) | |
12103 | (search-forward "\n\n" nil t) | |
12104 | (point))) | |
12105 | (point)))) | |
12106 | gnus-newsgroup-bookmarks)) | |
12107 | (gnus-message 6 "A bookmark has been added to the current article.")) | |
12108 | ||
12109 | (defun gnus-summary-remove-bookmark (article) | |
12110 | "Remove the bookmark from the current article." | |
12111 | (interactive (list (gnus-summary-article-number))) | |
231f989b | 12112 | (gnus-set-global-variables) |
41487370 LMI |
12113 | ;; Remove old bookmark, if one exists. |
12114 | (let ((old (assq article gnus-newsgroup-bookmarks))) | |
231f989b | 12115 | (if old |
41487370 | 12116 | (progn |
231f989b | 12117 | (setq gnus-newsgroup-bookmarks |
41487370 LMI |
12118 | (delq old gnus-newsgroup-bookmarks)) |
12119 | (gnus-message 6 "Removed bookmark.")) | |
12120 | (gnus-message 6 "No bookmark in current article.")))) | |
12121 | ||
12122 | ;; Suggested by Daniel Quinlan <quinlan@best.com>. | |
12123 | (defun gnus-summary-mark-as-dormant (n) | |
12124 | "Mark N articles forward as dormant. | |
12125 | If N is negative, mark backward instead. The difference between N and | |
12126 | the actual number of articles marked is returned." | |
12127 | (interactive "p") | |
231f989b | 12128 | (gnus-set-global-variables) |
41487370 LMI |
12129 | (gnus-summary-mark-forward n gnus-dormant-mark)) |
12130 | ||
12131 | (defun gnus-summary-set-process-mark (article) | |
12132 | "Set the process mark on ARTICLE and update the summary line." | |
231f989b LMI |
12133 | (setq gnus-newsgroup-processable |
12134 | (cons article | |
7e988fb6 | 12135 | (delq article gnus-newsgroup-processable))) |
231f989b LMI |
12136 | (when (gnus-summary-goto-subject article) |
12137 | (gnus-summary-show-thread) | |
12138 | (gnus-summary-update-secondary-mark article))) | |
41487370 LMI |
12139 | |
12140 | (defun gnus-summary-remove-process-mark (article) | |
12141 | "Remove the process mark from ARTICLE and update the summary line." | |
12142 | (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) | |
231f989b LMI |
12143 | (when (gnus-summary-goto-subject article) |
12144 | (gnus-summary-show-thread) | |
12145 | (gnus-summary-update-secondary-mark article))) | |
12146 | ||
12147 | (defun gnus-summary-set-saved-mark (article) | |
12148 | "Set the process mark on ARTICLE and update the summary line." | |
12149 | (push article gnus-newsgroup-saved) | |
12150 | (when (gnus-summary-goto-subject article) | |
12151 | (gnus-summary-update-secondary-mark article))) | |
41487370 LMI |
12152 | |
12153 | (defun gnus-summary-mark-forward (n &optional mark no-expire) | |
12154 | "Mark N articles as read forwards. | |
231f989b | 12155 | If N is negative, mark backwards instead. Mark with MARK, ?r by default. |
41487370 LMI |
12156 | The difference between N and the actual number of articles marked is |
12157 | returned." | |
12158 | (interactive "p") | |
12159 | (gnus-set-global-variables) | |
12160 | (let ((backward (< n 0)) | |
12161 | (gnus-summary-goto-unread | |
12162 | (and gnus-summary-goto-unread | |
231f989b | 12163 | (not (eq gnus-summary-goto-unread 'never)) |
41487370 LMI |
12164 | (not (memq mark (list gnus-unread-mark |
12165 | gnus-ticked-mark gnus-dormant-mark))))) | |
12166 | (n (abs n)) | |
12167 | (mark (or mark gnus-del-mark))) | |
12168 | (while (and (> n 0) | |
12169 | (gnus-summary-mark-article nil mark no-expire) | |
231f989b LMI |
12170 | (zerop (gnus-summary-next-subject |
12171 | (if backward -1 1) | |
12172 | (and gnus-summary-goto-unread | |
12173 | (not (eq gnus-summary-goto-unread 'never))) | |
12174 | t))) | |
41487370 LMI |
12175 | (setq n (1- n))) |
12176 | (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) | |
12177 | (gnus-summary-recenter) | |
231f989b | 12178 | (gnus-summary-position-point) |
41487370 LMI |
12179 | (gnus-set-mode-line 'summary) |
12180 | n)) | |
12181 | ||
12182 | (defun gnus-summary-mark-article-as-read (mark) | |
12183 | "Mark the current article quickly as read with MARK." | |
12184 | (let ((article (gnus-summary-article-number))) | |
12185 | (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) | |
12186 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) | |
12187 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
12188 | (setq gnus-newsgroup-reads | |
12189 | (cons (cons article mark) gnus-newsgroup-reads)) | |
231f989b | 12190 | ;; Possibly remove from cache, if that is used. |
41487370 | 12191 | (and gnus-use-cache (gnus-cache-enter-remove-article article)) |
231f989b LMI |
12192 | ;; Allow the backend to change the mark. |
12193 | (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) | |
12194 | ;; Check for auto-expiry. | |
12195 | (when (and gnus-newsgroup-auto-expire | |
12196 | (or (= mark gnus-killed-mark) (= mark gnus-del-mark) | |
12197 | (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) | |
12198 | (= mark gnus-ancient-mark) | |
12199 | (= mark gnus-read-mark) (= mark gnus-souped-mark))) | |
12200 | (setq mark gnus-expirable-mark) | |
12201 | (push article gnus-newsgroup-expirable)) | |
12202 | ;; Set the mark in the buffer. | |
41487370 LMI |
12203 | (gnus-summary-update-mark mark 'unread) |
12204 | t)) | |
12205 | ||
12206 | (defun gnus-summary-mark-article-as-unread (mark) | |
12207 | "Mark the current article quickly as unread with MARK." | |
12208 | (let ((article (gnus-summary-article-number))) | |
231f989b LMI |
12209 | (if (< article 0) |
12210 | (gnus-error 1 "Unmarkable article") | |
12211 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) | |
12212 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
12213 | (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) | |
12214 | (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) | |
12215 | (cond ((= mark gnus-ticked-mark) | |
12216 | (push article gnus-newsgroup-marked)) | |
12217 | ((= mark gnus-dormant-mark) | |
12218 | (push article gnus-newsgroup-dormant)) | |
12219 | (t | |
12220 | (push article gnus-newsgroup-unreads))) | |
12221 | (setq gnus-newsgroup-reads | |
12222 | (delq (assq article gnus-newsgroup-reads) | |
12223 | gnus-newsgroup-reads)) | |
12224 | ||
12225 | ;; See whether the article is to be put in the cache. | |
12226 | (and gnus-use-cache | |
12227 | (vectorp (gnus-summary-article-header article)) | |
12228 | (save-excursion | |
12229 | (gnus-cache-possibly-enter-article | |
12230 | gnus-newsgroup-name article | |
12231 | (gnus-summary-article-header article) | |
12232 | (= mark gnus-ticked-mark) | |
12233 | (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) | |
12234 | ||
12235 | ;; Fix the mark. | |
12236 | (gnus-summary-update-mark mark 'unread)) | |
41487370 LMI |
12237 | t)) |
12238 | ||
12239 | (defun gnus-summary-mark-article (&optional article mark no-expire) | |
12240 | "Mark ARTICLE with MARK. MARK can be any character. | |
231f989b LMI |
12241 | Four MARK strings are reserved: `? ' (unread), `?!' (ticked), |
12242 | `??' (dormant) and `?E' (expirable). | |
41487370 LMI |
12243 | If MARK is nil, then the default character `?D' is used. |
12244 | If ARTICLE is nil, then the article on the current line will be | |
231f989b LMI |
12245 | marked." |
12246 | ;; The mark might be a string. | |
41487370 LMI |
12247 | (and (stringp mark) |
12248 | (setq mark (aref mark 0))) | |
12249 | ;; If no mark is given, then we check auto-expiring. | |
12250 | (and (not no-expire) | |
231f989b | 12251 | gnus-newsgroup-auto-expire |
41487370 | 12252 | (or (not mark) |
231f989b | 12253 | (and (numberp mark) |
41487370 LMI |
12254 | (or (= mark gnus-killed-mark) (= mark gnus-del-mark) |
12255 | (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) | |
231f989b | 12256 | (= mark gnus-read-mark) (= mark gnus-souped-mark)))) |
41487370 LMI |
12257 | (setq mark gnus-expirable-mark)) |
12258 | (let* ((mark (or mark gnus-del-mark)) | |
12259 | (article (or article (gnus-summary-article-number)))) | |
12260 | (or article (error "No article on current line")) | |
231f989b LMI |
12261 | (if (or (= mark gnus-unread-mark) |
12262 | (= mark gnus-ticked-mark) | |
41487370 LMI |
12263 | (= mark gnus-dormant-mark)) |
12264 | (gnus-mark-article-as-unread article mark) | |
12265 | (gnus-mark-article-as-read article mark)) | |
12266 | ||
12267 | ;; See whether the article is to be put in the cache. | |
12268 | (and gnus-use-cache | |
12269 | (not (= mark gnus-canceled-mark)) | |
231f989b | 12270 | (vectorp (gnus-summary-article-header article)) |
41487370 | 12271 | (save-excursion |
231f989b LMI |
12272 | (gnus-cache-possibly-enter-article |
12273 | gnus-newsgroup-name article | |
12274 | (gnus-summary-article-header article) | |
41487370 LMI |
12275 | (= mark gnus-ticked-mark) |
12276 | (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) | |
12277 | ||
231f989b | 12278 | (if (gnus-summary-goto-subject article nil t) |
41487370 LMI |
12279 | (let ((buffer-read-only nil)) |
12280 | (gnus-summary-show-thread) | |
41487370 LMI |
12281 | ;; Fix the mark. |
12282 | (gnus-summary-update-mark mark 'unread) | |
12283 | t)))) | |
12284 | ||
231f989b LMI |
12285 | (defun gnus-summary-update-secondary-mark (article) |
12286 | "Update the secondary (read, process, cache) mark." | |
12287 | (gnus-summary-update-mark | |
12288 | (cond ((memq article gnus-newsgroup-processable) | |
12289 | gnus-process-mark) | |
12290 | ((memq article gnus-newsgroup-cached) | |
12291 | gnus-cached-mark) | |
12292 | ((memq article gnus-newsgroup-replied) | |
12293 | gnus-replied-mark) | |
12294 | ((memq article gnus-newsgroup-saved) | |
12295 | gnus-saved-mark) | |
12296 | (t gnus-unread-mark)) | |
12297 | 'replied) | |
12298 | (when (gnus-visual-p 'summary-highlight 'highlight) | |
12299 | (run-hooks 'gnus-summary-update-hook)) | |
12300 | t) | |
12301 | ||
41487370 LMI |
12302 | (defun gnus-summary-update-mark (mark type) |
12303 | (beginning-of-line) | |
12304 | (let ((forward (cdr (assq type gnus-summary-mark-positions))) | |
231f989b LMI |
12305 | (buffer-read-only nil)) |
12306 | (when (and forward | |
12307 | (<= (+ forward (point)) (point-max))) | |
12308 | ;; Go to the right position on the line. | |
12309 | (goto-char (+ forward (point))) | |
12310 | ;; Replace the old mark with the new mark. | |
12311 | (subst-char-in-region (point) (1+ (point)) (following-char) mark) | |
12312 | ;; Optionally update the marks by some user rule. | |
12313 | (when (eq type 'unread) | |
12314 | (gnus-data-set-mark | |
12315 | (gnus-data-find (gnus-summary-article-number)) mark) | |
12316 | (gnus-summary-update-line (eq mark gnus-unread-mark)))))) | |
12317 | ||
41487370 LMI |
12318 | (defun gnus-mark-article-as-read (article &optional mark) |
12319 | "Enter ARTICLE in the pertinent lists and remove it from others." | |
12320 | ;; Make the article expirable. | |
12321 | (let ((mark (or mark gnus-del-mark))) | |
12322 | (if (= mark gnus-expirable-mark) | |
12323 | (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) | |
12324 | (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) | |
12325 | ;; Remove from unread and marked lists. | |
12326 | (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) | |
12327 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) | |
12328 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
231f989b LMI |
12329 | (push (cons article mark) gnus-newsgroup-reads) |
12330 | ;; Possibly remove from cache, if that is used. | |
12331 | (when gnus-use-cache | |
12332 | (gnus-cache-enter-remove-article article)))) | |
41487370 LMI |
12333 | |
12334 | (defun gnus-mark-article-as-unread (article &optional mark) | |
12335 | "Enter ARTICLE in the pertinent lists and remove it from others." | |
12336 | (let ((mark (or mark gnus-ticked-mark))) | |
41487370 LMI |
12337 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) |
12338 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
12339 | (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) | |
231f989b LMI |
12340 | (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) |
12341 | (cond ((= mark gnus-ticked-mark) | |
12342 | (push article gnus-newsgroup-marked)) | |
12343 | ((= mark gnus-dormant-mark) | |
12344 | (push article gnus-newsgroup-dormant)) | |
12345 | (t | |
12346 | (push article gnus-newsgroup-unreads))) | |
41487370 LMI |
12347 | (setq gnus-newsgroup-reads |
12348 | (delq (assq article gnus-newsgroup-reads) | |
231f989b | 12349 | gnus-newsgroup-reads)))) |
41487370 | 12350 | |
231f989b | 12351 | (defalias 'gnus-summary-mark-as-unread-forward |
41487370 | 12352 | 'gnus-summary-tick-article-forward) |
231f989b | 12353 | (make-obsolete 'gnus-summary-mark-as-unread-forward |
41487370 LMI |
12354 | 'gnus-summary-tick-article-forward) |
12355 | (defun gnus-summary-tick-article-forward (n) | |
12356 | "Tick N articles forwards. | |
12357 | If N is negative, tick backwards instead. | |
12358 | The difference between N and the number of articles ticked is returned." | |
745bc783 | 12359 | (interactive "p") |
41487370 LMI |
12360 | (gnus-summary-mark-forward n gnus-ticked-mark)) |
12361 | ||
231f989b | 12362 | (defalias 'gnus-summary-mark-as-unread-backward |
41487370 | 12363 | 'gnus-summary-tick-article-backward) |
231f989b | 12364 | (make-obsolete 'gnus-summary-mark-as-unread-backward |
41487370 LMI |
12365 | 'gnus-summary-tick-article-backward) |
12366 | (defun gnus-summary-tick-article-backward (n) | |
12367 | "Tick N articles backwards. | |
12368 | The difference between N and the number of articles ticked is returned." | |
12369 | (interactive "p") | |
12370 | (gnus-summary-mark-forward (- n) gnus-ticked-mark)) | |
745bc783 | 12371 | |
41487370 LMI |
12372 | (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) |
12373 | (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) | |
12374 | (defun gnus-summary-tick-article (&optional article clear-mark) | |
745bc783 | 12375 | "Mark current article as unread. |
b027f415 RS |
12376 | Optional 1st argument ARTICLE specifies article number to be marked as unread. |
12377 | Optional 2nd argument CLEAR-MARK remove any kinds of mark." | |
231f989b | 12378 | (interactive) |
41487370 LMI |
12379 | (gnus-summary-mark-article article (if clear-mark gnus-unread-mark |
12380 | gnus-ticked-mark))) | |
12381 | ||
12382 | (defun gnus-summary-mark-as-read-forward (n) | |
12383 | "Mark N articles as read forwards. | |
12384 | If N is negative, mark backwards instead. | |
12385 | The difference between N and the actual number of articles marked is | |
12386 | returned." | |
745bc783 | 12387 | (interactive "p") |
41487370 LMI |
12388 | (gnus-summary-mark-forward n gnus-del-mark t)) |
12389 | ||
12390 | (defun gnus-summary-mark-as-read-backward (n) | |
12391 | "Mark the N articles as read backwards. | |
12392 | The difference between N and the actual number of articles marked is | |
12393 | returned." | |
745bc783 | 12394 | (interactive "p") |
41487370 | 12395 | (gnus-summary-mark-forward (- n) gnus-del-mark t)) |
745bc783 | 12396 | |
b027f415 | 12397 | (defun gnus-summary-mark-as-read (&optional article mark) |
745bc783 | 12398 | "Mark current article as read. |
41487370 LMI |
12399 | ARTICLE specifies the article to be marked as read. |
12400 | MARK specifies a string to be inserted at the beginning of the line." | |
12401 | (gnus-summary-mark-article article mark)) | |
12402 | ||
12403 | (defun gnus-summary-clear-mark-forward (n) | |
12404 | "Clear marks from N articles forward. | |
12405 | If N is negative, clear backward instead. | |
12406 | The difference between N and the number of marks cleared is returned." | |
745bc783 | 12407 | (interactive "p") |
41487370 | 12408 | (gnus-summary-mark-forward n gnus-unread-mark)) |
745bc783 | 12409 | |
41487370 LMI |
12410 | (defun gnus-summary-clear-mark-backward (n) |
12411 | "Clear marks from N articles backward. | |
12412 | The difference between N and the number of marks cleared is returned." | |
12413 | (interactive "p") | |
12414 | (gnus-summary-mark-forward (- n) gnus-unread-mark)) | |
12415 | ||
12416 | (defun gnus-summary-mark-unread-as-read () | |
12417 | "Intended to be used by `gnus-summary-mark-article-hook'." | |
231f989b LMI |
12418 | (when (memq gnus-current-article gnus-newsgroup-unreads) |
12419 | (gnus-summary-mark-article gnus-current-article gnus-read-mark))) | |
12420 | ||
12421 | (defun gnus-summary-mark-read-and-unread-as-read () | |
12422 | "Intended to be used by `gnus-summary-mark-article-hook'." | |
12423 | (let ((mark (gnus-summary-article-mark))) | |
12424 | (when (or (gnus-unread-mark-p mark) | |
12425 | (gnus-read-mark-p mark)) | |
12426 | (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) | |
41487370 LMI |
12427 | |
12428 | (defun gnus-summary-mark-region-as-read (point mark all) | |
12429 | "Mark all unread articles between point and mark as read. | |
12430 | If given a prefix, mark all articles between point and mark as read, | |
12431 | even ticked and dormant ones." | |
12432 | (interactive "r\nP") | |
12433 | (save-excursion | |
231f989b LMI |
12434 | (let (article) |
12435 | (goto-char point) | |
12436 | (beginning-of-line) | |
12437 | (while (and | |
12438 | (< (point) mark) | |
12439 | (progn | |
12440 | (when (or all | |
12441 | (memq (setq article (gnus-summary-article-number)) | |
12442 | gnus-newsgroup-unreads)) | |
12443 | (gnus-summary-mark-article article gnus-del-mark)) | |
12444 | t) | |
12445 | (gnus-summary-find-next)))))) | |
41487370 LMI |
12446 | |
12447 | (defun gnus-summary-mark-below (score mark) | |
12448 | "Mark articles with score less than SCORE with MARK." | |
12449 | (interactive "P\ncMark: ") | |
12450 | (gnus-set-global-variables) | |
12451 | (setq score (if score | |
12452 | (prefix-numeric-value score) | |
12453 | (or gnus-summary-default-score 0))) | |
12454 | (save-excursion | |
12455 | (set-buffer gnus-summary-buffer) | |
12456 | (goto-char (point-min)) | |
231f989b LMI |
12457 | (while |
12458 | (progn | |
12459 | (and (< (gnus-summary-article-score) score) | |
12460 | (gnus-summary-mark-article nil mark)) | |
12461 | (gnus-summary-find-next))))) | |
41487370 LMI |
12462 | |
12463 | (defun gnus-summary-kill-below (&optional score) | |
12464 | "Mark articles with score below SCORE as read." | |
12465 | (interactive "P") | |
12466 | (gnus-set-global-variables) | |
12467 | (gnus-summary-mark-below score gnus-killed-mark)) | |
12468 | ||
12469 | (defun gnus-summary-clear-above (&optional score) | |
12470 | "Clear all marks from articles with score above SCORE." | |
12471 | (interactive "P") | |
12472 | (gnus-set-global-variables) | |
12473 | (gnus-summary-mark-above score gnus-unread-mark)) | |
12474 | ||
12475 | (defun gnus-summary-tick-above (&optional score) | |
12476 | "Tick all articles with score above SCORE." | |
12477 | (interactive "P") | |
12478 | (gnus-set-global-variables) | |
12479 | (gnus-summary-mark-above score gnus-ticked-mark)) | |
12480 | ||
12481 | (defun gnus-summary-mark-above (score mark) | |
12482 | "Mark articles with score over SCORE with MARK." | |
12483 | (interactive "P\ncMark: ") | |
12484 | (gnus-set-global-variables) | |
12485 | (setq score (if score | |
12486 | (prefix-numeric-value score) | |
12487 | (or gnus-summary-default-score 0))) | |
12488 | (save-excursion | |
12489 | (set-buffer gnus-summary-buffer) | |
12490 | (goto-char (point-min)) | |
231f989b LMI |
12491 | (while (and (progn |
12492 | (if (> (gnus-summary-article-score) score) | |
12493 | (gnus-summary-mark-article nil mark)) | |
12494 | t) | |
12495 | (gnus-summary-find-next))))) | |
41487370 | 12496 | |
231f989b LMI |
12497 | ;; Suggested by Daniel Quinlan <quinlan@best.com>. |
12498 | (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) | |
12499 | (defun gnus-summary-limit-include-expunged () | |
41487370 LMI |
12500 | "Display all the hidden articles that were expunged for low scores." |
12501 | (interactive) | |
12502 | (gnus-set-global-variables) | |
12503 | (let ((buffer-read-only nil)) | |
12504 | (let ((scored gnus-newsgroup-scored) | |
12505 | headers h) | |
12506 | (while scored | |
231f989b LMI |
12507 | (or (gnus-summary-goto-subject (caar scored)) |
12508 | (and (setq h (gnus-summary-article-header (caar scored))) | |
12509 | (< (cdar scored) gnus-summary-expunge-below) | |
41487370 LMI |
12510 | (setq headers (cons h headers)))) |
12511 | (setq scored (cdr scored))) | |
12512 | (or headers (error "No expunged articles hidden.")) | |
12513 | (goto-char (point-min)) | |
231f989b | 12514 | (gnus-summary-prepare-unthreaded (nreverse headers))) |
41487370 | 12515 | (goto-char (point-min)) |
231f989b | 12516 | (gnus-summary-position-point))) |
41487370 LMI |
12517 | |
12518 | (defun gnus-summary-catchup (&optional all quietly to-here not-mark) | |
12519 | "Mark all articles not marked as unread in this newsgroup as read. | |
12520 | If prefix argument ALL is non-nil, all articles are marked as read. | |
12521 | If QUIETLY is non-nil, no questions will be asked. | |
231f989b | 12522 | If TO-HERE is non-nil, it should be a point in the buffer. All |
41487370 LMI |
12523 | articles before this point will be marked as read. |
12524 | The number of articles marked as read is returned." | |
12525 | (interactive "P") | |
12526 | (gnus-set-global-variables) | |
12527 | (prog1 | |
12528 | (if (or quietly | |
12529 | (not gnus-interactive-catchup) ;Without confirmation? | |
12530 | gnus-expert-user | |
12531 | (gnus-y-or-n-p | |
12532 | (if all | |
12533 | "Mark absolutely all articles as read? " | |
12534 | "Mark all unread articles as read? "))) | |
231f989b | 12535 | (if (and not-mark |
41487370 LMI |
12536 | (not gnus-newsgroup-adaptive) |
12537 | (not gnus-newsgroup-auto-expire)) | |
12538 | (progn | |
231f989b LMI |
12539 | (when all |
12540 | (setq gnus-newsgroup-marked nil | |
12541 | gnus-newsgroup-dormant nil)) | |
12542 | (setq gnus-newsgroup-unreads nil)) | |
41487370 | 12543 | ;; We actually mark all articles as canceled, which we |
231f989b | 12544 | ;; have to do when using auto-expiry or adaptive scoring. |
41487370 LMI |
12545 | (gnus-summary-show-all-threads) |
12546 | (if (gnus-summary-first-subject (not all)) | |
231f989b | 12547 | (while (and |
41487370 LMI |
12548 | (if to-here (< (point) to-here) t) |
12549 | (gnus-summary-mark-article-as-read gnus-catchup-mark) | |
231f989b LMI |
12550 | (gnus-summary-find-next (not all))))) |
12551 | (unless to-here | |
12552 | (setq gnus-newsgroup-unreads nil)) | |
12553 | (gnus-set-mode-line 'summary))) | |
41487370 LMI |
12554 | (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) |
12555 | (if (and (not to-here) (eq 'nnvirtual (car method))) | |
12556 | (nnvirtual-catchup-group | |
12557 | (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) | |
231f989b | 12558 | (gnus-summary-position-point))) |
41487370 LMI |
12559 | |
12560 | (defun gnus-summary-catchup-to-here (&optional all) | |
12561 | "Mark all unticked articles before the current one as read. | |
12562 | If ALL is non-nil, also mark ticked and dormant articles as read." | |
12563 | (interactive "P") | |
12564 | (gnus-set-global-variables) | |
12565 | (save-excursion | |
231f989b LMI |
12566 | (gnus-save-hidden-threads |
12567 | (let ((beg (point))) | |
12568 | ;; We check that there are unread articles. | |
12569 | (when (or all (gnus-summary-find-prev)) | |
12570 | (gnus-summary-catchup all t beg))))) | |
12571 | (gnus-summary-position-point)) | |
41487370 LMI |
12572 | |
12573 | (defun gnus-summary-catchup-all (&optional quietly) | |
12574 | "Mark all articles in this newsgroup as read." | |
12575 | (interactive "P") | |
12576 | (gnus-set-global-variables) | |
12577 | (gnus-summary-catchup t quietly)) | |
12578 | ||
12579 | (defun gnus-summary-catchup-and-exit (&optional all quietly) | |
12580 | "Mark all articles not marked as unread in this newsgroup as read, then exit. | |
12581 | If prefix argument ALL is non-nil, all articles are marked as read." | |
12582 | (interactive "P") | |
12583 | (gnus-set-global-variables) | |
12584 | (gnus-summary-catchup all quietly nil 'fast) | |
12585 | ;; Select next newsgroup or exit. | |
231f989b | 12586 | (if (eq gnus-auto-select-next 'quietly) |
41487370 LMI |
12587 | (gnus-summary-next-group nil) |
12588 | (gnus-summary-exit))) | |
12589 | ||
12590 | (defun gnus-summary-catchup-all-and-exit (&optional quietly) | |
12591 | "Mark all articles in this newsgroup as read, and then exit." | |
12592 | (interactive "P") | |
12593 | (gnus-set-global-variables) | |
12594 | (gnus-summary-catchup-and-exit t quietly)) | |
12595 | ||
12596 | ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>. | |
12597 | (defun gnus-summary-catchup-and-goto-next-group (&optional all) | |
12598 | "Mark all articles in this group as read and select the next group. | |
12599 | If given a prefix, mark all articles, unread as well as ticked, as | |
231f989b | 12600 | read." |
41487370 LMI |
12601 | (interactive "P") |
12602 | (gnus-set-global-variables) | |
231f989b LMI |
12603 | (save-excursion |
12604 | (gnus-summary-catchup all)) | |
12605 | (gnus-summary-next-article t nil nil t)) | |
745bc783 JB |
12606 | |
12607 | ;; Thread-based commands. | |
12608 | ||
231f989b LMI |
12609 | (defun gnus-summary-articles-in-thread (&optional article) |
12610 | "Return a list of all articles in the current thread. | |
12611 | If ARTICLE is non-nil, return all articles in the thread that starts | |
12612 | with that article." | |
12613 | (let* ((article (or article (gnus-summary-article-number))) | |
12614 | (data (gnus-data-find-list article)) | |
12615 | (top-level (gnus-data-level (car data))) | |
12616 | (top-subject | |
12617 | (cond ((null gnus-thread-operation-ignore-subject) | |
12618 | (gnus-simplify-subject-re | |
12619 | (mail-header-subject (gnus-data-header (car data))))) | |
12620 | ((eq gnus-thread-operation-ignore-subject 'fuzzy) | |
12621 | (gnus-simplify-subject-fuzzy | |
12622 | (mail-header-subject (gnus-data-header (car data))))) | |
12623 | (t nil))) | |
12624 | (end-point (save-excursion | |
12625 | (if (gnus-summary-go-to-next-thread) | |
12626 | (point) (point-max)))) | |
12627 | articles) | |
12628 | (while (and data | |
12629 | (< (gnus-data-pos (car data)) end-point)) | |
12630 | (when (or (not top-subject) | |
12631 | (string= top-subject | |
12632 | (if (eq gnus-thread-operation-ignore-subject 'fuzzy) | |
12633 | (gnus-simplify-subject-fuzzy | |
12634 | (mail-header-subject | |
12635 | (gnus-data-header (car data)))) | |
12636 | (gnus-simplify-subject-re | |
12637 | (mail-header-subject | |
12638 | (gnus-data-header (car data))))))) | |
12639 | (push (gnus-data-number (car data)) articles)) | |
12640 | (unless (and (setq data (cdr data)) | |
12641 | (> (gnus-data-level (car data)) top-level)) | |
12642 | (setq data nil))) | |
12643 | ;; Return the list of articles. | |
12644 | (nreverse articles))) | |
12645 | ||
12646 | (defun gnus-summary-rethread-current () | |
12647 | "Rethread the thread the current article is part of." | |
12648 | (interactive) | |
12649 | (gnus-set-global-variables) | |
12650 | (let* ((gnus-show-threads t) | |
12651 | (article (gnus-summary-article-number)) | |
12652 | (id (mail-header-id (gnus-summary-article-header))) | |
12653 | (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) | |
12654 | (unless id | |
12655 | (error "No article on the current line")) | |
12656 | (gnus-rebuild-thread id) | |
12657 | (gnus-summary-goto-subject article))) | |
12658 | ||
12659 | (defun gnus-summary-reparent-thread () | |
12660 | "Make current article child of the marked (or previous) article. | |
12661 | ||
12662 | Note that the re-threading will only work if `gnus-thread-ignore-subject' | |
12663 | is non-nil or the Subject: of both articles are the same." | |
12664 | (interactive) | |
12665 | (or (not (gnus-group-read-only-p)) | |
12666 | (error "The current newsgroup does not support article editing.")) | |
12667 | (or (<= (length gnus-newsgroup-processable) 1) | |
12668 | (error "No more than one article may be marked.")) | |
12669 | (save-window-excursion | |
12670 | (let ((gnus-article-buffer " *reparent*") | |
12671 | (current-article (gnus-summary-article-number)) | |
12672 | ; first grab the marked article, otherwise one line up. | |
12673 | (parent-article (if (not (null gnus-newsgroup-processable)) | |
12674 | (car gnus-newsgroup-processable) | |
12675 | (save-excursion | |
12676 | (if (eq (forward-line -1) 0) | |
12677 | (gnus-summary-article-number) | |
12678 | (error "Beginning of summary buffer.")))))) | |
12679 | (or (not (eq current-article parent-article)) | |
12680 | (error "An article may not be self-referential.")) | |
12681 | (let ((message-id (mail-header-id | |
12682 | (gnus-summary-article-header parent-article)))) | |
12683 | (or (and message-id (not (equal message-id ""))) | |
12684 | (error "No message-id in desired parent.")) | |
12685 | (gnus-summary-select-article t t nil current-article) | |
12686 | (set-buffer gnus-article-buffer) | |
12687 | (setq buffer-read-only nil) | |
12688 | (let ((buf (format "%s" (buffer-string)))) | |
12689 | (erase-buffer) | |
12690 | (insert buf)) | |
12691 | (goto-char (point-min)) | |
12692 | (if (search-forward-regexp "^References: " nil t) | |
12693 | (insert message-id " " ) | |
12694 | (insert "References: " message-id "\n")) | |
12695 | (or (gnus-request-replace-article current-article | |
12696 | (car gnus-article-current) | |
12697 | gnus-article-buffer) | |
12698 | (error "Couldn't replace article.")) | |
12699 | (set-buffer gnus-summary-buffer) | |
12700 | (gnus-summary-unmark-all-processable) | |
12701 | (gnus-summary-rethread-current) | |
12702 | (gnus-message 3 "Article %d is now the child of article %d." | |
12703 | current-article parent-article))))) | |
12704 | ||
41487370 | 12705 | (defun gnus-summary-toggle-threads (&optional arg) |
745bc783 | 12706 | "Toggle showing conversation threads. |
41487370 | 12707 | If ARG is positive number, turn showing conversation threads on." |
745bc783 | 12708 | (interactive "P") |
41487370 LMI |
12709 | (gnus-set-global-variables) |
12710 | (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) | |
745bc783 JB |
12711 | (setq gnus-show-threads |
12712 | (if (null arg) (not gnus-show-threads) | |
12713 | (> (prefix-numeric-value arg) 0))) | |
b027f415 RS |
12714 | (gnus-summary-prepare) |
12715 | (gnus-summary-goto-subject current) | |
231f989b | 12716 | (gnus-summary-position-point))) |
745bc783 | 12717 | |
b027f415 | 12718 | (defun gnus-summary-show-all-threads () |
41487370 | 12719 | "Show all threads." |
745bc783 | 12720 | (interactive) |
41487370 LMI |
12721 | (gnus-set-global-variables) |
12722 | (save-excursion | |
12723 | (let ((buffer-read-only nil)) | |
12724 | (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) | |
231f989b | 12725 | (gnus-summary-position-point)) |
745bc783 | 12726 | |
b027f415 | 12727 | (defun gnus-summary-show-thread () |
41487370 LMI |
12728 | "Show thread subtrees. |
12729 | Returns nil if no thread was there to be shown." | |
745bc783 | 12730 | (interactive) |
41487370 LMI |
12731 | (gnus-set-global-variables) |
12732 | (let ((buffer-read-only nil) | |
231f989b | 12733 | (orig (point)) |
41487370 LMI |
12734 | ;; first goto end then to beg, to have point at beg after let |
12735 | (end (progn (end-of-line) (point))) | |
12736 | (beg (progn (beginning-of-line) (point)))) | |
12737 | (prog1 | |
12738 | ;; Any hidden lines here? | |
12739 | (search-forward "\r" end t) | |
12740 | (subst-char-in-region beg end ?\^M ?\n t) | |
12741 | (goto-char orig) | |
231f989b | 12742 | (gnus-summary-position-point)))) |
745bc783 | 12743 | |
b027f415 | 12744 | (defun gnus-summary-hide-all-threads () |
745bc783 JB |
12745 | "Hide all thread subtrees." |
12746 | (interactive) | |
41487370 LMI |
12747 | (gnus-set-global-variables) |
12748 | (save-excursion | |
12749 | (goto-char (point-min)) | |
12750 | (gnus-summary-hide-thread) | |
231f989b | 12751 | (while (zerop (gnus-summary-next-thread 1 t)) |
41487370 | 12752 | (gnus-summary-hide-thread))) |
231f989b | 12753 | (gnus-summary-position-point)) |
745bc783 | 12754 | |
b027f415 | 12755 | (defun gnus-summary-hide-thread () |
41487370 LMI |
12756 | "Hide thread subtrees. |
12757 | Returns nil if no threads were there to be hidden." | |
745bc783 | 12758 | (interactive) |
41487370 LMI |
12759 | (gnus-set-global-variables) |
12760 | (let ((buffer-read-only nil) | |
12761 | (start (point)) | |
231f989b LMI |
12762 | (article (gnus-summary-article-number))) |
12763 | (goto-char start) | |
41487370 | 12764 | ;; Go forward until either the buffer ends or the subthread |
231f989b LMI |
12765 | ;; ends. |
12766 | (when (and (not (eobp)) | |
12767 | (or (zerop (gnus-summary-next-thread 1 t)) | |
12768 | (goto-char (point-max)))) | |
41487370 | 12769 | (prog1 |
231f989b LMI |
12770 | (if (and (> (point) start) |
12771 | (search-backward "\n" start t)) | |
12772 | (progn | |
12773 | (subst-char-in-region start (point) ?\n ?\^M) | |
12774 | (gnus-summary-goto-subject article)) | |
12775 | (goto-char start) | |
12776 | nil) | |
12777 | ;;(gnus-summary-position-point) | |
12778 | )))) | |
41487370 LMI |
12779 | |
12780 | (defun gnus-summary-go-to-next-thread (&optional previous) | |
12781 | "Go to the same level (or less) next thread. | |
12782 | If PREVIOUS is non-nil, go to previous thread instead. | |
12783 | Return the article number moved to, or nil if moving was impossible." | |
12784 | (let ((level (gnus-summary-thread-level)) | |
231f989b LMI |
12785 | (way (if previous -1 1)) |
12786 | (beg (point))) | |
12787 | (forward-line way) | |
12788 | (while (and (not (eobp)) | |
12789 | (< level (gnus-summary-thread-level))) | |
12790 | (forward-line way)) | |
12791 | (if (eobp) | |
12792 | (progn | |
12793 | (goto-char beg) | |
12794 | nil) | |
12795 | (setq beg (point)) | |
12796 | (prog1 | |
12797 | (gnus-summary-article-number) | |
12798 | (goto-char beg))))) | |
745bc783 | 12799 | |
231f989b LMI |
12800 | (defun gnus-summary-go-to-next-thread-old (&optional previous) |
12801 | "Go to the same level (or less) next thread. | |
12802 | If PREVIOUS is non-nil, go to previous thread instead. | |
12803 | Return the article number moved to, or nil if moving was impossible." | |
12804 | (if (and (eq gnus-summary-make-false-root 'dummy) | |
12805 | (gnus-summary-article-intangible-p)) | |
12806 | (let ((beg (point))) | |
12807 | (while (and (zerop (forward-line 1)) | |
12808 | (not (gnus-summary-article-intangible-p)) | |
12809 | (not (zerop (save-excursion | |
12810 | (gnus-summary-thread-level)))))) | |
12811 | (if (eobp) | |
12812 | (progn | |
12813 | (goto-char beg) | |
12814 | nil) | |
12815 | (point))) | |
12816 | (let* ((level (gnus-summary-thread-level)) | |
12817 | (article (gnus-summary-article-number)) | |
12818 | (data (cdr (gnus-data-find-list article (gnus-data-list previous)))) | |
12819 | oart) | |
12820 | (while data | |
12821 | (if (<= (gnus-data-level (car data)) level) | |
12822 | (setq oart (gnus-data-number (car data)) | |
12823 | data nil) | |
12824 | (setq data (cdr data)))) | |
12825 | (and oart | |
12826 | (gnus-summary-goto-subject oart))))) | |
12827 | ||
12828 | (defun gnus-summary-next-thread (n &optional silent) | |
41487370 LMI |
12829 | "Go to the same level next N'th thread. |
12830 | If N is negative, search backward instead. | |
12831 | Returns the difference between N and the number of skips actually | |
231f989b LMI |
12832 | done. |
12833 | ||
12834 | If SILENT, don't output messages." | |
745bc783 | 12835 | (interactive "p") |
41487370 LMI |
12836 | (gnus-set-global-variables) |
12837 | (let ((backward (< n 0)) | |
231f989b LMI |
12838 | (n (abs n)) |
12839 | old dum int) | |
745bc783 | 12840 | (while (and (> n 0) |
41487370 | 12841 | (gnus-summary-go-to-next-thread backward)) |
231f989b LMI |
12842 | (decf n)) |
12843 | (unless silent | |
12844 | (gnus-summary-position-point)) | |
12845 | (when (and (not silent) (/= 0 n)) | |
12846 | (gnus-message 7 "No more threads")) | |
41487370 | 12847 | n)) |
745bc783 | 12848 | |
b027f415 | 12849 | (defun gnus-summary-prev-thread (n) |
41487370 LMI |
12850 | "Go to the same level previous N'th thread. |
12851 | Returns the difference between N and the number of skips actually | |
12852 | done." | |
745bc783 | 12853 | (interactive "p") |
41487370 LMI |
12854 | (gnus-set-global-variables) |
12855 | (gnus-summary-next-thread (- n))) | |
12856 | ||
231f989b LMI |
12857 | (defun gnus-summary-go-down-thread () |
12858 | "Go down one level in the current thread." | |
12859 | (let ((children (gnus-summary-article-children))) | |
12860 | (and children | |
12861 | (gnus-summary-goto-subject (car children))))) | |
41487370 LMI |
12862 | |
12863 | (defun gnus-summary-go-up-thread () | |
12864 | "Go up one level in the current thread." | |
231f989b LMI |
12865 | (let ((parent (gnus-summary-article-parent))) |
12866 | (and parent | |
12867 | (gnus-summary-goto-subject parent)))) | |
41487370 LMI |
12868 | |
12869 | (defun gnus-summary-down-thread (n) | |
12870 | "Go down thread N steps. | |
12871 | If N is negative, go up instead. | |
12872 | Returns the difference between N and how many steps down that were | |
12873 | taken." | |
745bc783 | 12874 | (interactive "p") |
41487370 LMI |
12875 | (gnus-set-global-variables) |
12876 | (let ((up (< n 0)) | |
12877 | (n (abs n))) | |
12878 | (while (and (> n 0) | |
12879 | (if up (gnus-summary-go-up-thread) | |
12880 | (gnus-summary-go-down-thread))) | |
12881 | (setq n (1- n))) | |
231f989b | 12882 | (gnus-summary-position-point) |
41487370 LMI |
12883 | (if (/= 0 n) (gnus-message 7 "Can't go further")) |
12884 | n)) | |
12885 | ||
12886 | (defun gnus-summary-up-thread (n) | |
12887 | "Go up thread N steps. | |
12888 | If N is negative, go up instead. | |
12889 | Returns the difference between N and how many steps down that were | |
12890 | taken." | |
745bc783 | 12891 | (interactive "p") |
41487370 LMI |
12892 | (gnus-set-global-variables) |
12893 | (gnus-summary-down-thread (- n))) | |
12894 | ||
231f989b LMI |
12895 | (defun gnus-summary-top-thread () |
12896 | "Go to the top of the thread." | |
12897 | (interactive) | |
12898 | (gnus-set-global-variables) | |
12899 | (while (gnus-summary-go-up-thread)) | |
12900 | (gnus-summary-article-number)) | |
12901 | ||
41487370 | 12902 | (defun gnus-summary-kill-thread (&optional unmark) |
745bc783 | 12903 | "Mark articles under current thread as read. |
41487370 LMI |
12904 | If the prefix argument is positive, remove any kinds of marks. |
12905 | If the prefix argument is negative, tick articles instead." | |
745bc783 | 12906 | (interactive "P") |
41487370 | 12907 | (gnus-set-global-variables) |
231f989b LMI |
12908 | (when unmark |
12909 | (setq unmark (prefix-numeric-value unmark))) | |
12910 | (let ((articles (gnus-summary-articles-in-thread))) | |
41487370 LMI |
12911 | (save-excursion |
12912 | ;; Expand the thread. | |
12913 | (gnus-summary-show-thread) | |
231f989b LMI |
12914 | ;; Mark all the articles. |
12915 | (while articles | |
12916 | (gnus-summary-goto-subject (car articles)) | |
12917 | (cond ((null unmark) | |
12918 | (gnus-summary-mark-article-as-read gnus-killed-mark)) | |
12919 | ((> unmark 0) | |
12920 | (gnus-summary-mark-article-as-unread gnus-unread-mark)) | |
12921 | (t | |
12922 | (gnus-summary-mark-article-as-unread gnus-ticked-mark))) | |
12923 | (setq articles (cdr articles)))) | |
41487370 LMI |
12924 | ;; Hide killed subtrees. |
12925 | (and (null unmark) | |
12926 | gnus-thread-hide-killed | |
12927 | (gnus-summary-hide-thread)) | |
12928 | ;; If marked as read, go to next unread subject. | |
12929 | (if (null unmark) | |
12930 | ;; Go to next unread subject. | |
12931 | (gnus-summary-next-subject 1 t))) | |
12932 | (gnus-set-mode-line 'summary)) | |
745bc783 | 12933 | |
41487370 | 12934 | ;; Summary sorting commands |
745bc783 | 12935 | |
41487370 LMI |
12936 | (defun gnus-summary-sort-by-number (&optional reverse) |
12937 | "Sort summary buffer by article number. | |
745bc783 JB |
12938 | Argument REVERSE means reverse order." |
12939 | (interactive "P") | |
231f989b | 12940 | (gnus-summary-sort 'number reverse)) |
41487370 LMI |
12941 | |
12942 | (defun gnus-summary-sort-by-author (&optional reverse) | |
12943 | "Sort summary buffer by author name alphabetically. | |
745bc783 JB |
12944 | If case-fold-search is non-nil, case of letters is ignored. |
12945 | Argument REVERSE means reverse order." | |
12946 | (interactive "P") | |
231f989b | 12947 | (gnus-summary-sort 'author reverse)) |
41487370 LMI |
12948 | |
12949 | (defun gnus-summary-sort-by-subject (&optional reverse) | |
12950 | "Sort summary buffer by subject alphabetically. `Re:'s are ignored. | |
745bc783 JB |
12951 | If case-fold-search is non-nil, case of letters is ignored. |
12952 | Argument REVERSE means reverse order." | |
12953 | (interactive "P") | |
231f989b | 12954 | (gnus-summary-sort 'subject reverse)) |
41487370 LMI |
12955 | |
12956 | (defun gnus-summary-sort-by-date (&optional reverse) | |
12957 | "Sort summary buffer by date. | |
745bc783 JB |
12958 | Argument REVERSE means reverse order." |
12959 | (interactive "P") | |
231f989b | 12960 | (gnus-summary-sort 'date reverse)) |
41487370 LMI |
12961 | |
12962 | (defun gnus-summary-sort-by-score (&optional reverse) | |
12963 | "Sort summary buffer by score. | |
12964 | Argument REVERSE means reverse order." | |
745bc783 | 12965 | (interactive "P") |
231f989b | 12966 | (gnus-summary-sort 'score reverse)) |
41487370 | 12967 | |
41487370 | 12968 | (defun gnus-summary-sort (predicate reverse) |
231f989b LMI |
12969 | "Sort summary buffer by PREDICATE. REVERSE means reverse order." |
12970 | (gnus-set-global-variables) | |
12971 | (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) | |
12972 | (article (intern (format "gnus-article-sort-by-%s" predicate))) | |
12973 | (gnus-thread-sort-functions | |
12974 | (list | |
12975 | (if (not reverse) | |
12976 | thread | |
12977 | `(lambda (t1 t2) | |
12978 | (,thread t2 t1))))) | |
12979 | (gnus-article-sort-functions | |
12980 | (list | |
12981 | (if (not reverse) | |
12982 | article | |
12983 | `(lambda (t1 t2) | |
12984 | (,article t2 t1))))) | |
12985 | (buffer-read-only) | |
12986 | (gnus-summary-prepare-hook nil)) | |
12987 | ;; We do the sorting by regenerating the threads. | |
12988 | (gnus-summary-prepare) | |
12989 | ;; Hide subthreads if needed. | |
12990 | (when (and gnus-show-threads gnus-thread-hide-subtree) | |
12991 | (gnus-summary-hide-all-threads))) | |
12992 | ;; If in async mode, we send some info to the backend. | |
12993 | (when gnus-newsgroup-async | |
12994 | (gnus-request-asynchronous | |
12995 | gnus-newsgroup-name gnus-newsgroup-data))) | |
41487370 | 12996 | |
41487370 LMI |
12997 | (defun gnus-sortable-date (date) |
12998 | "Make sortable string by string-lessp from DATE. | |
12999 | Timezone package is used." | |
231f989b LMI |
13000 | (condition-case () |
13001 | (progn | |
13002 | (setq date (inline (timezone-fix-time | |
13003 | date nil | |
13004 | (aref (inline (timezone-parse-date date)) 4)))) | |
13005 | (inline | |
13006 | (timezone-make-sortable-date | |
13007 | (aref date 0) (aref date 1) (aref date 2) | |
13008 | (inline | |
13009 | (timezone-make-time-string | |
13010 | (aref date 3) (aref date 4) (aref date 5)))))) | |
13011 | (error ""))) | |
13012 | ||
41487370 LMI |
13013 | ;; Summary saving commands. |
13014 | ||
231f989b | 13015 | (defun gnus-summary-save-article (&optional n not-saved) |
41487370 LMI |
13016 | "Save the current article using the default saver function. |
13017 | If N is a positive number, save the N next articles. | |
13018 | If N is a negative number, save the N previous articles. | |
13019 | If N is nil and any articles have been marked with the process mark, | |
13020 | save those articles instead. | |
b027f415 | 13021 | The variable `gnus-default-article-saver' specifies the saver function." |
41487370 LMI |
13022 | (interactive "P") |
13023 | (gnus-set-global-variables) | |
231f989b LMI |
13024 | (let ((articles (gnus-summary-work-articles n)) |
13025 | (save-buffer (save-excursion | |
13026 | (nnheader-set-temp-buffer " *Gnus Save*"))) | |
13027 | file header article) | |
41487370 | 13028 | (while articles |
231f989b LMI |
13029 | (setq header (gnus-summary-article-header |
13030 | (setq article (pop articles)))) | |
13031 | (if (not (vectorp header)) | |
13032 | ;; This is a pseudo-article. | |
41487370 LMI |
13033 | (if (assq 'name header) |
13034 | (gnus-copy-file (cdr (assq 'name header))) | |
231f989b LMI |
13035 | (gnus-message 1 "Article %d is unsaveable" article)) |
13036 | ;; This is a real article. | |
13037 | (save-window-excursion | |
13038 | (gnus-summary-select-article t nil nil article)) | |
13039 | (save-excursion | |
13040 | (set-buffer save-buffer) | |
13041 | (erase-buffer) | |
13042 | (insert-buffer-substring gnus-original-article-buffer)) | |
13043 | (unless gnus-save-all-headers | |
13044 | ;; Remove headers accoring to `gnus-saved-headers'. | |
13045 | (let ((gnus-visible-headers | |
13046 | (or gnus-saved-headers gnus-visible-headers)) | |
13047 | (gnus-article-buffer save-buffer)) | |
13048 | (gnus-article-hide-headers 1 t))) | |
13049 | (save-window-excursion | |
13050 | (if (not gnus-default-article-saver) | |
13051 | (error "No default saver is defined.") | |
13052 | ;; !!! Magic! The saving functions all save | |
13053 | ;; `gnus-original-article-buffer' (or so they think), | |
13054 | ;; but we bind that variable to our save-buffer. | |
13055 | (set-buffer gnus-article-buffer) | |
13056 | (let ((gnus-original-article-buffer save-buffer)) | |
13057 | (set-buffer gnus-summary-buffer) | |
13058 | (setq file (funcall | |
13059 | gnus-default-article-saver | |
13060 | (cond | |
13061 | ((not gnus-prompt-before-saving) | |
13062 | 'default) | |
13063 | ((eq gnus-prompt-before-saving 'always) | |
13064 | nil) | |
13065 | (t file))))))) | |
13066 | (gnus-summary-remove-process-mark article) | |
13067 | (unless not-saved | |
13068 | (gnus-summary-set-saved-mark article)))) | |
13069 | (gnus-kill-buffer save-buffer) | |
13070 | (gnus-summary-position-point) | |
41487370 LMI |
13071 | n)) |
13072 | ||
13073 | (defun gnus-summary-pipe-output (&optional arg) | |
13074 | "Pipe the current article to a subprocess. | |
13075 | If N is a positive number, pipe the N next articles. | |
13076 | If N is a negative number, pipe the N previous articles. | |
13077 | If N is nil and any articles have been marked with the process mark, | |
13078 | pipe those articles instead." | |
13079 | (interactive "P") | |
13080 | (gnus-set-global-variables) | |
13081 | (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) | |
231f989b | 13082 | (gnus-summary-save-article arg t)) |
bf8aeaf9 | 13083 | (gnus-configure-windows 'pipe)) |
41487370 LMI |
13084 | |
13085 | (defun gnus-summary-save-article-mail (&optional arg) | |
13086 | "Append the current article to an mail file. | |
13087 | If N is a positive number, save the N next articles. | |
13088 | If N is a negative number, save the N previous articles. | |
13089 | If N is nil and any articles have been marked with the process mark, | |
13090 | save those articles instead." | |
13091 | (interactive "P") | |
13092 | (gnus-set-global-variables) | |
13093 | (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) | |
13094 | (gnus-summary-save-article arg))) | |
13095 | ||
13096 | (defun gnus-summary-save-article-rmail (&optional arg) | |
13097 | "Append the current article to an rmail file. | |
13098 | If N is a positive number, save the N next articles. | |
13099 | If N is a negative number, save the N previous articles. | |
13100 | If N is nil and any articles have been marked with the process mark, | |
13101 | save those articles instead." | |
13102 | (interactive "P") | |
13103 | (gnus-set-global-variables) | |
13104 | (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) | |
13105 | (gnus-summary-save-article arg))) | |
13106 | ||
13107 | (defun gnus-summary-save-article-file (&optional arg) | |
13108 | "Append the current article to a file. | |
13109 | If N is a positive number, save the N next articles. | |
13110 | If N is a negative number, save the N previous articles. | |
13111 | If N is nil and any articles have been marked with the process mark, | |
13112 | save those articles instead." | |
13113 | (interactive "P") | |
13114 | (gnus-set-global-variables) | |
13115 | (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) | |
13116 | (gnus-summary-save-article arg))) | |
13117 | ||
231f989b LMI |
13118 | (defun gnus-summary-save-article-body-file (&optional arg) |
13119 | "Append the current article body to a file. | |
13120 | If N is a positive number, save the N next articles. | |
13121 | If N is a negative number, save the N previous articles. | |
13122 | If N is nil and any articles have been marked with the process mark, | |
13123 | save those articles instead." | |
13124 | (interactive "P") | |
13125 | (gnus-set-global-variables) | |
13126 | (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) | |
13127 | (gnus-summary-save-article arg))) | |
13128 | ||
13129 | (defun gnus-get-split-value (methods) | |
13130 | "Return a value based on the split METHODS." | |
13131 | (let (split-name method result match) | |
13132 | (when methods | |
41487370 | 13133 | (save-excursion |
231f989b LMI |
13134 | (set-buffer gnus-original-article-buffer) |
13135 | (save-restriction | |
13136 | (nnheader-narrow-to-headers) | |
13137 | (while methods | |
13138 | (goto-char (point-min)) | |
13139 | (setq method (pop methods)) | |
13140 | (setq match (car method)) | |
13141 | (when (cond | |
13142 | ((stringp match) | |
13143 | ;; Regular expression. | |
13144 | (condition-case () | |
13145 | (re-search-forward match nil t) | |
13146 | (error nil))) | |
13147 | ((gnus-functionp match) | |
13148 | ;; Function. | |
13149 | (save-restriction | |
13150 | (widen) | |
13151 | (setq result (funcall match gnus-newsgroup-name)))) | |
13152 | ((consp match) | |
13153 | ;; Form. | |
13154 | (save-restriction | |
13155 | (widen) | |
13156 | (setq result (eval match))))) | |
13157 | (setq split-name (append (cdr method) split-name)) | |
13158 | (cond ((stringp result) | |
13159 | (push result split-name)) | |
13160 | ((consp result) | |
13161 | (setq split-name (append result split-name))))))))) | |
13162 | split-name)) | |
13163 | ||
13164 | (defun gnus-read-move-group-name (prompt default articles prefix) | |
13165 | "Read a group name." | |
13166 | (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) | |
13167 | (minibuffer-confirm-incomplete nil) ; XEmacs | |
13168 | group-map | |
13169 | (dum (mapatoms | |
13170 | (lambda (g) | |
13171 | (and (boundp g) | |
13172 | (symbol-name g) | |
13173 | (memq 'respool | |
13174 | (assoc (symbol-name | |
13175 | (car (gnus-find-method-for-group | |
13176 | (symbol-name g)))) | |
13177 | gnus-valid-select-methods)) | |
13178 | (push (list (symbol-name g)) group-map))) | |
13179 | gnus-active-hashtb)) | |
13180 | (prom | |
13181 | (format "%s %s to:" | |
13182 | prompt | |
13183 | (if (> (length articles) 1) | |
13184 | (format "these %d articles" (length articles)) | |
13185 | "this article"))) | |
13186 | (to-newsgroup | |
13187 | (cond | |
13188 | ((null split-name) | |
13189 | (gnus-completing-read default prom | |
13190 | group-map nil nil prefix | |
13191 | 'gnus-group-history)) | |
13192 | ((= 1 (length split-name)) | |
13193 | (gnus-completing-read (car split-name) prom group-map | |
13194 | nil nil nil | |
13195 | 'gnus-group-history)) | |
13196 | (t | |
13197 | (gnus-completing-read nil prom | |
13198 | (mapcar (lambda (el) (list el)) | |
13199 | (nreverse split-name)) | |
13200 | nil nil nil | |
13201 | 'gnus-group-history))))) | |
13202 | (when to-newsgroup | |
13203 | (if (or (string= to-newsgroup "") | |
13204 | (string= to-newsgroup prefix)) | |
13205 | (setq to-newsgroup (or default ""))) | |
13206 | (or (gnus-active to-newsgroup) | |
13207 | (gnus-activate-group to-newsgroup) | |
13208 | (if (gnus-y-or-n-p (format "No such group: %s. Create it? " | |
13209 | to-newsgroup)) | |
13210 | (or (and (gnus-request-create-group | |
13211 | to-newsgroup (gnus-group-name-to-method to-newsgroup)) | |
13212 | (gnus-activate-group to-newsgroup nil nil | |
13213 | (gnus-group-name-to-method | |
13214 | to-newsgroup))) | |
13215 | (error "Couldn't create group %s" to-newsgroup))) | |
13216 | (error "No such group: %s" to-newsgroup))) | |
13217 | to-newsgroup)) | |
13218 | ||
13219 | (defun gnus-read-save-file-name (prompt default-name) | |
13220 | (let* ((split-name (gnus-get-split-value gnus-split-methods)) | |
13221 | (file | |
13222 | ;; Let the split methods have their say. | |
13223 | (cond | |
13224 | ;; No split name was found. | |
13225 | ((null split-name) | |
13226 | (read-file-name | |
13227 | (concat prompt " (default " | |
13228 | (file-name-nondirectory default-name) ") ") | |
13229 | (file-name-directory default-name) | |
13230 | default-name)) | |
13231 | ;; A single split name was found | |
13232 | ((= 1 (length split-name)) | |
13233 | (let* ((name (car split-name)) | |
13234 | (dir (cond ((file-directory-p name) | |
13235 | (file-name-as-directory name)) | |
13236 | ((file-exists-p name) name) | |
13237 | (t gnus-article-save-directory)))) | |
13238 | (read-file-name | |
13239 | (concat prompt " (default " name ") ") | |
13240 | dir name))) | |
13241 | ;; A list of splits was found. | |
13242 | (t | |
13243 | (setq split-name (nreverse split-name)) | |
13244 | (let (result) | |
13245 | (let ((file-name-history (nconc split-name file-name-history))) | |
13246 | (setq result | |
13247 | (read-file-name | |
13248 | (concat prompt " (`M-p' for defaults) ") | |
13249 | gnus-article-save-directory | |
13250 | (car split-name)))) | |
13251 | (car (push result file-name-history))))))) | |
13252 | ;; If we have read a directory, we append the default file name. | |
13253 | (when (file-directory-p file) | |
13254 | (setq file (concat (file-name-as-directory file) | |
13255 | (file-name-nondirectory default-name)))) | |
13256 | ;; Possibly translate some charaters. | |
13257 | (nnheader-translate-file-chars file))) | |
13258 | ||
13259 | (defun gnus-article-archive-name (group) | |
13260 | "Return the first instance of an \"Archive-name\" in the current buffer." | |
13261 | (let ((case-fold-search t)) | |
13262 | (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) | |
13263 | (match-string 1)))) | |
745bc783 | 13264 | |
b027f415 | 13265 | (defun gnus-summary-save-in-rmail (&optional filename) |
745bc783 JB |
13266 | "Append this article to Rmail file. |
13267 | Optional argument FILENAME specifies file name. | |
231f989b | 13268 | Directory to save to is default to `gnus-article-save-directory'." |
745bc783 | 13269 | (interactive) |
41487370 LMI |
13270 | (gnus-set-global-variables) |
13271 | (let ((default-name | |
13272 | (funcall gnus-rmail-save-name gnus-newsgroup-name | |
13273 | gnus-current-headers gnus-newsgroup-last-rmail))) | |
231f989b LMI |
13274 | (setq filename |
13275 | (cond ((eq filename 'default) | |
13276 | default-name) | |
13277 | (filename filename) | |
13278 | (t (gnus-read-save-file-name | |
13279 | "Save in rmail file:" default-name)))) | |
41487370 | 13280 | (gnus-make-directory (file-name-directory filename)) |
231f989b LMI |
13281 | (gnus-eval-in-buffer-window gnus-original-article-buffer |
13282 | (save-excursion | |
13283 | (save-restriction | |
13284 | (widen) | |
13285 | (gnus-output-to-rmail filename)))) | |
41487370 LMI |
13286 | ;; Remember the directory name to save articles |
13287 | (setq gnus-newsgroup-last-rmail filename))) | |
745bc783 | 13288 | |
b027f415 | 13289 | (defun gnus-summary-save-in-mail (&optional filename) |
745bc783 JB |
13290 | "Append this article to Unix mail file. |
13291 | Optional argument FILENAME specifies file name. | |
231f989b | 13292 | Directory to save to is default to `gnus-article-save-directory'." |
745bc783 | 13293 | (interactive) |
41487370 LMI |
13294 | (gnus-set-global-variables) |
13295 | (let ((default-name | |
13296 | (funcall gnus-mail-save-name gnus-newsgroup-name | |
13297 | gnus-current-headers gnus-newsgroup-last-mail))) | |
231f989b LMI |
13298 | (setq filename |
13299 | (cond ((eq filename 'default) | |
13300 | default-name) | |
13301 | (filename filename) | |
13302 | (t (gnus-read-save-file-name | |
13303 | "Save in Unix mail file:" default-name)))) | |
41487370 LMI |
13304 | (setq filename |
13305 | (expand-file-name filename | |
13306 | (and default-name | |
13307 | (file-name-directory default-name)))) | |
13308 | (gnus-make-directory (file-name-directory filename)) | |
231f989b LMI |
13309 | (gnus-eval-in-buffer-window gnus-original-article-buffer |
13310 | (save-excursion | |
13311 | (save-restriction | |
13312 | (widen) | |
13313 | (if (and (file-readable-p filename) (mail-file-babyl-p filename)) | |
13314 | (gnus-output-to-rmail filename) | |
13315 | (let ((mail-use-rfc822 t)) | |
13316 | (rmail-output filename 1 t t)))))) | |
41487370 LMI |
13317 | ;; Remember the directory name to save articles. |
13318 | (setq gnus-newsgroup-last-mail filename))) | |
745bc783 | 13319 | |
b027f415 | 13320 | (defun gnus-summary-save-in-file (&optional filename) |
745bc783 JB |
13321 | "Append this article to file. |
13322 | Optional argument FILENAME specifies file name. | |
231f989b LMI |
13323 | Directory to save to is default to `gnus-article-save-directory'." |
13324 | (interactive) | |
13325 | (gnus-set-global-variables) | |
13326 | (let ((default-name | |
13327 | (funcall gnus-file-save-name gnus-newsgroup-name | |
13328 | gnus-current-headers gnus-newsgroup-last-file))) | |
13329 | (setq filename | |
13330 | (cond ((eq filename 'default) | |
13331 | default-name) | |
13332 | (filename filename) | |
13333 | (t (gnus-read-save-file-name | |
13334 | "Save in file:" default-name)))) | |
13335 | (gnus-make-directory (file-name-directory filename)) | |
13336 | (gnus-eval-in-buffer-window gnus-original-article-buffer | |
13337 | (save-excursion | |
13338 | (save-restriction | |
13339 | (widen) | |
13340 | (gnus-output-to-file filename)))) | |
13341 | ;; Remember the directory name to save articles. | |
13342 | (setq gnus-newsgroup-last-file filename))) | |
13343 | ||
13344 | (defun gnus-summary-save-body-in-file (&optional filename) | |
13345 | "Append this article body to a file. | |
13346 | Optional argument FILENAME specifies file name. | |
13347 | The directory to save in defaults to `gnus-article-save-directory'." | |
745bc783 | 13348 | (interactive) |
41487370 LMI |
13349 | (gnus-set-global-variables) |
13350 | (let ((default-name | |
13351 | (funcall gnus-file-save-name gnus-newsgroup-name | |
13352 | gnus-current-headers gnus-newsgroup-last-file))) | |
231f989b LMI |
13353 | (setq filename |
13354 | (cond ((eq filename 'default) | |
13355 | default-name) | |
13356 | (filename filename) | |
13357 | (t (gnus-read-save-file-name | |
13358 | "Save body in file:" default-name)))) | |
41487370 | 13359 | (gnus-make-directory (file-name-directory filename)) |
231f989b LMI |
13360 | (gnus-eval-in-buffer-window gnus-original-article-buffer |
13361 | (save-excursion | |
13362 | (save-restriction | |
13363 | (widen) | |
13364 | (goto-char (point-min)) | |
13365 | (and (search-forward "\n\n" nil t) | |
13366 | (narrow-to-region (point) (point-max))) | |
13367 | (gnus-output-to-file filename)))) | |
41487370 LMI |
13368 | ;; Remember the directory name to save articles. |
13369 | (setq gnus-newsgroup-last-file filename))) | |
13370 | ||
13371 | (defun gnus-summary-save-in-pipe (&optional command) | |
745bc783 JB |
13372 | "Pipe this article to subprocess." |
13373 | (interactive) | |
41487370 | 13374 | (gnus-set-global-variables) |
231f989b LMI |
13375 | (setq command |
13376 | (cond ((eq command 'default) | |
13377 | gnus-last-shell-command) | |
13378 | (command command) | |
13379 | (t (read-string "Shell command on article: " | |
13380 | gnus-last-shell-command)))) | |
13381 | (if (string-equal command "") | |
13382 | (setq command gnus-last-shell-command)) | |
13383 | (gnus-eval-in-buffer-window gnus-article-buffer | |
13384 | (save-restriction | |
13385 | (widen) | |
13386 | (shell-command-on-region (point-min) (point-max) command nil))) | |
13387 | (setq gnus-last-shell-command command)) | |
41487370 LMI |
13388 | |
13389 | ;; Summary extract commands | |
13390 | ||
13391 | (defun gnus-summary-insert-pseudos (pslist &optional not-view) | |
13392 | (let ((buffer-read-only nil) | |
13393 | (article (gnus-summary-article-number)) | |
231f989b | 13394 | after-article b e) |
41487370 LMI |
13395 | (or (gnus-summary-goto-subject article) |
13396 | (error (format "No such article: %d" article))) | |
231f989b | 13397 | (gnus-summary-position-point) |
41487370 | 13398 | ;; If all commands are to be bunched up on one line, we collect |
231f989b | 13399 | ;; them here. |
41487370 LMI |
13400 | (if gnus-view-pseudos-separately |
13401 | () | |
13402 | (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) | |
13403 | files action) | |
13404 | (while ps | |
13405 | (setq action (cdr (assq 'action (car ps)))) | |
13406 | (setq files (list (cdr (assq 'name (car ps))))) | |
13407 | (while (and ps (cdr ps) | |
13408 | (string= (or action "1") | |
231f989b LMI |
13409 | (or (cdr (assq 'action (cadr ps))) "2"))) |
13410 | (setq files (cons (cdr (assq 'name (cadr ps))) files)) | |
13411 | (setcdr ps (cddr ps))) | |
41487370 LMI |
13412 | (if (not files) |
13413 | () | |
13414 | (if (not (string-match "%s" action)) | |
13415 | (setq files (cons " " files))) | |
13416 | (setq files (cons " " files)) | |
13417 | (and (assq 'execute (car ps)) | |
13418 | (setcdr (assq 'execute (car ps)) | |
13419 | (funcall (if (string-match "%s" action) | |
13420 | 'format 'concat) | |
231f989b | 13421 | action |
41487370 LMI |
13422 | (mapconcat (lambda (f) f) files " "))))) |
13423 | (setq ps (cdr ps))))) | |
13424 | (if (and gnus-view-pseudos (not not-view)) | |
13425 | (while pslist | |
13426 | (and (assq 'execute (car pslist)) | |
13427 | (gnus-execute-command (cdr (assq 'execute (car pslist))) | |
13428 | (eq gnus-view-pseudos 'not-confirm))) | |
13429 | (setq pslist (cdr pslist))) | |
13430 | (save-excursion | |
13431 | (while pslist | |
231f989b LMI |
13432 | (setq after-article (or (cdr (assq 'article (car pslist))) |
13433 | (gnus-summary-article-number))) | |
13434 | (gnus-summary-goto-subject after-article) | |
41487370 LMI |
13435 | (forward-line 1) |
13436 | (setq b (point)) | |
231f989b | 13437 | (insert " " (file-name-nondirectory |
41487370 LMI |
13438 | (cdr (assq 'name (car pslist)))) |
13439 | ": " (or (cdr (assq 'execute (car pslist))) "") "\n") | |
231f989b LMI |
13440 | (setq e (point)) |
13441 | (forward-line -1) ; back to `b' | |
13442 | (gnus-add-text-properties | |
13443 | b (1- e) (list 'gnus-number gnus-reffed-article-number | |
13444 | gnus-mouse-face-prop gnus-mouse-face)) | |
13445 | (gnus-data-enter | |
13446 | after-article gnus-reffed-article-number | |
13447 | gnus-unread-mark b (car pslist) 0 (- e b)) | |
13448 | (push gnus-reffed-article-number gnus-newsgroup-unreads) | |
41487370 LMI |
13449 | (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) |
13450 | (setq pslist (cdr pslist))))))) | |
13451 | ||
13452 | (defun gnus-pseudos< (p1 p2) | |
13453 | (let ((c1 (cdr (assq 'action p1))) | |
13454 | (c2 (cdr (assq 'action p2)))) | |
13455 | (and c1 c2 (string< c1 c2)))) | |
13456 | ||
13457 | (defun gnus-request-pseudo-article (props) | |
13458 | (cond ((assq 'execute props) | |
13459 | (gnus-execute-command (cdr (assq 'execute props))))) | |
13460 | (let ((gnus-current-article (gnus-summary-article-number))) | |
13461 | (run-hooks 'gnus-mark-article-hook))) | |
13462 | ||
13463 | (defun gnus-execute-command (command &optional automatic) | |
13464 | (save-excursion | |
13465 | (gnus-article-setup-buffer) | |
13466 | (set-buffer gnus-article-buffer) | |
231f989b | 13467 | (setq buffer-read-only nil) |
41487370 | 13468 | (let ((command (if automatic command (read-string "Command: " command))) |
231f989b LMI |
13469 | ;; Just binding this here doesn't help, because there might |
13470 | ;; be output from the process after exiting the scope of | |
13471 | ;; this `let'. | |
13472 | ;; (buffer-read-only nil) | |
13473 | ) | |
41487370 LMI |
13474 | (erase-buffer) |
13475 | (insert "$ " command "\n\n") | |
13476 | (if gnus-view-pseudo-asynchronously | |
231f989b LMI |
13477 | (start-process "gnus-execute" nil shell-file-name |
13478 | shell-command-switch command) | |
13479 | (call-process shell-file-name nil t nil | |
13480 | shell-command-switch command))))) | |
745bc783 | 13481 | |
41487370 LMI |
13482 | (defun gnus-copy-file (file &optional to) |
13483 | "Copy FILE to TO." | |
13484 | (interactive | |
13485 | (list (read-file-name "Copy file: " default-directory) | |
13486 | (read-file-name "Copy file to: " default-directory))) | |
13487 | (gnus-set-global-variables) | |
13488 | (or to (setq to (read-file-name "Copy file to: " default-directory))) | |
231f989b | 13489 | (and (file-directory-p to) |
41487370 LMI |
13490 | (setq to (concat (file-name-as-directory to) |
13491 | (file-name-nondirectory file)))) | |
13492 | (copy-file file to)) | |
13493 | ||
13494 | ;; Summary kill commands. | |
13495 | ||
13496 | (defun gnus-summary-edit-global-kill (article) | |
13497 | "Edit the \"global\" kill file." | |
13498 | (interactive (list (gnus-summary-article-number))) | |
13499 | (gnus-set-global-variables) | |
13500 | (gnus-group-edit-global-kill article)) | |
745bc783 | 13501 | |
b027f415 | 13502 | (defun gnus-summary-edit-local-kill () |
41487370 | 13503 | "Edit a local kill file applied to the current newsgroup." |
745bc783 | 13504 | (interactive) |
41487370 | 13505 | (gnus-set-global-variables) |
231f989b | 13506 | (setq gnus-current-headers (gnus-summary-article-header)) |
41487370 | 13507 | (gnus-set-global-variables) |
231f989b | 13508 | (gnus-group-edit-local-kill |
41487370 | 13509 | (gnus-summary-article-number) gnus-newsgroup-name)) |
745bc783 JB |
13510 | |
13511 | \f | |
13512 | ;;; | |
41487370 | 13513 | ;;; Gnus article mode |
745bc783 JB |
13514 | ;;; |
13515 | ||
41487370 LMI |
13516 | (put 'gnus-article-mode 'mode-class 'special) |
13517 | ||
b027f415 | 13518 | (if gnus-article-mode-map |
745bc783 | 13519 | nil |
b027f415 RS |
13520 | (setq gnus-article-mode-map (make-keymap)) |
13521 | (suppress-keymap gnus-article-mode-map) | |
41487370 | 13522 | |
231f989b LMI |
13523 | (gnus-define-keys gnus-article-mode-map |
13524 | " " gnus-article-goto-next-page | |
13525 | "\177" gnus-article-goto-prev-page | |
13526 | [delete] gnus-article-goto-prev-page | |
13527 | "\C-c^" gnus-article-refer-article | |
13528 | "h" gnus-article-show-summary | |
13529 | "s" gnus-article-show-summary | |
13530 | "\C-c\C-m" gnus-article-mail | |
13531 | "?" gnus-article-describe-briefly | |
13532 | gnus-mouse-2 gnus-article-push-button | |
13533 | "\r" gnus-article-press-button | |
13534 | "\t" gnus-article-next-button | |
13535 | "\M-\t" gnus-article-prev-button | |
13536 | "<" beginning-of-buffer | |
13537 | ">" end-of-buffer | |
564b670b | 13538 | "\C-c\C-i" gnus-info-find-node |
231f989b LMI |
13539 | "\C-c\C-b" gnus-bug) |
13540 | ||
13541 | (substitute-key-definition | |
13542 | 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) | |
b027f415 RS |
13543 | |
13544 | (defun gnus-article-mode () | |
41487370 LMI |
13545 | "Major mode for displaying an article. |
13546 | ||
13547 | All normal editing commands are switched off. | |
13548 | ||
13549 | The following commands are available: | |
13550 | ||
13551 | \\<gnus-article-mode-map> | |
13552 | \\[gnus-article-next-page]\t Scroll the article one page forwards | |
13553 | \\[gnus-article-prev-page]\t Scroll the article one page backwards | |
13554 | \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point | |
13555 | \\[gnus-article-show-summary]\t Display the summary buffer | |
13556 | \\[gnus-article-mail]\t Send a reply to the address near point | |
13557 | \\[gnus-article-describe-briefly]\t Describe the current mode briefly | |
13558 | \\[gnus-info-find-node]\t Go to the Gnus info node" | |
745bc783 | 13559 | (interactive) |
231f989b LMI |
13560 | (when (and menu-bar-mode |
13561 | (gnus-visual-p 'article-menu 'menu)) | |
13562 | (gnus-article-make-menu-bar)) | |
745bc783 | 13563 | (kill-all-local-variables) |
a828a776 | 13564 | (gnus-simplify-mode-line) |
745bc783 | 13565 | (setq mode-name "Article") |
41487370 | 13566 | (setq major-mode 'gnus-article-mode) |
b027f415 RS |
13567 | (make-local-variable 'minor-mode-alist) |
13568 | (or (assq 'gnus-show-mime minor-mode-alist) | |
13569 | (setq minor-mode-alist | |
13570 | (cons (list 'gnus-show-mime " MIME") minor-mode-alist))) | |
b027f415 | 13571 | (use-local-map gnus-article-mode-map) |
745bc783 JB |
13572 | (make-local-variable 'page-delimiter) |
13573 | (setq page-delimiter gnus-page-delimiter) | |
41487370 | 13574 | (buffer-disable-undo (current-buffer)) |
745bc783 | 13575 | (setq buffer-read-only t) ;Disable modification |
b027f415 | 13576 | (run-hooks 'gnus-article-mode-hook)) |
745bc783 | 13577 | |
b027f415 | 13578 | (defun gnus-article-setup-buffer () |
231f989b LMI |
13579 | "Initialize the article buffer." |
13580 | (let* ((name (if gnus-single-article-buffer "*Article*" | |
13581 | (concat "*Article " gnus-newsgroup-name "*"))) | |
13582 | (original | |
13583 | (progn (string-match "\\*Article" name) | |
13584 | (concat " *Original Article" | |
13585 | (substring name (match-end 0)))))) | |
13586 | (setq gnus-article-buffer name) | |
13587 | (setq gnus-original-article-buffer original) | |
13588 | ;; This might be a variable local to the summary buffer. | |
13589 | (unless gnus-single-article-buffer | |
745bc783 | 13590 | (save-excursion |
231f989b LMI |
13591 | (set-buffer gnus-summary-buffer) |
13592 | (setq gnus-article-buffer name) | |
13593 | (setq gnus-original-article-buffer original) | |
13594 | (gnus-set-global-variables)) | |
13595 | (make-local-variable 'gnus-summary-buffer)) | |
13596 | ;; Init original article buffer. | |
41487370 | 13597 | (save-excursion |
231f989b LMI |
13598 | (set-buffer (get-buffer-create gnus-original-article-buffer)) |
13599 | (buffer-disable-undo (current-buffer)) | |
13600 | (setq major-mode 'gnus-original-article-mode) | |
13601 | (make-local-variable 'gnus-original-article)) | |
13602 | (if (get-buffer name) | |
13603 | (save-excursion | |
13604 | (set-buffer name) | |
13605 | (buffer-disable-undo (current-buffer)) | |
13606 | (setq buffer-read-only t) | |
13607 | (gnus-add-current-to-buffer-list) | |
13608 | (or (eq major-mode 'gnus-article-mode) | |
13609 | (gnus-article-mode)) | |
13610 | (current-buffer)) | |
13611 | (save-excursion | |
13612 | (set-buffer (get-buffer-create name)) | |
13613 | (gnus-add-current-to-buffer-list) | |
13614 | (gnus-article-mode) | |
13615 | (current-buffer))))) | |
41487370 LMI |
13616 | |
13617 | ;; Set article window start at LINE, where LINE is the number of lines | |
13618 | ;; from the head of the article. | |
13619 | (defun gnus-article-set-window-start (&optional line) | |
231f989b LMI |
13620 | (set-window-start |
13621 | (get-buffer-window gnus-article-buffer t) | |
41487370 LMI |
13622 | (save-excursion |
13623 | (set-buffer gnus-article-buffer) | |
13624 | (goto-char (point-min)) | |
13625 | (if (not line) | |
13626 | (point-min) | |
13627 | (gnus-message 6 "Moved to bookmark") | |
13628 | (search-forward "\n\n" nil t) | |
13629 | (forward-line line) | |
13630 | (point))))) | |
13631 | ||
231f989b LMI |
13632 | (defun gnus-kill-all-overlays () |
13633 | "Delete all overlays in the current buffer." | |
13634 | (when (fboundp 'overlay-lists) | |
13635 | (let* ((overlayss (overlay-lists)) | |
13636 | (buffer-read-only nil) | |
13637 | (overlays (nconc (car overlayss) (cdr overlayss)))) | |
13638 | (while overlays | |
13639 | (delete-overlay (pop overlays)))))) | |
13640 | ||
41487370 LMI |
13641 | (defun gnus-request-article-this-buffer (article group) |
13642 | "Get an article and insert it into this buffer." | |
231f989b LMI |
13643 | (let (do-update-line) |
13644 | (prog1 | |
13645 | (save-excursion | |
41487370 | 13646 | (erase-buffer) |
231f989b LMI |
13647 | (gnus-kill-all-overlays) |
13648 | (setq group (or group gnus-newsgroup-name)) | |
13649 | ||
13650 | ;; Open server if it has closed. | |
13651 | (gnus-check-server (gnus-find-method-for-group group)) | |
13652 | ||
13653 | ;; Using `gnus-request-article' directly will insert the article into | |
13654 | ;; `nntp-server-buffer' - so we'll save some time by not having to | |
13655 | ;; copy it from the server buffer into the article buffer. | |
13656 | ||
13657 | ;; We only request an article by message-id when we do not have the | |
13658 | ;; headers for it, so we'll have to get those. | |
13659 | (when (stringp article) | |
13660 | (let ((gnus-override-method gnus-refer-article-method)) | |
13661 | (gnus-read-header article))) | |
13662 | ||
13663 | ;; If the article number is negative, that means that this article | |
13664 | ;; doesn't belong in this newsgroup (possibly), so we find its | |
13665 | ;; message-id and request it by id instead of number. | |
13666 | (when (and (numberp article) | |
13667 | gnus-summary-buffer | |
13668 | (get-buffer gnus-summary-buffer) | |
13669 | (buffer-name (get-buffer gnus-summary-buffer))) | |
13670 | (save-excursion | |
13671 | (set-buffer gnus-summary-buffer) | |
13672 | (let ((header (gnus-summary-article-header article))) | |
13673 | (if (< article 0) | |
13674 | (cond | |
13675 | ((memq article gnus-newsgroup-sparse) | |
13676 | ;; This is a sparse gap article. | |
13677 | (setq do-update-line article) | |
13678 | (setq article (mail-header-id header)) | |
13679 | (let ((gnus-override-method gnus-refer-article-method)) | |
13680 | (gnus-read-header article)) | |
13681 | (setq gnus-newsgroup-sparse | |
13682 | (delq article gnus-newsgroup-sparse))) | |
13683 | ((vectorp header) | |
13684 | ;; It's a real article. | |
13685 | (setq article (mail-header-id header))) | |
13686 | (t | |
13687 | ;; It is an extracted pseudo-article. | |
13688 | (setq article 'pseudo) | |
13689 | (gnus-request-pseudo-article header)))) | |
13690 | ||
13691 | (let ((method (gnus-find-method-for-group | |
13692 | gnus-newsgroup-name))) | |
13693 | (if (not (eq (car method) 'nneething)) | |
13694 | () | |
13695 | (let ((dir (concat (file-name-as-directory (nth 1 method)) | |
13696 | (mail-header-subject header)))) | |
13697 | (if (file-directory-p dir) | |
13698 | (progn | |
13699 | (setq article 'nneething) | |
13700 | (gnus-group-enter-directory dir))))))))) | |
13701 | ||
13702 | (cond | |
13703 | ;; Refuse to select canceled articles. | |
13704 | ((and (numberp article) | |
13705 | gnus-summary-buffer | |
13706 | (get-buffer gnus-summary-buffer) | |
13707 | (buffer-name (get-buffer gnus-summary-buffer)) | |
13708 | (eq (cdr (save-excursion | |
13709 | (set-buffer gnus-summary-buffer) | |
13710 | (assq article gnus-newsgroup-reads))) | |
13711 | gnus-canceled-mark)) | |
13712 | nil) | |
13713 | ;; We first check `gnus-original-article-buffer'. | |
13714 | ((and (get-buffer gnus-original-article-buffer) | |
13715 | (numberp article) | |
13716 | (save-excursion | |
13717 | (set-buffer gnus-original-article-buffer) | |
13718 | (and (equal (car gnus-original-article) group) | |
13719 | (eq (cdr gnus-original-article) article)))) | |
13720 | (insert-buffer-substring gnus-original-article-buffer) | |
13721 | 'article) | |
13722 | ;; Check the backlog. | |
13723 | ((and gnus-keep-backlog | |
13724 | (gnus-backlog-request-article group article (current-buffer))) | |
13725 | 'article) | |
13726 | ;; Check the cache. | |
13727 | ((and gnus-use-cache | |
13728 | (numberp article) | |
13729 | (gnus-cache-request-article article group)) | |
13730 | 'article) | |
13731 | ;; Get the article and put into the article buffer. | |
13732 | ((or (stringp article) (numberp article)) | |
13733 | (let ((gnus-override-method | |
13734 | (and (stringp article) gnus-refer-article-method)) | |
13735 | (buffer-read-only nil)) | |
13736 | (erase-buffer) | |
13737 | (gnus-kill-all-overlays) | |
13738 | (if (gnus-request-article article group (current-buffer)) | |
13739 | (progn | |
13740 | (and gnus-keep-backlog | |
13741 | (numberp article) | |
13742 | (gnus-backlog-enter-article | |
13743 | group article (current-buffer))) | |
13744 | 'article)))) | |
13745 | ;; It was a pseudo. | |
13746 | (t article))) | |
13747 | ||
13748 | ;; Take the article from the original article buffer | |
13749 | ;; and place it in the buffer it's supposed to be in. | |
13750 | (when (and (get-buffer gnus-article-buffer) | |
13751 | ;;(numberp article) | |
13752 | (equal (buffer-name (current-buffer)) | |
13753 | (buffer-name (get-buffer gnus-article-buffer)))) | |
13754 | (save-excursion | |
13755 | (if (get-buffer gnus-original-article-buffer) | |
13756 | (set-buffer (get-buffer gnus-original-article-buffer)) | |
13757 | (set-buffer (get-buffer-create gnus-original-article-buffer)) | |
13758 | (buffer-disable-undo (current-buffer)) | |
13759 | (setq major-mode 'gnus-original-article-mode) | |
13760 | (setq buffer-read-only t) | |
13761 | (gnus-add-current-to-buffer-list)) | |
13762 | (let (buffer-read-only) | |
13763 | (erase-buffer) | |
13764 | (insert-buffer-substring gnus-article-buffer)) | |
13765 | (setq gnus-original-article (cons group article)))) | |
13766 | ||
13767 | ;; Update sparse articles. | |
13768 | (when (and do-update-line | |
13769 | (or (numberp article) | |
13770 | (stringp article))) | |
13771 | (let ((buf (current-buffer))) | |
13772 | (set-buffer gnus-summary-buffer) | |
13773 | (gnus-summary-update-article do-update-line) | |
13774 | (gnus-summary-goto-subject do-update-line nil t) | |
13775 | (set-window-point (get-buffer-window (current-buffer) t) | |
13776 | (point)) | |
13777 | (set-buffer buf)))))) | |
41487370 | 13778 | |
231f989b | 13779 | (defun gnus-read-header (id &optional header) |
41487370 | 13780 | "Read the headers of article ID and enter them into the Gnus system." |
231f989b LMI |
13781 | (let ((group gnus-newsgroup-name) |
13782 | (gnus-override-method | |
13783 | (and (gnus-news-group-p gnus-newsgroup-name) | |
13784 | gnus-refer-article-method)) | |
13785 | where) | |
13786 | ;; First we check to see whether the header in question is already | |
13787 | ;; fetched. | |
13788 | (if (stringp id) | |
13789 | ;; This is a Message-ID. | |
13790 | (setq header (or header (gnus-id-to-header id))) | |
13791 | ;; This is an article number. | |
13792 | (setq header (or header (gnus-summary-article-header id)))) | |
13793 | (if (and header | |
13794 | (not (memq (mail-header-number header) gnus-newsgroup-sparse))) | |
13795 | ;; We have found the header. | |
13796 | header | |
13797 | ;; We have to really fetch the header to this article. | |
13798 | (when (setq where (gnus-request-head id group)) | |
13799 | (save-excursion | |
13800 | (set-buffer nntp-server-buffer) | |
13801 | (goto-char (point-max)) | |
13802 | (insert ".\n") | |
13803 | (goto-char (point-min)) | |
13804 | (insert "211 ") | |
13805 | (princ (cond | |
13806 | ((numberp id) id) | |
13807 | ((cdr where) (cdr where)) | |
13808 | (header (mail-header-number header)) | |
13809 | (t gnus-reffed-article-number)) | |
13810 | (current-buffer)) | |
13811 | (insert " Article retrieved.\n")) | |
13812 | ;(when (and header | |
13813 | ; (memq (mail-header-number header) gnus-newsgroup-sparse)) | |
13814 | ; (setcar (gnus-id-to-thread id) nil)) | |
13815 | (if (not (setq header (car (gnus-get-newsgroup-headers)))) | |
13816 | () ; Malformed head. | |
13817 | (unless (memq (mail-header-number header) gnus-newsgroup-sparse) | |
13818 | (if (and (stringp id) | |
13819 | (not (string= (gnus-group-real-name group) | |
13820 | (car where)))) | |
13821 | ;; If we fetched by Message-ID and the article came | |
13822 | ;; from a different group, we fudge some bogus article | |
13823 | ;; numbers for this article. | |
13824 | (mail-header-set-number header gnus-reffed-article-number)) | |
13825 | (decf gnus-reffed-article-number) | |
13826 | (gnus-remove-header (mail-header-number header)) | |
13827 | (push header gnus-newsgroup-headers) | |
13828 | (setq gnus-current-headers header) | |
13829 | (push (mail-header-number header) gnus-newsgroup-limit)) | |
13830 | header))))) | |
13831 | ||
13832 | (defun gnus-remove-header (number) | |
13833 | "Remove header NUMBER from `gnus-newsgroup-headers'." | |
13834 | (if (and gnus-newsgroup-headers | |
13835 | (= number (mail-header-number (car gnus-newsgroup-headers)))) | |
13836 | (pop gnus-newsgroup-headers) | |
13837 | (let ((headers gnus-newsgroup-headers)) | |
13838 | (while (and (cdr headers) | |
13839 | (not (= number (mail-header-number (cadr headers))))) | |
13840 | (pop headers)) | |
13841 | (when (cdr headers) | |
13842 | (setcdr headers (cddr headers)))))) | |
41487370 LMI |
13843 | |
13844 | (defun gnus-article-prepare (article &optional all-headers header) | |
13845 | "Prepare ARTICLE in article mode buffer. | |
13846 | ARTICLE should either be an article number or a Message-ID. | |
13847 | If ARTICLE is an id, HEADER should be the article headers. | |
13848 | If ALL-HEADERS is non-nil, no headers are hidden." | |
745bc783 | 13849 | (save-excursion |
41487370 | 13850 | ;; Make sure we start in a summary buffer. |
231f989b LMI |
13851 | (unless (eq major-mode 'gnus-summary-mode) |
13852 | (set-buffer gnus-summary-buffer)) | |
41487370 LMI |
13853 | (setq gnus-summary-buffer (current-buffer)) |
13854 | ;; Make sure the connection to the server is alive. | |
231f989b LMI |
13855 | (unless (gnus-server-opened |
13856 | (gnus-find-method-for-group gnus-newsgroup-name)) | |
13857 | (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) | |
13858 | (gnus-request-group gnus-newsgroup-name t)) | |
41487370 LMI |
13859 | (let* ((article (if header (mail-header-number header) article)) |
13860 | (summary-buffer (current-buffer)) | |
13861 | (internal-hook gnus-article-internal-prepare-hook) | |
13862 | (group gnus-newsgroup-name) | |
13863 | result) | |
13864 | (save-excursion | |
13865 | (gnus-article-setup-buffer) | |
13866 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
13867 | ;; Deactivate active regions. |
13868 | (when (and (boundp 'transient-mark-mode) | |
13869 | transient-mark-mode) | |
13870 | (setq mark-active nil)) | |
41487370 | 13871 | (if (not (setq result (let ((buffer-read-only nil)) |
231f989b | 13872 | (gnus-request-article-this-buffer |
41487370 LMI |
13873 | article group)))) |
13874 | ;; There is no such article. | |
13875 | (save-excursion | |
231f989b LMI |
13876 | (when (and (numberp article) |
13877 | (not (memq article gnus-newsgroup-sparse))) | |
13878 | (setq gnus-article-current | |
41487370 LMI |
13879 | (cons gnus-newsgroup-name article)) |
13880 | (set-buffer gnus-summary-buffer) | |
13881 | (setq gnus-current-article article) | |
13882 | (gnus-summary-mark-article article gnus-canceled-mark)) | |
231f989b LMI |
13883 | (unless (memq article gnus-newsgroup-sparse) |
13884 | (gnus-error | |
13885 | 1 "No such article (may have expired or been canceled)"))) | |
41487370 LMI |
13886 | (if (or (eq result 'pseudo) (eq result 'nneething)) |
13887 | (progn | |
13888 | (save-excursion | |
13889 | (set-buffer summary-buffer) | |
13890 | (setq gnus-last-article gnus-current-article | |
13891 | gnus-newsgroup-history (cons gnus-current-article | |
13892 | gnus-newsgroup-history) | |
13893 | gnus-current-article 0 | |
13894 | gnus-current-headers nil | |
13895 | gnus-article-current nil) | |
13896 | (if (eq result 'nneething) | |
13897 | (gnus-configure-windows 'summary) | |
13898 | (gnus-configure-windows 'article)) | |
13899 | (gnus-set-global-variables)) | |
13900 | (gnus-set-mode-line 'article)) | |
13901 | ;; The result from the `request' was an actual article - | |
13902 | ;; or at least some text that is now displayed in the | |
13903 | ;; article buffer. | |
745bc783 JB |
13904 | (if (and (numberp article) |
13905 | (not (eq article gnus-current-article))) | |
41487370 LMI |
13906 | ;; Seems like a new article has been selected. |
13907 | ;; `gnus-current-article' must be an article number. | |
13908 | (save-excursion | |
13909 | (set-buffer summary-buffer) | |
13910 | (setq gnus-last-article gnus-current-article | |
13911 | gnus-newsgroup-history (cons gnus-current-article | |
13912 | gnus-newsgroup-history) | |
13913 | gnus-current-article article | |
231f989b LMI |
13914 | gnus-current-headers |
13915 | (gnus-summary-article-header gnus-current-article) | |
13916 | gnus-article-current | |
41487370 | 13917 | (cons gnus-newsgroup-name gnus-current-article)) |
231f989b LMI |
13918 | (unless (vectorp gnus-current-headers) |
13919 | (setq gnus-current-headers nil)) | |
41487370 | 13920 | (gnus-summary-show-thread) |
b027f415 | 13921 | (run-hooks 'gnus-mark-article-hook) |
41487370 | 13922 | (gnus-set-mode-line 'summary) |
231f989b | 13923 | (and (gnus-visual-p 'article-highlight 'highlight) |
41487370 LMI |
13924 | (run-hooks 'gnus-visual-mark-article-hook)) |
13925 | ;; Set the global newsgroup variables here. | |
13926 | ;; Suggested by Jim Sisolak | |
13927 | ;; <sisolak@trans4.neep.wisc.edu>. | |
13928 | (gnus-set-global-variables) | |
231f989b | 13929 | (setq gnus-have-all-headers |
41487370 | 13930 | (or all-headers gnus-show-all-headers)) |
231f989b LMI |
13931 | (and gnus-use-cache |
13932 | (vectorp (gnus-summary-article-header article)) | |
41487370 LMI |
13933 | (gnus-cache-possibly-enter-article |
13934 | group article | |
231f989b | 13935 | (gnus-summary-article-header article) |
41487370 LMI |
13936 | (memq article gnus-newsgroup-marked) |
13937 | (memq article gnus-newsgroup-dormant) | |
13938 | (memq article gnus-newsgroup-unreads))))) | |
231f989b LMI |
13939 | (when (or (numberp article) |
13940 | (stringp article)) | |
13941 | ;; Hooks for getting information from the article. | |
13942 | ;; This hook must be called before being narrowed. | |
13943 | (let (buffer-read-only) | |
13944 | (run-hooks 'internal-hook) | |
13945 | (run-hooks 'gnus-article-prepare-hook) | |
13946 | ;; Decode MIME message. | |
13947 | (if gnus-show-mime | |
13948 | (if (or (not gnus-strict-mime) | |
13949 | (gnus-fetch-field "Mime-Version")) | |
13950 | (funcall gnus-show-mime-method) | |
13951 | (funcall gnus-decode-encoded-word-method))) | |
13952 | ;; Perform the article display hooks. | |
13953 | (run-hooks 'gnus-article-display-hook)) | |
13954 | ;; Do page break. | |
13955 | (goto-char (point-min)) | |
13956 | (and gnus-break-pages (gnus-narrow-to-page))) | |
41487370 LMI |
13957 | (gnus-set-mode-line 'article) |
13958 | (gnus-configure-windows 'article) | |
13959 | (goto-char (point-min)) | |
13960 | t)))))) | |
745bc783 | 13961 | |
b027f415 | 13962 | (defun gnus-article-show-all-headers () |
41487370 | 13963 | "Show all article headers in article mode buffer." |
231f989b | 13964 | (save-excursion |
41487370 LMI |
13965 | (gnus-article-setup-buffer) |
13966 | (set-buffer gnus-article-buffer) | |
13967 | (let ((buffer-read-only nil)) | |
231f989b | 13968 | (gnus-unhide-text (point-min) (point-max))))) |
745bc783 | 13969 | |
41487370 LMI |
13970 | (defun gnus-article-hide-headers-if-wanted () |
13971 | "Hide unwanted headers if `gnus-have-all-headers' is nil. | |
b94ae5f7 | 13972 | Provided for backwards compatibility." |
41487370 | 13973 | (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) |
231f989b | 13974 | gnus-inhibit-hiding |
41487370 | 13975 | (gnus-article-hide-headers))) |
745bc783 | 13976 | |
231f989b LMI |
13977 | (defsubst gnus-article-header-rank () |
13978 | "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." | |
13979 | (let ((list gnus-sorted-header-list) | |
13980 | (i 0)) | |
13981 | (while list | |
13982 | (when (looking-at (car list)) | |
13983 | (setq list nil)) | |
13984 | (setq list (cdr list)) | |
13985 | (incf i)) | |
13986 | i)) | |
13987 | ||
13988 | (defun gnus-article-hide-headers (&optional arg delete) | |
13989 | "Toggle whether to hide unwanted headers and possibly sort them as well. | |
13990 | If given a negative prefix, always show; if given a positive prefix, | |
13991 | always hide." | |
13992 | (interactive (gnus-hidden-arg)) | |
13993 | (if (gnus-article-check-hidden-text 'headers arg) | |
13994 | ;; Show boring headers as well. | |
13995 | (gnus-article-show-hidden-text 'boring-headers) | |
13996 | ;; This function might be inhibited. | |
13997 | (unless gnus-inhibit-hiding | |
13998 | (save-excursion | |
13999 | (set-buffer gnus-article-buffer) | |
14000 | (save-restriction | |
14001 | (let ((buffer-read-only nil) | |
14002 | (props (nconc (list 'gnus-type 'headers) | |
14003 | gnus-hidden-properties)) | |
14004 | (max (1+ (length gnus-sorted-header-list))) | |
14005 | (ignored (when (not (stringp gnus-visible-headers)) | |
14006 | (cond ((stringp gnus-ignored-headers) | |
14007 | gnus-ignored-headers) | |
14008 | ((listp gnus-ignored-headers) | |
14009 | (mapconcat 'identity gnus-ignored-headers | |
14010 | "\\|"))))) | |
14011 | (visible | |
14012 | (cond ((stringp gnus-visible-headers) | |
14013 | gnus-visible-headers) | |
14014 | ((and gnus-visible-headers | |
14015 | (listp gnus-visible-headers)) | |
14016 | (mapconcat 'identity gnus-visible-headers "\\|")))) | |
14017 | (inhibit-point-motion-hooks t) | |
14018 | want-list beg) | |
14019 | ;; First we narrow to just the headers. | |
14020 | (widen) | |
14021 | (goto-char (point-min)) | |
14022 | ;; Hide any "From " lines at the beginning of (mail) articles. | |
14023 | (while (looking-at "From ") | |
14024 | (forward-line 1)) | |
14025 | (unless (bobp) | |
14026 | (if delete | |
14027 | (delete-region (point-min) (point)) | |
14028 | (gnus-hide-text (point-min) (point) props))) | |
14029 | ;; Then treat the rest of the header lines. | |
14030 | (narrow-to-region | |
14031 | (point) | |
14032 | (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) | |
14033 | ;; Then we use the two regular expressions | |
14034 | ;; `gnus-ignored-headers' and `gnus-visible-headers' to | |
14035 | ;; select which header lines is to remain visible in the | |
14036 | ;; article buffer. | |
14037 | (goto-char (point-min)) | |
14038 | (while (re-search-forward "^[^ \t]*:" nil t) | |
14039 | (beginning-of-line) | |
14040 | ;; We add the headers we want to keep to a list and delete | |
14041 | ;; them from the buffer. | |
14042 | (gnus-put-text-property | |
14043 | (point) (1+ (point)) 'message-rank | |
14044 | (if (or (and visible (looking-at visible)) | |
14045 | (and ignored | |
14046 | (not (looking-at ignored)))) | |
14047 | (gnus-article-header-rank) | |
14048 | (+ 2 max))) | |
14049 | (forward-line 1)) | |
14050 | (message-sort-headers-1) | |
14051 | (when (setq beg (text-property-any | |
14052 | (point-min) (point-max) 'message-rank (+ 2 max))) | |
14053 | ;; We make the unwanted headers invisible. | |
14054 | (if delete | |
14055 | (delete-region beg (point-max)) | |
14056 | ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>. | |
14057 | (gnus-hide-text-type beg (point-max) 'headers)) | |
14058 | ;; Work around XEmacs lossage. | |
14059 | (gnus-put-text-property (point-min) beg 'invisible nil)))))))) | |
14060 | ||
14061 | (defun gnus-article-hide-boring-headers (&optional arg) | |
14062 | "Toggle hiding of headers that aren't very interesting. | |
14063 | If given a negative prefix, always show; if given a positive prefix, | |
14064 | always hide." | |
14065 | (interactive (gnus-hidden-arg)) | |
14066 | (unless (gnus-article-check-hidden-text 'boring-headers arg) | |
14067 | (save-excursion | |
14068 | (set-buffer gnus-article-buffer) | |
14069 | (save-restriction | |
14070 | (let ((buffer-read-only nil) | |
14071 | (list gnus-boring-article-headers) | |
14072 | (inhibit-point-motion-hooks t) | |
14073 | elem) | |
14074 | (nnheader-narrow-to-headers) | |
14075 | (while list | |
14076 | (setq elem (pop list)) | |
14077 | (goto-char (point-min)) | |
14078 | (cond | |
14079 | ;; Hide empty headers. | |
14080 | ((eq elem 'empty) | |
14081 | (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t) | |
14082 | (forward-line -1) | |
14083 | (gnus-hide-text-type | |
14084 | (progn (beginning-of-line) (point)) | |
14085 | (progn | |
14086 | (end-of-line) | |
14087 | (if (re-search-forward "^[^ \t]" nil t) | |
14088 | (match-beginning 0) | |
14089 | (point-max))) | |
14090 | 'boring-headers))) | |
14091 | ;; Hide boring Newsgroups header. | |
14092 | ((eq elem 'newsgroups) | |
14093 | (when (equal (message-fetch-field "newsgroups") | |
14094 | (gnus-group-real-name gnus-newsgroup-name)) | |
14095 | (gnus-article-hide-header "newsgroups"))) | |
14096 | ((eq elem 'followup-to) | |
14097 | (when (equal (message-fetch-field "followup-to") | |
14098 | (message-fetch-field "newsgroups")) | |
14099 | (gnus-article-hide-header "followup-to"))) | |
14100 | ((eq elem 'reply-to) | |
14101 | (let ((from (message-fetch-field "from")) | |
14102 | (reply-to (message-fetch-field "reply-to"))) | |
14103 | (when (and | |
14104 | from reply-to | |
14105 | (equal | |
14106 | (nth 1 (funcall gnus-extract-address-components from)) | |
14107 | (nth 1 (funcall gnus-extract-address-components | |
14108 | reply-to)))) | |
14109 | (gnus-article-hide-header "reply-to")))) | |
14110 | ((eq elem 'date) | |
14111 | (let ((date (message-fetch-field "date"))) | |
14112 | (when (and date | |
14113 | (< (gnus-days-between date (current-time-string)) | |
14114 | 4)) | |
14115 | (gnus-article-hide-header "date"))))))))))) | |
14116 | ||
14117 | (defun gnus-article-hide-header (header) | |
41487370 | 14118 | (save-excursion |
231f989b LMI |
14119 | (goto-char (point-min)) |
14120 | (when (re-search-forward (concat "^" header ":") nil t) | |
14121 | (gnus-hide-text-type | |
14122 | (progn (beginning-of-line) (point)) | |
14123 | (progn | |
14124 | (end-of-line) | |
14125 | (if (re-search-forward "^[^ \t]" nil t) | |
14126 | (match-beginning 0) | |
14127 | (point-max))) | |
14128 | 'boring-headers)))) | |
41487370 LMI |
14129 | |
14130 | ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>. | |
14131 | (defun gnus-article-treat-overstrike () | |
14132 | "Translate overstrikes into bold text." | |
745bc783 | 14133 | (interactive) |
41487370 LMI |
14134 | (save-excursion |
14135 | (set-buffer gnus-article-buffer) | |
14136 | (let ((buffer-read-only nil)) | |
14137 | (while (search-forward "\b" nil t) | |
14138 | (let ((next (following-char)) | |
14139 | (previous (char-after (- (point) 2)))) | |
231f989b LMI |
14140 | (cond |
14141 | ((eq next previous) | |
14142 | (gnus-put-text-property (- (point) 2) (point) 'invisible t) | |
14143 | (gnus-put-text-property (point) (1+ (point)) 'face 'bold)) | |
14144 | ((eq next ?_) | |
14145 | (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t) | |
14146 | (gnus-put-text-property | |
14147 | (- (point) 2) (1- (point)) 'face 'underline)) | |
14148 | ((eq previous ?_) | |
14149 | (gnus-put-text-property (- (point) 2) (point) 'invisible t) | |
14150 | (gnus-put-text-property | |
14151 | (point) (1+ (point)) 'face 'underline)))))))) | |
41487370 LMI |
14152 | |
14153 | (defun gnus-article-word-wrap () | |
14154 | "Format too long lines." | |
745bc783 | 14155 | (interactive) |
41487370 LMI |
14156 | (save-excursion |
14157 | (set-buffer gnus-article-buffer) | |
14158 | (let ((buffer-read-only nil)) | |
231f989b | 14159 | (widen) |
41487370 LMI |
14160 | (goto-char (point-min)) |
14161 | (search-forward "\n\n" nil t) | |
14162 | (end-of-line 1) | |
14163 | (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") | |
14164 | (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") | |
14165 | (adaptive-fill-mode t)) | |
14166 | (while (not (eobp)) | |
14167 | (and (>= (current-column) (min fill-column (window-width))) | |
14168 | (/= (preceding-char) ?:) | |
14169 | (fill-paragraph nil)) | |
14170 | (end-of-line 2)))))) | |
14171 | ||
14172 | (defun gnus-article-remove-cr () | |
14173 | "Remove carriage returns from an article." | |
745bc783 | 14174 | (interactive) |
41487370 LMI |
14175 | (save-excursion |
14176 | (set-buffer gnus-article-buffer) | |
14177 | (let ((buffer-read-only nil)) | |
14178 | (goto-char (point-min)) | |
14179 | (while (search-forward "\r" nil t) | |
14180 | (replace-match "" t t))))) | |
745bc783 | 14181 | |
231f989b LMI |
14182 | (defun gnus-article-remove-trailing-blank-lines () |
14183 | "Remove all trailing blank lines from the article." | |
14184 | (interactive) | |
14185 | (save-excursion | |
14186 | (set-buffer gnus-article-buffer) | |
14187 | (let ((buffer-read-only nil)) | |
14188 | (goto-char (point-max)) | |
14189 | (delete-region | |
14190 | (point) | |
14191 | (progn | |
14192 | (while (looking-at "^[ \t]*$") | |
14193 | (forward-line -1)) | |
14194 | (forward-line 1) | |
14195 | (point)))))) | |
14196 | ||
41487370 LMI |
14197 | (defun gnus-article-display-x-face (&optional force) |
14198 | "Look for an X-Face header and display it if present." | |
14199 | (interactive (list 'force)) | |
14200 | (save-excursion | |
14201 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
14202 | ;; Delete the old process, if any. |
14203 | (when (process-status "gnus-x-face") | |
14204 | (delete-process "gnus-x-face")) | |
41487370 LMI |
14205 | (let ((inhibit-point-motion-hooks t) |
14206 | (case-fold-search nil) | |
14207 | from) | |
14208 | (save-restriction | |
231f989b LMI |
14209 | (nnheader-narrow-to-headers) |
14210 | (setq from (message-fetch-field "from")) | |
41487370 | 14211 | (goto-char (point-min)) |
231f989b LMI |
14212 | (when (and gnus-article-x-face-command |
14213 | (or force | |
14214 | ;; Check whether this face is censored. | |
14215 | (not gnus-article-x-face-too-ugly) | |
14216 | (and gnus-article-x-face-too-ugly from | |
14217 | (not (string-match gnus-article-x-face-too-ugly | |
14218 | from)))) | |
14219 | ;; Has to be present. | |
14220 | (re-search-forward "^X-Face: " nil t)) | |
14221 | ;; We now have the area of the buffer where the X-Face is stored. | |
41487370 LMI |
14222 | (let ((beg (point)) |
14223 | (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) | |
231f989b | 14224 | ;; We display the face. |
41487370 | 14225 | (if (symbolp gnus-article-x-face-command) |
231f989b LMI |
14226 | ;; The command is a lisp function, so we call it. |
14227 | (if (gnus-functionp gnus-article-x-face-command) | |
14228 | (funcall gnus-article-x-face-command beg end) | |
14229 | (error "%s is not a function" gnus-article-x-face-command)) | |
14230 | ;; The command is a string, so we interpret the command | |
14231 | ;; as a, well, command, and fork it off. | |
14232 | (let ((process-connection-type nil)) | |
14233 | (process-kill-without-query | |
14234 | (start-process | |
14235 | "gnus-x-face" nil shell-file-name shell-command-switch | |
14236 | gnus-article-x-face-command)) | |
14237 | (process-send-region "gnus-x-face" beg end) | |
14238 | (process-send-eof "gnus-x-face"))))))))) | |
14239 | ||
14240 | (defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522) | |
14241 | (defun gnus-decode-rfc1522 () | |
14242 | "Hack to remove QP encoding from headers." | |
14243 | (let ((case-fold-search t) | |
14244 | (inhibit-point-motion-hooks t) | |
14245 | (buffer-read-only nil) | |
14246 | string) | |
14247 | (save-restriction | |
14248 | (narrow-to-region | |
14249 | (goto-char (point-min)) | |
14250 | (or (search-forward "\n\n" nil t) (point-max))) | |
14251 | ||
14252 | (while (re-search-forward | |
14253 | "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) | |
14254 | (setq string (match-string 1)) | |
14255 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
14256 | (delete-region (point-min) (point-max)) | |
14257 | (insert string) | |
14258 | (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) | |
14259 | (subst-char-in-region (point-min) (point-max) ?_ ? ) | |
14260 | (widen) | |
14261 | (goto-char (point-min)))))) | |
41487370 LMI |
14262 | |
14263 | (defun gnus-article-de-quoted-unreadable (&optional force) | |
14264 | "Do a naive translation of a quoted-printable-encoded article. | |
14265 | This is in no way, shape or form meant as a replacement for real MIME | |
14266 | processing, but is simply a stop-gap measure until MIME support is | |
14267 | written. | |
14268 | If FORCE, decode the article whether it is marked as quoted-printable | |
231f989b | 14269 | or not." |
41487370 LMI |
14270 | (interactive (list 'force)) |
14271 | (save-excursion | |
14272 | (set-buffer gnus-article-buffer) | |
14273 | (let ((case-fold-search t) | |
14274 | (buffer-read-only nil) | |
14275 | (type (gnus-fetch-field "content-transfer-encoding"))) | |
231f989b LMI |
14276 | (gnus-decode-rfc1522) |
14277 | (when (or force | |
14278 | (and type (string-match "quoted-printable" (downcase type)))) | |
14279 | (goto-char (point-min)) | |
14280 | (search-forward "\n\n" nil 'move) | |
14281 | (gnus-mime-decode-quoted-printable (point) (point-max)))))) | |
745bc783 | 14282 | |
41487370 | 14283 | (defun gnus-mime-decode-quoted-printable (from to) |
231f989b LMI |
14284 | "Decode Quoted-Printable in the region between FROM and TO." |
14285 | (interactive "r") | |
14286 | (goto-char from) | |
14287 | (while (search-forward "=" to t) | |
14288 | (cond ((eq (following-char) ?\n) | |
14289 | (delete-char -1) | |
14290 | (delete-char 1)) | |
14291 | ((looking-at "[0-9A-F][0-9A-F]") | |
14292 | (subst-char-in-region | |
14293 | (1- (point)) (point) ?= | |
14294 | (hexl-hex-string-to-integer | |
14295 | (buffer-substring (point) (+ 2 (point))))) | |
14296 | (delete-char 2)) | |
14297 | ((looking-at "=") | |
14298 | (delete-char 1)) | |
14299 | ((gnus-message 3 "Malformed MIME quoted-printable message"))))) | |
14300 | ||
14301 | (defun gnus-article-hide-pgp (&optional arg) | |
14302 | "Toggle hiding of any PGP headers and signatures in the current article. | |
14303 | If given a negative prefix, always show; if given a positive prefix, | |
14304 | always hide." | |
14305 | (interactive (gnus-hidden-arg)) | |
14306 | (unless (gnus-article-check-hidden-text 'pgp arg) | |
14307 | (save-excursion | |
14308 | (set-buffer gnus-article-buffer) | |
14309 | (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties)) | |
14310 | buffer-read-only beg end) | |
14311 | (widen) | |
14312 | (goto-char (point-min)) | |
14313 | ;; Hide the "header". | |
14314 | (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) | |
14315 | (gnus-hide-text (match-beginning 0) (match-end 0) props)) | |
14316 | (setq beg (point)) | |
14317 | ;; Hide the actual signature. | |
14318 | (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) | |
14319 | (setq end (1+ (match-beginning 0))) | |
14320 | (gnus-hide-text | |
14321 | end | |
14322 | (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) | |
14323 | (match-end 0) | |
14324 | ;; Perhaps we shouldn't hide to the end of the buffer | |
14325 | ;; if there is no end to the signature? | |
14326 | (point-max)) | |
14327 | props)) | |
14328 | ;; Hide "- " PGP quotation markers. | |
14329 | (when (and beg end) | |
14330 | (narrow-to-region beg end) | |
14331 | (goto-char (point-min)) | |
14332 | (while (re-search-forward "^- " nil t) | |
14333 | (gnus-hide-text (match-beginning 0) (match-end 0) props)) | |
14334 | (widen)))))) | |
14335 | ||
14336 | (defun gnus-article-hide-signature (&optional arg) | |
14337 | "Hide the signature in the current article. | |
14338 | If given a negative prefix, always show; if given a positive prefix, | |
14339 | always hide." | |
14340 | (interactive (gnus-hidden-arg)) | |
14341 | (unless (gnus-article-check-hidden-text 'signature arg) | |
14342 | (save-excursion | |
14343 | (set-buffer gnus-article-buffer) | |
14344 | (save-restriction | |
14345 | (let ((buffer-read-only nil)) | |
14346 | (when (gnus-narrow-to-signature) | |
14347 | (gnus-hide-text-type (point-min) (point-max) 'signature))))))) | |
14348 | ||
14349 | (defun gnus-article-strip-leading-blank-lines () | |
14350 | "Remove all blank lines from the beginning of the article." | |
14351 | (interactive) | |
14352 | (save-excursion | |
14353 | (set-buffer gnus-article-buffer) | |
14354 | (let (buffer-read-only) | |
14355 | (goto-char (point-min)) | |
14356 | (when (search-forward "\n\n" nil t) | |
14357 | (while (looking-at "[ \t]$") | |
14358 | (gnus-delete-line)))))) | |
14359 | ||
14360 | (defvar mime::preview/content-list) | |
14361 | (defvar mime::preview-content-info/point-min) | |
14362 | (defun gnus-narrow-to-signature () | |
14363 | "Narrow to the signature." | |
14364 | (widen) | |
14365 | (if (and (boundp 'mime::preview/content-list) | |
14366 | mime::preview/content-list) | |
14367 | (let ((pcinfo (car (last mime::preview/content-list)))) | |
14368 | (condition-case () | |
14369 | (narrow-to-region | |
14370 | (funcall (intern "mime::preview-content-info/point-min") pcinfo) | |
14371 | (point-max)) | |
14372 | (error nil)))) | |
14373 | (goto-char (point-max)) | |
14374 | (when (re-search-backward gnus-signature-separator nil t) | |
14375 | (forward-line 1) | |
14376 | (when (or (null gnus-signature-limit) | |
14377 | (and (numberp gnus-signature-limit) | |
14378 | (< (- (point-max) (point)) gnus-signature-limit)) | |
14379 | (and (gnus-functionp gnus-signature-limit) | |
14380 | (funcall gnus-signature-limit)) | |
14381 | (and (stringp gnus-signature-limit) | |
14382 | (not (re-search-forward gnus-signature-limit nil t)))) | |
14383 | (narrow-to-region (point) (point-max)) | |
14384 | t))) | |
14385 | ||
14386 | (defun gnus-hidden-arg () | |
14387 | "Return the current prefix arg as a number, or 0 if no prefix." | |
14388 | (list (if current-prefix-arg | |
14389 | (prefix-numeric-value current-prefix-arg) | |
14390 | 0))) | |
14391 | ||
14392 | (defun gnus-article-check-hidden-text (type arg) | |
14393 | "Return nil if hiding is necessary. | |
14394 | Arg can be nil or a number. Nil and positive means hide, negative | |
14395 | means show, 0 means toggle." | |
14396 | (save-excursion | |
14397 | (set-buffer gnus-article-buffer) | |
14398 | (let ((hide (gnus-article-hidden-text-p type))) | |
14399 | (cond | |
14400 | ((or (null arg) | |
14401 | (> arg 0)) | |
14402 | nil) | |
14403 | ((< arg 0) | |
14404 | (gnus-article-show-hidden-text type)) | |
14405 | (t | |
14406 | (if (eq hide 'hidden) | |
14407 | (gnus-article-show-hidden-text type) | |
14408 | nil)))))) | |
14409 | ||
14410 | (defun gnus-article-hidden-text-p (type) | |
14411 | "Say whether the current buffer contains hidden text of type TYPE." | |
14412 | (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))) | |
14413 | (when pos | |
14414 | (if (get-text-property pos 'invisible) | |
14415 | 'hidden | |
14416 | 'shown)))) | |
14417 | ||
14418 | (defun gnus-article-hide (&optional arg force) | |
14419 | "Hide all the gruft in the current article. | |
14420 | This means that PGP stuff, signatures, cited text and (some) | |
14421 | headers will be hidden. | |
14422 | If given a prefix, show the hidden text instead." | |
14423 | (interactive (list current-prefix-arg 'force)) | |
14424 | (gnus-article-hide-headers arg) | |
14425 | (gnus-article-hide-pgp arg) | |
14426 | (gnus-article-hide-citation-maybe arg force) | |
14427 | (gnus-article-hide-signature arg)) | |
14428 | ||
14429 | (defun gnus-article-show-hidden-text (type &optional hide) | |
14430 | "Show all hidden text of type TYPE. | |
14431 | If HIDE, hide the text instead." | |
41487370 | 14432 | (save-excursion |
231f989b LMI |
14433 | (set-buffer gnus-article-buffer) |
14434 | (let ((buffer-read-only nil) | |
14435 | (inhibit-point-motion-hooks t) | |
14436 | (beg (point-min))) | |
14437 | (while (gnus-goto-char (text-property-any | |
14438 | beg (point-max) 'gnus-type type)) | |
14439 | (setq beg (point)) | |
14440 | (forward-char) | |
14441 | (if hide | |
14442 | (gnus-hide-text beg (point) gnus-hidden-properties) | |
14443 | (gnus-unhide-text beg (point))) | |
14444 | (setq beg (point))) | |
14445 | t))) | |
41487370 LMI |
14446 | |
14447 | (defvar gnus-article-time-units | |
231f989b LMI |
14448 | `((year . ,(* 365.25 24 60 60)) |
14449 | (week . ,(* 7 24 60 60)) | |
14450 | (day . ,(* 24 60 60)) | |
14451 | (hour . ,(* 60 60)) | |
14452 | (minute . 60) | |
14453 | (second . 1)) | |
14454 | "Mapping from time units to seconds.") | |
14455 | ||
14456 | (defun gnus-article-date-ut (&optional type highlight) | |
41487370 LMI |
14457 | "Convert DATE date to universal time in the current article. |
14458 | If TYPE is `local', convert to local time; if it is `lapsed', output | |
14459 | how much time has lapsed since DATE." | |
231f989b LMI |
14460 | (interactive (list 'ut t)) |
14461 | (let* ((header (or gnus-current-headers | |
14462 | (gnus-summary-article-header) "")) | |
14463 | (date (and (vectorp header) (mail-header-date header))) | |
14464 | (date-regexp "^Date: \\|^X-Sent: ") | |
14465 | (now (current-time)) | |
14466 | (inhibit-point-motion-hooks t) | |
14467 | bface eface) | |
14468 | (when (and date (not (string= date ""))) | |
41487370 LMI |
14469 | (save-excursion |
14470 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
14471 | (save-restriction |
14472 | (nnheader-narrow-to-headers) | |
14473 | (let ((buffer-read-only nil)) | |
14474 | ;; Delete any old Date headers. | |
14475 | (if (re-search-forward date-regexp nil t) | |
14476 | (progn | |
14477 | (setq bface (get-text-property (gnus-point-at-bol) 'face) | |
14478 | eface (get-text-property (1- (gnus-point-at-eol)) | |
14479 | 'face)) | |
14480 | (message-remove-header date-regexp t) | |
14481 | (beginning-of-line)) | |
14482 | (goto-char (point-max))) | |
14483 | (insert (gnus-make-date-line date type)) | |
14484 | ;; Do highlighting. | |
14485 | (forward-line -1) | |
14486 | (when (and (gnus-visual-p 'article-highlight 'highlight) | |
14487 | (looking-at "\\([^:]+\\): *\\(.*\\)$")) | |
14488 | (gnus-put-text-property (match-beginning 1) (match-end 1) | |
14489 | 'face bface) | |
14490 | (gnus-put-text-property (match-beginning 2) (match-end 2) | |
14491 | 'face eface)))))))) | |
14492 | ||
14493 | (defun gnus-make-date-line (date type) | |
14494 | "Return a DATE line of TYPE." | |
14495 | (cond | |
14496 | ;; Convert to the local timezone. We have to slap a | |
14497 | ;; `condition-case' round the calls to the timezone | |
14498 | ;; functions since they aren't particularly resistant to | |
14499 | ;; buggy dates. | |
14500 | ((eq type 'local) | |
14501 | (concat "Date: " (condition-case () | |
14502 | (timezone-make-date-arpa-standard date) | |
41487370 | 14503 | (error date)) |
231f989b LMI |
14504 | "\n")) |
14505 | ;; Convert to Universal Time. | |
14506 | ((eq type 'ut) | |
14507 | (concat "Date: " | |
14508 | (condition-case () | |
14509 | (timezone-make-date-arpa-standard date nil "UT") | |
14510 | (error date)) | |
14511 | "\n")) | |
14512 | ;; Get the original date from the article. | |
14513 | ((eq type 'original) | |
14514 | (concat "Date: " date "\n")) | |
14515 | ;; Do an X-Sent lapsed format. | |
14516 | ((eq type 'lapsed) | |
14517 | ;; If the date is seriously mangled, the timezone | |
14518 | ;; functions are liable to bug out, so we condition-case | |
14519 | ;; the entire thing. | |
14520 | (let* ((now (current-time)) | |
14521 | (real-time | |
14522 | (condition-case () | |
14523 | (gnus-time-minus | |
14524 | (gnus-encode-date | |
14525 | (timezone-make-date-arpa-standard | |
14526 | (current-time-string now) | |
14527 | (current-time-zone now) "UT")) | |
14528 | (gnus-encode-date | |
14529 | (timezone-make-date-arpa-standard | |
14530 | date nil "UT"))) | |
14531 | (error '(0 0)))) | |
14532 | (real-sec (+ (* (float (car real-time)) 65536) | |
14533 | (cadr real-time))) | |
14534 | (sec (abs real-sec)) | |
14535 | num prev) | |
14536 | (cond | |
14537 | ((equal real-time '(0 0)) | |
14538 | "X-Sent: Unknown\n") | |
14539 | ((zerop sec) | |
14540 | "X-Sent: Now\n") | |
14541 | (t | |
14542 | (concat | |
14543 | "X-Sent: " | |
14544 | ;; This is a bit convoluted, but basically we go | |
14545 | ;; through the time units for years, weeks, etc, | |
14546 | ;; and divide things to see whether that results | |
14547 | ;; in positive answers. | |
14548 | (mapconcat | |
14549 | (lambda (unit) | |
14550 | (if (zerop (setq num (ffloor (/ sec (cdr unit))))) | |
14551 | ;; The (remaining) seconds are too few to | |
14552 | ;; be divided into this time unit. | |
14553 | "" | |
14554 | ;; It's big enough, so we output it. | |
14555 | (setq sec (- sec (* num (cdr unit)))) | |
14556 | (prog1 | |
14557 | (concat (if prev ", " "") (int-to-string | |
14558 | (floor num)) | |
14559 | " " (symbol-name (car unit)) | |
14560 | (if (> num 1) "s" "")) | |
14561 | (setq prev t)))) | |
14562 | gnus-article-time-units "") | |
14563 | ;; If dates are odd, then it might appear like the | |
14564 | ;; article was sent in the future. | |
14565 | (if (> real-sec 0) | |
14566 | " ago\n" | |
14567 | " in the future\n")))))) | |
14568 | (t | |
14569 | (error "Unknown conversion type: %s" type)))) | |
745bc783 | 14570 | |
231f989b | 14571 | (defun gnus-article-date-local (&optional highlight) |
41487370 | 14572 | "Convert the current article date to the local timezone." |
231f989b LMI |
14573 | (interactive (list t)) |
14574 | (gnus-article-date-ut 'local highlight)) | |
14575 | ||
14576 | (defun gnus-article-date-original (&optional highlight) | |
14577 | "Convert the current article date to what it was originally. | |
14578 | This is only useful if you have used some other date conversion | |
14579 | function and want to see what the date was before converting." | |
14580 | (interactive (list t)) | |
14581 | (gnus-article-date-ut 'original highlight)) | |
745bc783 | 14582 | |
231f989b | 14583 | (defun gnus-article-date-lapsed (&optional highlight) |
41487370 | 14584 | "Convert the current article date to time lapsed since it was sent." |
231f989b LMI |
14585 | (interactive (list t)) |
14586 | (gnus-article-date-ut 'lapsed highlight)) | |
745bc783 | 14587 | |
41487370 LMI |
14588 | (defun gnus-article-maybe-highlight () |
14589 | "Do some article highlighting if `gnus-visual' is non-nil." | |
231f989b LMI |
14590 | (if (gnus-visual-p 'article-highlight 'highlight) |
14591 | (gnus-article-highlight-some))) | |
745bc783 | 14592 | |
231f989b | 14593 | ;;; Article savers. |
745bc783 JB |
14594 | |
14595 | (defun gnus-output-to-rmail (file-name) | |
14596 | "Append the current article to an Rmail file named FILE-NAME." | |
14597 | (require 'rmail) | |
14598 | ;; Most of these codes are borrowed from rmailout.el. | |
14599 | (setq file-name (expand-file-name file-name)) | |
f670fcba | 14600 | (setq rmail-default-rmail-file file-name) |
745bc783 | 14601 | (let ((artbuf (current-buffer)) |
41487370 | 14602 | (tmpbuf (get-buffer-create " *Gnus-output*"))) |
745bc783 JB |
14603 | (save-excursion |
14604 | (or (get-file-buffer file-name) | |
14605 | (file-exists-p file-name) | |
41487370 | 14606 | (if (gnus-yes-or-no-p |
745bc783 JB |
14607 | (concat "\"" file-name "\" does not exist, create it? ")) |
14608 | (let ((file-buffer (create-file-buffer file-name))) | |
14609 | (save-excursion | |
14610 | (set-buffer file-buffer) | |
14611 | (rmail-insert-rmail-file-header) | |
14612 | (let ((require-final-newline nil)) | |
14613 | (write-region (point-min) (point-max) file-name t 1))) | |
14614 | (kill-buffer file-buffer)) | |
14615 | (error "Output file does not exist"))) | |
14616 | (set-buffer tmpbuf) | |
41487370 | 14617 | (buffer-disable-undo (current-buffer)) |
745bc783 JB |
14618 | (erase-buffer) |
14619 | (insert-buffer-substring artbuf) | |
14620 | (gnus-convert-article-to-rmail) | |
14621 | ;; Decide whether to append to a file or to an Emacs buffer. | |
14622 | (let ((outbuf (get-file-buffer file-name))) | |
14623 | (if (not outbuf) | |
14624 | (append-to-file (point-min) (point-max) file-name) | |
14625 | ;; File has been visited, in buffer OUTBUF. | |
14626 | (set-buffer outbuf) | |
14627 | (let ((buffer-read-only nil) | |
14628 | (msg (and (boundp 'rmail-current-message) | |
41487370 | 14629 | (symbol-value 'rmail-current-message)))) |
745bc783 JB |
14630 | ;; If MSG is non-nil, buffer is in RMAIL mode. |
14631 | (if msg | |
14632 | (progn (widen) | |
14633 | (narrow-to-region (point-max) (point-max)))) | |
14634 | (insert-buffer-substring tmpbuf) | |
14635 | (if msg | |
14636 | (progn | |
14637 | (goto-char (point-min)) | |
14638 | (widen) | |
14639 | (search-backward "\^_") | |
14640 | (narrow-to-region (point) (point-max)) | |
14641 | (goto-char (1+ (point-min))) | |
14642 | (rmail-count-new-messages t) | |
41487370 LMI |
14643 | (rmail-show-message msg))))))) |
14644 | (kill-buffer tmpbuf))) | |
745bc783 JB |
14645 | |
14646 | (defun gnus-output-to-file (file-name) | |
14647 | "Append the current article to a file named FILE-NAME." | |
231f989b LMI |
14648 | (let ((artbuf (current-buffer))) |
14649 | (nnheader-temp-write nil | |
745bc783 JB |
14650 | (insert-buffer-substring artbuf) |
14651 | ;; Append newline at end of the buffer as separator, and then | |
14652 | ;; save it to file. | |
14653 | (goto-char (point-max)) | |
14654 | (insert "\n") | |
231f989b | 14655 | (append-to-file (point-min) (point-max) file-name)))) |
745bc783 JB |
14656 | |
14657 | (defun gnus-convert-article-to-rmail () | |
14658 | "Convert article in current buffer to Rmail message format." | |
14659 | (let ((buffer-read-only nil)) | |
14660 | ;; Convert article directly into Babyl format. | |
14661 | ;; Suggested by Rob Austein <sra@lcs.mit.edu> | |
14662 | (goto-char (point-min)) | |
14663 | (insert "\^L\n0, unseen,,\n*** EOOH ***\n") | |
14664 | (while (search-forward "\n\^_" nil t) ;single char | |
41487370 | 14665 | (replace-match "\n^_" t t)) ;2 chars: "^" and "_" |
745bc783 JB |
14666 | (goto-char (point-max)) |
14667 | (insert "\^_"))) | |
14668 | ||
41487370 | 14669 | (defun gnus-narrow-to-page (&optional arg) |
231f989b LMI |
14670 | "Narrow the article buffer to a page. |
14671 | If given a numerical ARG, move forward ARG pages." | |
41487370 LMI |
14672 | (interactive "P") |
14673 | (setq arg (if arg (prefix-numeric-value arg) 0)) | |
14674 | (save-excursion | |
231f989b LMI |
14675 | (set-buffer gnus-article-buffer) |
14676 | (goto-char (point-min)) | |
41487370 | 14677 | (widen) |
231f989b LMI |
14678 | (when (gnus-visual-p 'page-marker) |
14679 | (let ((buffer-read-only nil)) | |
14680 | (gnus-remove-text-with-property 'gnus-prev) | |
14681 | (gnus-remove-text-with-property 'gnus-next))) | |
14682 | (when | |
14683 | (cond ((< arg 0) | |
14684 | (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) | |
14685 | ((> arg 0) | |
14686 | (re-search-forward page-delimiter nil 'move arg))) | |
14687 | (goto-char (match-end 0))) | |
14688 | (narrow-to-region | |
14689 | (point) | |
14690 | (if (re-search-forward page-delimiter nil 'move) | |
14691 | (match-beginning 0) | |
14692 | (point))) | |
14693 | (when (and (gnus-visual-p 'page-marker) | |
14694 | (not (= (point-min) 1))) | |
14695 | (save-excursion | |
14696 | (goto-char (point-min)) | |
14697 | (gnus-insert-prev-page-button))) | |
14698 | (when (and (gnus-visual-p 'page-marker) | |
14699 | (not (= (1- (point-max)) (buffer-size)))) | |
14700 | (save-excursion | |
14701 | (goto-char (point-max)) | |
14702 | (gnus-insert-next-page-button))))) | |
745bc783 | 14703 | |
41487370 | 14704 | ;; Article mode commands |
745bc783 | 14705 | |
231f989b LMI |
14706 | (defun gnus-article-goto-next-page () |
14707 | "Show the next page of the article." | |
14708 | (interactive) | |
14709 | (when (gnus-article-next-page) | |
14710 | (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) | |
14711 | ||
14712 | (defun gnus-article-goto-prev-page () | |
14713 | "Show the next page of the article." | |
14714 | (interactive) | |
14715 | (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)) | |
14716 | (gnus-article-prev-page nil))) | |
14717 | ||
41487370 | 14718 | (defun gnus-article-next-page (&optional lines) |
231f989b LMI |
14719 | "Show the next page of the current article. |
14720 | If end of article, return non-nil. Otherwise return nil. | |
41487370 | 14721 | Argument LINES specifies lines to be scrolled up." |
231f989b | 14722 | (interactive "p") |
41487370 LMI |
14723 | (move-to-window-line -1) |
14724 | ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) | |
14725 | (if (save-excursion | |
14726 | (end-of-line) | |
14727 | (and (pos-visible-in-window-p) ;Not continuation line. | |
14728 | (eobp))) | |
14729 | ;; Nothing in this page. | |
14730 | (if (or (not gnus-break-pages) | |
14731 | (save-excursion | |
14732 | (save-restriction | |
14733 | (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? | |
14734 | t ;Nothing more. | |
14735 | (gnus-narrow-to-page 1) ;Go to next page. | |
14736 | nil) | |
14737 | ;; More in this page. | |
14738 | (condition-case () | |
14739 | (scroll-up lines) | |
14740 | (end-of-buffer | |
14741 | ;; Long lines may cause an end-of-buffer error. | |
14742 | (goto-char (point-max)))) | |
231f989b | 14743 | (move-to-window-line 0) |
41487370 | 14744 | nil)) |
b027f415 | 14745 | |
41487370 LMI |
14746 | (defun gnus-article-prev-page (&optional lines) |
14747 | "Show previous page of current article. | |
14748 | Argument LINES specifies lines to be scrolled down." | |
231f989b | 14749 | (interactive "p") |
41487370 LMI |
14750 | (move-to-window-line 0) |
14751 | (if (and gnus-break-pages | |
14752 | (bobp) | |
14753 | (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? | |
14754 | (progn | |
14755 | (gnus-narrow-to-page -1) ;Go to previous page. | |
14756 | (goto-char (point-max)) | |
14757 | (recenter -1)) | |
231f989b LMI |
14758 | (prog1 |
14759 | (condition-case () | |
14760 | (scroll-down lines) | |
14761 | (error nil)) | |
14762 | (move-to-window-line 0)))) | |
745bc783 | 14763 | |
41487370 LMI |
14764 | (defun gnus-article-refer-article () |
14765 | "Read article specified by message-id around point." | |
14766 | (interactive) | |
231f989b LMI |
14767 | (let ((point (point))) |
14768 | (search-forward ">" nil t) ;Move point to end of "<....>". | |
14769 | (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) | |
14770 | (let ((message-id (match-string 1))) | |
14771 | (goto-char point) | |
14772 | (set-buffer gnus-summary-buffer) | |
14773 | (gnus-summary-refer-article message-id)) | |
14774 | (goto-char (point)) | |
14775 | (error "No references around point")))) | |
745bc783 | 14776 | |
41487370 LMI |
14777 | (defun gnus-article-show-summary () |
14778 | "Reconfigure windows to show summary buffer." | |
14779 | (interactive) | |
14780 | (gnus-configure-windows 'article) | |
14781 | (gnus-summary-goto-subject gnus-current-article)) | |
745bc783 | 14782 | |
41487370 LMI |
14783 | (defun gnus-article-describe-briefly () |
14784 | "Describe article mode commands briefly." | |
745bc783 | 14785 | (interactive) |
41487370 | 14786 | (gnus-message 6 |
564b670b | 14787 | (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) |
745bc783 | 14788 | |
41487370 LMI |
14789 | (defun gnus-article-summary-command () |
14790 | "Execute the last keystroke in the summary buffer." | |
745bc783 | 14791 | (interactive) |
41487370 LMI |
14792 | (let ((obuf (current-buffer)) |
14793 | (owin (current-window-configuration)) | |
14794 | func) | |
14795 | (switch-to-buffer gnus-summary-buffer 'norecord) | |
14796 | (setq func (lookup-key (current-local-map) (this-command-keys))) | |
14797 | (call-interactively func) | |
14798 | (set-buffer obuf) | |
14799 | (set-window-configuration owin) | |
14800 | (set-window-point (get-buffer-window (current-buffer)) (point)))) | |
14801 | ||
14802 | (defun gnus-article-summary-command-nosave () | |
14803 | "Execute the last keystroke in the summary buffer." | |
14804 | (interactive) | |
14805 | (let (func) | |
14806 | (pop-to-buffer gnus-summary-buffer 'norecord) | |
14807 | (setq func (lookup-key (current-local-map) (this-command-keys))) | |
14808 | (call-interactively func))) | |
745bc783 | 14809 | |
231f989b LMI |
14810 | (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) |
14811 | "Read a summary buffer key sequence and execute it from the article buffer." | |
14812 | (interactive "P") | |
14813 | (let ((nosaves | |
14814 | '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" | |
14815 | "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" | |
14816 | "=" "^" "\M-^" "|")) | |
564b670b LMI |
14817 | (nosave-but-article |
14818 | '("A\r")) | |
231f989b LMI |
14819 | keys) |
14820 | (save-excursion | |
14821 | (set-buffer gnus-summary-buffer) | |
14822 | (push (or key last-command-event) unread-command-events) | |
14823 | (setq keys (read-key-sequence nil))) | |
14824 | (message "") | |
14825 | ||
564b670b LMI |
14826 | (if (or (member keys nosaves) |
14827 | (member keys nosave-but-article)) | |
231f989b | 14828 | (let (func) |
564b670b LMI |
14829 | (save-window-excursion |
14830 | (pop-to-buffer gnus-summary-buffer 'norecord) | |
14831 | (setq func (lookup-key (current-local-map) keys))) | |
14832 | (if (not func) | |
14833 | (ding) | |
14834 | (set-buffer gnus-summary-buffer) | |
14835 | (call-interactively func)) | |
14836 | (when (member keys nosave-but-article) | |
14837 | (pop-to-buffer gnus-article-buffer 'norecord))) | |
231f989b LMI |
14838 | (let ((obuf (current-buffer)) |
14839 | (owin (current-window-configuration)) | |
14840 | (opoint (point)) | |
14841 | func in-buffer) | |
14842 | (if not-restore-window | |
14843 | (pop-to-buffer gnus-summary-buffer 'norecord) | |
14844 | (switch-to-buffer gnus-summary-buffer 'norecord)) | |
14845 | (setq in-buffer (current-buffer)) | |
14846 | (if (setq func (lookup-key (current-local-map) keys)) | |
14847 | (call-interactively func) | |
14848 | (ding)) | |
14849 | (when (eq in-buffer (current-buffer)) | |
14850 | (set-buffer obuf) | |
14851 | (unless not-restore-window | |
14852 | (set-window-configuration owin)) | |
14853 | (set-window-point (get-buffer-window (current-buffer)) opoint)))))) | |
14854 | ||
41487370 | 14855 | \f |
231f989b LMI |
14856 | ;;; |
14857 | ;;; Kill file handling. | |
14858 | ;;; | |
41487370 LMI |
14859 | |
14860 | ;;;###autoload | |
14861 | (defalias 'gnus-batch-kill 'gnus-batch-score) | |
14862 | ;;;###autoload | |
14863 | (defun gnus-batch-score () | |
14864 | "Run batched scoring. | |
14865 | Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ... | |
14866 | Newsgroups is a list of strings in Bnews format. If you want to score | |
231f989b | 14867 | the comp hierarchy, you'd say \"comp.all\". If you would not like to |
41487370 LMI |
14868 | score the alt hierarchy, you'd say \"!alt.all\"." |
14869 | (interactive) | |
14870 | (let* ((yes-and-no | |
14871 | (gnus-newsrc-parse-options | |
14872 | (apply (function concat) | |
14873 | (mapcar (lambda (g) (concat g " ")) | |
14874 | command-line-args-left)))) | |
14875 | (gnus-expert-user t) | |
14876 | (nnmail-spool-file nil) | |
14877 | (gnus-use-dribble-file nil) | |
14878 | (yes (car yes-and-no)) | |
14879 | (no (cdr yes-and-no)) | |
14880 | group newsrc entry | |
14881 | ;; Disable verbose message. | |
14882 | gnus-novice-user gnus-large-newsgroup) | |
14883 | ;; Eat all arguments. | |
14884 | (setq command-line-args-left nil) | |
14885 | ;; Start Gnus. | |
14886 | (gnus) | |
14887 | ;; Apply kills to specified newsgroups in command line arguments. | |
14888 | (setq newsrc (cdr gnus-newsrc-alist)) | |
14889 | (while newsrc | |
231f989b | 14890 | (setq group (caar newsrc)) |
41487370 LMI |
14891 | (setq entry (gnus-gethash group gnus-newsrc-hashtb)) |
14892 | (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) | |
14893 | (and (car entry) | |
14894 | (or (eq (car entry) t) | |
14895 | (not (zerop (car entry))))) | |
14896 | (if yes (string-match yes group) t) | |
14897 | (or (null no) (not (string-match no group)))) | |
745bc783 | 14898 | (progn |
231f989b | 14899 | (gnus-summary-read-group group nil t nil t) |
41487370 LMI |
14900 | (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) |
14901 | (gnus-summary-exit)))) | |
14902 | (setq newsrc (cdr newsrc))) | |
14903 | ;; Exit Emacs. | |
14904 | (switch-to-buffer gnus-group-buffer) | |
14905 | (gnus-group-save-newsrc))) | |
745bc783 | 14906 | |
41487370 LMI |
14907 | (defun gnus-apply-kill-file () |
14908 | "Apply a kill file to the current newsgroup. | |
14909 | Returns the number of articles marked as read." | |
14910 | (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) | |
14911 | (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) | |
14912 | (gnus-apply-kill-file-internal) | |
14913 | 0)) | |
14914 | ||
14915 | (defun gnus-kill-save-kill-buffer () | |
231f989b LMI |
14916 | (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) |
14917 | (when (get-file-buffer file) | |
14918 | (save-excursion | |
14919 | (set-buffer (get-file-buffer file)) | |
14920 | (and (buffer-modified-p) (save-buffer)) | |
14921 | (kill-buffer (current-buffer)))))) | |
745bc783 | 14922 | |
41487370 LMI |
14923 | (defvar gnus-kill-file-name "KILL" |
14924 | "Suffix of the kill files.") | |
b027f415 | 14925 | |
41487370 LMI |
14926 | (defun gnus-newsgroup-kill-file (newsgroup) |
14927 | "Return the name of a kill file name for NEWSGROUP. | |
14928 | If NEWSGROUP is nil, return the global kill file name instead." | |
231f989b LMI |
14929 | (cond |
14930 | ;; The global KILL file is placed at top of the directory. | |
14931 | ((or (null newsgroup) | |
14932 | (string-equal newsgroup "")) | |
14933 | (expand-file-name gnus-kill-file-name | |
14934 | gnus-kill-files-directory)) | |
14935 | ;; Append ".KILL" to newsgroup name. | |
14936 | ((gnus-use-long-file-name 'not-kill) | |
14937 | (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) | |
14938 | "." gnus-kill-file-name) | |
14939 | gnus-kill-files-directory)) | |
14940 | ;; Place "KILL" under the hierarchical directory. | |
14941 | (t | |
14942 | (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) | |
14943 | "/" gnus-kill-file-name) | |
14944 | gnus-kill-files-directory)))) | |
b027f415 | 14945 | |
41487370 LMI |
14946 | \f |
14947 | ;;; | |
14948 | ;;; Dribble file | |
14949 | ;;; | |
745bc783 | 14950 | |
41487370 LMI |
14951 | (defvar gnus-dribble-ignore nil) |
14952 | (defvar gnus-dribble-eval-file nil) | |
14953 | ||
14954 | (defun gnus-dribble-file-name () | |
231f989b LMI |
14955 | "Return the dribble file for the current .newsrc." |
14956 | (concat | |
14957 | (if gnus-dribble-directory | |
14958 | (concat (file-name-as-directory gnus-dribble-directory) | |
14959 | (file-name-nondirectory gnus-current-startup-file)) | |
14960 | gnus-current-startup-file) | |
14961 | "-dribble")) | |
41487370 LMI |
14962 | |
14963 | (defun gnus-dribble-enter (string) | |
231f989b | 14964 | "Enter STRING into the dribble buffer." |
41487370 LMI |
14965 | (if (and (not gnus-dribble-ignore) |
14966 | gnus-dribble-buffer | |
14967 | (buffer-name gnus-dribble-buffer)) | |
14968 | (let ((obuf (current-buffer))) | |
14969 | (set-buffer gnus-dribble-buffer) | |
14970 | (insert string "\n") | |
14971 | (set-window-point (get-buffer-window (current-buffer)) (point-max)) | |
564b670b | 14972 | (bury-buffer gnus-dribble-buffer) |
41487370 LMI |
14973 | (set-buffer obuf)))) |
14974 | ||
14975 | (defun gnus-dribble-read-file () | |
231f989b | 14976 | "Read the dribble file from disk." |
41487370 | 14977 | (let ((dribble-file (gnus-dribble-file-name))) |
231f989b LMI |
14978 | (save-excursion |
14979 | (set-buffer (setq gnus-dribble-buffer | |
14980 | (get-buffer-create | |
41487370 LMI |
14981 | (file-name-nondirectory dribble-file)))) |
14982 | (gnus-add-current-to-buffer-list) | |
14983 | (erase-buffer) | |
231f989b LMI |
14984 | (setq buffer-file-name dribble-file) |
14985 | (auto-save-mode t) | |
41487370 LMI |
14986 | (buffer-disable-undo (current-buffer)) |
14987 | (bury-buffer (current-buffer)) | |
14988 | (set-buffer-modified-p nil) | |
14989 | (let ((auto (make-auto-save-file-name)) | |
231f989b LMI |
14990 | (gnus-dribble-ignore t) |
14991 | modes) | |
14992 | (when (or (file-exists-p auto) (file-exists-p dribble-file)) | |
14993 | ;; Load whichever file is newest -- the auto save file | |
14994 | ;; or the "real" file. | |
14995 | (if (file-newer-than-file-p auto dribble-file) | |
14996 | (insert-file-contents auto) | |
14997 | (insert-file-contents dribble-file)) | |
14998 | (unless (zerop (buffer-size)) | |
14999 | (set-buffer-modified-p t)) | |
15000 | ;; Set the file modes to reflect the .newsrc file modes. | |
15001 | (save-buffer) | |
15002 | (when (and (file-exists-p gnus-current-startup-file) | |
15003 | (setq modes (file-modes gnus-current-startup-file))) | |
15004 | (set-file-modes dribble-file modes)) | |
15005 | ;; Possibly eval the file later. | |
15006 | (when (gnus-y-or-n-p | |
15007 | "Auto-save file exists. Do you want to read it? ") | |
15008 | (setq gnus-dribble-eval-file t))))))) | |
41487370 LMI |
15009 | |
15010 | (defun gnus-dribble-eval-file () | |
231f989b | 15011 | (when gnus-dribble-eval-file |
41487370 LMI |
15012 | (setq gnus-dribble-eval-file nil) |
15013 | (save-excursion | |
15014 | (let ((gnus-dribble-ignore t)) | |
15015 | (set-buffer gnus-dribble-buffer) | |
15016 | (eval-buffer (current-buffer)))))) | |
15017 | ||
15018 | (defun gnus-dribble-delete-file () | |
231f989b LMI |
15019 | (when (file-exists-p (gnus-dribble-file-name)) |
15020 | (delete-file (gnus-dribble-file-name))) | |
15021 | (when gnus-dribble-buffer | |
15022 | (save-excursion | |
15023 | (set-buffer gnus-dribble-buffer) | |
15024 | (let ((auto (make-auto-save-file-name))) | |
15025 | (if (file-exists-p auto) | |
15026 | (delete-file auto)) | |
15027 | (erase-buffer) | |
15028 | (set-buffer-modified-p nil))))) | |
41487370 LMI |
15029 | |
15030 | (defun gnus-dribble-save () | |
231f989b LMI |
15031 | (when (and gnus-dribble-buffer |
15032 | (buffer-name gnus-dribble-buffer)) | |
15033 | (save-excursion | |
15034 | (set-buffer gnus-dribble-buffer) | |
15035 | (save-buffer)))) | |
745bc783 | 15036 | |
41487370 | 15037 | (defun gnus-dribble-clear () |
231f989b LMI |
15038 | (when (gnus-buffer-exists-p gnus-dribble-buffer) |
15039 | (save-excursion | |
15040 | (set-buffer gnus-dribble-buffer) | |
15041 | (erase-buffer) | |
15042 | (set-buffer-modified-p nil) | |
15043 | (setq buffer-saved-size (buffer-size))))) | |
745bc783 | 15044 | |
231f989b | 15045 | \f |
745bc783 | 15046 | ;;; |
41487370 | 15047 | ;;; Server Communication |
745bc783 JB |
15048 | ;;; |
15049 | ||
41487370 LMI |
15050 | (defun gnus-start-news-server (&optional confirm) |
15051 | "Open a method for getting news. | |
15052 | If CONFIRM is non-nil, the user will be asked for an NNTP server." | |
15053 | (let (how) | |
15054 | (if gnus-current-select-method | |
15055 | ;; Stream is already opened. | |
15056 | nil | |
15057 | ;; Open NNTP server. | |
15058 | (if (null gnus-nntp-service) (setq gnus-nntp-server nil)) | |
15059 | (if confirm | |
15060 | (progn | |
15061 | ;; Read server name with completion. | |
15062 | (setq gnus-nntp-server | |
15063 | (completing-read "NNTP server: " | |
15064 | (mapcar (lambda (server) (list server)) | |
15065 | (cons (list gnus-nntp-server) | |
15066 | gnus-secondary-servers)) | |
15067 | nil nil gnus-nntp-server)))) | |
15068 | ||
231f989b | 15069 | (if (and gnus-nntp-server |
41487370 LMI |
15070 | (stringp gnus-nntp-server) |
15071 | (not (string= gnus-nntp-server ""))) | |
15072 | (setq gnus-select-method | |
15073 | (cond ((or (string= gnus-nntp-server "") | |
15074 | (string= gnus-nntp-server "::")) | |
15075 | (list 'nnspool (system-name))) | |
15076 | ((string-match "^:" gnus-nntp-server) | |
231f989b LMI |
15077 | (list 'nnmh gnus-nntp-server |
15078 | (list 'nnmh-directory | |
41487370 LMI |
15079 | (file-name-as-directory |
15080 | (expand-file-name | |
15081 | (concat "~/" (substring | |
15082 | gnus-nntp-server 1))))) | |
15083 | (list 'nnmh-get-new-mail nil))) | |
15084 | (t | |
15085 | (list 'nntp gnus-nntp-server))))) | |
15086 | ||
15087 | (setq how (car gnus-select-method)) | |
15088 | (cond ((eq how 'nnspool) | |
15089 | (require 'nnspool) | |
15090 | (gnus-message 5 "Looking up local news spool...")) | |
15091 | ((eq how 'nnmh) | |
15092 | (require 'nnmh) | |
15093 | (gnus-message 5 "Looking up mh spool...")) | |
15094 | (t | |
15095 | (require 'nntp))) | |
15096 | (setq gnus-current-select-method gnus-select-method) | |
15097 | (run-hooks 'gnus-open-server-hook) | |
231f989b | 15098 | (or |
41487370 | 15099 | ;; gnus-open-server-hook might have opened it |
231f989b | 15100 | (gnus-server-opened gnus-select-method) |
41487370 LMI |
15101 | (gnus-open-server gnus-select-method) |
15102 | (gnus-y-or-n-p | |
15103 | (format | |
231f989b LMI |
15104 | "%s (%s) open error: '%s'. Continue? " |
15105 | (car gnus-select-method) (cadr gnus-select-method) | |
41487370 | 15106 | (gnus-status-message gnus-select-method))) |
231f989b LMI |
15107 | (gnus-error 1 "Couldn't open server on %s" |
15108 | (nth 1 gnus-select-method)))))) | |
15109 | ||
15110 | (defun gnus-check-group (group) | |
15111 | "Try to make sure that the server where GROUP exists is alive." | |
15112 | (let ((method (gnus-find-method-for-group group))) | |
15113 | (or (gnus-server-opened method) | |
15114 | (gnus-open-server method)))) | |
15115 | ||
15116 | (defun gnus-check-server (&optional method silent) | |
15117 | "Check whether the connection to METHOD is down. | |
15118 | If METHOD is nil, use `gnus-select-method'. | |
15119 | If it is down, start it up (again)." | |
15120 | (let ((method (or method gnus-select-method))) | |
15121 | ;; Transform virtual server names into select methods. | |
15122 | (when (stringp method) | |
15123 | (setq method (gnus-server-to-method method))) | |
41487370 | 15124 | (if (gnus-server-opened method) |
231f989b | 15125 | ;; The stream is already opened. |
41487370 | 15126 | t |
231f989b LMI |
15127 | ;; Open the server. |
15128 | (unless silent | |
15129 | (gnus-message 5 "Opening %s server%s..." (car method) | |
15130 | (if (equal (nth 1 method) "") "" | |
15131 | (format " on %s" (nth 1 method))))) | |
41487370 LMI |
15132 | (run-hooks 'gnus-open-server-hook) |
15133 | (prog1 | |
15134 | (gnus-open-server method) | |
231f989b LMI |
15135 | (unless silent |
15136 | (message "")))))) | |
15137 | ||
15138 | (defun gnus-get-function (method function &optional noerror) | |
15139 | "Return a function symbol based on METHOD and FUNCTION." | |
15140 | ;; Translate server names into methods. | |
15141 | (unless method | |
15142 | (error "Attempted use of a nil select method")) | |
15143 | (when (stringp method) | |
15144 | (setq method (gnus-server-to-method method))) | |
41487370 | 15145 | (let ((func (intern (format "%s-%s" (car method) function)))) |
231f989b LMI |
15146 | ;; If the functions isn't bound, we require the backend in |
15147 | ;; question. | |
15148 | (unless (fboundp func) | |
15149 | (require (car method)) | |
15150 | (when (and (not (fboundp func)) | |
15151 | (not noerror)) | |
15152 | ;; This backend doesn't implement this function. | |
15153 | (error "No such function: %s" func))) | |
41487370 LMI |
15154 | func)) |
15155 | ||
231f989b LMI |
15156 | \f |
15157 | ;;; | |
41487370 | 15158 | ;;; Interface functions to the backends. |
231f989b | 15159 | ;;; |
41487370 LMI |
15160 | |
15161 | (defun gnus-open-server (method) | |
231f989b LMI |
15162 | "Open a connection to METHOD." |
15163 | (when (stringp method) | |
15164 | (setq method (gnus-server-to-method method))) | |
15165 | (let ((elem (assoc method gnus-opened-servers))) | |
15166 | ;; If this method was previously denied, we just return nil. | |
15167 | (if (eq (nth 1 elem) 'denied) | |
15168 | (progn | |
15169 | (gnus-message 1 "Denied server") | |
15170 | nil) | |
15171 | ;; Open the server. | |
15172 | (let ((result | |
15173 | (funcall (gnus-get-function method 'open-server) | |
15174 | (nth 1 method) (nthcdr 2 method)))) | |
15175 | ;; If this hasn't been opened before, we add it to the list. | |
15176 | (unless elem | |
15177 | (setq elem (list method nil) | |
15178 | gnus-opened-servers (cons elem gnus-opened-servers))) | |
15179 | ;; Set the status of this server. | |
15180 | (setcar (cdr elem) (if result 'ok 'denied)) | |
15181 | ;; Return the result from the "open" call. | |
15182 | result)))) | |
41487370 LMI |
15183 | |
15184 | (defun gnus-close-server (method) | |
231f989b LMI |
15185 | "Close the connection to METHOD." |
15186 | (when (stringp method) | |
15187 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15188 | (funcall (gnus-get-function method 'close-server) (nth 1 method))) |
15189 | ||
15190 | (defun gnus-request-list (method) | |
231f989b LMI |
15191 | "Request the active file from METHOD." |
15192 | (when (stringp method) | |
15193 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15194 | (funcall (gnus-get-function method 'request-list) (nth 1 method))) |
15195 | ||
15196 | (defun gnus-request-list-newsgroups (method) | |
231f989b LMI |
15197 | "Request the newsgroups file from METHOD." |
15198 | (when (stringp method) | |
15199 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15200 | (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) |
15201 | ||
15202 | (defun gnus-request-newgroups (date method) | |
231f989b LMI |
15203 | "Request all new groups since DATE from METHOD." |
15204 | (when (stringp method) | |
15205 | (setq method (gnus-server-to-method method))) | |
15206 | (funcall (gnus-get-function method 'request-newgroups) | |
41487370 LMI |
15207 | date (nth 1 method))) |
15208 | ||
15209 | (defun gnus-server-opened (method) | |
231f989b LMI |
15210 | "Check whether a connection to METHOD has been opened." |
15211 | (when (stringp method) | |
15212 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15213 | (funcall (gnus-get-function method 'server-opened) (nth 1 method))) |
15214 | ||
15215 | (defun gnus-status-message (method) | |
231f989b LMI |
15216 | "Return the status message from METHOD. |
15217 | If METHOD is a string, it is interpreted as a group name. The method | |
15218 | this group uses will be queried." | |
41487370 LMI |
15219 | (let ((method (if (stringp method) (gnus-find-method-for-group method) |
15220 | method))) | |
15221 | (funcall (gnus-get-function method 'status-message) (nth 1 method)))) | |
15222 | ||
231f989b LMI |
15223 | (defun gnus-request-group (group &optional dont-check method) |
15224 | "Request GROUP. If DONT-CHECK, no information is required." | |
15225 | (let ((method (or method (gnus-find-method-for-group group)))) | |
15226 | (when (stringp method) | |
15227 | (setq method (gnus-server-to-method method))) | |
15228 | (funcall (gnus-get-function method 'request-group) | |
41487370 LMI |
15229 | (gnus-group-real-name group) (nth 1 method) dont-check))) |
15230 | ||
15231 | (defun gnus-request-asynchronous (group &optional articles) | |
231f989b LMI |
15232 | "Request that GROUP behave asynchronously. |
15233 | ARTICLES is the `data' of the group." | |
41487370 | 15234 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15235 | (funcall (gnus-get-function method 'request-asynchronous) |
41487370 LMI |
15236 | (gnus-group-real-name group) (nth 1 method) articles))) |
15237 | ||
15238 | (defun gnus-list-active-group (group) | |
231f989b | 15239 | "Request active information on GROUP." |
41487370 LMI |
15240 | (let ((method (gnus-find-method-for-group group)) |
15241 | (func 'list-active-group)) | |
231f989b LMI |
15242 | (when (gnus-check-backend-function func group) |
15243 | (funcall (gnus-get-function method func) | |
15244 | (gnus-group-real-name group) (nth 1 method))))) | |
41487370 LMI |
15245 | |
15246 | (defun gnus-request-group-description (group) | |
231f989b | 15247 | "Request a description of GROUP." |
41487370 LMI |
15248 | (let ((method (gnus-find-method-for-group group)) |
15249 | (func 'request-group-description)) | |
231f989b LMI |
15250 | (when (gnus-check-backend-function func group) |
15251 | (funcall (gnus-get-function method func) | |
15252 | (gnus-group-real-name group) (nth 1 method))))) | |
41487370 LMI |
15253 | |
15254 | (defun gnus-close-group (group) | |
231f989b | 15255 | "Request the GROUP be closed." |
41487370 | 15256 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15257 | (funcall (gnus-get-function method 'close-group) |
41487370 LMI |
15258 | (gnus-group-real-name group) (nth 1 method)))) |
15259 | ||
231f989b LMI |
15260 | (defun gnus-retrieve-headers (articles group &optional fetch-old) |
15261 | "Request headers for ARTICLES in GROUP. | |
15262 | If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." | |
41487370 LMI |
15263 | (let ((method (gnus-find-method-for-group group))) |
15264 | (if (and gnus-use-cache (numberp (car articles))) | |
231f989b LMI |
15265 | (gnus-cache-retrieve-headers articles group fetch-old) |
15266 | (funcall (gnus-get-function method 'retrieve-headers) | |
15267 | articles (gnus-group-real-name group) (nth 1 method) | |
15268 | fetch-old)))) | |
41487370 LMI |
15269 | |
15270 | (defun gnus-retrieve-groups (groups method) | |
231f989b LMI |
15271 | "Request active information on GROUPS from METHOD." |
15272 | (when (stringp method) | |
15273 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15274 | (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) |
15275 | ||
231f989b LMI |
15276 | (defun gnus-request-type (group &optional article) |
15277 | "Return the type (`post' or `mail') of GROUP (and ARTICLE)." | |
15278 | (let ((method (gnus-find-method-for-group group))) | |
15279 | (if (not (gnus-check-backend-function 'request-type (car method))) | |
15280 | 'unknown | |
15281 | (funcall (gnus-get-function method 'request-type) | |
15282 | (gnus-group-real-name group) article)))) | |
15283 | ||
15284 | (defun gnus-request-update-mark (group article mark) | |
15285 | "Return the type (`post' or `mail') of GROUP (and ARTICLE)." | |
15286 | (let ((method (gnus-find-method-for-group group))) | |
15287 | (if (not (gnus-check-backend-function 'request-update-mark (car method))) | |
15288 | mark | |
15289 | (funcall (gnus-get-function method 'request-update-mark) | |
15290 | (gnus-group-real-name group) article mark)))) | |
15291 | ||
41487370 | 15292 | (defun gnus-request-article (article group &optional buffer) |
231f989b LMI |
15293 | "Request the ARTICLE in GROUP. |
15294 | ARTICLE can either be an article number or an article Message-ID. | |
15295 | If BUFFER, insert the article in that group." | |
41487370 | 15296 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15297 | (funcall (gnus-get-function method 'request-article) |
41487370 LMI |
15298 | article (gnus-group-real-name group) (nth 1 method) buffer))) |
15299 | ||
15300 | (defun gnus-request-head (article group) | |
231f989b LMI |
15301 | "Request the head of ARTICLE in GROUP." |
15302 | (let* ((method (gnus-find-method-for-group group)) | |
15303 | (head (gnus-get-function method 'request-head t))) | |
15304 | (if (fboundp head) | |
15305 | (funcall head article (gnus-group-real-name group) (nth 1 method)) | |
15306 | (let ((res (gnus-request-article article group))) | |
15307 | (when res | |
15308 | (save-excursion | |
15309 | (set-buffer nntp-server-buffer) | |
15310 | (goto-char (point-min)) | |
15311 | (when (search-forward "\n\n" nil t) | |
15312 | (delete-region (1- (point)) (point-max))) | |
15313 | (nnheader-fold-continuation-lines))) | |
15314 | res)))) | |
41487370 LMI |
15315 | |
15316 | (defun gnus-request-body (article group) | |
231f989b | 15317 | "Request the body of ARTICLE in GROUP." |
41487370 | 15318 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15319 | (funcall (gnus-get-function method 'request-body) |
41487370 LMI |
15320 | article (gnus-group-real-name group) (nth 1 method)))) |
15321 | ||
231f989b LMI |
15322 | (defun gnus-request-post (method) |
15323 | "Post the current buffer using METHOD." | |
15324 | (when (stringp method) | |
15325 | (setq method (gnus-server-to-method method))) | |
15326 | (funcall (gnus-get-function method 'request-post) (nth 1 method))) | |
15327 | ||
15328 | (defun gnus-request-scan (group method) | |
15329 | "Request a SCAN being performed in GROUP from METHOD. | |
15330 | If GROUP is nil, all groups on METHOD are scanned." | |
15331 | (let ((method (if group (gnus-find-method-for-group group) method))) | |
15332 | (funcall (gnus-get-function method 'request-scan) | |
15333 | (and group (gnus-group-real-name group)) (nth 1 method)))) | |
15334 | ||
15335 | (defsubst gnus-request-update-info (info method) | |
15336 | "Request that METHOD update INFO." | |
15337 | (when (stringp method) | |
15338 | (setq method (gnus-server-to-method method))) | |
15339 | (when (gnus-check-backend-function 'request-update-info (car method)) | |
15340 | (funcall (gnus-get-function method 'request-update-info) | |
15341 | (gnus-group-real-name (gnus-info-group info)) | |
15342 | info (nth 1 method)))) | |
41487370 LMI |
15343 | |
15344 | (defun gnus-request-expire-articles (articles group &optional force) | |
15345 | (let ((method (gnus-find-method-for-group group))) | |
231f989b | 15346 | (funcall (gnus-get-function method 'request-expire-articles) |
41487370 LMI |
15347 | articles (gnus-group-real-name group) (nth 1 method) |
15348 | force))) | |
15349 | ||
231f989b | 15350 | (defun gnus-request-move-article |
41487370 LMI |
15351 | (article group server accept-function &optional last) |
15352 | (let ((method (gnus-find-method-for-group group))) | |
231f989b LMI |
15353 | (funcall (gnus-get-function method 'request-move-article) |
15354 | article (gnus-group-real-name group) | |
41487370 LMI |
15355 | (nth 1 method) accept-function last))) |
15356 | ||
231f989b LMI |
15357 | (defun gnus-request-accept-article (group method &optional last) |
15358 | ;; Make sure there's a newline at the end of the article. | |
15359 | (when (stringp method) | |
15360 | (setq method (gnus-server-to-method method))) | |
15361 | (when (and (not method) | |
15362 | (stringp group)) | |
15363 | (setq method (gnus-group-name-to-method group))) | |
fc103e78 | 15364 | (goto-char (point-max)) |
231f989b LMI |
15365 | (unless (bolp) |
15366 | (insert "\n")) | |
15367 | (let ((func (car (or method (gnus-find-method-for-group group))))) | |
41487370 LMI |
15368 | (funcall (intern (format "%s-request-accept-article" func)) |
15369 | (if (stringp group) (gnus-group-real-name group) group) | |
231f989b | 15370 | (cadr method) |
41487370 LMI |
15371 | last))) |
15372 | ||
15373 | (defun gnus-request-replace-article (article group buffer) | |
15374 | (let ((func (car (gnus-find-method-for-group group)))) | |
15375 | (funcall (intern (format "%s-request-replace-article" func)) | |
15376 | article (gnus-group-real-name group) buffer))) | |
15377 | ||
231f989b LMI |
15378 | (defun gnus-request-associate-buffer (group) |
15379 | (let ((method (gnus-find-method-for-group group))) | |
15380 | (funcall (gnus-get-function method 'request-associate-buffer) | |
15381 | (gnus-group-real-name group)))) | |
15382 | ||
15383 | (defun gnus-request-restore-buffer (article group) | |
15384 | "Request a new buffer restored to the state of ARTICLE." | |
41487370 | 15385 | (let ((method (gnus-find-method-for-group group))) |
231f989b LMI |
15386 | (funcall (gnus-get-function method 'request-restore-buffer) |
15387 | article (gnus-group-real-name group) (nth 1 method)))) | |
15388 | ||
15389 | (defun gnus-request-create-group (group &optional method) | |
15390 | (when (stringp method) | |
15391 | (setq method (gnus-server-to-method method))) | |
15392 | (let ((method (or method (gnus-find-method-for-group group)))) | |
15393 | (funcall (gnus-get-function method 'request-create-group) | |
41487370 LMI |
15394 | (gnus-group-real-name group) (nth 1 method)))) |
15395 | ||
231f989b LMI |
15396 | (defun gnus-request-delete-group (group &optional force) |
15397 | (let ((method (gnus-find-method-for-group group))) | |
15398 | (funcall (gnus-get-function method 'request-delete-group) | |
15399 | (gnus-group-real-name group) force (nth 1 method)))) | |
15400 | ||
15401 | (defun gnus-request-rename-group (group new-name) | |
15402 | (let ((method (gnus-find-method-for-group group))) | |
15403 | (funcall (gnus-get-function method 'request-rename-group) | |
15404 | (gnus-group-real-name group) | |
15405 | (gnus-group-real-name new-name) (nth 1 method)))) | |
15406 | ||
41487370 | 15407 | (defun gnus-member-of-valid (symbol group) |
231f989b | 15408 | "Find out if GROUP has SYMBOL as part of its \"valid\" spec." |
41487370 | 15409 | (memq symbol (assoc |
231f989b | 15410 | (symbol-name (car (gnus-find-method-for-group group))) |
41487370 LMI |
15411 | gnus-valid-select-methods))) |
15412 | ||
231f989b LMI |
15413 | (defun gnus-method-option-p (method option) |
15414 | "Return non-nil if select METHOD has OPTION as a parameter." | |
15415 | (when (stringp method) | |
15416 | (setq method (gnus-server-to-method method))) | |
15417 | (memq option (assoc (format "%s" (car method)) | |
15418 | gnus-valid-select-methods))) | |
15419 | ||
15420 | (defun gnus-server-extend-method (group method) | |
15421 | ;; This function "extends" a virtual server. If the server is | |
15422 | ;; "hello", and the select method is ("hello" (my-var "something")) | |
15423 | ;; in the group "alt.alt", this will result in a new virtual server | |
15424 | ;; called "hello+alt.alt". | |
15425 | (let ((entry | |
15426 | (gnus-copy-sequence | |
15427 | (if (equal (car method) "native") gnus-select-method | |
15428 | (cdr (assoc (car method) gnus-server-alist)))))) | |
15429 | (setcar (cdr entry) (concat (nth 1 entry) "+" group)) | |
15430 | (nconc entry (cdr method)))) | |
15431 | ||
564b670b LMI |
15432 | (defun gnus-server-status (method) |
15433 | "Return the status of METHOD." | |
15434 | (nth 1 (assoc method gnus-opened-servers))) | |
15435 | ||
231f989b LMI |
15436 | (defun gnus-group-name-to-method (group) |
15437 | "Return a select method suitable for GROUP." | |
15438 | (if (string-match ":" group) | |
15439 | (let ((server (substring group 0 (match-beginning 0)))) | |
15440 | (if (string-match "\\+" server) | |
15441 | (list (intern (substring server 0 (match-beginning 0))) | |
15442 | (substring server (match-end 0))) | |
15443 | (list (intern server) ""))) | |
15444 | gnus-select-method)) | |
41487370 LMI |
15445 | |
15446 | (defun gnus-find-method-for-group (group &optional info) | |
231f989b | 15447 | "Find the select method that GROUP uses." |
41487370 LMI |
15448 | (or gnus-override-method |
15449 | (and (not group) | |
15450 | gnus-select-method) | |
231f989b | 15451 | (let ((info (or info (gnus-get-info group))) |
41487370 LMI |
15452 | method) |
15453 | (if (or (not info) | |
231f989b LMI |
15454 | (not (setq method (gnus-info-method info))) |
15455 | (equal method "native")) | |
15456 | gnus-select-method | |
41487370 LMI |
15457 | (setq method |
15458 | (cond ((stringp method) | |
15459 | (gnus-server-to-method method)) | |
15460 | ((stringp (car method)) | |
15461 | (gnus-server-extend-method group method)) | |
15462 | (t | |
231f989b LMI |
15463 | method))) |
15464 | (cond ((equal (cadr method) "") | |
15465 | method) | |
15466 | ((null (cadr method)) | |
15467 | (list (car method) "")) | |
15468 | (t | |
15469 | (gnus-server-add-address method))))))) | |
41487370 LMI |
15470 | |
15471 | (defun gnus-check-backend-function (func group) | |
231f989b | 15472 | "Check whether GROUP supports function FUNC." |
41487370 LMI |
15473 | (let ((method (if (stringp group) (car (gnus-find-method-for-group group)) |
15474 | group))) | |
15475 | (fboundp (intern (format "%s-%s" method func))))) | |
15476 | ||
231f989b LMI |
15477 | (defun gnus-methods-using (feature) |
15478 | "Find all methods that have FEATURE." | |
41487370 LMI |
15479 | (let ((valids gnus-valid-select-methods) |
15480 | outs) | |
15481 | (while valids | |
231f989b | 15482 | (if (memq feature (car valids)) |
41487370 LMI |
15483 | (setq outs (cons (car valids) outs))) |
15484 | (setq valids (cdr valids))) | |
15485 | outs)) | |
15486 | ||
231f989b LMI |
15487 | \f |
15488 | ;;; | |
41487370 LMI |
15489 | ;;; Active & Newsrc File Handling |
15490 | ;;; | |
15491 | ||
231f989b | 15492 | (defun gnus-setup-news (&optional rawfile level dont-connect) |
41487370 LMI |
15493 | "Setup news information. |
15494 | If RAWFILE is non-nil, the .newsrc file will also be read. | |
15495 | If LEVEL is non-nil, the news will be set up at level LEVEL." | |
15496 | (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) | |
41487370 | 15497 | |
231f989b LMI |
15498 | (when init |
15499 | ;; Clear some variables to re-initialize news information. | |
15500 | (setq gnus-newsrc-alist nil | |
15501 | gnus-active-hashtb nil) | |
15502 | ;; Read the newsrc file and create `gnus-newsrc-hashtb'. | |
15503 | (gnus-read-newsrc-file rawfile)) | |
15504 | ||
15505 | (when (and (not (assoc "archive" gnus-server-alist)) | |
564b670b | 15506 | (gnus-archive-server-wanted-p)) |
231f989b LMI |
15507 | (push (cons "archive" gnus-message-archive-method) |
15508 | gnus-server-alist)) | |
41487370 LMI |
15509 | |
15510 | ;; If we don't read the complete active file, we fill in the | |
231f989b | 15511 | ;; hashtb here. |
41487370 LMI |
15512 | (if (or (null gnus-read-active-file) |
15513 | (eq gnus-read-active-file 'some)) | |
15514 | (gnus-update-active-hashtb-from-killed)) | |
15515 | ||
15516 | ;; Read the active file and create `gnus-active-hashtb'. | |
15517 | ;; If `gnus-read-active-file' is nil, then we just create an empty | |
231f989b | 15518 | ;; hash table. The partial filling out of the hash table will be |
41487370 | 15519 | ;; done in `gnus-get-unread-articles'. |
231f989b | 15520 | (and gnus-read-active-file |
41487370 LMI |
15521 | (not level) |
15522 | (gnus-read-active-file)) | |
15523 | ||
15524 | (or gnus-active-hashtb | |
15525 | (setq gnus-active-hashtb (make-vector 4095 0))) | |
15526 | ||
231f989b LMI |
15527 | ;; Initialize the cache. |
15528 | (when gnus-use-cache | |
15529 | (gnus-cache-open)) | |
15530 | ||
41487370 | 15531 | ;; Possibly eval the dribble file. |
231f989b LMI |
15532 | (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) |
15533 | ||
15534 | ;; Slave Gnusii should then clear the dribble buffer. | |
15535 | (when (and init gnus-slave) | |
15536 | (gnus-dribble-clear)) | |
41487370 LMI |
15537 | |
15538 | (gnus-update-format-specifications) | |
15539 | ||
231f989b LMI |
15540 | ;; See whether we need to read the description file. |
15541 | (if (and (string-match "%[-,0-9]*D" gnus-group-line-format) | |
15542 | (not gnus-description-hashtb) | |
15543 | (not dont-connect) | |
15544 | gnus-read-active-file) | |
15545 | (gnus-read-all-descriptions-files)) | |
15546 | ||
41487370 | 15547 | ;; Find new newsgroups and treat them. |
231f989b | 15548 | (if (and init gnus-check-new-newsgroups (not level) |
7e988fb6 | 15549 | (gnus-check-server gnus-select-method)) |
41487370 LMI |
15550 | (gnus-find-new-newsgroups)) |
15551 | ||
231f989b LMI |
15552 | ;; We might read in new NoCeM messages here. |
15553 | (when (and gnus-use-nocem | |
15554 | (not level) | |
15555 | (not dont-connect)) | |
15556 | (gnus-nocem-scan-groups)) | |
15557 | ||
41487370 LMI |
15558 | ;; Find the number of unread articles in each non-dead group. |
15559 | (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) | |
231f989b | 15560 | (gnus-get-unread-articles level)) |
41487370 | 15561 | |
231f989b | 15562 | (if (and init gnus-check-bogus-newsgroups |
41487370 LMI |
15563 | gnus-read-active-file (not level) |
15564 | (gnus-server-opened gnus-select-method)) | |
15565 | (gnus-check-bogus-newsgroups)))) | |
745bc783 | 15566 | |
231f989b | 15567 | (defun gnus-find-new-newsgroups (&optional arg) |
41487370 LMI |
15568 | "Search for new newsgroups and add them. |
15569 | Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' | |
231f989b LMI |
15570 | The `-n' option line from .newsrc is respected. |
15571 | If ARG (the prefix), use the `ask-server' method to query | |
15572 | the server for new groups." | |
15573 | (interactive "P") | |
15574 | (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) | |
15575 | (null gnus-read-active-file) | |
15576 | (eq gnus-read-active-file 'some)) | |
15577 | 'ask-server gnus-check-new-newsgroups))) | |
15578 | (unless (gnus-check-first-time-used) | |
15579 | (if (or (consp check) | |
15580 | (eq check 'ask-server)) | |
15581 | ;; Ask the server for new groups. | |
41487370 | 15582 | (gnus-ask-server-for-new-groups) |
231f989b | 15583 | ;; Go through the active hashtb and look for new groups. |
41487370 LMI |
15584 | (let ((groups 0) |
15585 | group new-newsgroups) | |
15586 | (gnus-message 5 "Looking for new newsgroups...") | |
231f989b LMI |
15587 | (unless gnus-have-read-active-file |
15588 | (gnus-read-active-file)) | |
41487370 | 15589 | (setq gnus-newsrc-last-checked-date (current-time-string)) |
231f989b LMI |
15590 | (unless gnus-killed-hashtb |
15591 | (gnus-make-hashtable-from-killed)) | |
41487370 LMI |
15592 | ;; Go though every newsgroup in `gnus-active-hashtb' and compare |
15593 | ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. | |
15594 | (mapatoms | |
15595 | (lambda (sym) | |
15596 | (if (or (null (setq group (symbol-name sym))) | |
231f989b | 15597 | (not (boundp sym)) |
41487370 LMI |
15598 | (null (symbol-value sym)) |
15599 | (gnus-gethash group gnus-killed-hashtb) | |
15600 | (gnus-gethash group gnus-newsrc-hashtb)) | |
15601 | () | |
15602 | (let ((do-sub (gnus-matches-options-n group))) | |
231f989b | 15603 | (cond |
41487370 LMI |
15604 | ((eq do-sub 'subscribe) |
15605 | (setq groups (1+ groups)) | |
15606 | (gnus-sethash group group gnus-killed-hashtb) | |
15607 | (funcall gnus-subscribe-options-newsgroup-method group)) | |
15608 | ((eq do-sub 'ignore) | |
15609 | nil) | |
15610 | (t | |
15611 | (setq groups (1+ groups)) | |
15612 | (gnus-sethash group group gnus-killed-hashtb) | |
15613 | (if gnus-subscribe-hierarchical-interactive | |
15614 | (setq new-newsgroups (cons group new-newsgroups)) | |
15615 | (funcall gnus-subscribe-newsgroup-method group))))))) | |
15616 | gnus-active-hashtb) | |
231f989b LMI |
15617 | (when new-newsgroups |
15618 | (gnus-subscribe-hierarchical-interactive new-newsgroups)) | |
41487370 LMI |
15619 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. |
15620 | (if (> groups 0) | |
231f989b | 15621 | (gnus-message 6 "%d new newsgroup%s arrived." |
41487370 | 15622 | groups (if (> groups 1) "s have" " has")) |
231f989b | 15623 | (gnus-message 6 "No new newsgroups."))))))) |
41487370 LMI |
15624 | |
15625 | (defun gnus-matches-options-n (group) | |
b94ae5f7 | 15626 | ;; Returns `subscribe' if the group is to be unconditionally |
41487370 LMI |
15627 | ;; subscribed, `ignore' if it is to be ignored, and nil if there is |
15628 | ;; no match for the group. | |
15629 | ||
15630 | ;; First we check the two user variables. | |
15631 | (cond | |
15632 | ((and gnus-options-subscribe | |
15633 | (string-match gnus-options-subscribe group)) | |
15634 | 'subscribe) | |
231f989b LMI |
15635 | ((and gnus-auto-subscribed-groups |
15636 | (string-match gnus-auto-subscribed-groups group)) | |
15637 | 'subscribe) | |
41487370 LMI |
15638 | ((and gnus-options-not-subscribe |
15639 | (string-match gnus-options-not-subscribe group)) | |
15640 | 'ignore) | |
15641 | ;; Then we go through the list that was retrieved from the .newsrc | |
231f989b LMI |
15642 | ;; file. This list has elements on the form |
15643 | ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list | |
41487370 LMI |
15644 | ;; is in the reverse order of the options line) is returned. |
15645 | (t | |
15646 | (let ((regs gnus-newsrc-options-n)) | |
15647 | (while (and regs | |
231f989b | 15648 | (not (string-match (caar regs) group))) |
41487370 | 15649 | (setq regs (cdr regs))) |
231f989b | 15650 | (and regs (cdar regs)))))) |
41487370 LMI |
15651 | |
15652 | (defun gnus-ask-server-for-new-groups () | |
15653 | (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) | |
231f989b LMI |
15654 | (methods (cons gnus-select-method |
15655 | (nconc | |
564b670b | 15656 | (when (gnus-archive-server-wanted-p) |
231f989b LMI |
15657 | (list "archive")) |
15658 | (append | |
15659 | (and (consp gnus-check-new-newsgroups) | |
15660 | gnus-check-new-newsgroups) | |
15661 | gnus-secondary-select-methods)))) | |
41487370 LMI |
15662 | (groups 0) |
15663 | (new-date (current-time-string)) | |
231f989b LMI |
15664 | group new-newsgroups got-new method hashtb |
15665 | gnus-override-subscribe-method) | |
15666 | ;; Go through both primary and secondary select methods and | |
15667 | ;; request new newsgroups. | |
15668 | (while (setq method (gnus-server-get-method nil (pop methods))) | |
15669 | (setq new-newsgroups nil) | |
15670 | (setq gnus-override-subscribe-method method) | |
15671 | (when (and (gnus-check-server method) | |
15672 | (gnus-request-newgroups date method)) | |
15673 | (save-excursion | |
15674 | (setq got-new t) | |
15675 | (setq hashtb (gnus-make-hashtable 100)) | |
15676 | (set-buffer nntp-server-buffer) | |
15677 | ;; Enter all the new groups into a hashtable. | |
15678 | (gnus-active-to-gnus-format method hashtb 'ignore)) | |
15679 | ;; Now all new groups from `method' are in `hashtb'. | |
15680 | (mapatoms | |
15681 | (lambda (group-sym) | |
15682 | (if (or (null (setq group (symbol-name group-sym))) | |
15683 | (not (boundp group-sym)) | |
15684 | (null (symbol-value group-sym)) | |
15685 | (gnus-gethash group gnus-newsrc-hashtb) | |
15686 | (member group gnus-zombie-list) | |
15687 | (member group gnus-killed-list)) | |
15688 | ;; The group is already known. | |
15689 | () | |
15690 | ;; Make this group active. | |
15691 | (when (symbol-value group-sym) | |
15692 | (gnus-set-active group (symbol-value group-sym))) | |
15693 | ;; Check whether we want it or not. | |
15694 | (let ((do-sub (gnus-matches-options-n group))) | |
15695 | (cond | |
15696 | ((eq do-sub 'subscribe) | |
15697 | (incf groups) | |
15698 | (gnus-sethash group group gnus-killed-hashtb) | |
15699 | (funcall gnus-subscribe-options-newsgroup-method group)) | |
15700 | ((eq do-sub 'ignore) | |
15701 | nil) | |
15702 | (t | |
15703 | (incf groups) | |
15704 | (gnus-sethash group group gnus-killed-hashtb) | |
15705 | (if gnus-subscribe-hierarchical-interactive | |
15706 | (push group new-newsgroups) | |
15707 | (funcall gnus-subscribe-newsgroup-method group))))))) | |
15708 | hashtb)) | |
15709 | (when new-newsgroups | |
15710 | (gnus-subscribe-hierarchical-interactive new-newsgroups))) | |
41487370 | 15711 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. |
231f989b LMI |
15712 | (when (> groups 0) |
15713 | (gnus-message 6 "%d new newsgroup%s arrived." | |
15714 | groups (if (> groups 1) "s have" " has"))) | |
15715 | (and got-new (setq gnus-newsrc-last-checked-date new-date)) | |
41487370 LMI |
15716 | got-new)) |
15717 | ||
15718 | (defun gnus-check-first-time-used () | |
15719 | (if (or (> (length gnus-newsrc-alist) 1) | |
15720 | (file-exists-p gnus-startup-file) | |
15721 | (file-exists-p (concat gnus-startup-file ".el")) | |
15722 | (file-exists-p (concat gnus-startup-file ".eld"))) | |
15723 | nil | |
15724 | (gnus-message 6 "First time user; subscribing you to default groups") | |
231f989b LMI |
15725 | (unless (gnus-read-active-file-p) |
15726 | (gnus-read-active-file)) | |
41487370 LMI |
15727 | (setq gnus-newsrc-last-checked-date (current-time-string)) |
15728 | (let ((groups gnus-default-subscribed-newsgroups) | |
15729 | group) | |
15730 | (if (eq groups t) | |
15731 | nil | |
15732 | (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) | |
15733 | (mapatoms | |
15734 | (lambda (sym) | |
15735 | (if (null (setq group (symbol-name sym))) | |
15736 | () | |
15737 | (let ((do-sub (gnus-matches-options-n group))) | |
231f989b | 15738 | (cond |
41487370 LMI |
15739 | ((eq do-sub 'subscribe) |
15740 | (gnus-sethash group group gnus-killed-hashtb) | |
15741 | (funcall gnus-subscribe-options-newsgroup-method group)) | |
15742 | ((eq do-sub 'ignore) | |
15743 | nil) | |
15744 | (t | |
15745 | (setq gnus-killed-list (cons group gnus-killed-list))))))) | |
15746 | gnus-active-hashtb) | |
15747 | (while groups | |
231f989b LMI |
15748 | (if (gnus-active (car groups)) |
15749 | (gnus-group-change-level | |
41487370 LMI |
15750 | (car groups) gnus-level-default-subscribed gnus-level-killed)) |
15751 | (setq groups (cdr groups))) | |
15752 | (gnus-group-make-help-group) | |
15753 | (and gnus-novice-user | |
15754 | (gnus-message 7 "`A k' to list killed groups")))))) | |
15755 | ||
15756 | (defun gnus-subscribe-group (group previous &optional method) | |
231f989b | 15757 | (gnus-group-change-level |
41487370 LMI |
15758 | (if method |
15759 | (list t group gnus-level-default-subscribed nil nil method) | |
231f989b | 15760 | group) |
41487370 LMI |
15761 | gnus-level-default-subscribed gnus-level-killed previous t)) |
15762 | ||
15763 | ;; `gnus-group-change-level' is the fundamental function for changing | |
231f989b | 15764 | ;; subscription levels of newsgroups. This might mean just changing |
41487370 LMI |
15765 | ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back |
15766 | ;; again, which subscribes/unsubscribes a group, which is equally | |
231f989b | 15767 | ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and |
41487370 LMI |
15768 | ;; from 8-9 to 1-7 means that you remove the group from the list of |
15769 | ;; killed (or zombie) groups and add them to the (kinda) subscribed | |
231f989b | 15770 | ;; groups. And last but not least, moving from 8 to 9 and 9 to 8, |
41487370 LMI |
15771 | ;; which is trivial. |
15772 | ;; ENTRY can either be a string (newsgroup name) or a list (if | |
15773 | ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), | |
15774 | ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' | |
231f989b | 15775 | ;; entries. |
41487370 LMI |
15776 | ;; LEVEL is the new level of the group, OLDLEVEL is the old level and |
15777 | ;; PREVIOUS is the group (in hashtb entry format) to insert this group | |
231f989b | 15778 | ;; after. |
41487370 LMI |
15779 | (defun gnus-group-change-level (entry level &optional oldlevel |
15780 | previous fromkilled) | |
15781 | (let (group info active num) | |
15782 | ;; Glean what info we can from the arguments | |
15783 | (if (consp entry) | |
15784 | (if fromkilled (setq group (nth 1 entry)) | |
15785 | (setq group (car (nth 2 entry)))) | |
15786 | (setq group entry)) | |
15787 | (if (and (stringp entry) | |
231f989b | 15788 | oldlevel |
41487370 LMI |
15789 | (< oldlevel gnus-level-zombie)) |
15790 | (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) | |
15791 | (if (and (not oldlevel) | |
15792 | (consp entry)) | |
231f989b LMI |
15793 | (setq oldlevel (gnus-info-level (nth 2 entry))) |
15794 | (setq oldlevel (or oldlevel 9))) | |
41487370 LMI |
15795 | (if (stringp previous) |
15796 | (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) | |
15797 | ||
15798 | (if (and (>= oldlevel gnus-level-zombie) | |
15799 | (gnus-gethash group gnus-newsrc-hashtb)) | |
15800 | ;; We are trying to subscribe a group that is already | |
231f989b LMI |
15801 | ;; subscribed. |
15802 | () ; Do nothing. | |
41487370 LMI |
15803 | |
15804 | (or (gnus-ephemeral-group-p group) | |
15805 | (gnus-dribble-enter | |
231f989b | 15806 | (format "(gnus-group-change-level %S %S %S %S %S)" |
41487370 | 15807 | group level oldlevel (car (nth 2 previous)) fromkilled))) |
231f989b | 15808 | |
41487370 LMI |
15809 | ;; Then we remove the newgroup from any old structures, if needed. |
15810 | ;; If the group was killed, we remove it from the killed or zombie | |
231f989b | 15811 | ;; list. If not, and it is in fact going to be killed, we remove |
41487370 | 15812 | ;; it from the newsrc hash table and assoc. |
231f989b LMI |
15813 | (cond |
15814 | ((>= oldlevel gnus-level-zombie) | |
15815 | (if (= oldlevel gnus-level-zombie) | |
15816 | (setq gnus-zombie-list (delete group gnus-zombie-list)) | |
15817 | (setq gnus-killed-list (delete group gnus-killed-list)))) | |
15818 | (t | |
15819 | (if (and (>= level gnus-level-zombie) | |
15820 | entry) | |
15821 | (progn | |
15822 | (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) | |
15823 | (if (nth 3 entry) | |
15824 | (setcdr (gnus-gethash (car (nth 3 entry)) | |
15825 | gnus-newsrc-hashtb) | |
15826 | (cdr entry))) | |
15827 | (setcdr (cdr entry) (cdddr entry)))))) | |
41487370 LMI |
15828 | |
15829 | ;; Finally we enter (if needed) the list where it is supposed to | |
231f989b | 15830 | ;; go, and change the subscription level. If it is to be killed, |
41487370 | 15831 | ;; we enter it into the killed or zombie list. |
231f989b LMI |
15832 | (cond |
15833 | ((>= level gnus-level-zombie) | |
15834 | ;; Remove from the hash table. | |
15835 | (gnus-sethash group nil gnus-newsrc-hashtb) | |
15836 | ;; We do not enter foreign groups into the list of dead | |
15837 | ;; groups. | |
15838 | (unless (gnus-group-foreign-p group) | |
15839 | (if (= level gnus-level-zombie) | |
15840 | (setq gnus-zombie-list (cons group gnus-zombie-list)) | |
15841 | (setq gnus-killed-list (cons group gnus-killed-list))))) | |
15842 | (t | |
15843 | ;; If the list is to be entered into the newsrc assoc, and | |
15844 | ;; it was killed, we have to create an entry in the newsrc | |
15845 | ;; hashtb format and fix the pointers in the newsrc assoc. | |
15846 | (if (< oldlevel gnus-level-zombie) | |
15847 | ;; It was alive, and it is going to stay alive, so we | |
15848 | ;; just change the level and don't change any pointers or | |
15849 | ;; hash table entries. | |
15850 | (setcar (cdaddr entry) level) | |
15851 | (if (listp entry) | |
15852 | (setq info (cdr entry) | |
15853 | num (car entry)) | |
15854 | (setq active (gnus-active group)) | |
15855 | (setq num | |
15856 | (if active (- (1+ (cdr active)) (car active)) t)) | |
15857 | ;; Check whether the group is foreign. If so, the | |
15858 | ;; foreign select method has to be entered into the | |
15859 | ;; info. | |
15860 | (let ((method (or gnus-override-subscribe-method | |
15861 | (gnus-group-method group)))) | |
15862 | (if (eq method gnus-select-method) | |
15863 | (setq info (list group level nil)) | |
15864 | (setq info (list group level nil nil method))))) | |
15865 | (unless previous | |
15866 | (setq previous | |
15867 | (let ((p gnus-newsrc-alist)) | |
15868 | (while (cddr p) | |
15869 | (setq p (cdr p))) | |
15870 | p))) | |
15871 | (setq entry (cons info (cddr previous))) | |
15872 | (if (cdr previous) | |
15873 | (progn | |
15874 | (setcdr (cdr previous) entry) | |
15875 | (gnus-sethash group (cons num (cdr previous)) | |
15876 | gnus-newsrc-hashtb)) | |
15877 | (setcdr previous entry) | |
15878 | (gnus-sethash group (cons num previous) | |
15879 | gnus-newsrc-hashtb)) | |
15880 | (when (cdr entry) | |
15881 | (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))))) | |
15882 | (when gnus-group-change-level-function | |
15883 | (funcall gnus-group-change-level-function group level oldlevel))))) | |
41487370 LMI |
15884 | |
15885 | (defun gnus-kill-newsgroup (newsgroup) | |
231f989b | 15886 | "Obsolete function. Kills a newsgroup." |
41487370 LMI |
15887 | (gnus-group-change-level |
15888 | (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) | |
745bc783 JB |
15889 | |
15890 | (defun gnus-check-bogus-newsgroups (&optional confirm) | |
41487370 LMI |
15891 | "Remove bogus newsgroups. |
15892 | If CONFIRM is non-nil, the user has to confirm the deletion of every | |
231f989b | 15893 | newsgroup." |
41487370 | 15894 | (let ((newsrc (cdr gnus-newsrc-alist)) |
231f989b | 15895 | bogus group entry info) |
41487370 | 15896 | (gnus-message 5 "Checking bogus newsgroups...") |
231f989b LMI |
15897 | (unless (gnus-read-active-file-p) |
15898 | (gnus-read-active-file)) | |
15899 | (when (gnus-read-active-file-p) | |
15900 | ;; Find all bogus newsgroup that are subscribed. | |
15901 | (while newsrc | |
15902 | (setq info (pop newsrc) | |
15903 | group (gnus-info-group info)) | |
15904 | (unless (or (gnus-active group) ; Active | |
15905 | (gnus-info-method info) ; Foreign | |
15906 | (and confirm | |
15907 | (not (gnus-y-or-n-p | |
15908 | (format "Remove bogus newsgroup: %s " group))))) | |
15909 | ;; Found a bogus newsgroup. | |
15910 | (push group bogus))) | |
15911 | ;; Remove all bogus subscribed groups by first killing them, and | |
15912 | ;; then removing them from the list of killed groups. | |
15913 | (while bogus | |
15914 | (when (setq entry (gnus-gethash (setq group (pop bogus)) | |
15915 | gnus-newsrc-hashtb)) | |
15916 | (gnus-group-change-level entry gnus-level-killed) | |
15917 | (setq gnus-killed-list (delete group gnus-killed-list)))) | |
15918 | ;; Then we remove all bogus groups from the list of killed and | |
15919 | ;; zombie groups. They are are removed without confirmation. | |
15920 | (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) | |
15921 | killed) | |
15922 | (while dead-lists | |
15923 | (setq killed (symbol-value (car dead-lists))) | |
15924 | (while killed | |
15925 | (unless (gnus-active (setq group (pop killed))) | |
41487370 | 15926 | ;; The group is bogus. |
231f989b | 15927 | ;; !!!Slow as hell. |
41487370 | 15928 | (set (car dead-lists) |
231f989b LMI |
15929 | (delete group (symbol-value (car dead-lists)))))) |
15930 | (setq dead-lists (cdr dead-lists)))) | |
15931 | (gnus-message 5 "Checking bogus newsgroups...done")))) | |
41487370 LMI |
15932 | |
15933 | (defun gnus-check-duplicate-killed-groups () | |
15934 | "Remove duplicates from the list of killed groups." | |
15935 | (interactive) | |
15936 | (let ((killed gnus-killed-list)) | |
15937 | (while killed | |
15938 | (gnus-message 9 "%d" (length killed)) | |
15939 | (setcdr killed (delete (car killed) (cdr killed))) | |
15940 | (setq killed (cdr killed))))) | |
15941 | ||
231f989b LMI |
15942 | ;; We want to inline a function from gnus-cache, so we cheat here: |
15943 | (eval-when-compile | |
15944 | (provide 'gnus) | |
15945 | (require 'gnus-cache)) | |
15946 | ||
15947 | (defun gnus-get-unread-articles-in-group (info active &optional update) | |
15948 | (when active | |
15949 | ;; Allow the backend to update the info in the group. | |
15950 | (when (and update | |
15951 | (gnus-request-update-info | |
15952 | info (gnus-find-method-for-group (gnus-info-group info)))) | |
15953 | (gnus-activate-group (gnus-info-group info) nil t)) | |
15954 | (let* ((range (gnus-info-read info)) | |
15955 | (num 0)) | |
15956 | ;; If a cache is present, we may have to alter the active info. | |
15957 | (when (and gnus-use-cache info) | |
15958 | (inline (gnus-cache-possibly-alter-active | |
15959 | (gnus-info-group info) active))) | |
15960 | ;; Modify the list of read articles according to what articles | |
15961 | ;; are available; then tally the unread articles and add the | |
15962 | ;; number to the group hash table entry. | |
15963 | (cond | |
15964 | ((zerop (cdr active)) | |
15965 | (setq num 0)) | |
15966 | ((not range) | |
15967 | (setq num (- (1+ (cdr active)) (car active)))) | |
15968 | ((not (listp (cdr range))) | |
15969 | ;; Fix a single (num . num) range according to the | |
15970 | ;; active hash table. | |
15971 | ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>. | |
15972 | (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) | |
15973 | (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) | |
15974 | ;; Compute number of unread articles. | |
15975 | (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) | |
15976 | (t | |
15977 | ;; The read list is a list of ranges. Fix them according to | |
15978 | ;; the active hash table. | |
15979 | ;; First peel off any elements that are below the lower | |
15980 | ;; active limit. | |
15981 | (while (and (cdr range) | |
15982 | (>= (car active) | |
15983 | (or (and (atom (cadr range)) (cadr range)) | |
15984 | (caadr range)))) | |
15985 | (if (numberp (car range)) | |
15986 | (setcar range | |
15987 | (cons (car range) | |
15988 | (or (and (numberp (cadr range)) | |
15989 | (cadr range)) | |
15990 | (cdadr range)))) | |
15991 | (setcdr (car range) | |
15992 | (or (and (numberp (nth 1 range)) (nth 1 range)) | |
15993 | (cdadr range)))) | |
15994 | (setcdr range (cddr range))) | |
15995 | ;; Adjust the first element to be the same as the lower limit. | |
15996 | (if (and (not (atom (car range))) | |
15997 | (< (cdar range) (car active))) | |
15998 | (setcdr (car range) (1- (car active)))) | |
15999 | ;; Then we want to peel off any elements that are higher | |
16000 | ;; than the upper active limit. | |
16001 | (let ((srange range)) | |
16002 | ;; Go past all legal elements. | |
16003 | (while (and (cdr srange) | |
16004 | (<= (or (and (atom (cadr srange)) | |
16005 | (cadr srange)) | |
16006 | (caadr srange)) (cdr active))) | |
16007 | (setq srange (cdr srange))) | |
16008 | (if (cdr srange) | |
16009 | ;; Nuke all remaining illegal elements. | |
16010 | (setcdr srange nil)) | |
16011 | ||
16012 | ;; Adjust the final element. | |
16013 | (if (and (not (atom (car srange))) | |
16014 | (> (cdar srange) (cdr active))) | |
16015 | (setcdr (car srange) (cdr active)))) | |
16016 | ;; Compute the number of unread articles. | |
16017 | (while range | |
16018 | (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) | |
16019 | (cdar range))) | |
16020 | (or (and (atom (car range)) (car range)) | |
16021 | (caar range))))) | |
16022 | (setq range (cdr range))) | |
16023 | (setq num (max 0 (- (cdr active) num))))) | |
16024 | ;; Set the number of unread articles. | |
16025 | (when info | |
16026 | (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) | |
16027 | num))) | |
16028 | ||
41487370 LMI |
16029 | ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' |
16030 | ;; and compute how many unread articles there are in each group. | |
231f989b | 16031 | (defun gnus-get-unread-articles (&optional level) |
41487370 | 16032 | (let* ((newsrc (cdr gnus-newsrc-alist)) |
231f989b | 16033 | (level (or level gnus-activate-level (1+ gnus-level-subscribed))) |
41487370 | 16034 | (foreign-level |
231f989b LMI |
16035 | (min |
16036 | (cond ((and gnus-activate-foreign-newsgroups | |
41487370 LMI |
16037 | (not (numberp gnus-activate-foreign-newsgroups))) |
16038 | (1+ gnus-level-subscribed)) | |
16039 | ((numberp gnus-activate-foreign-newsgroups) | |
16040 | gnus-activate-foreign-newsgroups) | |
16041 | (t 0)) | |
16042 | level)) | |
231f989b | 16043 | info group active method) |
41487370 | 16044 | (gnus-message 5 "Checking new news...") |
745bc783 | 16045 | |
41487370 | 16046 | (while newsrc |
231f989b LMI |
16047 | (setq active (gnus-active (setq group (gnus-info-group |
16048 | (setq info (pop newsrc)))))) | |
41487370 | 16049 | |
231f989b | 16050 | ;; Check newsgroups. If the user doesn't want to check them, or |
41487370 LMI |
16051 | ;; they can't be checked (for instance, if the news server can't |
16052 | ;; be reached) we just set the number of unread articles in this | |
231f989b | 16053 | ;; newsgroup to t. This means that Gnus thinks that there are |
41487370 | 16054 | ;; unread articles, but it has no idea how many. |
231f989b LMI |
16055 | (if (and (setq method (gnus-info-method info)) |
16056 | (not (gnus-server-equal | |
16057 | gnus-select-method | |
16058 | (setq method (gnus-server-get-method nil method)))) | |
41487370 | 16059 | (not (gnus-secondary-method-p method))) |
231f989b LMI |
16060 | ;; These groups are foreign. Check the level. |
16061 | (when (<= (gnus-info-level info) foreign-level) | |
16062 | (setq active (gnus-activate-group group 'scan)) | |
16063 | (unless (inline (gnus-virtual-group-p group)) | |
16064 | (inline (gnus-close-group group))) | |
16065 | (when (fboundp (intern (concat (symbol-name (car method)) | |
16066 | "-request-update-info"))) | |
16067 | (inline (gnus-request-update-info info method)))) | |
16068 | ;; These groups are native or secondary. | |
16069 | (when (and (<= (gnus-info-level info) level) | |
16070 | (not gnus-read-active-file)) | |
16071 | (setq active (gnus-activate-group group 'scan)) | |
16072 | (inline (gnus-close-group group)))) | |
16073 | ||
16074 | ;; Get the number of unread articles in the group. | |
41487370 | 16075 | (if active |
231f989b | 16076 | (inline (gnus-get-unread-articles-in-group info active)) |
41487370 LMI |
16077 | ;; The group couldn't be reached, so we nix out the number of |
16078 | ;; unread articles and stuff. | |
231f989b LMI |
16079 | (gnus-set-active group nil) |
16080 | (setcar (gnus-gethash group gnus-newsrc-hashtb) t))) | |
41487370 LMI |
16081 | |
16082 | (gnus-message 5 "Checking new news...done"))) | |
16083 | ||
231f989b | 16084 | ;; Create a hash table out of the newsrc alist. The `car's of the |
41487370 LMI |
16085 | ;; alist elements are used as keys. |
16086 | (defun gnus-make-hashtable-from-newsrc-alist () | |
16087 | (let ((alist gnus-newsrc-alist) | |
16088 | (ohashtb gnus-newsrc-hashtb) | |
16089 | prev) | |
16090 | (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) | |
231f989b LMI |
16091 | (setq alist |
16092 | (setq prev (setq gnus-newsrc-alist | |
16093 | (if (equal (caar gnus-newsrc-alist) | |
41487370 LMI |
16094 | "dummy.group") |
16095 | gnus-newsrc-alist | |
16096 | (cons (list "dummy.group" 0 nil) alist))))) | |
16097 | (while alist | |
231f989b LMI |
16098 | (gnus-sethash |
16099 | (caar alist) | |
16100 | (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) | |
16101 | prev) | |
16102 | gnus-newsrc-hashtb) | |
41487370 LMI |
16103 | (setq prev alist |
16104 | alist (cdr alist))))) | |
16105 | ||
16106 | (defun gnus-make-hashtable-from-killed () | |
16107 | "Create a hash table from the killed and zombie lists." | |
16108 | (let ((lists '(gnus-killed-list gnus-zombie-list)) | |
16109 | list) | |
231f989b LMI |
16110 | (setq gnus-killed-hashtb |
16111 | (gnus-make-hashtable | |
41487370 | 16112 | (+ (length gnus-killed-list) (length gnus-zombie-list)))) |
231f989b LMI |
16113 | (while (setq list (pop lists)) |
16114 | (setq list (symbol-value list)) | |
41487370 | 16115 | (while list |
231f989b LMI |
16116 | (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) |
16117 | ||
16118 | (defun gnus-activate-group (group &optional scan dont-check method) | |
41487370 | 16119 | ;; Check whether a group has been activated or not. |
231f989b LMI |
16120 | ;; If SCAN, request a scan of that group as well. |
16121 | (let ((method (or method (gnus-find-method-for-group group))) | |
41487370 LMI |
16122 | active) |
16123 | (and (gnus-check-server method) | |
16124 | ;; We escape all bugs and quit here to make it possible to | |
16125 | ;; continue if a group is so out-there that it reports bugs | |
16126 | ;; and stuff. | |
231f989b LMI |
16127 | (progn |
16128 | (and scan | |
16129 | (gnus-check-backend-function 'request-scan (car method)) | |
16130 | (gnus-request-scan group method)) | |
16131 | t) | |
41487370 | 16132 | (condition-case () |
231f989b LMI |
16133 | (gnus-request-group group dont-check method) |
16134 | ; (error nil) | |
41487370 LMI |
16135 | (quit nil)) |
16136 | (save-excursion | |
16137 | (set-buffer nntp-server-buffer) | |
16138 | (goto-char (point-min)) | |
16139 | ;; Parse the result we got from `gnus-request-group'. | |
16140 | (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") | |
16141 | (progn | |
16142 | (goto-char (match-beginning 1)) | |
231f989b | 16143 | (gnus-set-active |
41487370 | 16144 | group (setq active (cons (read (current-buffer)) |
231f989b LMI |
16145 | (read (current-buffer))))) |
16146 | ;; Return the new active info. | |
16147 | active)))))) | |
16148 | ||
16149 | (defun gnus-update-read-articles (group unread) | |
41487370 LMI |
16150 | "Update the list of read and ticked articles in GROUP using the |
16151 | UNREAD and TICKED lists. | |
16152 | Note: UNSELECTED has to be sorted over `<'. | |
16153 | Returns whether the updating was successful." | |
231f989b | 16154 | (let* ((active (or gnus-newsgroup-active (gnus-active group))) |
41487370 LMI |
16155 | (entry (gnus-gethash group gnus-newsrc-hashtb)) |
16156 | (info (nth 2 entry)) | |
41487370 | 16157 | (prev 1) |
231f989b | 16158 | (unread (sort (copy-sequence unread) '<)) |
41487370 LMI |
16159 | read) |
16160 | (if (or (not info) (not active)) | |
16161 | ;; There is no info on this group if it was, in fact, | |
231f989b LMI |
16162 | ;; killed. Gnus stores no information on killed groups, so |
16163 | ;; there's nothing to be done. | |
41487370 | 16164 | ;; One could store the information somewhere temporarily, |
231f989b | 16165 | ;; perhaps... Hmmm... |
41487370 LMI |
16166 | () |
16167 | ;; Remove any negative articles numbers. | |
16168 | (while (and unread (< (car unread) 0)) | |
16169 | (setq unread (cdr unread))) | |
16170 | ;; Remove any expired article numbers | |
16171 | (while (and unread (< (car unread) (car active))) | |
16172 | (setq unread (cdr unread))) | |
41487370 | 16173 | ;; Compute the ranges of read articles by looking at the list of |
231f989b | 16174 | ;; unread articles. |
41487370 LMI |
16175 | (while unread |
16176 | (if (/= (car unread) prev) | |
16177 | (setq read (cons (if (= prev (1- (car unread))) prev | |
16178 | (cons prev (1- (car unread)))) read))) | |
16179 | (setq prev (1+ (car unread))) | |
16180 | (setq unread (cdr unread))) | |
231f989b LMI |
16181 | (when (<= prev (cdr active)) |
16182 | (setq read (cons (cons prev (cdr active)) read))) | |
41487370 | 16183 | ;; Enter this list into the group info. |
231f989b LMI |
16184 | (gnus-info-set-read |
16185 | info (if (> (length read) 1) (nreverse read) read)) | |
41487370 | 16186 | ;; Set the number of unread articles in gnus-newsrc-hashtb. |
231f989b | 16187 | (gnus-get-unread-articles-in-group info (gnus-active group)) |
41487370 LMI |
16188 | t))) |
16189 | ||
16190 | (defun gnus-make-articles-unread (group articles) | |
16191 | "Mark ARTICLES in GROUP as unread." | |
16192 | (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) | |
16193 | (gnus-gethash (gnus-group-real-name group) | |
16194 | gnus-newsrc-hashtb)))) | |
231f989b LMI |
16195 | (ranges (gnus-info-read info)) |
16196 | news article) | |
41487370 | 16197 | (while articles |
231f989b LMI |
16198 | (when (gnus-member-of-range |
16199 | (setq article (pop articles)) ranges) | |
16200 | (setq news (cons article news)))) | |
16201 | (when news | |
16202 | (gnus-info-set-read | |
16203 | info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) | |
41487370 LMI |
16204 | (gnus-group-update-group group t)))) |
16205 | ||
16206 | ;; Enter all dead groups into the hashtb. | |
16207 | (defun gnus-update-active-hashtb-from-killed () | |
16208 | (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0))) | |
16209 | (lists (list gnus-killed-list gnus-zombie-list)) | |
16210 | killed) | |
16211 | (while lists | |
16212 | (setq killed (car lists)) | |
16213 | (while killed | |
16214 | (gnus-sethash (car killed) nil hashtb) | |
16215 | (setq killed (cdr killed))) | |
16216 | (setq lists (cdr lists))))) | |
16217 | ||
231f989b LMI |
16218 | (defun gnus-get-killed-groups () |
16219 | "Go through the active hashtb and all all unknown groups as killed." | |
16220 | ;; First make sure active file has been read. | |
16221 | (unless (gnus-read-active-file-p) | |
16222 | (let ((gnus-read-active-file t)) | |
16223 | (gnus-read-active-file))) | |
16224 | (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) | |
16225 | ;; Go through all newsgroups that are known to Gnus - enlarge kill list. | |
16226 | (mapatoms | |
16227 | (lambda (sym) | |
16228 | (let ((groups 0) | |
16229 | (group (symbol-name sym))) | |
16230 | (if (or (null group) | |
16231 | (gnus-gethash group gnus-killed-hashtb) | |
16232 | (gnus-gethash group gnus-newsrc-hashtb)) | |
16233 | () | |
16234 | (let ((do-sub (gnus-matches-options-n group))) | |
16235 | (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) | |
16236 | () | |
16237 | (setq groups (1+ groups)) | |
16238 | (setq gnus-killed-list | |
16239 | (cons group gnus-killed-list)) | |
16240 | (gnus-sethash group group gnus-killed-hashtb)))))) | |
16241 | gnus-active-hashtb)) | |
16242 | ||
41487370 | 16243 | ;; Get the active file(s) from the backend(s). |
745bc783 | 16244 | (defun gnus-read-active-file () |
41487370 | 16245 | (gnus-group-set-mode-line) |
231f989b LMI |
16246 | (let ((methods |
16247 | (append | |
16248 | (if (gnus-check-server gnus-select-method) | |
16249 | ;; The native server is available. | |
16250 | (cons gnus-select-method gnus-secondary-select-methods) | |
16251 | ;; The native server is down, so we just do the | |
16252 | ;; secondary ones. | |
16253 | gnus-secondary-select-methods) | |
16254 | ;; Also read from the archive server. | |
564b670b | 16255 | (when (gnus-archive-server-wanted-p) |
231f989b | 16256 | (list "archive")))) |
41487370 LMI |
16257 | list-type) |
16258 | (setq gnus-have-read-active-file nil) | |
16259 | (save-excursion | |
16260 | (set-buffer nntp-server-buffer) | |
16261 | (while methods | |
231f989b LMI |
16262 | (let* ((method (if (stringp (car methods)) |
16263 | (gnus-server-get-method nil (car methods)) | |
16264 | (car methods))) | |
41487370 LMI |
16265 | (where (nth 1 method)) |
16266 | (mesg (format "Reading active file%s via %s..." | |
16267 | (if (and where (not (zerop (length where)))) | |
16268 | (concat " from " where) "") | |
16269 | (car method)))) | |
16270 | (gnus-message 5 mesg) | |
231f989b LMI |
16271 | (when (gnus-check-server method) |
16272 | ;; Request that the backend scan its incoming messages. | |
16273 | (and (gnus-check-backend-function 'request-scan (car method)) | |
16274 | (gnus-request-scan nil method)) | |
16275 | (cond | |
41487370 LMI |
16276 | ((and (eq gnus-read-active-file 'some) |
16277 | (gnus-check-backend-function 'retrieve-groups (car method))) | |
16278 | (let ((newsrc (cdr gnus-newsrc-alist)) | |
16279 | (gmethod (gnus-server-get-method nil method)) | |
231f989b LMI |
16280 | groups info) |
16281 | (while (setq info (pop newsrc)) | |
16282 | (when (gnus-server-equal | |
16283 | (gnus-find-method-for-group | |
16284 | (gnus-info-group info) info) | |
16285 | gmethod) | |
16286 | (push (gnus-group-real-name (gnus-info-group info)) | |
16287 | groups))) | |
16288 | (when groups | |
16289 | (gnus-check-server method) | |
16290 | (setq list-type (gnus-retrieve-groups groups method)) | |
16291 | (cond | |
16292 | ((not list-type) | |
16293 | (gnus-error | |
16294 | 1.2 "Cannot read partial active file from %s server." | |
16295 | (car method))) | |
16296 | ((eq list-type 'active) | |
16297 | (gnus-active-to-gnus-format method gnus-active-hashtb)) | |
16298 | (t | |
16299 | (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) | |
41487370 LMI |
16300 | (t |
16301 | (if (not (gnus-request-list method)) | |
231f989b LMI |
16302 | (unless (equal method gnus-message-archive-method) |
16303 | (gnus-error 1 "Cannot read active file from %s server." | |
16304 | (car method))) | |
16305 | (gnus-message 5 mesg) | |
16306 | (gnus-active-to-gnus-format method gnus-active-hashtb) | |
41487370 | 16307 | ;; We mark this active file as read. |
231f989b | 16308 | (push method gnus-have-read-active-file) |
41487370 LMI |
16309 | (gnus-message 5 "%sdone" mesg)))))) |
16310 | (setq methods (cdr methods)))))) | |
16311 | ||
16312 | ;; Read an active file and place the results in `gnus-active-hashtb'. | |
231f989b LMI |
16313 | (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) |
16314 | (unless method | |
16315 | (setq method gnus-select-method)) | |
41487370 | 16316 | (let ((cur (current-buffer)) |
231f989b LMI |
16317 | (hashtb (or hashtb |
16318 | (if (and gnus-active-hashtb | |
41487370 LMI |
16319 | (not (equal method gnus-select-method))) |
16320 | gnus-active-hashtb | |
16321 | (setq gnus-active-hashtb | |
16322 | (if (equal method gnus-select-method) | |
231f989b | 16323 | (gnus-make-hashtable |
41487370 | 16324 | (count-lines (point-min) (point-max))) |
231f989b | 16325 | (gnus-make-hashtable 4096))))))) |
41487370 LMI |
16326 | ;; Delete unnecessary lines. |
16327 | (goto-char (point-min)) | |
16328 | (while (search-forward "\nto." nil t) | |
231f989b | 16329 | (delete-region (1+ (match-beginning 0)) |
41487370 LMI |
16330 | (progn (forward-line 1) (point)))) |
16331 | (or (string= gnus-ignored-newsgroups "") | |
16332 | (progn | |
16333 | (goto-char (point-min)) | |
16334 | (delete-matching-lines gnus-ignored-newsgroups))) | |
16335 | ;; Make the group names readable as a lisp expression even if they | |
16336 | ;; contain special characters. | |
16337 | ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>. | |
16338 | (goto-char (point-max)) | |
16339 | (while (re-search-backward "[][';?()#]" nil t) | |
16340 | (insert ?\\)) | |
16341 | ;; If these are groups from a foreign select method, we insert the | |
231f989b | 16342 | ;; group prefix in front of the group names. |
41487370 LMI |
16343 | (and method (not (gnus-server-equal |
16344 | (gnus-server-get-method nil method) | |
16345 | (gnus-server-get-method nil gnus-select-method))) | |
16346 | (let ((prefix (gnus-group-prefixed-name "" method))) | |
16347 | (goto-char (point-min)) | |
16348 | (while (and (not (eobp)) | |
16349 | (progn (insert prefix) | |
16350 | (zerop (forward-line 1))))))) | |
16351 | ;; Store the active file in a hash table. | |
16352 | (goto-char (point-min)) | |
16353 | (if (string-match "%[oO]" gnus-group-line-format) | |
16354 | ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>. | |
16355 | ;; If we want information on moderated groups, we use this | |
231f989b | 16356 | ;; loop... |
41487370 LMI |
16357 | (let* ((mod-hashtb (make-vector 7 0)) |
16358 | (m (intern "m" mod-hashtb)) | |
16359 | group max min) | |
16360 | (while (not (eobp)) | |
16361 | (condition-case nil | |
16362 | (progn | |
16363 | (narrow-to-region (point) (gnus-point-at-eol)) | |
16364 | (setq group (let ((obarray hashtb)) (read cur))) | |
16365 | (if (and (numberp (setq max (read cur))) | |
16366 | (numberp (setq min (read cur))) | |
231f989b | 16367 | (progn |
41487370 LMI |
16368 | (skip-chars-forward " \t") |
16369 | (not | |
16370 | (or (= (following-char) ?=) | |
16371 | (= (following-char) ?x) | |
16372 | (= (following-char) ?j))))) | |
16373 | (set group (cons min max)) | |
16374 | (set group nil)) | |
16375 | ;; Enter moderated groups into a list. | |
16376 | (if (eq (let ((obarray mod-hashtb)) (read cur)) m) | |
231f989b | 16377 | (setq gnus-moderated-list |
41487370 | 16378 | (cons (symbol-name group) gnus-moderated-list)))) |
231f989b | 16379 | (error |
41487370 LMI |
16380 | (and group |
16381 | (symbolp group) | |
16382 | (set group nil)))) | |
16383 | (widen) | |
16384 | (forward-line 1))) | |
16385 | ;; And if we do not care about moderation, we use this loop, | |
16386 | ;; which is faster. | |
16387 | (let (group max min) | |
16388 | (while (not (eobp)) | |
16389 | (condition-case () | |
16390 | (progn | |
16391 | (narrow-to-region (point) (gnus-point-at-eol)) | |
16392 | ;; group gets set to a symbol interned in the hash table | |
16393 | ;; (what a hack!!) - jwz | |
16394 | (setq group (let ((obarray hashtb)) (read cur))) | |
16395 | (if (and (numberp (setq max (read cur))) | |
16396 | (numberp (setq min (read cur))) | |
231f989b | 16397 | (progn |
41487370 LMI |
16398 | (skip-chars-forward " \t") |
16399 | (not | |
16400 | (or (= (following-char) ?=) | |
16401 | (= (following-char) ?x) | |
16402 | (= (following-char) ?j))))) | |
16403 | (set group (cons min max)) | |
16404 | (set group nil))) | |
231f989b LMI |
16405 | (error |
16406 | (progn | |
41487370 LMI |
16407 | (and group |
16408 | (symbolp group) | |
16409 | (set group nil)) | |
16410 | (or ignore-errors | |
16411 | (gnus-message 3 "Warning - illegal active: %s" | |
231f989b | 16412 | (buffer-substring |
41487370 LMI |
16413 | (gnus-point-at-bol) (gnus-point-at-eol))))))) |
16414 | (widen) | |
16415 | (forward-line 1)))))) | |
16416 | ||
16417 | (defun gnus-groups-to-gnus-format (method &optional hashtb) | |
16418 | ;; Parse a "groups" active file. | |
16419 | (let ((cur (current-buffer)) | |
231f989b | 16420 | (hashtb (or hashtb |
41487370 LMI |
16421 | (if (and method gnus-active-hashtb) |
16422 | gnus-active-hashtb | |
16423 | (setq gnus-active-hashtb | |
231f989b | 16424 | (gnus-make-hashtable |
41487370 | 16425 | (count-lines (point-min) (point-max))))))) |
231f989b | 16426 | (prefix (and method |
41487370 LMI |
16427 | (not (gnus-server-equal |
16428 | (gnus-server-get-method nil method) | |
16429 | (gnus-server-get-method nil gnus-select-method))) | |
16430 | (gnus-group-prefixed-name "" method)))) | |
745bc783 | 16431 | |
41487370 LMI |
16432 | (goto-char (point-min)) |
16433 | ;; We split this into to separate loops, one with the prefix | |
16434 | ;; and one without to speed the reading up somewhat. | |
16435 | (if prefix | |
16436 | (let (min max opoint group) | |
16437 | (while (not (eobp)) | |
16438 | (condition-case () | |
16439 | (progn | |
16440 | (read cur) (read cur) | |
16441 | (setq min (read cur) | |
16442 | max (read cur) | |
16443 | opoint (point)) | |
16444 | (skip-chars-forward " \t") | |
16445 | (insert prefix) | |
16446 | (goto-char opoint) | |
231f989b | 16447 | (set (let ((obarray hashtb)) (read cur)) |
41487370 LMI |
16448 | (cons min max))) |
16449 | (error (and group (symbolp group) (set group nil)))) | |
16450 | (forward-line 1))) | |
16451 | (let (min max group) | |
16452 | (while (not (eobp)) | |
16453 | (condition-case () | |
16454 | (if (= (following-char) ?2) | |
16455 | (progn | |
16456 | (read cur) (read cur) | |
16457 | (setq min (read cur) | |
16458 | max (read cur)) | |
16459 | (set (setq group (let ((obarray hashtb)) (read cur))) | |
16460 | (cons min max)))) | |
16461 | (error (and group (symbolp group) (set group nil)))) | |
16462 | (forward-line 1)))))) | |
16463 | ||
16464 | (defun gnus-read-newsrc-file (&optional force) | |
16465 | "Read startup file. | |
16466 | If FORCE is non-nil, the .newsrc file is read." | |
16467 | ;; Reset variables that might be defined in the .newsrc.eld file. | |
745bc783 JB |
16468 | (let ((variables gnus-variable-list)) |
16469 | (while variables | |
16470 | (set (car variables) nil) | |
16471 | (setq variables (cdr variables)))) | |
16472 | (let* ((newsrc-file gnus-current-startup-file) | |
41487370 | 16473 | (quick-file (concat newsrc-file ".el"))) |
745bc783 | 16474 | (save-excursion |
231f989b | 16475 | ;; We always load the .newsrc.eld file. If always contains |
41487370 LMI |
16476 | ;; much information that can not be gotten from the .newsrc |
16477 | ;; file (ticked articles, killed groups, foreign methods, etc.) | |
16478 | (gnus-read-newsrc-el-file quick-file) | |
231f989b LMI |
16479 | |
16480 | (if (and (file-exists-p gnus-current-startup-file) | |
16481 | (or force | |
16482 | (and (file-newer-than-file-p newsrc-file quick-file) | |
16483 | (file-newer-than-file-p newsrc-file | |
16484 | (concat quick-file "d"))) | |
16485 | (not gnus-newsrc-alist))) | |
16486 | ;; We read the .newsrc file. Note that if there if a | |
41487370 | 16487 | ;; .newsrc.eld file exists, it has already been read, and |
231f989b | 16488 | ;; the `gnus-newsrc-hashtb' has been created. While reading |
41487370 LMI |
16489 | ;; the .newsrc file, Gnus will only use the information it |
16490 | ;; can find there for changing the data already read - | |
16491 | ;; ie. reading the .newsrc file will not trash the data | |
16492 | ;; already read (except for read articles). | |
16493 | (save-excursion | |
16494 | (gnus-message 5 "Reading %s..." newsrc-file) | |
16495 | (set-buffer (find-file-noselect newsrc-file)) | |
16496 | (buffer-disable-undo (current-buffer)) | |
16497 | (gnus-newsrc-to-gnus-format) | |
16498 | (kill-buffer (current-buffer)) | |
231f989b LMI |
16499 | (gnus-message 5 "Reading %s...done" newsrc-file))) |
16500 | ||
16501 | ;; Read any slave files. | |
16502 | (unless gnus-slave | |
16503 | (gnus-master-read-slave-newsrc)) | |
16504 | ||
16505 | ;; Convert old to new. | |
16506 | (gnus-convert-old-newsrc)))) | |
16507 | ||
16508 | (defun gnus-continuum-version (version) | |
16509 | "Return VERSION as a floating point number." | |
16510 | (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) | |
16511 | (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) | |
16512 | (let* ((alpha (and (match-beginning 1) (match-string 1 version))) | |
16513 | (number (match-string 2 version)) | |
16514 | major minor least) | |
16515 | (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) | |
16516 | (setq major (string-to-number (match-string 1 number))) | |
16517 | (setq minor (string-to-number (match-string 2 number))) | |
16518 | (setq least (if (match-beginning 3) | |
16519 | (string-to-number (match-string 3 number)) | |
16520 | 0)) | |
16521 | (string-to-number | |
16522 | (if (zerop major) | |
16523 | (format "%s00%02d%02d" | |
16524 | (cond | |
16525 | ((member alpha '("(ding)" "d")) "4.99") | |
16526 | ((member alpha '("September" "s")) "5.01") | |
16527 | ((member alpha '("Red" "r")) "5.03")) | |
16528 | minor least) | |
16529 | (format "%d.%02d%02d" major minor least)))))) | |
16530 | ||
16531 | (defun gnus-convert-old-newsrc () | |
16532 | "Convert old newsrc into the new format, if needed." | |
16533 | (let ((fcv (and gnus-newsrc-file-version | |
16534 | (gnus-continuum-version gnus-newsrc-file-version)))) | |
16535 | (cond | |
16536 | ;; No .newsrc.eld file was loaded. | |
16537 | ((null fcv) nil) | |
16538 | ;; Gnus 5 .newsrc.eld was loaded. | |
16539 | ((< fcv (gnus-continuum-version "September Gnus v0.1")) | |
16540 | (gnus-convert-old-ticks))))) | |
16541 | ||
16542 | (defun gnus-convert-old-ticks () | |
16543 | (let ((newsrc (cdr gnus-newsrc-alist)) | |
16544 | marks info dormant ticked) | |
16545 | (while (setq info (pop newsrc)) | |
16546 | (when (setq marks (gnus-info-marks info)) | |
16547 | (setq dormant (cdr (assq 'dormant marks)) | |
16548 | ticked (cdr (assq 'tick marks))) | |
16549 | (when (or dormant ticked) | |
16550 | (gnus-info-set-read | |
16551 | info | |
16552 | (gnus-add-to-range | |
16553 | (gnus-info-read info) | |
16554 | (nconc (gnus-uncompress-range dormant) | |
16555 | (gnus-uncompress-range ticked))))))))) | |
41487370 LMI |
16556 | |
16557 | (defun gnus-read-newsrc-el-file (file) | |
16558 | (let ((ding-file (concat file "d"))) | |
16559 | ;; We always, always read the .eld file. | |
16560 | (gnus-message 5 "Reading %s..." ding-file) | |
16561 | (let (gnus-newsrc-assoc) | |
745bc783 | 16562 | (condition-case nil |
41487370 | 16563 | (load ding-file t t t) |
231f989b LMI |
16564 | (error |
16565 | (gnus-error 1 "Error in %s" ding-file))) | |
16566 | (when gnus-newsrc-assoc | |
16567 | (setq gnus-newsrc-alist gnus-newsrc-assoc))) | |
41487370 | 16568 | (gnus-make-hashtable-from-newsrc-alist) |
231f989b | 16569 | (when (file-newer-than-file-p file ding-file) |
41487370 LMI |
16570 | ;; Old format quick file |
16571 | (gnus-message 5 "Reading %s..." file) | |
16572 | ;; The .el file is newer than the .eld file, so we read that one | |
231f989b | 16573 | ;; as well. |
41487370 LMI |
16574 | (gnus-read-old-newsrc-el-file file)))) |
16575 | ||
16576 | ;; Parse the old-style quick startup file | |
16577 | (defun gnus-read-old-newsrc-el-file (file) | |
231f989b | 16578 | (let (newsrc killed marked group m info) |
41487370 LMI |
16579 | (prog1 |
16580 | (let ((gnus-killed-assoc nil) | |
16581 | gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) | |
16582 | (prog1 | |
16583 | (condition-case nil | |
16584 | (load file t t t) | |
16585 | (error nil)) | |
16586 | (setq newsrc gnus-newsrc-assoc | |
16587 | killed gnus-killed-assoc | |
16588 | marked gnus-marked-assoc))) | |
16589 | (setq gnus-newsrc-alist nil) | |
231f989b LMI |
16590 | (while (setq group (pop newsrc)) |
16591 | (if (setq info (gnus-get-info (car group))) | |
16592 | (progn | |
16593 | (gnus-info-set-read info (cddr group)) | |
16594 | (gnus-info-set-level | |
16595 | info (if (nth 1 group) gnus-level-default-subscribed | |
16596 | gnus-level-default-unsubscribed)) | |
16597 | (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) | |
16598 | (push (setq info | |
16599 | (list (car group) | |
16600 | (if (nth 1 group) gnus-level-default-subscribed | |
16601 | gnus-level-default-unsubscribed) | |
16602 | (cddr group))) | |
16603 | gnus-newsrc-alist)) | |
16604 | ;; Copy marks into info. | |
16605 | (when (setq m (assoc (car group) marked)) | |
16606 | (unless (nthcdr 3 info) | |
16607 | (nconc info (list nil))) | |
16608 | (gnus-info-set-marks | |
16609 | info (list (cons 'tick (gnus-compress-sequence | |
16610 | (sort (cdr m) '<) t)))))) | |
41487370 LMI |
16611 | (setq newsrc killed) |
16612 | (while newsrc | |
231f989b | 16613 | (setcar newsrc (caar newsrc)) |
41487370 LMI |
16614 | (setq newsrc (cdr newsrc))) |
16615 | (setq gnus-killed-list killed)) | |
16616 | ;; The .el file version of this variable does not begin with | |
16617 | ;; "options", while the .eld version does, so we just add it if it | |
16618 | ;; isn't there. | |
16619 | (and | |
231f989b | 16620 | gnus-newsrc-options |
41487370 LMI |
16621 | (progn |
16622 | (and (not (string-match "^ *options" gnus-newsrc-options)) | |
16623 | (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) | |
16624 | (and (not (string-match "\n$" gnus-newsrc-options)) | |
16625 | (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) | |
16626 | ;; Finally, if we read some options lines, we parse them. | |
16627 | (or (string= gnus-newsrc-options "") | |
16628 | (gnus-newsrc-parse-options gnus-newsrc-options)))) | |
16629 | ||
16630 | (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) | |
16631 | (gnus-make-hashtable-from-newsrc-alist))) | |
231f989b | 16632 | |
745bc783 JB |
16633 | (defun gnus-make-newsrc-file (file) |
16634 | "Make server dependent file name by catenating FILE and server host name." | |
16635 | (let* ((file (expand-file-name file nil)) | |
41487370 LMI |
16636 | (real-file (concat file "-" (nth 1 gnus-select-method)))) |
16637 | (if (or (file-exists-p real-file) | |
16638 | (file-exists-p (concat real-file ".el")) | |
16639 | (file-exists-p (concat real-file ".eld"))) | |
16640 | real-file file))) | |
16641 | ||
745bc783 | 16642 | (defun gnus-newsrc-to-gnus-format () |
41487370 LMI |
16643 | (setq gnus-newsrc-options "") |
16644 | (setq gnus-newsrc-options-n nil) | |
16645 | ||
16646 | (or gnus-active-hashtb | |
16647 | (setq gnus-active-hashtb (make-vector 4095 0))) | |
16648 | (let ((buf (current-buffer)) | |
16649 | (already-read (> (length gnus-newsrc-alist) 1)) | |
16650 | group subscribed options-symbol newsrc Options-symbol | |
16651 | symbol reads num1) | |
745bc783 | 16652 | (goto-char (point-min)) |
41487370 LMI |
16653 | ;; We intern the symbol `options' in the active hashtb so that we |
16654 | ;; can `eq' against it later. | |
16655 | (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) | |
16656 | (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) | |
231f989b | 16657 | |
41487370 LMI |
16658 | (while (not (eobp)) |
16659 | ;; We first read the first word on the line by narrowing and | |
16660 | ;; then reading into `gnus-active-hashtb'. Most groups will | |
16661 | ;; already exist in that hashtb, so this will save some string | |
16662 | ;; space. | |
16663 | (narrow-to-region | |
16664 | (point) | |
16665 | (progn (skip-chars-forward "^ \t!:\n") (point))) | |
16666 | (goto-char (point-min)) | |
231f989b | 16667 | (setq symbol |
41487370 LMI |
16668 | (and (/= (point-min) (point-max)) |
16669 | (let ((obarray gnus-active-hashtb)) (read buf)))) | |
16670 | (widen) | |
16671 | ;; Now, the symbol we have read is either `options' or a group | |
231f989b LMI |
16672 | ;; name. If it is an options line, we just add it to a string. |
16673 | (cond | |
41487370 LMI |
16674 | ((or (eq symbol options-symbol) |
16675 | (eq symbol Options-symbol)) | |
16676 | (setq gnus-newsrc-options | |
b94ae5f7 | 16677 | ;; This concating is quite inefficient, but since our |
41487370 LMI |
16678 | ;; thorough studies show that approx 99.37% of all |
16679 | ;; .newsrc files only contain a single options line, we | |
16680 | ;; don't give a damn, frankly, my dear. | |
16681 | (concat gnus-newsrc-options | |
231f989b | 16682 | (buffer-substring |
41487370 LMI |
16683 | (gnus-point-at-bol) |
16684 | ;; Options may continue on the next line. | |
16685 | (or (and (re-search-forward "^[^ \t]" nil 'move) | |
16686 | (progn (beginning-of-line) (point))) | |
16687 | (point))))) | |
16688 | (forward-line -1)) | |
16689 | (symbol | |
231f989b LMI |
16690 | ;; Group names can be just numbers. |
16691 | (when (numberp symbol) | |
16692 | (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) | |
41487370 LMI |
16693 | (or (boundp symbol) (set symbol nil)) |
16694 | ;; It was a group name. | |
16695 | (setq subscribed (= (following-char) ?:) | |
16696 | group (symbol-name symbol) | |
16697 | reads nil) | |
16698 | (if (eolp) | |
16699 | ;; If the line ends here, this is clearly a buggy line, so | |
16700 | ;; we put point a the beginning of line and let the cond | |
16701 | ;; below do the error handling. | |
16702 | (beginning-of-line) | |
16703 | ;; We skip to the beginning of the ranges. | |
16704 | (skip-chars-forward "!: \t")) | |
16705 | ;; We are now at the beginning of the list of read articles. | |
16706 | ;; We read them range by range. | |
16707 | (while | |
231f989b | 16708 | (cond |
41487370 LMI |
16709 | ((looking-at "[0-9]+") |
16710 | ;; We narrow and read a number instead of buffer-substring/ | |
231f989b | 16711 | ;; string-to-int because it's faster. narrow/widen is |
41487370 LMI |
16712 | ;; faster than save-restriction/narrow, and save-restriction |
16713 | ;; produces a garbage object. | |
16714 | (setq num1 (progn | |
16715 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
16716 | (read buf))) | |
16717 | (widen) | |
16718 | ;; If the next character is a dash, then this is a range. | |
16719 | (if (= (following-char) ?-) | |
16720 | (progn | |
16721 | ;; We read the upper bound of the range. | |
16722 | (forward-char 1) | |
16723 | (if (not (looking-at "[0-9]+")) | |
16724 | ;; This is a buggy line, by we pretend that | |
231f989b LMI |
16725 | ;; it's kinda OK. Perhaps the user should be |
16726 | ;; dinged? | |
41487370 | 16727 | (setq reads (cons num1 reads)) |
231f989b LMI |
16728 | (setq reads |
16729 | (cons | |
41487370 LMI |
16730 | (cons num1 |
16731 | (progn | |
231f989b | 16732 | (narrow-to-region (match-beginning 0) |
41487370 LMI |
16733 | (match-end 0)) |
16734 | (read buf))) | |
16735 | reads)) | |
16736 | (widen))) | |
16737 | ;; It was just a simple number, so we add it to the | |
16738 | ;; list of ranges. | |
16739 | (setq reads (cons num1 reads))) | |
16740 | ;; If the next char in ?\n, then we have reached the end | |
16741 | ;; of the line and return nil. | |
16742 | (/= (following-char) ?\n)) | |
16743 | ((= (following-char) ?\n) | |
16744 | ;; End of line, so we end. | |
16745 | nil) | |
16746 | (t | |
16747 | ;; Not numbers and not eol, so this might be a buggy | |
231f989b LMI |
16748 | ;; line... |
16749 | (or (eobp) | |
41487370 LMI |
16750 | ;; If it was eob instead of ?\n, we allow it. |
16751 | (progn | |
16752 | ;; The line was buggy. | |
16753 | (setq group nil) | |
231f989b LMI |
16754 | (gnus-error 3.1 "Mangled line: %s" |
16755 | (buffer-substring (gnus-point-at-bol) | |
16756 | (gnus-point-at-eol))))) | |
41487370 | 16757 | nil)) |
231f989b | 16758 | ;; Skip past ", ". Spaces are illegal in these ranges, but |
41487370 LMI |
16759 | ;; we allow them, because it's a common mistake to put a |
16760 | ;; space after the comma. | |
16761 | (skip-chars-forward ", ")) | |
16762 | ||
16763 | ;; We have already read .newsrc.eld, so we gently update the | |
16764 | ;; data in the hash table with the information we have just | |
231f989b LMI |
16765 | ;; read. |
16766 | (when group | |
16767 | (let ((info (gnus-get-info group)) | |
41487370 LMI |
16768 | level) |
16769 | (if info | |
16770 | ;; There is an entry for this file in the alist. | |
16771 | (progn | |
231f989b | 16772 | (gnus-info-set-read info (nreverse reads)) |
41487370 LMI |
16773 | ;; We update the level very gently. In fact, we |
16774 | ;; only change it if there's been a status change | |
16775 | ;; from subscribed to unsubscribed, or vice versa. | |
231f989b | 16776 | (setq level (gnus-info-level info)) |
41487370 LMI |
16777 | (cond ((and (<= level gnus-level-subscribed) |
16778 | (not subscribed)) | |
16779 | (setq level (if reads | |
231f989b | 16780 | gnus-level-default-unsubscribed |
41487370 LMI |
16781 | (1+ gnus-level-default-unsubscribed)))) |
16782 | ((and (> level gnus-level-subscribed) subscribed) | |
16783 | (setq level gnus-level-default-subscribed))) | |
231f989b | 16784 | (gnus-info-set-level info level)) |
41487370 | 16785 | ;; This is a new group. |
231f989b | 16786 | (setq info (list group |
41487370 | 16787 | (if subscribed |
231f989b | 16788 | gnus-level-default-subscribed |
41487370 LMI |
16789 | (if reads |
16790 | (1+ gnus-level-subscribed) | |
16791 | gnus-level-default-unsubscribed)) | |
16792 | (nreverse reads)))) | |
16793 | (setq newsrc (cons info newsrc)))))) | |
16794 | (forward-line 1)) | |
231f989b | 16795 | |
41487370 LMI |
16796 | (setq newsrc (nreverse newsrc)) |
16797 | ||
16798 | (if (not already-read) | |
16799 | () | |
16800 | ;; We now have two newsrc lists - `newsrc', which is what we | |
16801 | ;; have read from .newsrc, and `gnus-newsrc-alist', which is | |
231f989b LMI |
16802 | ;; what we've read from .newsrc.eld. We have to merge these |
16803 | ;; lists. We do this by "attaching" any (foreign) groups in the | |
16804 | ;; gnus-newsrc-alist to the (native) group that precedes them. | |
41487370 LMI |
16805 | (let ((rc (cdr gnus-newsrc-alist)) |
16806 | (prev gnus-newsrc-alist) | |
16807 | entry mentry) | |
16808 | (while rc | |
16809 | (or (null (nth 4 (car rc))) ; It's a native group. | |
231f989b LMI |
16810 | (assoc (caar rc) newsrc) ; It's already in the alist. |
16811 | (if (setq entry (assoc (caar prev) newsrc)) | |
41487370 LMI |
16812 | (setcdr (setq mentry (memq entry newsrc)) |
16813 | (cons (car rc) (cdr mentry))) | |
16814 | (setq newsrc (cons (car rc) newsrc)))) | |
16815 | (setq prev rc | |
16816 | rc (cdr rc))))) | |
16817 | ||
16818 | (setq gnus-newsrc-alist newsrc) | |
16819 | ;; We make the newsrc hashtb. | |
16820 | (gnus-make-hashtable-from-newsrc-alist) | |
16821 | ||
16822 | ;; Finally, if we read some options lines, we parse them. | |
16823 | (or (string= gnus-newsrc-options "") | |
16824 | (gnus-newsrc-parse-options gnus-newsrc-options)))) | |
16825 | ||
16826 | ;; Parse options lines to find "options -n !all rec.all" and stuff. | |
16827 | ;; The return value will be a list on the form | |
16828 | ;; ((regexp1 . ignore) | |
16829 | ;; (regexp2 . subscribe)...) | |
16830 | ;; When handling new newsgroups, groups that match a `ignore' regexp | |
16831 | ;; will be ignored, and groups that match a `subscribe' regexp will be | |
231f989b | 16832 | ;; subscribed. A line like |
41487370 LMI |
16833 | ;; options -n !all rec.all |
16834 | ;; will lead to a list that looks like | |
231f989b | 16835 | ;; (("^rec\\..+" . subscribe) |
41487370 LMI |
16836 | ;; ("^.+" . ignore)) |
16837 | ;; So all "rec.*" groups will be subscribed, while all the other | |
231f989b LMI |
16838 | ;; groups will be ignored. Note that "options -n !all rec.all" is very |
16839 | ;; different from "options -n rec.all !all". | |
41487370 LMI |
16840 | (defun gnus-newsrc-parse-options (options) |
16841 | (let (out eol) | |
16842 | (save-excursion | |
16843 | (gnus-set-work-buffer) | |
16844 | (insert (regexp-quote options)) | |
16845 | ;; First we treat all continuation lines. | |
16846 | (goto-char (point-min)) | |
16847 | (while (re-search-forward "\n[ \t]+" nil t) | |
16848 | (replace-match " " t t)) | |
16849 | ;; Then we transform all "all"s into ".+"s. | |
16850 | (goto-char (point-min)) | |
16851 | (while (re-search-forward "\\ball\\b" nil t) | |
16852 | (replace-match ".+" t t)) | |
16853 | (goto-char (point-min)) | |
16854 | ;; We remove all other options than the "-n" ones. | |
16855 | (while (re-search-forward "[ \t]-[^n][^-]*" nil t) | |
16856 | (replace-match " ") | |
16857 | (forward-char -1)) | |
16858 | (goto-char (point-min)) | |
16859 | ||
16860 | ;; We are only interested in "options -n" lines - we | |
16861 | ;; ignore the other option lines. | |
16862 | (while (re-search-forward "[ \t]-n" nil t) | |
231f989b | 16863 | (setq eol |
41487370 LMI |
16864 | (or (save-excursion |
16865 | (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) | |
16866 | (- (point) 2))) | |
16867 | (gnus-point-at-eol))) | |
16868 | ;; Search for all "words"... | |
16869 | (while (re-search-forward "[^ \t,\n]+" eol t) | |
16870 | (if (= (char-after (match-beginning 0)) ?!) | |
16871 | ;; If the word begins with a bang (!), this is a "not" | |
231f989b | 16872 | ;; spec. We put this spec (minus the bang) and the |
41487370 | 16873 | ;; symbol `ignore' into the list. |
231f989b LMI |
16874 | (setq out (cons (cons (concat |
16875 | "^" (buffer-substring | |
41487370 LMI |
16876 | (1+ (match-beginning 0)) |
16877 | (match-end 0))) | |
16878 | 'ignore) out)) | |
16879 | ;; There was no bang, so this is a "yes" spec. | |
231f989b | 16880 | (setq out (cons (cons (concat "^" (match-string 0)) |
41487370 | 16881 | 'subscribe) out))))) |
231f989b | 16882 | |
41487370 | 16883 | (setq gnus-newsrc-options-n out)))) |
745bc783 | 16884 | |
231f989b | 16885 | (defun gnus-save-newsrc-file (&optional force) |
41487370 | 16886 | "Save .newsrc file." |
745bc783 | 16887 | ;; Note: We cannot save .newsrc file if all newsgroups are removed |
41487370 | 16888 | ;; from the variable gnus-newsrc-alist. |
231f989b LMI |
16889 | (when (and (or gnus-newsrc-alist gnus-killed-list) |
16890 | gnus-current-startup-file) | |
16891 | (save-excursion | |
16892 | (if (and (or gnus-use-dribble-file gnus-slave) | |
16893 | (not force) | |
16894 | (or (not gnus-dribble-buffer) | |
16895 | (not (buffer-name gnus-dribble-buffer)) | |
16896 | (zerop (save-excursion | |
16897 | (set-buffer gnus-dribble-buffer) | |
16898 | (buffer-size))))) | |
16899 | (gnus-message 4 "(No changes need to be saved)") | |
16900 | (run-hooks 'gnus-save-newsrc-hook) | |
16901 | (if gnus-slave | |
16902 | (gnus-slave-save-newsrc) | |
16903 | ;; Save .newsrc. | |
16904 | (when gnus-save-newsrc-file | |
16905 | (gnus-message 5 "Saving %s..." gnus-current-startup-file) | |
16906 | (gnus-gnus-to-newsrc-format) | |
16907 | (gnus-message 5 "Saving %s...done" gnus-current-startup-file)) | |
16908 | ;; Save .newsrc.eld. | |
16909 | (set-buffer (get-buffer-create " *Gnus-newsrc*")) | |
16910 | (make-local-variable 'version-control) | |
16911 | (setq version-control 'never) | |
16912 | (setq buffer-file-name | |
16913 | (concat gnus-current-startup-file ".eld")) | |
16914 | (setq default-directory (file-name-directory buffer-file-name)) | |
16915 | (gnus-add-current-to-buffer-list) | |
16916 | (buffer-disable-undo (current-buffer)) | |
16917 | (erase-buffer) | |
16918 | (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) | |
16919 | (gnus-gnus-to-quick-newsrc-format) | |
16920 | (run-hooks 'gnus-save-quick-newsrc-hook) | |
16921 | (save-buffer) | |
16922 | (kill-buffer (current-buffer)) | |
16923 | (gnus-message | |
16924 | 5 "Saving %s.eld...done" gnus-current-startup-file)) | |
16925 | (gnus-dribble-delete-file) | |
16926 | (gnus-group-set-mode-line))))) | |
745bc783 JB |
16927 | |
16928 | (defun gnus-gnus-to-quick-newsrc-format () | |
41487370 LMI |
16929 | "Insert Gnus variables such as gnus-newsrc-alist in lisp format." |
16930 | (insert ";; Gnus startup file.\n") | |
16931 | (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n") | |
16932 | (insert ";; to read .newsrc.\n") | |
16933 | (insert "(setq gnus-newsrc-file-version " | |
16934 | (prin1-to-string gnus-version) ")\n") | |
231f989b LMI |
16935 | (let ((variables |
16936 | (if gnus-save-killed-list gnus-variable-list | |
16937 | ;; Remove the `gnus-killed-list' from the list of variables | |
16938 | ;; to be saved, if required. | |
16939 | (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) | |
16940 | ;; Peel off the "dummy" group. | |
41487370 LMI |
16941 | (gnus-newsrc-alist (cdr gnus-newsrc-alist)) |
16942 | variable) | |
231f989b | 16943 | ;; Insert the variables into the file. |
745bc783 | 16944 | (while variables |
231f989b LMI |
16945 | (when (and (boundp (setq variable (pop variables))) |
16946 | (symbol-value variable)) | |
16947 | (insert "(setq " (symbol-name variable) " '") | |
16948 | (prin1 (symbol-value variable) (current-buffer)) | |
16949 | (insert ")\n"))))) | |
41487370 LMI |
16950 | |
16951 | (defun gnus-gnus-to-newsrc-format () | |
16952 | ;; Generate and save the .newsrc file. | |
231f989b LMI |
16953 | (save-excursion |
16954 | (set-buffer (create-file-buffer gnus-current-startup-file)) | |
16955 | (let ((newsrc (cdr gnus-newsrc-alist)) | |
16956 | (standard-output (current-buffer)) | |
16957 | info ranges range method) | |
41487370 | 16958 | (setq buffer-file-name gnus-current-startup-file) |
231f989b | 16959 | (setq default-directory (file-name-directory buffer-file-name)) |
41487370 LMI |
16960 | (buffer-disable-undo (current-buffer)) |
16961 | (erase-buffer) | |
16962 | ;; Write options. | |
16963 | (if gnus-newsrc-options (insert gnus-newsrc-options)) | |
16964 | ;; Write subscribed and unsubscribed. | |
231f989b LMI |
16965 | (while (setq info (pop newsrc)) |
16966 | ;; Don't write foreign groups to .newsrc. | |
16967 | (when (or (null (setq method (gnus-info-method info))) | |
16968 | (equal method "native") | |
16969 | (gnus-server-equal method gnus-select-method)) | |
16970 | (insert (gnus-info-group info) | |
16971 | (if (> (gnus-info-level info) gnus-level-subscribed) | |
16972 | "!" ":")) | |
16973 | (when (setq ranges (gnus-info-read info)) | |
16974 | (insert " ") | |
16975 | (if (not (listp (cdr ranges))) | |
16976 | (if (= (car ranges) (cdr ranges)) | |
16977 | (princ (car ranges)) | |
16978 | (princ (car ranges)) | |
16979 | (insert "-") | |
16980 | (princ (cdr ranges))) | |
16981 | (while (setq range (pop ranges)) | |
16982 | (if (or (atom range) (= (car range) (cdr range))) | |
16983 | (princ (or (and (atom range) range) (car range))) | |
16984 | (princ (car range)) | |
16985 | (insert "-") | |
16986 | (princ (cdr range))) | |
16987 | (if ranges (insert ","))))) | |
16988 | (insert "\n"))) | |
e9110dc5 RS |
16989 | (make-local-variable 'version-control) |
16990 | (setq version-control 'never) | |
41487370 | 16991 | ;; It has been reported that sometime the modtime on the .newsrc |
231f989b LMI |
16992 | ;; file seems to be off. We really do want to overwrite it, so |
16993 | ;; we clear the modtime here before saving. It's a bit odd, | |
16994 | ;; though... | |
41487370 LMI |
16995 | ;; sometimes the modtime clear isn't sufficient. most brute force: |
16996 | ;; delete the silly thing entirely first. but this fails to provide | |
16997 | ;; such niceties as .newsrc~ creation. | |
16998 | (if gnus-modtime-botch | |
16999 | (delete-file gnus-startup-file) | |
17000 | (clear-visited-file-modtime)) | |
231f989b | 17001 | (run-hooks 'gnus-save-standard-newsrc-hook) |
41487370 LMI |
17002 | (save-buffer) |
17003 | (kill-buffer (current-buffer))))) | |
17004 | ||
231f989b LMI |
17005 | \f |
17006 | ;;; | |
17007 | ;;; Slave functions. | |
17008 | ;;; | |
17009 | ||
17010 | (defun gnus-slave-save-newsrc () | |
17011 | (save-excursion | |
17012 | (set-buffer gnus-dribble-buffer) | |
17013 | (let ((slave-name | |
17014 | (make-temp-name (concat gnus-current-startup-file "-slave-")))) | |
17015 | (write-region (point-min) (point-max) slave-name nil 'nomesg)))) | |
17016 | ||
17017 | (defun gnus-master-read-slave-newsrc () | |
17018 | (let ((slave-files | |
17019 | (directory-files | |
17020 | (file-name-directory gnus-current-startup-file) | |
17021 | t (concat | |
17022 | "^" (regexp-quote | |
17023 | (concat | |
17024 | (file-name-nondirectory gnus-current-startup-file) | |
17025 | "-slave-"))) | |
17026 | t)) | |
17027 | file) | |
17028 | (if (not slave-files) | |
17029 | () ; There are no slave files to read. | |
17030 | (gnus-message 7 "Reading slave newsrcs...") | |
17031 | (save-excursion | |
17032 | (set-buffer (get-buffer-create " *gnus slave*")) | |
17033 | (buffer-disable-undo (current-buffer)) | |
17034 | (setq slave-files | |
17035 | (sort (mapcar (lambda (file) | |
17036 | (list (nth 5 (file-attributes file)) file)) | |
17037 | slave-files) | |
17038 | (lambda (f1 f2) | |
17039 | (or (< (caar f1) (caar f2)) | |
17040 | (< (nth 1 (car f1)) (nth 1 (car f2))))))) | |
17041 | (while slave-files | |
17042 | (erase-buffer) | |
17043 | (setq file (nth 1 (car slave-files))) | |
17044 | (insert-file-contents file) | |
17045 | (if (condition-case () | |
17046 | (progn | |
17047 | (eval-buffer (current-buffer)) | |
17048 | t) | |
17049 | (error | |
17050 | (gnus-error 3.2 "Possible error in %s" file) | |
17051 | nil)) | |
17052 | (or gnus-slave ; Slaves shouldn't delete these files. | |
17053 | (condition-case () | |
17054 | (delete-file file) | |
17055 | (error nil)))) | |
17056 | (setq slave-files (cdr slave-files)))) | |
17057 | (gnus-message 7 "Reading slave newsrcs...done")))) | |
17058 | ||
17059 | \f | |
17060 | ;;; | |
17061 | ;;; Group description. | |
17062 | ;;; | |
17063 | ||
41487370 | 17064 | (defun gnus-read-all-descriptions-files () |
231f989b LMI |
17065 | (let ((methods (cons gnus-select-method |
17066 | (nconc | |
564b670b | 17067 | (when (gnus-archive-server-wanted-p) |
231f989b LMI |
17068 | (list "archive")) |
17069 | gnus-secondary-select-methods)))) | |
41487370 LMI |
17070 | (while methods |
17071 | (gnus-read-descriptions-file (car methods)) | |
17072 | (setq methods (cdr methods))) | |
17073 | t)) | |
17074 | ||
17075 | (defun gnus-read-descriptions-file (&optional method) | |
231f989b LMI |
17076 | (let ((method (or method gnus-select-method)) |
17077 | group) | |
17078 | (when (stringp method) | |
17079 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
17080 | ;; We create the hashtable whether we manage to read the desc file |
17081 | ;; to avoid trying to re-read after a failed read. | |
17082 | (or gnus-description-hashtb | |
231f989b | 17083 | (setq gnus-description-hashtb |
41487370 LMI |
17084 | (gnus-make-hashtable (length gnus-active-hashtb)))) |
17085 | ;; Mark this method's desc file as read. | |
17086 | (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" | |
17087 | gnus-description-hashtb) | |
17088 | ||
17089 | (gnus-message 5 "Reading descriptions file via %s..." (car method)) | |
231f989b | 17090 | (cond |
41487370 LMI |
17091 | ((not (gnus-check-server method)) |
17092 | (gnus-message 1 "Couldn't open server") | |
17093 | nil) | |
17094 | ((not (gnus-request-list-newsgroups method)) | |
17095 | (gnus-message 1 "Couldn't read newsgroups descriptions") | |
17096 | nil) | |
17097 | (t | |
231f989b LMI |
17098 | (save-excursion |
17099 | (save-restriction | |
17100 | (set-buffer nntp-server-buffer) | |
17101 | (goto-char (point-min)) | |
17102 | (when (or (search-forward "\n.\n" nil t) | |
41487370 | 17103 | (goto-char (point-max))) |
231f989b LMI |
17104 | (beginning-of-line) |
17105 | (narrow-to-region (point-min) (point))) | |
17106 | ;; If these are groups from a foreign select method, we insert the | |
17107 | ;; group prefix in front of the group names. | |
17108 | (and method (not (gnus-server-equal | |
17109 | (gnus-server-get-method nil method) | |
17110 | (gnus-server-get-method nil gnus-select-method))) | |
17111 | (let ((prefix (gnus-group-prefixed-name "" method))) | |
17112 | (goto-char (point-min)) | |
17113 | (while (and (not (eobp)) | |
17114 | (progn (insert prefix) | |
17115 | (zerop (forward-line 1))))))) | |
17116 | (goto-char (point-min)) | |
17117 | (while (not (eobp)) | |
17118 | ;; If we get an error, we set group to 0, which is not a | |
17119 | ;; symbol... | |
17120 | (setq group | |
17121 | (condition-case () | |
17122 | (let ((obarray gnus-description-hashtb)) | |
17123 | ;; Group is set to a symbol interned in this | |
17124 | ;; hash table. | |
17125 | (read nntp-server-buffer)) | |
17126 | (error 0))) | |
17127 | (skip-chars-forward " \t") | |
17128 | ;; ... which leads to this line being effectively ignored. | |
17129 | (and (symbolp group) | |
17130 | (set group (buffer-substring | |
17131 | (point) (progn (end-of-line) (point))))) | |
17132 | (forward-line 1)))) | |
17133 | (gnus-message 5 "Reading descriptions file...done") | |
17134 | t)))) | |
41487370 LMI |
17135 | |
17136 | (defun gnus-group-get-description (group) | |
231f989b LMI |
17137 | "Get the description of a group by sending XGTITLE to the server." |
17138 | (when (gnus-request-group-description group) | |
17139 | (save-excursion | |
17140 | (set-buffer nntp-server-buffer) | |
17141 | (goto-char (point-min)) | |
17142 | (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") | |
17143 | (match-string 1))))) | |
41487370 | 17144 | |
231f989b | 17145 | \f |
41487370 | 17146 | ;;; |
231f989b | 17147 | ;;; Buffering of read articles. |
41487370 LMI |
17148 | ;;; |
17149 | ||
231f989b LMI |
17150 | (defvar gnus-backlog-buffer " *Gnus Backlog*") |
17151 | (defvar gnus-backlog-articles nil) | |
17152 | (defvar gnus-backlog-hashtb nil) | |
41487370 | 17153 | |
231f989b LMI |
17154 | (defun gnus-backlog-buffer () |
17155 | "Return the backlog buffer." | |
17156 | (or (get-buffer gnus-backlog-buffer) | |
17157 | (save-excursion | |
17158 | (set-buffer (get-buffer-create gnus-backlog-buffer)) | |
17159 | (buffer-disable-undo (current-buffer)) | |
17160 | (setq buffer-read-only t) | |
17161 | (gnus-add-current-to-buffer-list) | |
17162 | (get-buffer gnus-backlog-buffer)))) | |
17163 | ||
17164 | (defun gnus-backlog-setup () | |
17165 | "Initialize backlog variables." | |
17166 | (unless gnus-backlog-hashtb | |
17167 | (setq gnus-backlog-hashtb (make-vector 1023 0)))) | |
17168 | ||
17169 | (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) | |
17170 | ||
17171 | (defun gnus-backlog-shutdown () | |
17172 | "Clear all backlog variables and buffers." | |
17173 | (when (get-buffer gnus-backlog-buffer) | |
17174 | (kill-buffer gnus-backlog-buffer)) | |
17175 | (setq gnus-backlog-hashtb nil | |
17176 | gnus-backlog-articles nil)) | |
17177 | ||
17178 | (defun gnus-backlog-enter-article (group number buffer) | |
17179 | (gnus-backlog-setup) | |
17180 | (let ((ident (intern (concat group ":" (int-to-string number)) | |
17181 | gnus-backlog-hashtb)) | |
17182 | b) | |
17183 | (if (memq ident gnus-backlog-articles) | |
17184 | () ; It's already kept. | |
17185 | ;; Remove the oldest article, if necessary. | |
17186 | (and (numberp gnus-keep-backlog) | |
17187 | (>= (length gnus-backlog-articles) gnus-keep-backlog) | |
17188 | (gnus-backlog-remove-oldest-article)) | |
17189 | (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) | |
17190 | ;; Insert the new article. | |
17191 | (save-excursion | |
17192 | (set-buffer (gnus-backlog-buffer)) | |
17193 | (let (buffer-read-only) | |
17194 | (goto-char (point-max)) | |
17195 | (or (bolp) (insert "\n")) | |
17196 | (setq b (point)) | |
17197 | (insert-buffer-substring buffer) | |
17198 | ;; Tag the beginning of the article with the ident. | |
17199 | (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) | |
41487370 | 17200 | |
231f989b | 17201 | (defun gnus-backlog-remove-oldest-article () |
41487370 | 17202 | (save-excursion |
231f989b LMI |
17203 | (set-buffer (gnus-backlog-buffer)) |
17204 | (goto-char (point-min)) | |
17205 | (if (zerop (buffer-size)) | |
17206 | () ; The buffer is empty. | |
17207 | (let ((ident (get-text-property (point) 'gnus-backlog)) | |
17208 | buffer-read-only) | |
17209 | ;; Remove the ident from the list of articles. | |
17210 | (when ident | |
17211 | (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) | |
17212 | ;; Delete the article itself. | |
17213 | (delete-region | |
17214 | (point) (next-single-property-change | |
17215 | (1+ (point)) 'gnus-backlog nil (point-max))))))) | |
17216 | ||
17217 | (defun gnus-backlog-remove-article (group number) | |
17218 | "Remove article NUMBER in GROUP from the backlog." | |
17219 | (when (numberp number) | |
17220 | (gnus-backlog-setup) | |
17221 | (let ((ident (intern (concat group ":" (int-to-string number)) | |
17222 | gnus-backlog-hashtb)) | |
17223 | beg end) | |
17224 | (when (memq ident gnus-backlog-articles) | |
17225 | ;; It was in the backlog. | |
17226 | (save-excursion | |
17227 | (set-buffer (gnus-backlog-buffer)) | |
17228 | (let (buffer-read-only) | |
17229 | (when (setq beg (text-property-any | |
17230 | (point-min) (point-max) 'gnus-backlog | |
17231 | ident)) | |
17232 | ;; Find the end (i. e., the beginning of the next article). | |
17233 | (setq end | |
17234 | (next-single-property-change | |
17235 | (1+ beg) 'gnus-backlog (current-buffer) (point-max))) | |
17236 | (delete-region beg end) | |
17237 | ;; Return success. | |
17238 | t))))))) | |
17239 | ||
17240 | (defun gnus-backlog-request-article (group number buffer) | |
17241 | (when (numberp number) | |
17242 | (gnus-backlog-setup) | |
17243 | (let ((ident (intern (concat group ":" (int-to-string number)) | |
17244 | gnus-backlog-hashtb)) | |
17245 | beg end) | |
17246 | (when (memq ident gnus-backlog-articles) | |
17247 | ;; It was in the backlog. | |
17248 | (save-excursion | |
17249 | (set-buffer (gnus-backlog-buffer)) | |
17250 | (if (not (setq beg (text-property-any | |
17251 | (point-min) (point-max) 'gnus-backlog | |
17252 | ident))) | |
17253 | ;; It wasn't in the backlog after all. | |
17254 | (ignore | |
17255 | (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) | |
17256 | ;; Find the end (i. e., the beginning of the next article). | |
17257 | (setq end | |
17258 | (next-single-property-change | |
17259 | (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) | |
17260 | (let ((buffer-read-only nil)) | |
17261 | (erase-buffer) | |
17262 | (insert-buffer-substring gnus-backlog-buffer beg end) | |
17263 | t))))) | |
41487370 LMI |
17264 | |
17265 | ;; Allow redefinition of Gnus functions. | |
17266 | ||
17267 | (gnus-ems-redefine) | |
17268 | ||
17269 | (provide 'gnus) | |
44cdca98 RS |
17270 | |
17271 | ;;; gnus.el ends here |