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 | ||
41487370 LMI |
58 | (defvar gnus-local-organization nil |
59 | "String with a description of what organization (if any) the user belongs to. | |
60 | The ORGANIZATION environment variable is used instead if it is defined. | |
61 | If this variable contains a function, this function will be called | |
231f989b | 62 | with the current newsgroup name as the argument. The function should |
41487370 LMI |
63 | return a string. |
64 | ||
65 | In any case, if the string (either in the variable, in the environment | |
66 | variable, or returned by the function) is a file name, the contents of | |
67 | this file will be used as the organization.") | |
68 | ||
41487370 LMI |
69 | ;; Customization variables |
70 | ||
71 | ;; Don't touch this variable. | |
343fbb30 | 72 | (defvar gnus-nntp-service "nntp" |
b027f415 | 73 | "*NNTP service name (\"nntp\" or 119). |
231f989b | 74 | This is an obsolete variable, which is scarcely used. If you use an |
41487370 LMI |
75 | nntp server for your newsgroup and want to change the port number |
76 | used to 899, you would say something along these lines: | |
b027f415 | 77 | |
41487370 LMI |
78 | (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") |
79 | ||
231f989b LMI |
80 | (defvar gnus-nntpserver-file "/etc/nntpserver" |
81 | "*A file with only the name of the nntp server in it.") | |
82 | ||
83 | ;; This function is used to check both the environment variable | |
84 | ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find | |
85 | ;; an nntp server name default. | |
86 | (defun gnus-getenv-nntpserver () | |
87 | (or (getenv "NNTPSERVER") | |
88 | (and (file-readable-p gnus-nntpserver-file) | |
89 | (save-excursion | |
90 | (set-buffer (get-buffer-create " *gnus nntp*")) | |
91 | (buffer-disable-undo (current-buffer)) | |
92 | (insert-file-contents gnus-nntpserver-file) | |
93 | (let ((name (buffer-string))) | |
94 | (prog1 | |
95 | (if (string-match "^[ \t\n]*$" name) | |
96 | nil | |
97 | name) | |
98 | (kill-buffer (current-buffer)))))))) | |
99 | ||
100 | (defvar gnus-select-method | |
41487370 | 101 | (nconc |
231f989b LMI |
102 | (list 'nntp (or (condition-case () |
103 | (gnus-getenv-nntpserver) | |
104 | (error nil)) | |
41487370 LMI |
105 | (if (and gnus-default-nntp-server |
106 | (not (string= gnus-default-nntp-server ""))) | |
107 | gnus-default-nntp-server) | |
108 | (system-name))) | |
109 | (if (or (null gnus-nntp-service) | |
110 | (equal gnus-nntp-service "nntp")) | |
231f989b | 111 | nil |
41487370 LMI |
112 | (list gnus-nntp-service))) |
113 | "*Default method for selecting a newsgroup. | |
114 | This variable should be a list, where the first element is how the | |
231f989b | 115 | news is to be fetched, the second is the address. |
41487370 LMI |
116 | |
117 | For instance, if you want to get your news via NNTP from | |
118 | \"flab.flab.edu\", you could say: | |
119 | ||
120 | (setq gnus-select-method '(nntp \"flab.flab.edu\")) | |
121 | ||
122 | If you want to use your local spool, say: | |
123 | ||
124 | (setq gnus-select-method (list 'nnspool (system-name))) | |
125 | ||
126 | If you use this variable, you must set `gnus-nntp-server' to nil. | |
127 | ||
128 | There is a lot more to know about select methods and virtual servers - | |
129 | see the manual for details.") | |
130 | ||
231f989b LMI |
131 | (defvar gnus-message-archive-method |
132 | `(nnfolder | |
133 | "archive" | |
134 | (nnfolder-directory ,(nnheader-concat message-directory "archive")) | |
135 | (nnfolder-active-file | |
136 | ,(nnheader-concat message-directory "archive/active")) | |
137 | (nnfolder-get-new-mail nil) | |
138 | (nnfolder-inhibit-expiry t)) | |
139 | "*Method used for archiving messages you've sent. | |
140 | This should be a mail method. | |
141 | ||
142 | It's probably not a very effective to change this variable once you've | |
143 | run Gnus once. After doing that, you must edit this server from the | |
144 | server buffer.") | |
41487370 | 145 | |
564b670b LMI |
146 | (defvar gnus-message-archive-group nil |
147 | "*Name of the group in which to save the messages you've written. | |
148 | This can either be a string, a list of strings; or an alist | |
149 | of regexps/functions/forms to be evaluated to return a string (or a list | |
150 | of strings). The functions are called with the name of the current | |
151 | group (or nil) as a parameter. | |
152 | ||
153 | Normally the group names returned by this variable should be | |
154 | unprefixed -- which implictly means \"store on the archive server\". | |
155 | However, you may wish to store the message on some other server. In | |
156 | that case, just return a fully prefixed name of the group -- | |
157 | \"nnml+private:mail.misc\", for instance.") | |
158 | ||
41487370 LMI |
159 | (defvar gnus-refer-article-method nil |
160 | "*Preferred method for fetching an article by Message-ID. | |
161 | If you are reading news from the local spool (with nnspool), fetching | |
231f989b | 162 | articles by Message-ID is painfully slow. By setting this method to an |
41487370 LMI |
163 | nntp method, you might get acceptable results. |
164 | ||
165 | The value of this variable must be a valid select method as discussed | |
231f989b | 166 | in the documentation of `gnus-select-method'.") |
41487370 LMI |
167 | |
168 | (defvar gnus-secondary-select-methods nil | |
169 | "*A list of secondary methods that will be used for reading news. | |
170 | This is a list where each element is a complete select method (see | |
231f989b | 171 | `gnus-select-method'). |
41487370 LMI |
172 | |
173 | If, for instance, you want to read your mail with the nnml backend, | |
174 | you could set this variable: | |
175 | ||
176 | (setq gnus-secondary-select-methods '((nnml \"\")))") | |
343fbb30 | 177 | |
41487370 LMI |
178 | (defvar gnus-secondary-servers nil |
179 | "*List of NNTP servers that the user can choose between interactively. | |
180 | To make Gnus query you for a server, you have to give `gnus' a | |
181 | non-numeric prefix - `C-u M-x gnus', in short.") | |
182 | ||
183 | (defvar gnus-nntp-server nil | |
184 | "*The name of the host running the NNTP server. | |
231f989b | 185 | This variable is semi-obsolete. Use the `gnus-select-method' |
41487370 LMI |
186 | variable instead.") |
187 | ||
188 | (defvar gnus-startup-file "~/.newsrc" | |
189 | "*Your `.newsrc' file. | |
190 | `.newsrc-SERVER' will be used instead if that exists.") | |
191 | ||
192 | (defvar gnus-init-file "~/.gnus" | |
193 | "*Your Gnus elisp startup file. | |
194 | If a file with the .el or .elc suffixes exist, it will be read | |
231f989b | 195 | instead.") |
41487370 LMI |
196 | |
197 | (defvar gnus-group-faq-directory | |
231f989b LMI |
198 | '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" |
199 | "/ftp@sunsite.auc.dk:/pub/usenet/" | |
200 | "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" | |
201 | "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" | |
202 | "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" | |
203 | "/ftp@rtfm.mit.edu:/pub/usenet/" | |
204 | "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" | |
205 | "/ftp@ftp.sunet.se:/pub/usenet/" | |
206 | "/ftp@nctuccca.edu.tw:/USENET/FAQ/" | |
207 | "/ftp@hwarang.postech.ac.kr:/pub/usenet/" | |
208 | "/ftp@ftp.hk.super.net:/mirror/faqs/") | |
41487370 LMI |
209 | "*Directory where the group FAQs are stored. |
210 | This will most commonly be on a remote machine, and the file will be | |
211 | fetched by ange-ftp. | |
212 | ||
231f989b | 213 | This variable can also be a list of directories. In that case, the |
564b670b LMI |
214 | first element in the list will be used by default. The others can |
215 | be used when being prompted for a site. | |
231f989b | 216 | |
41487370 LMI |
217 | Note that Gnus uses an aol machine as the default directory. If this |
218 | feels fundamentally unclean, just think of it as a way to finally get | |
219 | something of value back from them. | |
220 | ||
221 | If the default site is too slow, try one of these: | |
222 | ||
231f989b LMI |
223 | North America: mirrors.aol.com /pub/rtfm/usenet |
224 | ftp.seas.gwu.edu /pub/rtfm | |
225 | rtfm.mit.edu /pub/usenet | |
226 | Europe: ftp.uni-paderborn.de /pub/FAQ | |
227 | src.doc.ic.ac.uk /usenet/news-FAQS | |
228 | ftp.sunet.se /pub/usenet | |
229 | sunsite.auc.dk /pub/usenet | |
230 | Asia: nctuccca.edu.tw /USENET/FAQ | |
231 | hwarang.postech.ac.kr /pub/usenet | |
232 | ftp.hk.super.net /mirror/faqs") | |
41487370 LMI |
233 | |
234 | (defvar gnus-group-archive-directory | |
231f989b | 235 | "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" |
41487370 LMI |
236 | "*The address of the (ding) archives.") |
237 | ||
238 | (defvar gnus-group-recent-archive-directory | |
239 | "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" | |
240 | "*The address of the most recent (ding) articles.") | |
241 | ||
242 | (defvar gnus-default-subscribed-newsgroups nil | |
243 | "*This variable lists what newsgroups should be subscribed the first time Gnus is used. | |
244 | It should be a list of strings. | |
245 | If it is `t', Gnus will not do anything special the first time it is | |
246 | started; it'll just use the normal newsgroups subscription methods.") | |
745bc783 JB |
247 | |
248 | (defvar gnus-use-cross-reference t | |
41487370 | 249 | "*Non-nil means that cross referenced articles will be marked as read. |
b027f415 | 250 | If nil, ignore cross references. If t, mark articles as read in |
231f989b LMI |
251 | subscribed newsgroups. If neither t nor nil, mark as read in all |
252 | newsgroups.") | |
253 | ||
254 | (defvar gnus-single-article-buffer t | |
255 | "*If non-nil, display all articles in the same buffer. | |
256 | If nil, each group will get its own article buffer.") | |
745bc783 | 257 | |
41487370 LMI |
258 | (defvar gnus-use-dribble-file t |
259 | "*Non-nil means that Gnus will use a dribble file to store user updates. | |
260 | If Emacs should crash without saving the .newsrc files, complete | |
261 | information can be restored from the dribble file.") | |
745bc783 | 262 | |
231f989b LMI |
263 | (defvar gnus-dribble-directory nil |
264 | "*The directory where dribble files will be saved. | |
265 | If this variable is nil, the directory where the .newsrc files are | |
266 | saved will be used.") | |
267 | ||
41487370 LMI |
268 | (defvar gnus-asynchronous nil |
269 | "*If non-nil, Gnus will supply backends with data needed for async article fetching.") | |
270 | ||
231f989b LMI |
271 | (defvar gnus-kill-summary-on-exit t |
272 | "*If non-nil, kill the summary buffer when you exit from it. | |
273 | If nil, the summary will become a \"*Dead Summary*\" buffer, and | |
274 | it will be killed sometime later.") | |
745bc783 | 275 | |
41487370 LMI |
276 | (defvar gnus-large-newsgroup 200 |
277 | "*The number of articles which indicates a large newsgroup. | |
278 | If the number of articles in a newsgroup is greater than this value, | |
279 | confirmation is required for selecting the newsgroup.") | |
280 | ||
281 | ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>. | |
282 | (defvar gnus-no-groups-message "No news is horrible news" | |
283 | "*Message displayed by Gnus when no groups are available.") | |
284 | ||
285 | (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) | |
286 | "*Non-nil means that the default name of a file to save articles in is the group name. | |
287 | If it's nil, the directory form of the group name is used instead. | |
288 | ||
289 | If this variable is a list, and the list contains the element | |
290 | `not-score', long file names will not be used for score files; if it | |
291 | contains the element `not-save', long file names will not be used for | |
292 | saving; and if it contains the element `not-kill', long file names | |
231f989b LMI |
293 | will not be used for kill files. |
294 | ||
295 | Note that the default for this variable varies according to what system | |
296 | type you're using. On `usg-unix-v' and `xenix' this variable defaults | |
297 | to nil while on all other systems it defaults to t.") | |
41487370 | 298 | |
231f989b LMI |
299 | (defvar gnus-article-save-directory gnus-directory |
300 | "*Name of the directory articles will be saved in (default \"~/News\").") | |
745bc783 | 301 | |
231f989b LMI |
302 | (defvar gnus-kill-files-directory gnus-directory |
303 | "*Name of the directory where kill files will be stored (default \"~/News\").") | |
1507a647 | 304 | |
41487370 | 305 | (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail |
b027f415 | 306 | "*A function to save articles in your favorite format. |
745bc783 JB |
307 | The function must be interactively callable (in other words, it must |
308 | be an Emacs command). | |
309 | ||
41487370 LMI |
310 | Gnus provides the following functions: |
311 | ||
312 | * gnus-summary-save-in-rmail (Rmail format) | |
313 | * gnus-summary-save-in-mail (Unix mail format) | |
314 | * gnus-summary-save-in-folder (MH folder) | |
315 | * gnus-summary-save-in-file (article format). | |
316 | * gnus-summary-save-in-vm (use VM's folder format).") | |
745bc783 | 317 | |
231f989b LMI |
318 | (defvar gnus-prompt-before-saving 'always |
319 | "*This variable says how much prompting is to be done when saving articles. | |
320 | If it is nil, no prompting will be done, and the articles will be | |
321 | saved to the default files. If this variable is `always', each and | |
322 | every article that is saved will be preceded by a prompt, even when | |
323 | saving large batches of articles. If this variable is neither nil not | |
324 | `always', there the user will be prompted once for a file name for | |
325 | each invocation of the saving commands.") | |
326 | ||
745bc783 | 327 | (defvar gnus-rmail-save-name (function gnus-plain-save-name) |
b027f415 | 328 | "*A function generating a file name to save articles in Rmail format. |
745bc783 JB |
329 | The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") |
330 | ||
331 | (defvar gnus-mail-save-name (function gnus-plain-save-name) | |
b027f415 | 332 | "*A function generating a file name to save articles in Unix mail format. |
745bc783 JB |
333 | The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") |
334 | ||
335 | (defvar gnus-folder-save-name (function gnus-folder-save-name) | |
b027f415 | 336 | "*A function generating a file name to save articles in MH folder. |
745bc783 JB |
337 | The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.") |
338 | ||
339 | (defvar gnus-file-save-name (function gnus-numeric-save-name) | |
b027f415 | 340 | "*A function generating a file name to save articles in article format. |
41487370 LMI |
341 | The function is called with NEWSGROUP, HEADERS, and optional |
342 | LAST-FILE.") | |
745bc783 | 343 | |
231f989b LMI |
344 | (defvar gnus-split-methods |
345 | '((gnus-article-archive-name)) | |
41487370 | 346 | "*Variable used to suggest where articles are to be saved. |
41487370 LMI |
347 | For instance, if you would like to save articles related to Gnus in |
348 | the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", | |
349 | you could set this variable to something like: | |
350 | ||
351 | '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") | |
231f989b LMI |
352 | (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) |
353 | ||
354 | This variable is an alist where the where the key is the match and the | |
355 | value is a list of possible files to save in if the match is non-nil. | |
356 | ||
357 | If the match is a string, it is used as a regexp match on the | |
358 | article. If the match is a symbol, that symbol will be funcalled | |
359 | from the buffer of the article to be saved with the newsgroup as the | |
360 | parameter. If it is a list, it will be evaled in the same buffer. | |
361 | ||
362 | If this form or function returns a string, this string will be used as | |
363 | a possible file name; and if it returns a non-nil list, that list will | |
364 | be used as possible file names.") | |
365 | ||
366 | (defvar gnus-move-split-methods nil | |
367 | "*Variable used to suggest where articles are to be moved to. | |
368 | It uses the same syntax as the `gnus-split-methods' variable.") | |
41487370 LMI |
369 | |
370 | (defvar gnus-save-score nil | |
371 | "*If non-nil, save group scoring info.") | |
372 | ||
373 | (defvar gnus-use-adaptive-scoring nil | |
374 | "*If non-nil, use some adaptive scoring scheme.") | |
375 | ||
231f989b LMI |
376 | (defvar gnus-use-cache 'passive |
377 | "*If nil, Gnus will ignore the article cache. | |
378 | If `passive', it will allow entering (and reading) articles | |
379 | explicitly entered into the cache. If anything else, use the | |
380 | cache to the full extent of the law.") | |
381 | ||
382 | (defvar gnus-use-trees nil | |
383 | "*If non-nil, display a thread tree buffer.") | |
384 | ||
385 | (defvar gnus-use-grouplens nil | |
386 | "*If non-nil, use GroupLens ratings.") | |
387 | ||
388 | (defvar gnus-keep-backlog nil | |
389 | "*If non-nil, Gnus will keep read articles for later re-retrieval. | |
390 | If it is a number N, then Gnus will only keep the last N articles | |
391 | read. If it is neither nil nor a number, Gnus will keep all read | |
392 | articles. This is not a good idea.") | |
393 | ||
394 | (defvar gnus-use-nocem nil | |
395 | "*If non-nil, Gnus will read NoCeM cancel messages.") | |
396 | ||
397 | (defvar gnus-use-demon nil | |
398 | "If non-nil, Gnus might use some demons.") | |
41487370 LMI |
399 | |
400 | (defvar gnus-use-scoring t | |
401 | "*If non-nil, enable scoring.") | |
402 | ||
231f989b LMI |
403 | (defvar gnus-use-picons nil |
404 | "*If non-nil, display picons.") | |
405 | ||
41487370 LMI |
406 | (defvar gnus-fetch-old-headers nil |
407 | "*Non-nil means that Gnus will try to build threads by grabbing old headers. | |
408 | If an unread article in the group refers to an older, already read (or | |
409 | just marked as read) article, the old article will not normally be | |
410 | displayed in the Summary buffer. If this variable is non-nil, Gnus | |
411 | will attempt to grab the headers to the old articles, and thereby | |
231f989b | 412 | build complete threads. If it has the value `some', only enough |
41487370 | 413 | headers to connect otherwise loose threads will be displayed. |
231f989b LMI |
414 | This variable can also be a number. In that case, no more than that |
415 | number of old headers will be fetched. | |
41487370 | 416 | |
231f989b | 417 | The server has to support NOV for any of this to work.") |
41487370 LMI |
418 | |
419 | ;see gnus-cus.el | |
420 | ;(defvar gnus-visual t | |
421 | ; "*If non-nil, will do various highlighting. | |
422 | ;If nil, no mouse highlights (or any other highlights) will be | |
423 | ;performed. This might speed up Gnus some when generating large group | |
424 | ;and summary buffers.") | |
745bc783 JB |
425 | |
426 | (defvar gnus-novice-user t | |
41487370 LMI |
427 | "*Non-nil means that you are a usenet novice. |
428 | If non-nil, verbose messages may be displayed and confirmations may be | |
429 | required.") | |
430 | ||
431 | (defvar gnus-expert-user nil | |
432 | "*Non-nil means that you will never be asked for confirmation about anything. | |
433 | And that means *anything*.") | |
434 | ||
435 | (defvar gnus-verbose 7 | |
436 | "*Integer that says how verbose Gnus should be. | |
437 | The higher the number, the more messages Gnus will flash to say what | |
438 | it's doing. At zero, Gnus will be totally mute; at five, Gnus will | |
439 | display most important messages; and at ten, Gnus will keep on | |
440 | jabbering all the time.") | |
441 | ||
442 | (defvar gnus-keep-same-level nil | |
443 | "*Non-nil means that the next newsgroup after the current will be on the same level. | |
444 | When you type, for instance, `n' after reading the last article in the | |
231f989b | 445 | current newsgroup, you will go to the next newsgroup. If this variable |
41487370 | 446 | is nil, the next newsgroup will be the next from the group |
231f989b | 447 | buffer. |
41487370 LMI |
448 | If this variable is non-nil, Gnus will either put you in the |
449 | next newsgroup with the same level, or, if no such newsgroup is | |
450 | available, the next newsgroup with the lowest possible level higher | |
451 | than the current level. | |
452 | If this variable is `best', Gnus will make the next newsgroup the one | |
453 | with the best level.") | |
454 | ||
455 | (defvar gnus-summary-make-false-root 'adopt | |
456 | "*nil means that Gnus won't gather loose threads. | |
457 | If the root of a thread has expired or been read in a previous | |
458 | session, the information necessary to build a complete thread has been | |
231f989b LMI |
459 | lost. Instead of having many small sub-threads from this original thread |
460 | scattered all over the summary buffer, Gnus can gather them. | |
41487370 LMI |
461 | |
462 | If non-nil, Gnus will try to gather all loose sub-threads from an | |
463 | original thread into one large thread. | |
464 | ||
465 | If this variable is non-nil, it should be one of `none', `adopt', | |
466 | `dummy' or `empty'. | |
467 | ||
468 | If this variable is `none', Gnus will not make a false root, but just | |
469 | present the sub-threads after another. | |
470 | If this variable is `dummy', Gnus will create a dummy root that will | |
471 | have all the sub-threads as children. | |
472 | If this variable is `adopt', Gnus will make one of the \"children\" | |
473 | the parent and mark all the step-children as such. | |
474 | If this variable is `empty', the \"children\" are printed with empty | |
231f989b | 475 | subject fields. (Or rather, they will be printed with a string |
41487370 LMI |
476 | given by the `gnus-summary-same-subject' variable.)") |
477 | ||
231f989b LMI |
478 | (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" |
479 | "*A regexp to match subjects to be excluded from loose thread gathering. | |
480 | As loose thread gathering is done on subjects only, that means that | |
481 | there can be many false gatherings performed. By rooting out certain | |
482 | common subjects, gathering might become saner.") | |
483 | ||
41487370 LMI |
484 | (defvar gnus-summary-gather-subject-limit nil |
485 | "*Maximum length of subject comparisons when gathering loose threads. | |
486 | Use nil to compare full subjects. Setting this variable to a low | |
487 | number will help gather threads that have been corrupted by | |
488 | newsreaders chopping off subject lines, but it might also mean that | |
489 | unrelated articles that have subject that happen to begin with the | |
490 | same few characters will be incorrectly gathered. | |
491 | ||
492 | If this variable is `fuzzy', Gnus will use a fuzzy algorithm when | |
493 | comparing subjects.") | |
494 | ||
231f989b LMI |
495 | (defvar gnus-simplify-ignored-prefixes nil |
496 | "*Regexp, matches for which are removed from subject lines when simplifying.") | |
497 | ||
498 | (defvar gnus-build-sparse-threads nil | |
499 | "*If non-nil, fill in the gaps in threads. | |
500 | If `some', only fill in the gaps that are needed to tie loose threads | |
501 | together. If `more', fill in all leaf nodes that Gnus can find. If | |
502 | non-nil and non-`some', fill in all gaps that Gnus manages to guess.") | |
503 | ||
504 | (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject | |
505 | "Function used for gathering loose threads. | |
506 | There are two pre-defined functions: `gnus-gather-threads-by-subject', | |
507 | which only takes Subjects into consideration; and | |
508 | `gnus-gather-threads-by-references', which compared the References | |
509 | headers of the articles to find matches.") | |
510 | ||
41487370 LMI |
511 | ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. |
512 | (defvar gnus-summary-same-subject "" | |
513 | "*String indicating that the current article has the same subject as the previous. | |
514 | This variable will only be used if the value of | |
515 | `gnus-summary-make-false-root' is `empty'.") | |
516 | ||
517 | (defvar gnus-summary-goto-unread t | |
231f989b LMI |
518 | "*If non-nil, marking commands will go to the next unread article. |
519 | If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article, | |
520 | whether it is read or not.") | |
41487370 LMI |
521 | |
522 | (defvar gnus-group-goto-unread t | |
523 | "*If non-nil, movement commands will go to the next unread and subscribed group.") | |
524 | ||
231f989b LMI |
525 | (defvar gnus-goto-next-group-when-activating t |
526 | "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.") | |
527 | ||
41487370 LMI |
528 | (defvar gnus-check-new-newsgroups t |
529 | "*Non-nil means that Gnus will add new newsgroups at startup. | |
530 | If this variable is `ask-server', Gnus will ask the server for new | |
231f989b | 531 | groups since the last time it checked. This means that the killed list |
41487370 | 532 | is no longer necessary, so you could set `gnus-save-killed-list' to |
231f989b | 533 | nil. |
41487370 | 534 | |
231f989b | 535 | A variant is to have this variable be a list of select methods. Gnus |
41487370 LMI |
536 | will then use the `ask-server' method on all these select methods to |
537 | query for new groups from all those servers. | |
538 | ||
539 | Eg. | |
231f989b LMI |
540 | (setq gnus-check-new-newsgroups |
541 | '((nntp \"some.server\") (nntp \"other.server\"))) | |
41487370 LMI |
542 | |
543 | If this variable is nil, then you have to tell Gnus explicitly to | |
544 | check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].") | |
545 | ||
546 | (defvar gnus-check-bogus-newsgroups nil | |
547 | "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. | |
548 | If this variable is nil, then you have to tell Gnus explicitly to | |
549 | check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].") | |
550 | ||
551 | (defvar gnus-read-active-file t | |
552 | "*Non-nil means that Gnus will read the entire active file at startup. | |
553 | If this variable is nil, Gnus will only know about the groups in your | |
554 | `.newsrc' file. | |
555 | ||
556 | If this variable is `some', Gnus will try to only read the relevant | |
557 | parts of the active file from the server. Not all servers support | |
558 | this, and it might be quite slow with other servers, but this should | |
559 | generally be faster than both the t and nil value. | |
560 | ||
561 | If you set this variable to nil or `some', you probably still want to | |
562 | be told about new newsgroups that arrive. To do that, set | |
563 | `gnus-check-new-newsgroups' to `ask-server'. This may not work | |
564 | properly with all servers.") | |
565 | ||
566 | (defvar gnus-level-subscribed 5 | |
567 | "*Groups with levels less than or equal to this variable are subscribed.") | |
568 | ||
569 | (defvar gnus-level-unsubscribed 7 | |
570 | "*Groups with levels less than or equal to this variable are unsubscribed. | |
571 | Groups with levels less than `gnus-level-subscribed', which should be | |
572 | less than this variable, are subscribed.") | |
573 | ||
574 | (defvar gnus-level-zombie 8 | |
575 | "*Groups with this level are zombie groups.") | |
576 | ||
577 | (defvar gnus-level-killed 9 | |
578 | "*Groups with this level are killed.") | |
579 | ||
580 | (defvar gnus-level-default-subscribed 3 | |
581 | "*New subscribed groups will be subscribed at this level.") | |
582 | ||
583 | (defvar gnus-level-default-unsubscribed 6 | |
584 | "*New unsubscribed groups will be unsubscribed at this level.") | |
585 | ||
231f989b LMI |
586 | (defvar gnus-activate-level (1+ gnus-level-subscribed) |
587 | "*Groups higher than this level won't be activated on startup. | |
588 | Setting this variable to something log might save lots of time when | |
589 | you have many groups that you aren't interested in.") | |
590 | ||
41487370 LMI |
591 | (defvar gnus-activate-foreign-newsgroups 4 |
592 | "*If nil, Gnus will not check foreign newsgroups at startup. | |
231f989b | 593 | If it is non-nil, it should be a number between one and nine. Foreign |
41487370 | 594 | newsgroups that have a level lower or equal to this number will be |
231f989b LMI |
595 | activated on startup. For instance, if you want to active all |
596 | subscribed newsgroups, but not the rest, you'd set this variable to | |
41487370 LMI |
597 | `gnus-level-subscribed'. |
598 | ||
599 | If you subscribe to lots of newsgroups from different servers, startup | |
231f989b | 600 | might take a while. By setting this variable to nil, you'll save time, |
41487370 LMI |
601 | but you won't be told how many unread articles there are in the |
602 | groups.") | |
603 | ||
604 | (defvar gnus-save-newsrc-file t | |
605 | "*Non-nil means that Gnus will save the `.newsrc' file. | |
606 | Gnus always saves its own startup file, which is called | |
607 | \".newsrc.eld\". The file called \".newsrc\" is in a format that can | |
608 | be readily understood by other newsreaders. If you don't plan on | |
609 | using other newsreaders, set this variable to nil to save some time on | |
610 | exit.") | |
611 | ||
612 | (defvar gnus-save-killed-list t | |
613 | "*If non-nil, save the list of killed groups to the startup file. | |
231f989b LMI |
614 | If you set this variable to nil, you'll save both time (when starting |
615 | and quitting) and space (both memory and disk), but it will also mean | |
616 | that Gnus has no record of which groups are new and which are old, so | |
617 | the automatic new newsgroups subscription methods become meaningless. | |
618 | ||
619 | You should always set `gnus-check-new-newsgroups' to `ask-server' or | |
620 | nil if you set this variable to nil.") | |
b027f415 RS |
621 | |
622 | (defvar gnus-interactive-catchup t | |
41487370 | 623 | "*If non-nil, require your confirmation when catching up a group.") |
745bc783 | 624 | |
b027f415 | 625 | (defvar gnus-interactive-exit t |
41487370 LMI |
626 | "*If non-nil, require your confirmation when exiting Gnus.") |
627 | ||
628 | (defvar gnus-kill-killed t | |
629 | "*If non-nil, Gnus will apply kill files to already killed articles. | |
630 | If it is nil, Gnus will never apply kill files to articles that have | |
631 | already been through the scoring process, which might very well save lots | |
632 | of time.") | |
633 | ||
634 | (defvar gnus-extract-address-components 'gnus-extract-address-components | |
635 | "*Function for extracting address components from a From header. | |
636 | Two pre-defined function exist: `gnus-extract-address-components', | |
637 | which is the default, quite fast, and too simplistic solution, and | |
638 | `mail-extract-address-components', which works much better, but is | |
639 | slower.") | |
b027f415 | 640 | |
41487370 LMI |
641 | (defvar gnus-summary-default-score 0 |
642 | "*Default article score level. | |
643 | If this variable is nil, scoring will be disabled.") | |
745bc783 | 644 | |
41487370 LMI |
645 | (defvar gnus-summary-zcore-fuzz 0 |
646 | "*Fuzziness factor for the zcore in the summary buffer. | |
647 | Articles with scores closer than this to `gnus-summary-default-score' | |
648 | will not be marked.") | |
649 | ||
650 | (defvar gnus-simplify-subject-fuzzy-regexp nil | |
231f989b LMI |
651 | "*Strings to be removed when doing fuzzy matches. |
652 | This can either be a regular expression or list of regular expressions | |
653 | that will be removed from subject strings if fuzzy subject | |
654 | simplification is selected.") | |
655 | ||
656 | (defvar gnus-permanently-visible-groups nil | |
657 | "*Regexp to match groups that should always be listed in the group buffer. | |
658 | This means that they will still be listed when there are no unread | |
659 | articles in the groups.") | |
660 | ||
661 | (defvar gnus-list-groups-with-ticked-articles t | |
662 | "*If non-nil, list groups that have only ticked articles. | |
663 | If nil, only list groups that have unread articles.") | |
41487370 LMI |
664 | |
665 | (defvar gnus-group-default-list-level gnus-level-subscribed | |
231f989b | 666 | "*Default listing level. |
41487370 LMI |
667 | Ignored if `gnus-group-use-permanent-levels' is non-nil.") |
668 | ||
669 | (defvar gnus-group-use-permanent-levels nil | |
670 | "*If non-nil, once you set a level, Gnus will use this level.") | |
b027f415 | 671 | |
231f989b LMI |
672 | (defvar gnus-group-list-inactive-groups t |
673 | "*If non-nil, inactive groups will be listed.") | |
674 | ||
b027f415 | 675 | (defvar gnus-show-mime nil |
41487370 LMI |
676 | "*If non-nil, do mime processing of articles. |
677 | The articles will simply be fed to the function given by | |
678 | `gnus-show-mime-method'.") | |
745bc783 | 679 | |
41487370 | 680 | (defvar gnus-strict-mime t |
231f989b LMI |
681 | "*If nil, MIME-decode even if there is no Mime-Version header in the article.") |
682 | ||
683 | (defvar gnus-show-mime-method 'metamail-buffer | |
41487370 LMI |
684 | "*Function to process a MIME message. |
685 | The function is called from the article buffer.") | |
745bc783 | 686 | |
231f989b LMI |
687 | (defvar gnus-decode-encoded-word-method (lambda ()) |
688 | "*Function to decode a MIME encoded-words. | |
689 | The function is called from the article buffer.") | |
690 | ||
41487370 LMI |
691 | (defvar gnus-show-threads t |
692 | "*If non-nil, display threads in summary mode.") | |
745bc783 JB |
693 | |
694 | (defvar gnus-thread-hide-subtree nil | |
41487370 LMI |
695 | "*If non-nil, hide all threads initially. |
696 | If threads are hidden, you have to run the command | |
697 | `gnus-summary-show-thread' by hand or use `gnus-select-article-hook' | |
698 | to expose hidden threads.") | |
745bc783 JB |
699 | |
700 | (defvar gnus-thread-hide-killed t | |
41487370 | 701 | "*If non-nil, hide killed threads automatically.") |
745bc783 JB |
702 | |
703 | (defvar gnus-thread-ignore-subject nil | |
41487370 LMI |
704 | "*If non-nil, ignore subjects and do all threading based on the Reference header. |
705 | If nil, which is the default, articles that have different subjects | |
706 | from their parents will start separate threads.") | |
745bc783 | 707 | |
231f989b LMI |
708 | (defvar gnus-thread-operation-ignore-subject t |
709 | "*If non-nil, subjects will be ignored when doing thread commands. | |
710 | This affects commands like `gnus-summary-kill-thread' and | |
711 | `gnus-summary-lower-thread'. | |
712 | ||
713 | If this variable is nil, articles in the same thread with different | |
714 | subjects will not be included in the operation in question. If this | |
715 | variable is `fuzzy', only articles that have subjects that are fuzzily | |
716 | equal will be included.") | |
717 | ||
745bc783 | 718 | (defvar gnus-thread-indent-level 4 |
41487370 LMI |
719 | "*Number that says how much each sub-thread should be indented.") |
720 | ||
231f989b | 721 | (defvar gnus-ignored-newsgroups |
41487370 | 722 | (purecopy (mapconcat 'identity |
231f989b LMI |
723 | '("^to\\." ; not "real" groups |
724 | "^[0-9. \t]+ " ; all digits in name | |
725 | "[][\"#'()]" ; bogus characters | |
726 | ) | |
727 | "\\|")) | |
8483b957 | 728 | "*A regexp to match uninteresting newsgroups in the active file. |
b027f415 RS |
729 | Any lines in the active file matching this regular expression are |
730 | removed from the newsgroup list before anything else is done to it, | |
41487370 | 731 | thus making them effectively non-existent.") |
745bc783 JB |
732 | |
733 | (defvar gnus-ignored-headers | |
41487370 LMI |
734 | "^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:" |
735 | "*All headers that match this regexp will be hidden. | |
231f989b | 736 | This variable can also be a list of regexps of headers to be ignored. |
41487370 LMI |
737 | If `gnus-visible-headers' is non-nil, this variable will be ignored.") |
738 | ||
231f989b | 739 | (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 | 740 | "*All headers that do not match this regexp will be hidden. |
231f989b | 741 | This variable can also be a list of regexp of headers to remain visible. |
41487370 LMI |
742 | If this variable is non-nil, `gnus-ignored-headers' will be ignored.") |
743 | ||
744 | (defvar gnus-sorted-header-list | |
231f989b | 745 | '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" |
41487370 LMI |
746 | "^Cc:" "^Date:" "^Organization:") |
747 | "*This variable is a list of regular expressions. | |
748 | If it is non-nil, headers that match the regular expressions will | |
749 | be placed first in the article buffer in the sequence specified by | |
750 | this list.") | |
745bc783 | 751 | |
231f989b LMI |
752 | (defvar gnus-boring-article-headers |
753 | '(empty followup-to reply-to) | |
754 | "*Headers that are only to be displayed if they have interesting data. | |
755 | Possible values in this list are `empty', `newsgroups', `followup-to', | |
756 | `reply-to', and `date'.") | |
757 | ||
745bc783 | 758 | (defvar gnus-show-all-headers nil |
41487370 | 759 | "*If non-nil, don't hide any headers.") |
745bc783 | 760 | |
b027f415 | 761 | (defvar gnus-save-all-headers t |
41487370 | 762 | "*If non-nil, don't remove any headers before saving.") |
745bc783 | 763 | |
231f989b LMI |
764 | (defvar gnus-saved-headers gnus-visible-headers |
765 | "*Headers to keep if `gnus-save-all-headers' is nil. | |
766 | If `gnus-save-all-headers' is non-nil, this variable will be ignored. | |
767 | If that variable is nil, however, all headers that match this regexp | |
768 | will be kept while the rest will be deleted before saving.") | |
769 | ||
41487370 LMI |
770 | (defvar gnus-inhibit-startup-message nil |
771 | "*If non-nil, the startup message will not be displayed.") | |
772 | ||
773 | (defvar gnus-signature-separator "^-- *$" | |
774 | "Regexp matching signature separator.") | |
745bc783 | 775 | |
231f989b LMI |
776 | (defvar gnus-signature-limit nil |
777 | "Provide a limit to what is considered a signature. | |
778 | If it is a number, no signature may not be longer (in characters) than | |
779 | that number. If it is a function, the function will be called without | |
780 | any parameters, and if it returns nil, there is no signature in the | |
781 | buffer. If it is a string, it will be used as a regexp. If it | |
782 | matches, the text in question is not a signature.") | |
783 | ||
745bc783 | 784 | (defvar gnus-auto-extend-newsgroup t |
41487370 | 785 | "*If non-nil, extend newsgroup forward and backward when requested.") |
745bc783 JB |
786 | |
787 | (defvar gnus-auto-select-first t | |
231f989b LMI |
788 | "*If nil, don't select the first unread article when entering a group. |
789 | If this variable is `best', select the highest-scored unread article | |
790 | in the group. If neither nil nor `best', select the first unread | |
791 | article. | |
792 | ||
745bc783 | 793 | If you want to prevent automatic selection of the first unread article |
41487370 | 794 | in some newsgroups, set the variable to nil in |
231f989b | 795 | `gnus-select-group-hook'.") |
745bc783 JB |
796 | |
797 | (defvar gnus-auto-select-next t | |
41487370 LMI |
798 | "*If non-nil, offer to go to the next group from the end of the previous. |
799 | If the value is t and the next newsgroup is empty, Gnus will exit | |
231f989b LMI |
800 | summary mode and go back to group mode. If the value is neither nil |
801 | nor t, Gnus will select the following unread newsgroup. In | |
41487370 | 802 | particular, if the value is the symbol `quietly', the next unread |
231f989b LMI |
803 | newsgroup will be selected without any confirmation, and if it is |
804 | `almost-quietly', the next group will be selected without any | |
805 | confirmation if you are located on the last article in the group. | |
806 | Finally, if this variable is `slightly-quietly', the `Z n' command | |
807 | will go to the next group without confirmation.") | |
745bc783 JB |
808 | |
809 | (defvar gnus-auto-select-same nil | |
41487370 | 810 | "*If non-nil, select the next article with the same subject.") |
745bc783 | 811 | |
41487370 LMI |
812 | (defvar gnus-summary-check-current nil |
813 | "*If non-nil, consider the current article when moving. | |
814 | The \"unread\" movement commands will stay on the same line if the | |
815 | current article is unread.") | |
b027f415 | 816 | |
41487370 | 817 | (defvar gnus-auto-center-summary t |
231f989b LMI |
818 | "*If non-nil, always center the current summary buffer. |
819 | In particular, if `vertical' do only vertical recentering. If non-nil | |
820 | and non-`vertical', do both horizontal and vertical recentering.") | |
745bc783 JB |
821 | |
822 | (defvar gnus-break-pages t | |
41487370 LMI |
823 | "*If non-nil, do page breaking on articles. |
824 | The page delimiter is specified by the `gnus-page-delimiter' | |
825 | variable.") | |
745bc783 JB |
826 | |
827 | (defvar gnus-page-delimiter "^\^L" | |
41487370 LMI |
828 | "*Regexp describing what to use as article page delimiters. |
829 | The default value is \"^\^L\", which is a form linefeed at the | |
830 | beginning of a line.") | |
745bc783 JB |
831 | |
832 | (defvar gnus-use-full-window t | |
41487370 LMI |
833 | "*If non-nil, use the entire Emacs screen.") |
834 | ||
835 | (defvar gnus-window-configuration nil | |
836 | "Obsolete variable. See `gnus-buffer-configuration'.") | |
837 | ||
231f989b LMI |
838 | (defvar gnus-window-min-width 2 |
839 | "*Minimum width of Gnus buffers.") | |
840 | ||
841 | (defvar gnus-window-min-height 1 | |
842 | "*Minimum height of Gnus buffers.") | |
843 | ||
41487370 | 844 | (defvar gnus-buffer-configuration |
231f989b LMI |
845 | '((group |
846 | (vertical 1.0 | |
847 | (group 1.0 point) | |
848 | (if gnus-carpal '(group-carpal 4)))) | |
849 | (summary | |
850 | (vertical 1.0 | |
851 | (summary 1.0 point) | |
852 | (if gnus-carpal '(summary-carpal 4)))) | |
853 | (article | |
854 | (cond | |
855 | (gnus-use-picons | |
856 | '(frame 1.0 | |
857 | (vertical 1.0 | |
858 | (summary 0.25 point) | |
859 | (if gnus-carpal '(summary-carpal 4)) | |
860 | (article 1.0)) | |
861 | (vertical ((height . 5) (width . 15) | |
862 | (user-position . t) | |
863 | (left . -1) (top . 1)) | |
864 | (picons 1.0)))) | |
865 | (gnus-use-trees | |
866 | '(vertical 1.0 | |
867 | (summary 0.25 point) | |
868 | (tree 0.25) | |
869 | (article 1.0))) | |
870 | (t | |
871 | '(vertical 1.0 | |
872 | (summary 0.25 point) | |
873 | (if gnus-carpal '(summary-carpal 4)) | |
231f989b LMI |
874 | (article 1.0))))) |
875 | (server | |
876 | (vertical 1.0 | |
877 | (server 1.0 point) | |
878 | (if gnus-carpal '(server-carpal 2)))) | |
879 | (browse | |
880 | (vertical 1.0 | |
881 | (browse 1.0 point) | |
882 | (if gnus-carpal '(browse-carpal 2)))) | |
883 | (message | |
884 | (vertical 1.0 | |
885 | (message 1.0 point))) | |
886 | (pick | |
887 | (vertical 1.0 | |
888 | (article 1.0 point))) | |
889 | (info | |
890 | (vertical 1.0 | |
891 | (info 1.0 point))) | |
892 | (summary-faq | |
893 | (vertical 1.0 | |
894 | (summary 0.25) | |
895 | (faq 1.0 point))) | |
896 | (edit-group | |
897 | (vertical 1.0 | |
898 | (group 0.5) | |
899 | (edit-group 1.0 point))) | |
900 | (edit-server | |
901 | (vertical 1.0 | |
902 | (server 0.5) | |
903 | (edit-server 1.0 point))) | |
904 | (edit-score | |
905 | (vertical 1.0 | |
906 | (summary 0.25) | |
907 | (edit-score 1.0 point))) | |
908 | (post | |
909 | (vertical 1.0 | |
910 | (post 1.0 point))) | |
911 | (reply | |
912 | (vertical 1.0 | |
913 | (article-copy 0.5) | |
914 | (message 1.0 point))) | |
915 | (forward | |
916 | (vertical 1.0 | |
917 | (message 1.0 point))) | |
918 | (reply-yank | |
919 | (vertical 1.0 | |
920 | (message 1.0 point))) | |
921 | (mail-bounce | |
922 | (vertical 1.0 | |
923 | (article 0.5) | |
924 | (message 1.0 point))) | |
925 | (draft | |
926 | (vertical 1.0 | |
927 | (draft 1.0 point))) | |
928 | (pipe | |
929 | (vertical 1.0 | |
930 | (summary 0.25 point) | |
931 | (if gnus-carpal '(summary-carpal 4)) | |
932 | ("*Shell Command Output*" 1.0))) | |
933 | (bug | |
934 | (vertical 1.0 | |
935 | ("*Gnus Help Bug*" 0.5) | |
936 | ("*Gnus Bug*" 1.0 point))) | |
937 | (compose-bounce | |
938 | (vertical 1.0 | |
939 | (article 0.5) | |
940 | (message 1.0 point)))) | |
41487370 LMI |
941 | "Window configuration for all possible Gnus buffers. |
942 | This variable is a list of lists. Each of these lists has a NAME and | |
231f989b | 943 | a RULE. The NAMEs are commonsense names like `group', which names a |
41487370 LMI |
944 | rule used when displaying the group buffer; `summary', which names a |
945 | rule for what happens when you enter a group and do not display an | |
946 | article buffer; and so on. See the value of this variable for a | |
947 | complete list of NAMEs. | |
948 | ||
231f989b | 949 | Each RULE is a list of vectors. The first element in this vector is |
41487370 LMI |
950 | the name of the buffer to be displayed; the second element is the |
951 | percentage of the screen this buffer is to occupy (a number in the | |
952 | 0.0-0.99 range); the optional third element is `point', which should | |
953 | be present to denote which buffer point is to go to after making this | |
954 | buffer configuration.") | |
955 | ||
956 | (defvar gnus-window-to-buffer | |
957 | '((group . gnus-group-buffer) | |
958 | (summary . gnus-summary-buffer) | |
959 | (article . gnus-article-buffer) | |
960 | (server . gnus-server-buffer) | |
961 | (browse . "*Gnus Browse Server*") | |
962 | (edit-group . gnus-group-edit-buffer) | |
963 | (edit-server . gnus-server-edit-buffer) | |
964 | (group-carpal . gnus-carpal-group-buffer) | |
965 | (summary-carpal . gnus-carpal-summary-buffer) | |
966 | (server-carpal . gnus-carpal-server-buffer) | |
967 | (browse-carpal . gnus-carpal-browse-buffer) | |
968 | (edit-score . gnus-score-edit-buffer) | |
231f989b LMI |
969 | (message . gnus-message-buffer) |
970 | (mail . gnus-message-buffer) | |
971 | (post-news . gnus-message-buffer) | |
972 | (faq . gnus-faq-buffer) | |
973 | (picons . "*Picons*") | |
974 | (tree . gnus-tree-buffer) | |
975 | (info . gnus-info-buffer) | |
976 | (article-copy . gnus-article-copy) | |
977 | (draft . gnus-draft-buffer)) | |
41487370 LMI |
978 | "Mapping from short symbols to buffer names or buffer variables.") |
979 | ||
980 | (defvar gnus-carpal nil | |
981 | "*If non-nil, display clickable icons.") | |
982 | ||
983 | (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies | |
984 | "*Function called with a group name when new group is detected. | |
985 | A few pre-made functions are supplied: `gnus-subscribe-randomly' | |
986 | inserts new groups at the beginning of the list of groups; | |
987 | `gnus-subscribe-alphabetically' inserts new groups in strict | |
988 | alphabetic order; `gnus-subscribe-hierarchically' inserts new groups | |
989 | in hierarchical newsgroup order; `gnus-subscribe-interactively' asks | |
231f989b LMI |
990 | for your decision; `gnus-subscribe-killed' kills all new groups; |
991 | `gnus-subscribe-zombies' will make all new groups into zombies.") | |
41487370 LMI |
992 | |
993 | ;; Suggested by a bug report by Hallvard B Furuseth. | |
231f989b | 994 | ;; <h.b.furuseth@usit.uio.no>. |
41487370 | 995 | (defvar gnus-subscribe-options-newsgroup-method |
b027f415 | 996 | (function gnus-subscribe-alphabetically) |
41487370 LMI |
997 | "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. |
998 | If, for instance, you want to subscribe to all newsgroups in the | |
999 | \"no\" and \"alt\" hierarchies, you'd put the following in your | |
1000 | .newsrc file: | |
1001 | ||
1002 | options -n no.all alt.all | |
1003 | ||
1004 | Gnus will the subscribe all new newsgroups in these hierarchies with | |
1005 | the subscription method in this variable.") | |
1006 | ||
1007 | (defvar gnus-subscribe-hierarchical-interactive nil | |
1008 | "*If non-nil, Gnus will offer to subscribe hierarchically. | |
1009 | When a new hierarchy appears, Gnus will ask the user: | |
1010 | ||
1011 | 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): | |
1012 | ||
1013 | If the user pressed `d', Gnus will descend the hierarchy, `y' will | |
1014 | subscribe to all newsgroups in the hierarchy and `s' will skip this | |
1015 | hierarchy in its entirety.") | |
1016 | ||
1017 | (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet | |
1018 | "*Function used for sorting the group buffer. | |
1019 | This function will be called with group info entries as the arguments | |
1020 | for the groups to be sorted. Pre-made functions include | |
231f989b LMI |
1021 | `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread', |
1022 | `gnus-group-sort-by-level', `gnus-group-sort-by-score', and | |
1023 | `gnus-group-sort-by-rank'. | |
1024 | ||
1025 | This variable can also be a list of sorting functions. In that case, | |
1026 | the most significant sort function should be the last function in the | |
1027 | list.") | |
41487370 LMI |
1028 | |
1029 | ;; Mark variables suggested by Thomas Michanek | |
231f989b | 1030 | ;; <Thomas.Michanek@telelogic.se>. |
41487370 LMI |
1031 | (defvar gnus-unread-mark ? |
1032 | "*Mark used for unread articles.") | |
1033 | (defvar gnus-ticked-mark ?! | |
1034 | "*Mark used for ticked articles.") | |
1035 | (defvar gnus-dormant-mark ?? | |
1036 | "*Mark used for dormant articles.") | |
1037 | (defvar gnus-del-mark ?r | |
1038 | "*Mark used for del'd articles.") | |
1039 | (defvar gnus-read-mark ?R | |
1040 | "*Mark used for read articles.") | |
1041 | (defvar gnus-expirable-mark ?E | |
1042 | "*Mark used for expirable articles.") | |
1043 | (defvar gnus-killed-mark ?K | |
1044 | "*Mark used for killed articles.") | |
231f989b LMI |
1045 | (defvar gnus-souped-mark ?F |
1046 | "*Mark used for killed articles.") | |
41487370 LMI |
1047 | (defvar gnus-kill-file-mark ?X |
1048 | "*Mark used for articles killed by kill files.") | |
1049 | (defvar gnus-low-score-mark ?Y | |
1050 | "*Mark used for articles with a low score.") | |
1051 | (defvar gnus-catchup-mark ?C | |
1052 | "*Mark used for articles that are caught up.") | |
1053 | (defvar gnus-replied-mark ?A | |
1054 | "*Mark used for articles that have been replied to.") | |
231f989b LMI |
1055 | (defvar gnus-cached-mark ?* |
1056 | "*Mark used for articles that are in the cache.") | |
1057 | (defvar gnus-saved-mark ?S | |
1058 | "*Mark used for articles that have been saved to.") | |
1059 | (defvar gnus-process-mark ?# | |
41487370 LMI |
1060 | "*Process mark.") |
1061 | (defvar gnus-ancient-mark ?O | |
1062 | "*Mark used for ancient articles.") | |
231f989b LMI |
1063 | (defvar gnus-sparse-mark ?Q |
1064 | "*Mark used for sparsely reffed articles.") | |
41487370 LMI |
1065 | (defvar gnus-canceled-mark ?G |
1066 | "*Mark used for canceled articles.") | |
1067 | (defvar gnus-score-over-mark ?+ | |
1068 | "*Score mark used for articles with high scores.") | |
1069 | (defvar gnus-score-below-mark ?- | |
1070 | "*Score mark used for articles with low scores.") | |
1071 | (defvar gnus-empty-thread-mark ? | |
1072 | "*There is no thread under the article.") | |
1073 | (defvar gnus-not-empty-thread-mark ?= | |
1074 | "*There is a thread under the article.") | |
41487370 LMI |
1075 | |
1076 | (defvar gnus-view-pseudo-asynchronously nil | |
1077 | "*If non-nil, Gnus will view pseudo-articles asynchronously.") | |
1078 | ||
1079 | (defvar gnus-view-pseudos nil | |
1080 | "*If `automatic', pseudo-articles will be viewed automatically. | |
1081 | If `not-confirm', pseudos will be viewed automatically, and the user | |
1082 | will not be asked to confirm the command.") | |
1083 | ||
1084 | (defvar gnus-view-pseudos-separately t | |
1085 | "*If non-nil, one pseudo-article will be created for each file to be viewed. | |
1086 | If nil, all files that use the same viewing command will be given as a | |
1087 | list of parameters to that command.") | |
1088 | ||
231f989b LMI |
1089 | (defvar gnus-insert-pseudo-articles t |
1090 | "*If non-nil, insert pseudo-articles when decoding articles.") | |
1091 | ||
1092 | (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n" | |
41487370 LMI |
1093 | "*Format of group lines. |
1094 | It works along the same lines as a normal formatting string, | |
1095 | with some simple extensions. | |
1096 | ||
1097 | %M Only marked articles (character, \"*\" or \" \") | |
1098 | %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") | |
1099 | %L Level of subscribedness (integer) | |
1100 | %N Number of unread articles (integer) | |
1101 | %I Number of dormant articles (integer) | |
1102 | %i Number of ticked and dormant (integer) | |
1103 | %T Number of ticked articles (integer) | |
1104 | %R Number of read articles (integer) | |
1105 | %t Total number of articles (integer) | |
1106 | %y Number of unread, unticked articles (integer) | |
1107 | %G Group name (string) | |
1108 | %g Qualified group name (string) | |
1109 | %D Group description (string) | |
1110 | %s Select method (string) | |
1111 | %o Moderated group (char, \"m\") | |
1112 | %p Process mark (char) | |
1113 | %O Moderated group (string, \"(m)\" or \"\") | |
231f989b LMI |
1114 | %P Topic indentation (string) |
1115 | %l Whether there are GroupLens predictions for this group (string) | |
41487370 LMI |
1116 | %n Select from where (string) |
1117 | %z A string that look like `<%s:%n>' if a foreign select method is used | |
231f989b | 1118 | %u User defined specifier. The next character in the format string should |
41487370 | 1119 | be a letter. Gnus will call the function gnus-user-format-function-X, |
231f989b LMI |
1120 | where X is the letter following %u. The function will be passed the |
1121 | current header as argument. The function should return a string, which | |
41487370 LMI |
1122 | will be inserted into the buffer just like information from any other |
1123 | group specifier. | |
1124 | ||
1125 | Text between %( and %) will be highlighted with `gnus-mouse-face' when | |
1126 | the mouse point move inside the area. There can only be one such area. | |
1127 | ||
231f989b | 1128 | Note that this format specification is not always respected. For |
41487370 | 1129 | reasons of efficiency, when listing killed groups, this specification |
231f989b | 1130 | is ignored altogether. If the spec is changed considerably, your |
41487370 LMI |
1131 | output may end up looking strange when listing both alive and killed |
1132 | groups. | |
1133 | ||
1134 | If you use %o or %O, reading the active file will be slower and quite | |
1135 | a bit of extra memory will be used. %D will also worsen performance. | |
1136 | Also note that if you change the format specification to include any | |
1137 | of these specs, you must probably re-start Gnus to see them go into | |
231f989b | 1138 | effect.") |
41487370 LMI |
1139 | |
1140 | (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" | |
1141 | "*The format specification of the lines in the summary buffer. | |
1142 | ||
1143 | It works along the same lines as a normal formatting string, | |
1144 | with some simple extensions. | |
1145 | ||
1146 | %N Article number, left padded with spaces (string) | |
1147 | %S Subject (string) | |
1148 | %s Subject if it is at the root of a thread, and \"\" otherwise (string) | |
1149 | %n Name of the poster (string) | |
1150 | %a Extracted name of the poster (string) | |
1151 | %A Extracted address of the poster (string) | |
1152 | %F Contents of the From: header (string) | |
1153 | %x Contents of the Xref: header (string) | |
1154 | %D Date of the article (string) | |
1155 | %d Date of the article (string) in DD-MMM format | |
1156 | %M Message-id of the article (string) | |
1157 | %r References of the article (string) | |
1158 | %c Number of characters in the article (integer) | |
1159 | %L Number of lines in the article (integer) | |
1160 | %I Indentation based on thread level (a string of spaces) | |
1161 | %T A string with two possible values: 80 spaces if the article | |
1162 | is on thread level two or larger and 0 spaces on level one | |
1163 | %R \"A\" if this article has been replied to, \" \" otherwise (character) | |
1164 | %U Status of this article (character, \"R\", \"K\", \"-\" or \" \") | |
1165 | %[ Opening bracket (character, \"[\" or \"<\") | |
1166 | %] Closing bracket (character, \"]\" or \">\") | |
1167 | %> Spaces of length thread-level (string) | |
1168 | %< Spaces of length (- 20 thread-level) (string) | |
1169 | %i Article score (number) | |
1170 | %z Article zcore (character) | |
1171 | %t Number of articles under the current thread (number). | |
1172 | %e Whether the thread is empty or not (character). | |
231f989b LMI |
1173 | %l GroupLens score (string). |
1174 | %u User defined specifier. The next character in the format string should | |
41487370 | 1175 | be a letter. Gnus will call the function gnus-user-format-function-X, |
231f989b LMI |
1176 | where X is the letter following %u. The function will be passed the |
1177 | current header as argument. The function should return a string, which | |
41487370 LMI |
1178 | will be inserted into the summary just like information from any other |
1179 | summary specifier. | |
1180 | ||
1181 | Text between %( and %) will be highlighted with `gnus-mouse-face' | |
231f989b | 1182 | when the mouse point is placed inside the area. There can only be one |
41487370 LMI |
1183 | such area. |
1184 | ||
1185 | The %U (status), %R (replied) and %z (zcore) specs have to be handled | |
231f989b LMI |
1186 | with care. For reasons of efficiency, Gnus will compute what column |
1187 | these characters will end up in, and \"hard-code\" that. This means that | |
1188 | it is illegal to have these specs after a variable-length spec. Well, | |
41487370 LMI |
1189 | you might not be arrested, but your summary buffer will look strange, |
1190 | which is bad enough. | |
1191 | ||
1192 | The smart choice is to have these specs as for to the left as | |
231f989b | 1193 | possible. |
41487370 LMI |
1194 | |
1195 | This restriction may disappear in later versions of Gnus.") | |
1196 | ||
231f989b LMI |
1197 | (defvar gnus-summary-dummy-line-format |
1198 | "* %(: :%) %S\n" | |
41487370 LMI |
1199 | "*The format specification for the dummy roots in the summary buffer. |
1200 | It works along the same lines as a normal formatting string, | |
1201 | with some simple extensions. | |
1202 | ||
1203 | %S The subject") | |
1204 | ||
231f989b LMI |
1205 | (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" |
1206 | "*The format specification for the summary mode line. | |
1207 | It works along the same lines as a normal formatting string, | |
1208 | with some simple extensions: | |
1209 | ||
1210 | %G Group name | |
1211 | %p Unprefixed group name | |
1212 | %A Current article number | |
1213 | %V Gnus version | |
1214 | %U Number of unread articles in the group | |
1215 | %e Number of unselected articles in the group | |
1216 | %Z A string with unread/unselected article counts | |
1217 | %g Shortish group name | |
1218 | %S Subject of the current article | |
1219 | %u User-defined spec | |
1220 | %s Current score file name | |
1221 | %d Number of dormant articles | |
1222 | %r Number of articles that have been marked as read in this session | |
1223 | %E Number of articles expunged by the score files") | |
1224 | ||
1225 | (defvar gnus-article-mode-line-format "Gnus: %%b %S" | |
1226 | "*The format specification for the article mode line. | |
1227 | See `gnus-summary-mode-line-format' for a closer description.") | |
1228 | ||
1229 | (defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}" | |
1230 | "*The format specification for the group mode line. | |
1231 | It works along the same lines as a normal formatting string, | |
1232 | with some simple extensions: | |
41487370 | 1233 | |
231f989b LMI |
1234 | %S The native news server. |
1235 | %M The native select method. | |
1236 | %: \":\" if %S isn't \"\".") | |
41487370 LMI |
1237 | |
1238 | (defvar gnus-valid-select-methods | |
1239 | '(("nntp" post address prompt-address) | |
231f989b LMI |
1240 | ("nnspool" post address) |
1241 | ("nnvirtual" post-mail virtual prompt-address) | |
1242 | ("nnmbox" mail respool address) | |
1243 | ("nnml" mail respool address) | |
1244 | ("nnmh" mail respool address) | |
1245 | ("nndir" post-mail prompt-address address) | |
1246 | ("nneething" none address prompt-address) | |
1247 | ("nndoc" none address prompt-address) | |
1248 | ("nnbabyl" mail address respool) | |
1249 | ("nnkiboze" post virtual) | |
1250 | ("nnsoup" post-mail address) | |
1251 | ("nndraft" post-mail) | |
1252 | ("nnfolder" mail respool address)) | |
41487370 LMI |
1253 | "An alist of valid select methods. |
1254 | The first element of each list lists should be a string with the name | |
231f989b | 1255 | of the select method. The other elements may be be the category of |
41487370 LMI |
1256 | this method (ie. `post', `mail', `none' or whatever) or other |
1257 | properties that this method has (like being respoolable). | |
1258 | If you implement a new select method, all you should have to change is | |
231f989b | 1259 | this variable. I think.") |
41487370 | 1260 | |
231f989b | 1261 | (defvar gnus-updated-mode-lines '(group article summary tree) |
41487370 | 1262 | "*List of buffers that should update their mode lines. |
231f989b | 1263 | The list may contain the symbols `group', `article' and `summary'. If |
41487370 | 1264 | the corresponding symbol is present, Gnus will keep that mode line |
231f989b | 1265 | updated with information that may be pertinent. |
41487370 LMI |
1266 | If this variable is nil, screen refresh may be quicker.") |
1267 | ||
1268 | ;; Added by Keinonen Kari <kk85613@cs.tut.fi>. | |
6346a6e6 | 1269 | (defvar gnus-mode-non-string-length nil |
41487370 LMI |
1270 | "*Max length of mode-line non-string contents. |
1271 | If this is nil, Gnus will take space as is needed, leaving the rest | |
1272 | of the modeline intact.") | |
1273 | ||
1274 | ;see gnus-cus.el | |
1275 | ;(defvar gnus-mouse-face 'highlight | |
1276 | ; "*Face used for mouse highlighting in Gnus. | |
1277 | ;No mouse highlights will be done if `gnus-visual' is nil.") | |
1278 | ||
231f989b | 1279 | (defvar gnus-summary-mark-below 0 |
41487370 LMI |
1280 | "*Mark all articles with a score below this variable as read. |
1281 | This variable is local to each summary buffer and usually set by the | |
231f989b LMI |
1282 | score file.") |
1283 | ||
1284 | (defvar gnus-article-sort-functions '(gnus-article-sort-by-number) | |
1285 | "*List of functions used for sorting articles in the summary buffer. | |
1286 | This variable is only used when not using a threaded display.") | |
41487370 LMI |
1287 | |
1288 | (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) | |
1289 | "*List of functions used for sorting threads in the summary buffer. | |
1290 | By default, threads are sorted by article number. | |
1291 | ||
1292 | Each function takes two threads and return non-nil if the first thread | |
1293 | should be sorted before the other. If you use more than one function, | |
231f989b LMI |
1294 | the primary sort function should be the last. You should probably |
1295 | always include `gnus-thread-sort-by-number' in the list of sorting | |
1296 | functions -- preferably first. | |
41487370 LMI |
1297 | |
1298 | Ready-mady functions include `gnus-thread-sort-by-number', | |
1299 | `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', | |
1300 | `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and | |
1301 | `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').") | |
1302 | ||
1303 | (defvar gnus-thread-score-function '+ | |
1304 | "*Function used for calculating the total score of a thread. | |
1305 | ||
1306 | The function is called with the scores of the article and each | |
1307 | subthread and should then return the score of the thread. | |
1308 | ||
1309 | Some functions you can use are `+', `max', or `min'.") | |
1310 | ||
231f989b LMI |
1311 | (defvar gnus-summary-expunge-below nil |
1312 | "All articles that have a score less than this variable will be expunged.") | |
1313 | ||
1314 | (defvar gnus-thread-expunge-below nil | |
1315 | "All threads that have a total score less than this variable will be expunged. | |
1316 | See `gnus-thread-score-function' for en explanation of what a | |
1317 | \"thread score\" is.") | |
1318 | ||
1319 | (defvar gnus-auto-subscribed-groups | |
1320 | "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" | |
1321 | "*All new groups that match this regexp will be subscribed automatically. | |
1322 | Note that this variable only deals with new groups. It has no effect | |
564b670b LMI |
1323 | whatsoever on old groups. |
1324 | ||
1325 | New groups that match this regexp will not be handled by | |
1326 | `gnus-subscribe-newsgroup-method'. Instead, they will | |
1327 | be subscribed using `gnus-subscribe-options-newsgroup-method'.") | |
231f989b | 1328 | |
41487370 LMI |
1329 | (defvar gnus-options-subscribe nil |
1330 | "*All new groups matching this regexp will be subscribed unconditionally. | |
231f989b | 1331 | Note that this variable deals only with new newsgroups. This variable |
564b670b LMI |
1332 | does not affect old newsgroups. |
1333 | ||
1334 | New groups that match this regexp will not be handled by | |
1335 | `gnus-subscribe-newsgroup-method'. Instead, they will | |
1336 | be subscribed using `gnus-subscribe-options-newsgroup-method'.") | |
41487370 LMI |
1337 | |
1338 | (defvar gnus-options-not-subscribe nil | |
1339 | "*All new groups matching this regexp will be ignored. | |
231f989b | 1340 | Note that this variable deals only with new newsgroups. This variable |
41487370 LMI |
1341 | does not affect old (already subscribed) newsgroups.") |
1342 | ||
1343 | (defvar gnus-auto-expirable-newsgroups nil | |
1344 | "*Groups in which to automatically mark read articles as expirable. | |
1345 | If non-nil, this should be a regexp that should match all groups in | |
1346 | which to perform auto-expiry. This only makes sense for mail groups.") | |
1347 | ||
231f989b LMI |
1348 | (defvar gnus-total-expirable-newsgroups nil |
1349 | "*Groups in which to perform expiry of all read articles. | |
1350 | Use with extreme caution. All groups that match this regexp will be | |
1351 | expiring - which means that all read articles will be deleted after | |
1352 | (say) one week. (This only goes for mail groups and the like, of | |
1353 | course.)") | |
1354 | ||
1355 | (defvar gnus-group-uncollapsed-levels 1 | |
1356 | "Number of group name elements to leave alone when making a short group name.") | |
1357 | ||
41487370 LMI |
1358 | (defvar gnus-hidden-properties '(invisible t intangible t) |
1359 | "Property list to use for hiding text.") | |
1360 | ||
1361 | (defvar gnus-modtime-botch nil | |
231f989b LMI |
1362 | "*Non-nil means .newsrc should be deleted prior to save. |
1363 | Its use is due to the bogus appearance that .newsrc was modified on | |
1364 | disc.") | |
41487370 LMI |
1365 | |
1366 | ;; Hooks. | |
745bc783 | 1367 | |
b027f415 | 1368 | (defvar gnus-group-mode-hook nil |
41487370 | 1369 | "*A hook for Gnus group mode.") |
745bc783 | 1370 | |
b027f415 | 1371 | (defvar gnus-summary-mode-hook nil |
41487370 LMI |
1372 | "*A hook for Gnus summary mode. |
1373 | This hook is run before any variables are set in the summary buffer.") | |
745bc783 | 1374 | |
b027f415 | 1375 | (defvar gnus-article-mode-hook nil |
41487370 LMI |
1376 | "*A hook for Gnus article mode.") |
1377 | ||
231f989b | 1378 | (defvar gnus-summary-prepare-exit-hook nil |
41487370 LMI |
1379 | "*A hook called when preparing to exit from the summary buffer. |
1380 | It calls `gnus-summary-expire-articles' by default.") | |
1381 | (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) | |
745bc783 | 1382 | |
231f989b | 1383 | (defvar gnus-summary-exit-hook nil |
41487370 | 1384 | "*A hook called on exit from the summary buffer.") |
745bc783 | 1385 | |
231f989b LMI |
1386 | (defvar gnus-group-catchup-group-hook nil |
1387 | "*A hook run when catching up a group from the group buffer.") | |
1388 | ||
1389 | (defvar gnus-group-update-group-hook nil | |
1390 | "*A hook called when updating group lines.") | |
1391 | ||
b027f415 | 1392 | (defvar gnus-open-server-hook nil |
41487370 LMI |
1393 | "*A hook called just before opening connection to the news server.") |
1394 | ||
1395 | (defvar gnus-load-hook nil | |
1396 | "*A hook run while Gnus is loaded.") | |
745bc783 | 1397 | |
b027f415 | 1398 | (defvar gnus-startup-hook nil |
41487370 LMI |
1399 | "*A hook called at startup. |
1400 | This hook is called after Gnus is connected to the NNTP server.") | |
1401 | ||
1402 | (defvar gnus-get-new-news-hook nil | |
1403 | "*A hook run just before Gnus checks for new news.") | |
1404 | ||
231f989b LMI |
1405 | (defvar gnus-after-getting-new-news-hook nil |
1406 | "*A hook run after Gnus checks for new news.") | |
1407 | ||
41487370 LMI |
1408 | (defvar gnus-group-prepare-function 'gnus-group-prepare-flat |
1409 | "*A function that is called to generate the group buffer. | |
1410 | The function is called with three arguments: The first is a number; | |
1411 | all group with a level less or equal to that number should be listed, | |
231f989b LMI |
1412 | if the second is non-nil, empty groups should also be displayed. If |
1413 | the third is non-nil, it is a number. No groups with a level lower | |
41487370 LMI |
1414 | than this number should be displayed. |
1415 | ||
1416 | The only current function implemented is `gnus-group-prepare-flat'.") | |
745bc783 | 1417 | |
b027f415 | 1418 | (defvar gnus-group-prepare-hook nil |
41487370 LMI |
1419 | "*A hook called after the group buffer has been generated. |
1420 | If you want to modify the group buffer, you can use this hook.") | |
745bc783 | 1421 | |
b027f415 | 1422 | (defvar gnus-summary-prepare-hook nil |
41487370 LMI |
1423 | "*A hook called after the summary buffer has been generated. |
1424 | If you want to modify the summary buffer, you can use this hook.") | |
745bc783 | 1425 | |
231f989b LMI |
1426 | (defvar gnus-summary-generate-hook nil |
1427 | "*A hook run just before generating the summary buffer. | |
1428 | This hook is commonly used to customize threading variables and the | |
1429 | like.") | |
1430 | ||
b027f415 | 1431 | (defvar gnus-article-prepare-hook nil |
41487370 | 1432 | "*A hook called after an article has been prepared in the article buffer. |
745bc783 JB |
1433 | If you want to run a special decoding program like nkf, use this hook.") |
1434 | ||
41487370 LMI |
1435 | ;(defvar gnus-article-display-hook nil |
1436 | ; "*A hook called after the article is displayed in the article buffer. | |
1437 | ;The hook is designed to change the contents of the article | |
231f989b | 1438 | ;buffer. Typical functions that this hook may contain are |
41487370 | 1439 | ;`gnus-article-hide-headers' (hide selected headers), |
231f989b | 1440 | ;`gnus-article-maybe-highlight' (perform fancy article highlighting), |
41487370 LMI |
1441 | ;`gnus-article-hide-signature' (hide signature) and |
1442 | ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") | |
1443 | ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted) | |
1444 | ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike) | |
1445 | ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) | |
1446 | ||
41487370 LMI |
1447 | (defvar gnus-article-x-face-too-ugly nil |
1448 | "Regexp matching posters whose face shouldn't be shown automatically.") | |
1449 | ||
b027f415 RS |
1450 | (defvar gnus-select-group-hook nil |
1451 | "*A hook called when a newsgroup is selected. | |
b027f415 RS |
1452 | |
1453 | If you'd like to simplify subjects like the | |
1454 | `gnus-summary-next-same-subject' command does, you can use the | |
1455 | following hook: | |
1456 | ||
41487370 LMI |
1457 | (setq gnus-select-group-hook |
1458 | (list | |
8483b957 | 1459 | (lambda () |
41487370 LMI |
1460 | (mapcar (lambda (header) |
1461 | (mail-header-set-subject | |
8483b957 RS |
1462 | header |
1463 | (gnus-simplify-subject | |
41487370 LMI |
1464 | (mail-header-subject header) 're-only))) |
1465 | gnus-newsgroup-headers))))") | |
745bc783 | 1466 | |
231f989b LMI |
1467 | (defvar gnus-select-article-hook nil |
1468 | "*A hook called when an article is selected.") | |
745bc783 | 1469 | |
8483b957 | 1470 | (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) |
41487370 LMI |
1471 | "*A hook called to apply kill files to a group. |
1472 | This hook is intended to apply a kill file to the selected newsgroup. | |
8483b957 | 1473 | The function `gnus-apply-kill-file' is called by default. |
745bc783 | 1474 | |
41487370 | 1475 | Since a general kill file is too heavy to use only for a few |
231f989b | 1476 | newsgroups, I recommend you to use a lighter hook function. For |
41487370 | 1477 | example, if you'd like to apply a kill file to articles which contains |
745bc783 JB |
1478 | a string `rmgroup' in subject in newsgroup `control', you can use the |
1479 | following hook: | |
1480 | ||
41487370 | 1481 | (setq gnus-apply-kill-hook |
8483b957 | 1482 | (list |
8483b957 RS |
1483 | (lambda () |
1484 | (cond ((string-match \"control\" gnus-newsgroup-name) | |
1485 | (gnus-kill \"Subject\" \"rmgroup\") | |
41487370 | 1486 | (gnus-expunge \"X\"))))))") |
b027f415 | 1487 | |
231f989b | 1488 | (defvar gnus-visual-mark-article-hook |
41487370 LMI |
1489 | (list 'gnus-highlight-selected-summary) |
1490 | "*Hook run after selecting an article in the summary buffer. | |
1491 | It is meant to be used for highlighting the article in some way. It | |
1492 | is not run if `gnus-visual' is nil.") | |
b027f415 | 1493 | |
231f989b | 1494 | (defvar gnus-parse-headers-hook nil |
7e988fb6 | 1495 | "*A hook called before parsing the headers.") |
231f989b | 1496 | (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522) |
7e988fb6 | 1497 | |
b027f415 | 1498 | (defvar gnus-exit-group-hook nil |
41487370 | 1499 | "*A hook called when exiting (not quitting) summary mode.") |
745bc783 | 1500 | |
b027f415 | 1501 | (defvar gnus-suspend-gnus-hook nil |
41487370 | 1502 | "*A hook called when suspending (not exiting) Gnus.") |
745bc783 | 1503 | |
b027f415 | 1504 | (defvar gnus-exit-gnus-hook nil |
41487370 | 1505 | "*A hook called when exiting Gnus.") |
745bc783 | 1506 | |
231f989b LMI |
1507 | (defvar gnus-after-exiting-gnus-hook nil |
1508 | "*A hook called after exiting Gnus.") | |
1509 | ||
b027f415 | 1510 | (defvar gnus-save-newsrc-hook nil |
231f989b LMI |
1511 | "*A hook called before saving any of the newsrc files.") |
1512 | ||
1513 | (defvar gnus-save-quick-newsrc-hook nil | |
1514 | "*A hook called just before saving the quick newsrc file. | |
1515 | Can be used to turn version control on or off.") | |
de032aaa | 1516 | |
231f989b LMI |
1517 | (defvar gnus-save-standard-newsrc-hook nil |
1518 | "*A hook called just before saving the standard newsrc file. | |
1519 | Can be used to turn version control on or off.") | |
1520 | ||
1521 | (defvar gnus-summary-update-hook | |
41487370 LMI |
1522 | (list 'gnus-summary-highlight-line) |
1523 | "*A hook called when a summary line is changed. | |
1524 | The hook will not be called if `gnus-visual' is nil. | |
de032aaa | 1525 | |
41487370 LMI |
1526 | The default function `gnus-summary-highlight-line' will |
1527 | highlight the line according to the `gnus-summary-highlight' | |
1528 | variable.") | |
de032aaa | 1529 | |
231f989b LMI |
1530 | (defvar gnus-group-update-hook '(gnus-group-highlight-line) |
1531 | "*A hook called when a group line is changed. | |
1532 | The hook will not be called if `gnus-visual' is nil. | |
1533 | ||
1534 | The default function `gnus-group-highlight-line' will | |
1535 | highlight the line according to the `gnus-group-highlight' | |
1536 | variable.") | |
1537 | ||
1538 | (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) | |
41487370 LMI |
1539 | "*A hook called when an article is selected for the first time. |
1540 | The hook is intended to mark an article as read (or unread) | |
1541 | automatically when it is selected.") | |
de032aaa | 1542 | |
231f989b LMI |
1543 | (defvar gnus-group-change-level-function nil |
1544 | "Function run when a group level is changed. | |
1545 | It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.") | |
1546 | ||
41487370 LMI |
1547 | ;; Remove any hilit infestation. |
1548 | (add-hook 'gnus-startup-hook | |
1549 | (lambda () | |
1550 | (remove-hook 'gnus-summary-prepare-hook | |
1551 | 'hilit-rehighlight-buffer-quietly) | |
1552 | (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks) | |
231f989b LMI |
1553 | (setq gnus-mark-article-hook |
1554 | '(gnus-summary-mark-read-and-unread-as-read)) | |
41487370 LMI |
1555 | (remove-hook 'gnus-article-prepare-hook |
1556 | 'hilit-rehighlight-buffer-quietly))) | |
de032aaa | 1557 | |
745bc783 | 1558 | \f |
41487370 | 1559 | ;; Internal variables |
745bc783 | 1560 | |
231f989b LMI |
1561 | (defvar gnus-tree-buffer "*Tree*" |
1562 | "Buffer where Gnus thread trees are displayed.") | |
1563 | ||
1564 | ;; Dummy variable. | |
1565 | (defvar gnus-use-generic-from nil) | |
1566 | ||
1567 | (defvar gnus-thread-indent-array nil) | |
1568 | (defvar gnus-thread-indent-array-level gnus-thread-indent-level) | |
1569 | ||
1570 | (defvar gnus-newsrc-file-version nil) | |
1571 | ||
1572 | (defvar gnus-method-history nil) | |
1573 | ;; Variable holding the user answers to all method prompts. | |
1574 | ||
1575 | (defvar gnus-group-history nil) | |
1576 | ;; Variable holding the user answers to all group prompts. | |
1577 | ||
1578 | (defvar gnus-server-alist nil | |
1579 | "List of available servers.") | |
1580 | ||
1581 | (defvar gnus-group-indentation-function nil) | |
1582 | ||
1583 | (defvar gnus-topic-indentation "") ;; Obsolete variable. | |
1584 | ||
1585 | (defvar gnus-goto-missing-group-function nil) | |
1586 | ||
1587 | (defvar gnus-override-subscribe-method nil) | |
1588 | ||
1589 | (defvar gnus-group-goto-next-group-function nil | |
1590 | "Function to override finding the next group after listing groups.") | |
1591 | ||
1592 | (defconst gnus-article-mark-lists | |
1593 | '((marked . tick) (replied . reply) | |
1594 | (expirable . expire) (killed . killed) | |
1595 | (bookmarks . bookmark) (dormant . dormant) | |
1596 | (scored . score) (saved . save) | |
1597 | (cached . cache) | |
1598 | )) | |
1599 | ||
41487370 LMI |
1600 | ;; Avoid highlighting in kill files. |
1601 | (defvar gnus-summary-inhibit-highlight nil) | |
1602 | (defvar gnus-newsgroup-selected-overlay nil) | |
745bc783 | 1603 | |
231f989b LMI |
1604 | (defvar gnus-inhibit-hiding nil) |
1605 | (defvar gnus-group-indentation "") | |
1606 | (defvar gnus-inhibit-limiting nil) | |
1607 | (defvar gnus-created-frames nil) | |
1608 | ||
41487370 LMI |
1609 | (defvar gnus-article-mode-map nil) |
1610 | (defvar gnus-dribble-buffer nil) | |
1611 | (defvar gnus-headers-retrieved-by nil) | |
1612 | (defvar gnus-article-reply nil) | |
1613 | (defvar gnus-override-method nil) | |
1614 | (defvar gnus-article-check-size nil) | |
1615 | ||
1616 | (defvar gnus-current-score-file nil) | |
231f989b | 1617 | (defvar gnus-newsgroup-adaptive-score-file nil) |
41487370 LMI |
1618 | (defvar gnus-scores-exclude-files nil) |
1619 | ||
231f989b LMI |
1620 | (defvar gnus-opened-servers nil) |
1621 | ||
41487370 | 1622 | (defvar gnus-current-move-group nil) |
231f989b LMI |
1623 | (defvar gnus-current-copy-group nil) |
1624 | (defvar gnus-current-crosspost-group nil) | |
41487370 LMI |
1625 | |
1626 | (defvar gnus-newsgroup-dependencies nil) | |
41487370 LMI |
1627 | (defvar gnus-newsgroup-async nil) |
1628 | (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") | |
1629 | ||
1630 | (defvar gnus-newsgroup-adaptive nil) | |
1631 | ||
1632 | (defvar gnus-summary-display-table nil) | |
231f989b LMI |
1633 | (defvar gnus-summary-display-article-function nil) |
1634 | ||
1635 | (defvar gnus-summary-highlight-line-function nil | |
1636 | "Function called after highlighting a summary line.") | |
1637 | ||
1638 | (defvar gnus-group-line-format-alist | |
1639 | `((?M gnus-tmp-marked-mark ?c) | |
1640 | (?S gnus-tmp-subscribed ?c) | |
1641 | (?L gnus-tmp-level ?d) | |
1642 | (?N (cond ((eq number t) "*" ) | |
1643 | ((numberp number) | |
1644 | (int-to-string | |
1645 | (+ number | |
1646 | (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) | |
1647 | (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) | |
1648 | (t number)) ?s) | |
1649 | (?R gnus-tmp-number-of-read ?s) | |
1650 | (?t gnus-tmp-number-total ?d) | |
1651 | (?y gnus-tmp-number-of-unread ?s) | |
1652 | (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) | |
1653 | (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) | |
1654 | (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) | |
1655 | (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) | |
1656 | (?g gnus-tmp-group ?s) | |
1657 | (?G gnus-tmp-qualified-group ?s) | |
1658 | (?c (gnus-short-group-name gnus-tmp-group) ?s) | |
1659 | (?D gnus-tmp-newsgroup-description ?s) | |
1660 | (?o gnus-tmp-moderated ?c) | |
1661 | (?O gnus-tmp-moderated-string ?s) | |
1662 | (?p gnus-tmp-process-marked ?c) | |
1663 | (?s gnus-tmp-news-server ?s) | |
1664 | (?n gnus-tmp-news-method ?s) | |
1665 | (?P gnus-group-indentation ?s) | |
1666 | (?l gnus-tmp-grouplens ?s) | |
1667 | (?z gnus-tmp-news-method-string ?s) | |
1668 | (?u gnus-tmp-user-defined ?s))) | |
1669 | ||
1670 | (defvar gnus-summary-line-format-alist | |
1671 | `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) | |
1672 | (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) | |
1673 | (?s gnus-tmp-subject-or-nil ?s) | |
1674 | (?n gnus-tmp-name ?s) | |
1675 | (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) | |
1676 | ?s) | |
1677 | (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) | |
1678 | gnus-tmp-from) ?s) | |
1679 | (?F gnus-tmp-from ?s) | |
1680 | (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) | |
1681 | (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) | |
1682 | (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) | |
1683 | (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) | |
1684 | (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) | |
1685 | (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) | |
1686 | (?L gnus-tmp-lines ?d) | |
1687 | (?I gnus-tmp-indentation ?s) | |
1688 | (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) | |
1689 | (?R gnus-tmp-replied ?c) | |
1690 | (?\[ gnus-tmp-opening-bracket ?c) | |
1691 | (?\] gnus-tmp-closing-bracket ?c) | |
1692 | (?\> (make-string gnus-tmp-level ? ) ?s) | |
1693 | (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) | |
1694 | (?i gnus-tmp-score ?d) | |
1695 | (?z gnus-tmp-score-char ?c) | |
1696 | (?l (bbb-grouplens-score gnus-tmp-header) ?s) | |
1697 | (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) | |
1698 | (?U gnus-tmp-unread ?c) | |
1699 | (?t (gnus-summary-number-of-articles-in-thread | |
1700 | (and (boundp 'thread) (car thread)) gnus-tmp-level) | |
1701 | ?d) | |
1702 | (?e (gnus-summary-number-of-articles-in-thread | |
1703 | (and (boundp 'thread) (car thread)) gnus-tmp-level t) | |
1704 | ?c) | |
1705 | (?u gnus-tmp-user-defined ?s)) | |
41487370 LMI |
1706 | "An alist of format specifications that can appear in summary lines, |
1707 | and what variables they correspond with, along with the type of the | |
1708 | variable (string, integer, character, etc).") | |
1709 | ||
231f989b LMI |
1710 | (defvar gnus-summary-dummy-line-format-alist |
1711 | `((?S gnus-tmp-subject ?s) | |
1712 | (?N gnus-tmp-number ?d) | |
1713 | (?u gnus-tmp-user-defined ?s))) | |
1714 | ||
1715 | (defvar gnus-summary-mode-line-format-alist | |
1716 | `((?G gnus-tmp-group-name ?s) | |
1717 | (?g (gnus-short-group-name gnus-tmp-group-name) ?s) | |
1718 | (?p (gnus-group-real-name gnus-tmp-group-name) ?s) | |
1719 | (?A gnus-tmp-article-number ?d) | |
1720 | (?Z gnus-tmp-unread-and-unselected ?s) | |
1721 | (?V gnus-version ?s) | |
1722 | (?U gnus-tmp-unread-and-unticked ?d) | |
1723 | (?S gnus-tmp-subject ?s) | |
1724 | (?e gnus-tmp-unselected ?d) | |
1725 | (?u gnus-tmp-user-defined ?s) | |
1726 | (?d (length gnus-newsgroup-dormant) ?d) | |
1727 | (?t (length gnus-newsgroup-marked) ?d) | |
1728 | (?r (length gnus-newsgroup-reads) ?d) | |
1729 | (?E gnus-newsgroup-expunged-tally ?d) | |
1730 | (?s (gnus-current-score-file-nondirectory) ?s))) | |
1731 | ||
1732 | (defvar gnus-article-mode-line-format-alist | |
1733 | gnus-summary-mode-line-format-alist) | |
1734 | ||
1735 | (defvar gnus-group-mode-line-format-alist | |
1736 | `((?S gnus-tmp-news-server ?s) | |
1737 | (?M gnus-tmp-news-method ?s) | |
1738 | (?u gnus-tmp-user-defined ?s) | |
1739 | (?: gnus-tmp-colon ?s))) | |
41487370 LMI |
1740 | |
1741 | (defvar gnus-have-read-active-file nil) | |
1742 | ||
1743 | (defconst gnus-maintainer | |
1744 | "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" | |
1745 | "The mail address of the Gnus maintainers.") | |
1746 | ||
b1cfbae4 | 1747 | (defconst gnus-version-number "5.3" |
41487370 | 1748 | "Version number for this version of Gnus.") |
44cdca98 | 1749 | |
231f989b LMI |
1750 | (defconst gnus-version (format "Gnus v%s" gnus-version-number) |
1751 | "Version string for this version of Gnus.") | |
1752 | ||
b027f415 | 1753 | (defvar gnus-info-nodes |
231f989b LMI |
1754 | '((gnus-group-mode "(gnus)The Group Buffer") |
1755 | (gnus-summary-mode "(gnus)The Summary Buffer") | |
1756 | (gnus-article-mode "(gnus)The Article Buffer") | |
1757 | (gnus-server-mode "(gnus)The Server Buffer") | |
1758 | (gnus-browse-mode "(gnus)Browse Foreign Server") | |
1759 | (gnus-tree-mode "(gnus)Tree Display") | |
1760 | ) | |
1761 | "Alist of major modes and related Info nodes.") | |
745bc783 | 1762 | |
41487370 | 1763 | (defvar gnus-group-buffer "*Group*") |
b027f415 RS |
1764 | (defvar gnus-summary-buffer "*Summary*") |
1765 | (defvar gnus-article-buffer "*Article*") | |
41487370 LMI |
1766 | (defvar gnus-server-buffer "*Server*") |
1767 | ||
1768 | (defvar gnus-work-buffer " *gnus work*") | |
1769 | ||
231f989b LMI |
1770 | (defvar gnus-original-article-buffer " *Original Article*") |
1771 | (defvar gnus-original-article nil) | |
1772 | ||
41487370 LMI |
1773 | (defvar gnus-buffer-list nil |
1774 | "Gnus buffers that should be killed on exit.") | |
745bc783 | 1775 | |
231f989b LMI |
1776 | (defvar gnus-slave nil |
1777 | "Whether this Gnus is a slave or not.") | |
745bc783 JB |
1778 | |
1779 | (defvar gnus-variable-list | |
41487370 | 1780 | '(gnus-newsrc-options gnus-newsrc-options-n |
231f989b | 1781 | gnus-newsrc-last-checked-date |
41487370 | 1782 | gnus-newsrc-alist gnus-server-alist |
231f989b LMI |
1783 | gnus-killed-list gnus-zombie-list |
1784 | gnus-topic-topology gnus-topic-alist | |
1785 | gnus-format-specs) | |
41487370 | 1786 | "Gnus variables saved in the quick startup file.") |
745bc783 | 1787 | |
745bc783 | 1788 | (defvar gnus-newsrc-options nil |
41487370 | 1789 | "Options line in the .newsrc file.") |
745bc783 | 1790 | |
41487370 | 1791 | (defvar gnus-newsrc-options-n nil |
231f989b | 1792 | "List of regexps representing groups to be subscribed/ignored unconditionally.") |
745bc783 | 1793 | |
41487370 LMI |
1794 | (defvar gnus-newsrc-last-checked-date nil |
1795 | "Date Gnus last asked server for new newsgroups.") | |
745bc783 | 1796 | |
231f989b LMI |
1797 | (defvar gnus-topic-topology nil |
1798 | "The complete topic hierarchy.") | |
1799 | ||
1800 | (defvar gnus-topic-alist nil | |
1801 | "The complete topic-group alist.") | |
1802 | ||
41487370 | 1803 | (defvar gnus-newsrc-alist nil |
b027f415 | 1804 | "Assoc list of read articles. |
41487370 | 1805 | gnus-newsrc-hashtb should be kept so that both hold the same information.") |
b027f415 RS |
1806 | |
1807 | (defvar gnus-newsrc-hashtb nil | |
41487370 | 1808 | "Hashtable of gnus-newsrc-alist.") |
745bc783 | 1809 | |
41487370 LMI |
1810 | (defvar gnus-killed-list nil |
1811 | "List of killed newsgroups.") | |
b027f415 RS |
1812 | |
1813 | (defvar gnus-killed-hashtb nil | |
41487370 | 1814 | "Hash table equivalent of gnus-killed-list.") |
745bc783 | 1815 | |
41487370 LMI |
1816 | (defvar gnus-zombie-list nil |
1817 | "List of almost dead newsgroups.") | |
b027f415 | 1818 | |
41487370 LMI |
1819 | (defvar gnus-description-hashtb nil |
1820 | "Descriptions of newsgroups.") | |
745bc783 | 1821 | |
41487370 LMI |
1822 | (defvar gnus-list-of-killed-groups nil |
1823 | "List of newsgroups that have recently been killed by the user.") | |
745bc783 JB |
1824 | |
1825 | (defvar gnus-active-hashtb nil | |
1826 | "Hashtable of active articles.") | |
1827 | ||
41487370 LMI |
1828 | (defvar gnus-moderated-list nil |
1829 | "List of moderated newsgroups.") | |
1830 | ||
1831 | (defvar gnus-group-marked nil) | |
745bc783 JB |
1832 | |
1833 | (defvar gnus-current-startup-file nil | |
1834 | "Startup file for the current host.") | |
1835 | ||
1836 | (defvar gnus-last-search-regexp nil | |
1837 | "Default regexp for article search command.") | |
1838 | ||
1839 | (defvar gnus-last-shell-command nil | |
1840 | "Default shell command on article.") | |
1841 | ||
41487370 LMI |
1842 | (defvar gnus-current-select-method nil |
1843 | "The current method for selecting a newsgroup.") | |
1844 | ||
1845 | (defvar gnus-group-list-mode nil) | |
1846 | ||
1847 | (defvar gnus-article-internal-prepare-hook nil) | |
745bc783 JB |
1848 | |
1849 | (defvar gnus-newsgroup-name nil) | |
1850 | (defvar gnus-newsgroup-begin nil) | |
1851 | (defvar gnus-newsgroup-end nil) | |
1852 | (defvar gnus-newsgroup-last-rmail nil) | |
1853 | (defvar gnus-newsgroup-last-mail nil) | |
1854 | (defvar gnus-newsgroup-last-folder nil) | |
1855 | (defvar gnus-newsgroup-last-file nil) | |
41487370 LMI |
1856 | (defvar gnus-newsgroup-auto-expire nil) |
1857 | (defvar gnus-newsgroup-active nil) | |
745bc783 | 1858 | |
231f989b LMI |
1859 | (defvar gnus-newsgroup-data nil) |
1860 | (defvar gnus-newsgroup-data-reverse nil) | |
1861 | (defvar gnus-newsgroup-limit nil) | |
1862 | (defvar gnus-newsgroup-limits nil) | |
1863 | ||
745bc783 JB |
1864 | (defvar gnus-newsgroup-unreads nil |
1865 | "List of unread articles in the current newsgroup.") | |
1866 | ||
1867 | (defvar gnus-newsgroup-unselected nil | |
1868 | "List of unselected unread articles in the current newsgroup.") | |
1869 | ||
41487370 LMI |
1870 | (defvar gnus-newsgroup-reads nil |
1871 | "Alist of read articles and article marks in the current newsgroup.") | |
1872 | ||
231f989b LMI |
1873 | (defvar gnus-newsgroup-expunged-tally nil) |
1874 | ||
745bc783 | 1875 | (defvar gnus-newsgroup-marked nil |
41487370 LMI |
1876 | "List of ticked articles in the current newsgroup (a subset of unread art).") |
1877 | ||
1878 | (defvar gnus-newsgroup-killed nil | |
1879 | "List of ranges of articles that have been through the scoring process.") | |
1880 | ||
231f989b LMI |
1881 | (defvar gnus-newsgroup-cached nil |
1882 | "List of articles that come from the article cache.") | |
1883 | ||
1884 | (defvar gnus-newsgroup-saved nil | |
1885 | "List of articles that have been saved.") | |
1886 | ||
41487370 LMI |
1887 | (defvar gnus-newsgroup-kill-headers nil) |
1888 | ||
1889 | (defvar gnus-newsgroup-replied nil | |
1890 | "List of articles that have been replied to in the current newsgroup.") | |
1891 | ||
1892 | (defvar gnus-newsgroup-expirable nil | |
1893 | "List of articles in the current newsgroup that can be expired.") | |
1894 | ||
1895 | (defvar gnus-newsgroup-processable nil | |
1896 | "List of articles in the current newsgroup that can be processed.") | |
1897 | ||
1898 | (defvar gnus-newsgroup-bookmarks nil | |
1899 | "List of articles in the current newsgroup that have bookmarks.") | |
1900 | ||
1901 | (defvar gnus-newsgroup-dormant nil | |
1902 | "List of dormant articles in the current newsgroup.") | |
1903 | ||
1904 | (defvar gnus-newsgroup-scored nil | |
1905 | "List of scored articles in the current newsgroup.") | |
745bc783 JB |
1906 | |
1907 | (defvar gnus-newsgroup-headers nil | |
41487370 | 1908 | "List of article headers in the current newsgroup.") |
231f989b LMI |
1909 | |
1910 | (defvar gnus-newsgroup-threads nil) | |
1911 | ||
1912 | (defvar gnus-newsgroup-prepared nil | |
1913 | "Whether the current group has been prepared properly.") | |
745bc783 | 1914 | |
41487370 LMI |
1915 | (defvar gnus-newsgroup-ancient nil |
1916 | "List of `gnus-fetch-old-headers' articles in the current newsgroup.") | |
1917 | ||
231f989b LMI |
1918 | (defvar gnus-newsgroup-sparse nil) |
1919 | ||
745bc783 | 1920 | (defvar gnus-current-article nil) |
41487370 | 1921 | (defvar gnus-article-current nil) |
745bc783 | 1922 | (defvar gnus-current-headers nil) |
41487370 | 1923 | (defvar gnus-have-all-headers nil) |
745bc783 | 1924 | (defvar gnus-last-article nil) |
41487370 | 1925 | (defvar gnus-newsgroup-history nil) |
745bc783 JB |
1926 | (defvar gnus-current-kill-article nil) |
1927 | ||
1928 | ;; Save window configuration. | |
41487370 LMI |
1929 | (defvar gnus-prev-winconf nil) |
1930 | ||
41487370 LMI |
1931 | (defvar gnus-summary-mark-positions nil) |
1932 | (defvar gnus-group-mark-positions nil) | |
1933 | ||
41487370 LMI |
1934 | (defvar gnus-reffed-article-number nil) |
1935 | ||
231f989b | 1936 | ;;; Let the byte-compiler know that we know about this variable. |
41487370 LMI |
1937 | (defvar rmail-default-rmail-file) |
1938 | ||
b94ae5f7 | 1939 | (defvar gnus-cache-removable-articles nil) |
41487370 | 1940 | |
231f989b LMI |
1941 | (defvar gnus-dead-summary nil) |
1942 | ||
1943 | (defconst gnus-summary-local-variables | |
1944 | '(gnus-newsgroup-name | |
1945 | gnus-newsgroup-begin gnus-newsgroup-end | |
1946 | gnus-newsgroup-last-rmail gnus-newsgroup-last-mail | |
1947 | gnus-newsgroup-last-folder gnus-newsgroup-last-file | |
1948 | gnus-newsgroup-auto-expire gnus-newsgroup-unreads | |
41487370 | 1949 | gnus-newsgroup-unselected gnus-newsgroup-marked |
231f989b | 1950 | gnus-newsgroup-reads gnus-newsgroup-saved |
41487370 LMI |
1951 | gnus-newsgroup-replied gnus-newsgroup-expirable |
1952 | gnus-newsgroup-processable gnus-newsgroup-killed | |
1953 | gnus-newsgroup-bookmarks gnus-newsgroup-dormant | |
231f989b LMI |
1954 | gnus-newsgroup-headers gnus-newsgroup-threads |
1955 | gnus-newsgroup-prepared gnus-summary-highlight-line-function | |
41487370 LMI |
1956 | gnus-current-article gnus-current-headers gnus-have-all-headers |
1957 | gnus-last-article gnus-article-internal-prepare-hook | |
1958 | gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay | |
1959 | gnus-newsgroup-scored gnus-newsgroup-kill-headers | |
231f989b LMI |
1960 | gnus-newsgroup-async gnus-thread-expunge-below |
1961 | gnus-score-alist gnus-current-score-file gnus-summary-expunge-below | |
1962 | (gnus-summary-mark-below . global) | |
1963 | gnus-newsgroup-active gnus-scores-exclude-files | |
41487370 | 1964 | gnus-newsgroup-history gnus-newsgroup-ancient |
231f989b | 1965 | gnus-newsgroup-sparse |
41487370 | 1966 | (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) |
231f989b LMI |
1967 | gnus-newsgroup-adaptive-score-file |
1968 | (gnus-newsgroup-expunged-tally . 0) | |
1969 | gnus-cache-removable-articles gnus-newsgroup-cached | |
1970 | gnus-newsgroup-data gnus-newsgroup-data-reverse | |
1971 | gnus-newsgroup-limit gnus-newsgroup-limits) | |
41487370 LMI |
1972 | "Variables that are buffer-local to the summary buffers.") |
1973 | ||
1974 | (defconst gnus-bug-message | |
1975 | "Sending a bug report to the Gnus Towers. | |
1976 | ======================================== | |
1977 | ||
1978 | The buffer below is a mail buffer. When you press `C-c C-c', it will | |
231f989b | 1979 | be sent to the Gnus Bug Exterminators. |
41487370 LMI |
1980 | |
1981 | At the bottom of the buffer you'll see lots of variable settings. | |
1982 | Please do not delete those. They will tell the Bug People what your | |
1983 | environment is, so that it will be easier to locate the bugs. | |
1984 | ||
1985 | If you have found a bug that makes Emacs go \"beep\", set | |
231f989b | 1986 | debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') |
41487370 LMI |
1987 | and include the backtrace in your bug report. |
1988 | ||
1989 | Please describe the bug in annoying, painstaking detail. | |
1990 | ||
1991 | Thank you for your help in stamping out bugs. | |
1992 | ") | |
1993 | ||
1994 | ;;; End of variables. | |
1995 | ||
1996 | ;; Define some autoload functions Gnus might use. | |
1997 | (eval-and-compile | |
1998 | ||
231f989b LMI |
1999 | ;; This little mapcar goes through the list below and marks the |
2000 | ;; symbols in question as autoloaded functions. | |
2001 | (mapcar | |
2002 | (lambda (package) | |
2003 | (let ((interactive (nth 1 (memq ':interactive package)))) | |
2004 | (mapcar | |
2005 | (lambda (function) | |
2006 | (let (keymap) | |
2007 | (when (consp function) | |
2008 | (setq keymap (car (memq 'keymap function))) | |
2009 | (setq function (car function))) | |
2010 | (autoload function (car package) nil interactive keymap))) | |
2011 | (if (eq (nth 1 package) ':interactive) | |
2012 | (cdddr package) | |
2013 | (cdr package))))) | |
2014 | '(("metamail" metamail-buffer) | |
2015 | ("info" Info-goto-node) | |
2016 | ("hexl" hexl-hex-string-to-integer) | |
2017 | ("pp" pp pp-to-string pp-eval-expression) | |
2018 | ("mail-extr" mail-extract-address-components) | |
2019 | ("nnmail" nnmail-split-fancy nnmail-article-group) | |
2020 | ("nnvirtual" nnvirtual-catchup-group) | |
2021 | ("timezone" timezone-make-date-arpa-standard timezone-fix-time | |
2022 | timezone-make-sortable-date timezone-make-time-string) | |
2023 | ("rmailout" rmail-output) | |
2024 | ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages | |
2025 | rmail-show-message) | |
2026 | ("gnus-soup" :interactive t | |
2027 | gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article | |
2028 | gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) | |
2029 | ("nnsoup" nnsoup-pack-replies) | |
5ccf5115 | 2030 | ("score-mode" :interactive t gnus-score-mode) |
231f989b LMI |
2031 | ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder |
2032 | gnus-Folder-save-name gnus-folder-save-name) | |
2033 | ("gnus-mh" :interactive t gnus-summary-save-in-folder) | |
2034 | ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar | |
2035 | gnus-server-make-menu-bar gnus-article-make-menu-bar | |
2036 | gnus-browse-make-menu-bar gnus-highlight-selected-summary | |
2037 | gnus-summary-highlight-line gnus-carpal-setup-buffer | |
2038 | gnus-group-highlight-line | |
2039 | gnus-article-add-button gnus-insert-next-page-button | |
2040 | gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu) | |
2041 | ("gnus-vis" :interactive t | |
2042 | gnus-article-push-button gnus-article-press-button | |
2043 | gnus-article-highlight gnus-article-highlight-some | |
2044 | gnus-article-highlight-headers gnus-article-highlight-signature | |
2045 | gnus-article-add-buttons gnus-article-add-buttons-to-head | |
2046 | gnus-article-next-button gnus-article-prev-button) | |
2047 | ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail | |
2048 | gnus-demon-add-disconnection gnus-demon-add-handler | |
2049 | gnus-demon-remove-handler) | |
2050 | ("gnus-demon" :interactive t | |
2051 | gnus-demon-init gnus-demon-cancel) | |
2052 | ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree | |
2053 | gnus-tree-open gnus-tree-close) | |
2054 | ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close | |
2055 | gnus-nocem-unwanted-article-p) | |
2056 | ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info) | |
2057 | ("gnus-srvr" gnus-browse-foreign-server) | |
2058 | ("gnus-cite" :interactive t | |
2059 | gnus-article-highlight-citation gnus-article-hide-citation-maybe | |
2060 | gnus-article-hide-citation gnus-article-fill-cited-article | |
2061 | gnus-article-hide-citation-in-followups) | |
2062 | ("gnus-kill" gnus-kill gnus-apply-kill-file-internal | |
2063 | gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author | |
2064 | gnus-execute gnus-expunge) | |
2065 | ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers | |
2066 | gnus-cache-possibly-remove-articles gnus-cache-request-article | |
2067 | gnus-cache-retrieve-headers gnus-cache-possibly-alter-active | |
2068 | gnus-cache-enter-remove-article gnus-cached-article-p | |
2069 | gnus-cache-open gnus-cache-close gnus-cache-update-article) | |
2070 | ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article | |
2071 | gnus-cache-remove-article) | |
2072 | ("gnus-score" :interactive t | |
2073 | gnus-summary-increase-score gnus-summary-lower-score | |
2074 | gnus-score-flush-cache gnus-score-close | |
2075 | gnus-score-raise-same-subject-and-select | |
2076 | gnus-score-raise-same-subject gnus-score-default | |
2077 | gnus-score-raise-thread gnus-score-lower-same-subject-and-select | |
2078 | gnus-score-lower-same-subject gnus-score-lower-thread | |
2079 | gnus-possibly-score-headers gnus-summary-raise-score | |
2080 | gnus-summary-set-score gnus-summary-current-score) | |
2081 | ("gnus-score" | |
2082 | (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers | |
2083 | gnus-current-score-file-nondirectory gnus-score-adaptive | |
2084 | gnus-score-find-trace gnus-score-file-name) | |
2085 | ("gnus-edit" :interactive t gnus-score-customize) | |
2086 | ("gnus-topic" :interactive t gnus-topic-mode) | |
2087 | ("gnus-topic" gnus-topic-remove-group) | |
2088 | ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) | |
2089 | ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) | |
2090 | ("gnus-uu" :interactive t | |
2091 | gnus-uu-digest-mail-forward gnus-uu-digest-post-forward | |
2092 | gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer | |
2093 | gnus-uu-mark-by-regexp gnus-uu-mark-all | |
2094 | gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu | |
2095 | gnus-uu-decode-uu-and-save gnus-uu-decode-unshar | |
2096 | gnus-uu-decode-unshar-and-save gnus-uu-decode-save | |
2097 | gnus-uu-decode-binhex gnus-uu-decode-uu-view | |
2098 | gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view | |
2099 | gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view | |
2100 | gnus-uu-decode-binhex-view) | |
2101 | ("gnus-msg" (gnus-summary-send-map keymap) | |
2102 | gnus-mail-yank-original gnus-mail-send-and-exit | |
2103 | gnus-article-mail gnus-new-mail gnus-mail-reply) | |
2104 | ("gnus-msg" :interactive t | |
2105 | gnus-group-post-news gnus-group-mail gnus-summary-post-news | |
2106 | gnus-summary-followup gnus-summary-followup-with-original | |
2107 | gnus-summary-cancel-article gnus-summary-supersede-article | |
2108 | gnus-post-news gnus-inews-news | |
2109 | gnus-summary-reply gnus-summary-reply-with-original | |
2110 | gnus-summary-mail-forward gnus-summary-mail-other-window | |
2111 | gnus-bug) | |
2112 | ("gnus-picon" :interactive t gnus-article-display-picons | |
564b670b LMI |
2113 | gnus-group-display-picons gnus-picons-article-display-x-face |
2114 | gnus-picons-display-x-face) | |
231f989b LMI |
2115 | ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p |
2116 | gnus-grouplens-mode) | |
2117 | ("smiley" :interactive t gnus-smiley-display) | |
2118 | ("gnus-vm" gnus-vm-mail-setup) | |
2119 | ("gnus-vm" :interactive t gnus-summary-save-in-vm | |
2120 | gnus-summary-save-article-vm)))) | |
745bc783 JB |
2121 | |
2122 | \f | |
41487370 LMI |
2123 | |
2124 | ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
2125 | ;; If you want the cursor to go somewhere else, set these two | |
2126 | ;; functions in some startup hook to whatever you want. | |
231f989b LMI |
2127 | (defalias 'gnus-summary-position-point 'gnus-goto-colon) |
2128 | (defalias 'gnus-group-position-point 'gnus-goto-colon) | |
41487370 LMI |
2129 | |
2130 | ;;; Various macros and substs. | |
745bc783 | 2131 | |
231f989b LMI |
2132 | (defun gnus-header-from (header) |
2133 | (mail-header-from header)) | |
2134 | ||
745bc783 | 2135 | (defmacro gnus-eval-in-buffer-window (buffer &rest forms) |
231f989b LMI |
2136 | "Pop to BUFFER, evaluate FORMS, and then return to the original window." |
2137 | (let ((tempvar (make-symbol "GnusStartBufferWindow")) | |
2138 | (w (make-symbol "w")) | |
2139 | (buf (make-symbol "buf"))) | |
2140 | `(let* ((,tempvar (selected-window)) | |
2141 | (,buf ,buffer) | |
2142 | (,w (get-buffer-window ,buf 'visible))) | |
745bc783 JB |
2143 | (unwind-protect |
2144 | (progn | |
231f989b LMI |
2145 | (if ,w |
2146 | (select-window ,w) | |
2147 | (pop-to-buffer ,buf)) | |
2148 | ,@forms) | |
2149 | (select-window ,tempvar))))) | |
2150 | ||
2151 | (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) | |
2152 | (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) | |
2153 | (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) | |
745bc783 JB |
2154 | |
2155 | (defmacro gnus-gethash (string hashtable) | |
2156 | "Get hash value of STRING in HASHTABLE." | |
231f989b | 2157 | `(symbol-value (intern-soft ,string ,hashtable))) |
745bc783 JB |
2158 | |
2159 | (defmacro gnus-sethash (string value hashtable) | |
231f989b LMI |
2160 | "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." |
2161 | `(set (intern ,string ,hashtable) ,value)) | |
2162 | ||
2163 | (defmacro gnus-intern-safe (string hashtable) | |
2164 | "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." | |
2165 | `(let ((symbol (intern ,string ,hashtable))) | |
2166 | (or (boundp symbol) | |
2167 | (set symbol nil)) | |
2168 | symbol)) | |
2169 | ||
2170 | (defmacro gnus-group-unread (group) | |
2171 | "Get the currently computed number of unread articles in GROUP." | |
2172 | `(car (gnus-gethash ,group gnus-newsrc-hashtb))) | |
2173 | ||
2174 | (defmacro gnus-group-entry (group) | |
2175 | "Get the newsrc entry for GROUP." | |
2176 | `(gnus-gethash ,group gnus-newsrc-hashtb)) | |
745bc783 | 2177 | |
231f989b LMI |
2178 | (defmacro gnus-active (group) |
2179 | "Get active info on GROUP." | |
2180 | `(gnus-gethash ,group gnus-active-hashtb)) | |
2181 | ||
2182 | (defmacro gnus-set-active (group active) | |
2183 | "Set GROUP's active info." | |
2184 | `(gnus-sethash ,group ,active gnus-active-hashtb)) | |
41487370 LMI |
2185 | |
2186 | ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> | |
2187 | ;; function `substring' might cut on a middle of multi-octet | |
2188 | ;; character. | |
2189 | (defun gnus-truncate-string (str width) | |
2190 | (substring str 0 width)) | |
2191 | ||
231f989b LMI |
2192 | ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way |
2193 | ;; to limit the length of a string. This function is necessary since | |
41487370 LMI |
2194 | ;; `(substr "abc" 0 30)' pukes with "Args out of range". |
2195 | (defsubst gnus-limit-string (str width) | |
2196 | (if (> (length str) width) | |
2197 | (substring str 0 width) | |
2198 | str)) | |
2199 | ||
2200 | (defsubst gnus-simplify-subject-re (subject) | |
2201 | "Remove \"Re:\" from subject lines." | |
231f989b LMI |
2202 | (if (string-match "^[Rr][Ee]: *" subject) |
2203 | (substring subject (match-end 0)) | |
2204 | subject)) | |
2205 | ||
2206 | (defsubst gnus-functionp (form) | |
2207 | "Return non-nil if FORM is funcallable." | |
2208 | (or (and (symbolp form) (fboundp form)) | |
2209 | (and (listp form) (eq (car form) 'lambda)))) | |
41487370 LMI |
2210 | |
2211 | (defsubst gnus-goto-char (point) | |
2212 | (and point (goto-char point))) | |
2213 | ||
2214 | (defmacro gnus-buffer-exists-p (buffer) | |
231f989b LMI |
2215 | `(let ((buffer ,buffer)) |
2216 | (and buffer | |
2217 | (funcall (if (stringp buffer) 'get-buffer 'buffer-name) | |
2218 | buffer)))) | |
41487370 LMI |
2219 | |
2220 | (defmacro gnus-kill-buffer (buffer) | |
231f989b LMI |
2221 | `(let ((buf ,buffer)) |
2222 | (if (gnus-buffer-exists-p buf) | |
2223 | (kill-buffer buf)))) | |
41487370 LMI |
2224 | |
2225 | (defsubst gnus-point-at-bol () | |
231f989b | 2226 | "Return point at the beginning of the line." |
41487370 LMI |
2227 | (let ((p (point))) |
2228 | (beginning-of-line) | |
2229 | (prog1 | |
2230 | (point) | |
2231 | (goto-char p)))) | |
2232 | ||
2233 | (defsubst gnus-point-at-eol () | |
231f989b | 2234 | "Return point at the end of the line." |
41487370 LMI |
2235 | (let ((p (point))) |
2236 | (end-of-line) | |
2237 | (prog1 | |
2238 | (point) | |
2239 | (goto-char p)))) | |
2240 | ||
231f989b LMI |
2241 | (defun gnus-alive-p () |
2242 | "Say whether Gnus is running or not." | |
2243 | (and gnus-group-buffer | |
2244 | (get-buffer gnus-group-buffer))) | |
2245 | ||
2246 | (defun gnus-delete-first (elt list) | |
2247 | "Delete by side effect the first occurrence of ELT as a member of LIST." | |
2248 | (if (equal (car list) elt) | |
2249 | (cdr list) | |
2250 | (let ((total list)) | |
2251 | (while (and (cdr list) | |
2252 | (not (equal (cadr list) elt))) | |
2253 | (setq list (cdr list))) | |
2254 | (when (cdr list) | |
2255 | (setcdr list (cddr list))) | |
2256 | total))) | |
2257 | ||
41487370 LMI |
2258 | ;; Delete the current line (and the next N lines.); |
2259 | (defmacro gnus-delete-line (&optional n) | |
231f989b LMI |
2260 | `(delete-region (progn (beginning-of-line) (point)) |
2261 | (progn (forward-line ,(or n 1)) (point)))) | |
41487370 LMI |
2262 | |
2263 | ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>. | |
2264 | (defvar gnus-init-inhibit nil) | |
2265 | (defun gnus-read-init-file (&optional inhibit-next) | |
2266 | (if gnus-init-inhibit | |
2267 | (setq gnus-init-inhibit nil) | |
2268 | (setq gnus-init-inhibit inhibit-next) | |
2269 | (and gnus-init-file | |
4703f851 RS |
2270 | ;; Don't load .gnus if -q option was used. |
2271 | init-file-user | |
231f989b | 2272 | (or (and (file-exists-p gnus-init-file) |
41487370 LMI |
2273 | ;; Don't try to load a directory. |
2274 | (not (file-directory-p gnus-init-file))) | |
2275 | (file-exists-p (concat gnus-init-file ".el")) | |
2276 | (file-exists-p (concat gnus-init-file ".elc"))) | |
231f989b LMI |
2277 | (condition-case var |
2278 | (load gnus-init-file nil t) | |
2279 | (error | |
2280 | (error "Error in %s: %s" gnus-init-file var)))))) | |
2281 | ||
2282 | ;; Info access macros. | |
2283 | ||
2284 | (defmacro gnus-info-group (info) | |
2285 | `(nth 0 ,info)) | |
2286 | (defmacro gnus-info-rank (info) | |
2287 | `(nth 1 ,info)) | |
2288 | (defmacro gnus-info-read (info) | |
2289 | `(nth 2 ,info)) | |
2290 | (defmacro gnus-info-marks (info) | |
2291 | `(nth 3 ,info)) | |
2292 | (defmacro gnus-info-method (info) | |
2293 | `(nth 4 ,info)) | |
2294 | (defmacro gnus-info-params (info) | |
2295 | `(nth 5 ,info)) | |
2296 | ||
2297 | (defmacro gnus-info-level (info) | |
2298 | `(let ((rank (gnus-info-rank ,info))) | |
2299 | (if (consp rank) | |
2300 | (car rank) | |
2301 | rank))) | |
2302 | (defmacro gnus-info-score (info) | |
2303 | `(let ((rank (gnus-info-rank ,info))) | |
2304 | (or (and (consp rank) (cdr rank)) 0))) | |
2305 | ||
2306 | (defmacro gnus-info-set-group (info group) | |
2307 | `(setcar ,info ,group)) | |
2308 | (defmacro gnus-info-set-rank (info rank) | |
2309 | `(setcar (nthcdr 1 ,info) ,rank)) | |
2310 | (defmacro gnus-info-set-read (info read) | |
2311 | `(setcar (nthcdr 2 ,info) ,read)) | |
2312 | (defmacro gnus-info-set-marks (info marks) | |
2313 | `(setcar (nthcdr 3 ,info) ,marks)) | |
2314 | (defmacro gnus-info-set-method (info method) | |
2315 | `(setcar (nthcdr 4 ,info) ,method)) | |
2316 | (defmacro gnus-info-set-params (info params) | |
2317 | `(setcar (nthcdr 5 ,info) ,params)) | |
2318 | ||
2319 | (defmacro gnus-info-set-level (info level) | |
2320 | `(let ((rank (cdr ,info))) | |
2321 | (if (consp (car rank)) | |
2322 | (setcar (car rank) ,level) | |
2323 | (setcar rank ,level)))) | |
2324 | (defmacro gnus-info-set-score (info score) | |
2325 | `(let ((rank (cdr ,info))) | |
2326 | (if (consp (car rank)) | |
2327 | (setcdr (car rank) ,score) | |
2328 | (setcar rank (cons (car rank) ,score))))) | |
2329 | ||
2330 | (defmacro gnus-get-info (group) | |
2331 | `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) | |
2332 | ||
2333 | (defun gnus-byte-code (func) | |
2334 | "Return a form that can be `eval'ed based on FUNC." | |
2335 | (let ((fval (symbol-function func))) | |
2336 | (if (byte-code-function-p fval) | |
2337 | (let ((flist (append fval nil))) | |
2338 | (setcar flist 'byte-code) | |
2339 | flist) | |
2340 | (cons 'progn (cddr fval))))) | |
2341 | ||
2342 | ;; Find out whether the gnus-visual TYPE is wanted. | |
2343 | (defun gnus-visual-p (&optional type class) | |
2344 | (and gnus-visual ; Has to be non-nil, at least. | |
2345 | (if (not type) ; We don't care about type. | |
2346 | gnus-visual | |
2347 | (if (listp gnus-visual) ; It's a list, so we check it. | |
2348 | (or (memq type gnus-visual) | |
2349 | (memq class gnus-visual)) | |
2350 | t)))) | |
2351 | ||
2352 | ;;; Load the compatability functions. | |
41487370 LMI |
2353 | |
2354 | (require 'gnus-cus) | |
2355 | (require 'gnus-ems) | |
745bc783 | 2356 | |
41487370 | 2357 | \f |
231f989b LMI |
2358 | ;;; |
2359 | ;;; Shutdown | |
2360 | ;;; | |
2361 | ||
2362 | (defvar gnus-shutdown-alist nil) | |
2363 | ||
2364 | (defun gnus-add-shutdown (function &rest symbols) | |
2365 | "Run FUNCTION whenever one of SYMBOLS is shut down." | |
2366 | (push (cons function symbols) gnus-shutdown-alist)) | |
2367 | ||
2368 | (defun gnus-shutdown (symbol) | |
2369 | "Shut down everything that waits for SYMBOL." | |
2370 | (let ((alist gnus-shutdown-alist) | |
2371 | entry) | |
2372 | (while (setq entry (pop alist)) | |
2373 | (when (memq symbol (cdr entry)) | |
2374 | (funcall (car entry)))))) | |
2375 | ||
2376 | \f | |
2377 | ||
2378 | ;; Format specs. The chunks below are the machine-generated forms | |
2379 | ;; that are to be evaled as the result of the default format strings. | |
2380 | ;; We write them in here to get them byte-compiled. That way the | |
2381 | ;; default actions will be quite fast, while still retaining the full | |
2382 | ;; flexibility of the user-defined format specs. | |
2383 | ||
2384 | ;; First we have lots of dummy defvars to let the compiler know these | |
2385 | ;; are really dynamic variables. | |
2386 | ||
2387 | (defvar gnus-tmp-unread) | |
2388 | (defvar gnus-tmp-replied) | |
2389 | (defvar gnus-tmp-score-char) | |
2390 | (defvar gnus-tmp-indentation) | |
2391 | (defvar gnus-tmp-opening-bracket) | |
2392 | (defvar gnus-tmp-lines) | |
2393 | (defvar gnus-tmp-name) | |
2394 | (defvar gnus-tmp-closing-bracket) | |
2395 | (defvar gnus-tmp-subject-or-nil) | |
2396 | (defvar gnus-tmp-subject) | |
2397 | (defvar gnus-tmp-marked) | |
2398 | (defvar gnus-tmp-marked-mark) | |
2399 | (defvar gnus-tmp-subscribed) | |
2400 | (defvar gnus-tmp-process-marked) | |
2401 | (defvar gnus-tmp-number-of-unread) | |
2402 | (defvar gnus-tmp-group-name) | |
2403 | (defvar gnus-tmp-group) | |
2404 | (defvar gnus-tmp-article-number) | |
2405 | (defvar gnus-tmp-unread-and-unselected) | |
2406 | (defvar gnus-tmp-news-method) | |
2407 | (defvar gnus-tmp-news-server) | |
2408 | (defvar gnus-tmp-article-number) | |
2409 | (defvar gnus-mouse-face) | |
2410 | (defvar gnus-mouse-face-prop) | |
2411 | ||
2412 | (defun gnus-summary-line-format-spec () | |
2413 | (insert gnus-tmp-unread gnus-tmp-replied | |
2414 | gnus-tmp-score-char gnus-tmp-indentation) | |
2415 | (gnus-put-text-property | |
2416 | (point) | |
2417 | (progn | |
2418 | (insert | |
2419 | gnus-tmp-opening-bracket | |
2420 | (format "%4d: %-20s" | |
2421 | gnus-tmp-lines | |
2422 | (if (> (length gnus-tmp-name) 20) | |
2423 | (substring gnus-tmp-name 0 20) | |
2424 | gnus-tmp-name)) | |
2425 | gnus-tmp-closing-bracket) | |
2426 | (point)) | |
2427 | gnus-mouse-face-prop gnus-mouse-face) | |
2428 | (insert " " gnus-tmp-subject-or-nil "\n")) | |
2429 | ||
2430 | (defvar gnus-summary-line-format-spec | |
2431 | (gnus-byte-code 'gnus-summary-line-format-spec)) | |
2432 | ||
2433 | (defun gnus-summary-dummy-line-format-spec () | |
2434 | (insert "* ") | |
2435 | (gnus-put-text-property | |
2436 | (point) | |
2437 | (progn | |
2438 | (insert ": :") | |
2439 | (point)) | |
2440 | gnus-mouse-face-prop gnus-mouse-face) | |
2441 | (insert " " gnus-tmp-subject "\n")) | |
2442 | ||
2443 | (defvar gnus-summary-dummy-line-format-spec | |
2444 | (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) | |
2445 | ||
2446 | (defun gnus-group-line-format-spec () | |
2447 | (insert gnus-tmp-marked-mark gnus-tmp-subscribed | |
2448 | gnus-tmp-process-marked | |
2449 | gnus-group-indentation | |
2450 | (format "%5s: " gnus-tmp-number-of-unread)) | |
2451 | (gnus-put-text-property | |
2452 | (point) | |
2453 | (progn | |
2454 | (insert gnus-tmp-group "\n") | |
2455 | (1- (point))) | |
2456 | gnus-mouse-face-prop gnus-mouse-face)) | |
2457 | (defvar gnus-group-line-format-spec | |
2458 | (gnus-byte-code 'gnus-group-line-format-spec)) | |
2459 | ||
2460 | (defvar gnus-format-specs | |
2461 | `((version . ,emacs-version) | |
2462 | (group ,gnus-group-line-format ,gnus-group-line-format-spec) | |
2463 | (summary-dummy ,gnus-summary-dummy-line-format | |
2464 | ,gnus-summary-dummy-line-format-spec) | |
2465 | (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec))) | |
2466 | ||
2467 | (defvar gnus-article-mode-line-format-spec nil) | |
2468 | (defvar gnus-summary-mode-line-format-spec nil) | |
2469 | (defvar gnus-group-mode-line-format-spec nil) | |
2470 | ||
2471 | ;;; Phew. All that gruft is over, fortunately. | |
2472 | ||
2473 | \f | |
41487370 LMI |
2474 | ;;; |
2475 | ;;; Gnus Utility Functions | |
2476 | ;;; | |
745bc783 | 2477 | |
41487370 LMI |
2478 | (defun gnus-extract-address-components (from) |
2479 | (let (name address) | |
2480 | ;; First find the address - the thing with the @ in it. This may | |
2481 | ;; not be accurate in mail addresses, but does the trick most of | |
2482 | ;; the time in news messages. | |
2483 | (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) | |
2484 | (setq address (substring from (match-beginning 0) (match-end 0)))) | |
2485 | ;; Then we check whether the "name <address>" format is used. | |
2486 | (and address | |
231f989b LMI |
2487 | ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp> |
2488 | ;; Linear white space is not required. | |
2489 | (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) | |
2490 | (and (setq name (substring from 0 (match-beginning 0))) | |
41487370 LMI |
2491 | ;; Strip any quotes from the name. |
2492 | (string-match "\".*\"" name) | |
2493 | (setq name (substring name 1 (1- (match-end 0)))))) | |
2494 | ;; If not, then "address (name)" is used. | |
2495 | (or name | |
2496 | (and (string-match "(.+)" from) | |
231f989b | 2497 | (setq name (substring from (1+ (match-beginning 0)) |
41487370 LMI |
2498 | (1- (match-end 0))))) |
2499 | (and (string-match "()" from) | |
2500 | (setq name address)) | |
2501 | ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>. | |
2502 | ;; XOVER might not support folded From headers. | |
2503 | (and (string-match "(.*" from) | |
231f989b | 2504 | (setq name (substring from (1+ (match-beginning 0)) |
41487370 LMI |
2505 | (match-end 0))))) |
2506 | ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
2507 | (list (or name from) (or address from)))) | |
745bc783 | 2508 | |
41487370 LMI |
2509 | (defun gnus-fetch-field (field) |
2510 | "Return the value of the header FIELD of current article." | |
2511 | (save-excursion | |
2512 | (save-restriction | |
231f989b LMI |
2513 | (let ((case-fold-search t) |
2514 | (inhibit-point-motion-hooks t)) | |
2515 | (nnheader-narrow-to-headers) | |
2516 | (message-fetch-field field))))) | |
745bc783 | 2517 | |
41487370 LMI |
2518 | (defun gnus-goto-colon () |
2519 | (beginning-of-line) | |
2520 | (search-forward ":" (gnus-point-at-eol) t)) | |
745bc783 | 2521 | |
231f989b LMI |
2522 | ;;;###autoload |
2523 | (defun gnus-update-format (var) | |
2524 | "Update the format specification near point." | |
2525 | (interactive | |
2526 | (list | |
2527 | (save-excursion | |
2528 | (eval-defun nil) | |
2529 | ;; Find the end of the current word. | |
2530 | (re-search-forward "[ \t\n]" nil t) | |
2531 | ;; Search backward. | |
2532 | (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) | |
2533 | (match-string 1))))) | |
2534 | (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) | |
2535 | (match-string 1 var)))) | |
2536 | (entry (assq type gnus-format-specs)) | |
2537 | value spec) | |
2538 | (when entry | |
2539 | (setq gnus-format-specs (delq entry gnus-format-specs))) | |
2540 | (set | |
2541 | (intern (format "%s-spec" var)) | |
2542 | (gnus-parse-format (setq value (symbol-value (intern var))) | |
2543 | (symbol-value (intern (format "%s-alist" var))) | |
2544 | (not (string-match "mode" var)))) | |
2545 | (setq spec (symbol-value (intern (format "%s-spec" var)))) | |
2546 | (push (list type value spec) gnus-format-specs) | |
2547 | ||
2548 | (pop-to-buffer "*Gnus Format*") | |
2549 | (erase-buffer) | |
2550 | (lisp-interaction-mode) | |
2551 | (insert (pp-to-string spec)))) | |
41487370 | 2552 | |
231f989b LMI |
2553 | (defun gnus-update-format-specifications (&optional force) |
2554 | "Update all (necessary) format specifications." | |
2555 | ;; Make the indentation array. | |
41487370 LMI |
2556 | (gnus-make-thread-indent-array) |
2557 | ||
231f989b LMI |
2558 | ;; See whether all the stored info needs to be flushed. |
2559 | (when (or force | |
2560 | (not (equal emacs-version | |
2561 | (cdr (assq 'version gnus-format-specs))))) | |
2562 | (setq gnus-format-specs nil)) | |
2563 | ||
2564 | ;; Go through all the formats and see whether they need updating. | |
2565 | (let ((types '(summary summary-dummy group | |
2566 | summary-mode group-mode article-mode)) | |
2567 | new-format entry type val) | |
2568 | (while (setq type (pop types)) | |
2569 | ;; Jump to the proper buffer to find out the value of | |
2570 | ;; the variable, if possible. (It may be buffer-local.) | |
2571 | (save-excursion | |
2572 | (let ((buffer (intern (format "gnus-%s-buffer" type))) | |
2573 | val) | |
2574 | (when (and (boundp buffer) | |
2575 | (setq val (symbol-value buffer)) | |
2576 | (get-buffer val) | |
2577 | (buffer-name (get-buffer val))) | |
2578 | (set-buffer (get-buffer val))) | |
2579 | (setq new-format (symbol-value | |
2580 | (intern (format "gnus-%s-line-format" type)))))) | |
2581 | (setq entry (cdr (assq type gnus-format-specs))) | |
2582 | (if (and entry | |
2583 | (equal (car entry) new-format)) | |
2584 | ;; Use the old format. | |
2585 | (set (intern (format "gnus-%s-line-format-spec" type)) | |
2586 | (cadr entry)) | |
2587 | ;; This is a new format. | |
2588 | (setq val | |
2589 | (if (not (stringp new-format)) | |
2590 | ;; This is a function call or something. | |
2591 | new-format | |
2592 | ;; This is a "real" format. | |
2593 | (gnus-parse-format | |
2594 | new-format | |
2595 | (symbol-value | |
2596 | (intern (format "gnus-%s-line-format-alist" | |
2597 | (if (eq type 'article-mode) | |
2598 | 'summary-mode type)))) | |
2599 | (not (string-match "mode$" (symbol-name type)))))) | |
2600 | ;; Enter the new format spec into the list. | |
2601 | (if entry | |
2602 | (progn | |
2603 | (setcar (cdr entry) val) | |
2604 | (setcar entry new-format)) | |
2605 | (push (list type new-format val) gnus-format-specs)) | |
2606 | (set (intern (format "gnus-%s-line-format-spec" type)) val)))) | |
41487370 | 2607 | |
231f989b LMI |
2608 | (unless (assq 'version gnus-format-specs) |
2609 | (push (cons 'version emacs-version) gnus-format-specs)) | |
2610 | ||
2611 | (gnus-update-group-mark-positions) | |
2612 | (gnus-update-summary-mark-positions)) | |
41487370 LMI |
2613 | |
2614 | (defun gnus-update-summary-mark-positions () | |
231f989b | 2615 | "Compute where the summary marks are to go." |
41487370 | 2616 | (save-excursion |
231f989b LMI |
2617 | (when (and gnus-summary-buffer |
2618 | (get-buffer gnus-summary-buffer) | |
2619 | (buffer-name (get-buffer gnus-summary-buffer))) | |
2620 | (set-buffer gnus-summary-buffer)) | |
41487370 LMI |
2621 | (let ((gnus-replied-mark 129) |
2622 | (gnus-score-below-mark 130) | |
2623 | (gnus-score-over-mark 130) | |
2624 | (thread nil) | |
231f989b LMI |
2625 | (gnus-visual nil) |
2626 | (spec gnus-summary-line-format-spec) | |
41487370 | 2627 | pos) |
231f989b LMI |
2628 | (save-excursion |
2629 | (gnus-set-work-buffer) | |
2630 | (let ((gnus-summary-line-format-spec spec)) | |
2631 | (gnus-summary-insert-line | |
2632 | [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) | |
2633 | (goto-char (point-min)) | |
2634 | (setq pos (list (cons 'unread (and (search-forward "\200" nil t) | |
2635 | (- (point) 2))))) | |
2636 | (goto-char (point-min)) | |
2637 | (push (cons 'replied (and (search-forward "\201" nil t) | |
2638 | (- (point) 2))) | |
2639 | pos) | |
2640 | (goto-char (point-min)) | |
2641 | (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) | |
2642 | pos))) | |
41487370 | 2643 | (setq gnus-summary-mark-positions pos)))) |
745bc783 | 2644 | |
41487370 LMI |
2645 | (defun gnus-update-group-mark-positions () |
2646 | (save-excursion | |
2647 | (let ((gnus-process-mark 128) | |
231f989b LMI |
2648 | (gnus-group-marked '("dummy.group")) |
2649 | (gnus-active-hashtb (make-vector 10 0))) | |
2650 | (gnus-set-active "dummy.group" '(0 . 0)) | |
41487370 | 2651 | (gnus-set-work-buffer) |
231f989b | 2652 | (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) |
41487370 LMI |
2653 | (goto-char (point-min)) |
2654 | (setq gnus-group-mark-positions | |
2655 | (list (cons 'process (and (search-forward "\200" nil t) | |
2656 | (- (point) 2)))))))) | |
2657 | ||
231f989b LMI |
2658 | (defvar gnus-mouse-face-0 'highlight) |
2659 | (defvar gnus-mouse-face-1 'highlight) | |
2660 | (defvar gnus-mouse-face-2 'highlight) | |
2661 | (defvar gnus-mouse-face-3 'highlight) | |
2662 | (defvar gnus-mouse-face-4 'highlight) | |
2663 | ||
2664 | (defun gnus-mouse-face-function (form type) | |
2665 | `(gnus-put-text-property | |
2666 | (point) (progn ,@form (point)) | |
2667 | gnus-mouse-face-prop | |
2668 | ,(if (equal type 0) | |
2669 | 'gnus-mouse-face | |
2670 | `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) | |
2671 | ||
2672 | (defvar gnus-face-0 'bold) | |
2673 | (defvar gnus-face-1 'italic) | |
2674 | (defvar gnus-face-2 'bold-italic) | |
2675 | (defvar gnus-face-3 'bold) | |
2676 | (defvar gnus-face-4 'bold) | |
2677 | ||
2678 | (defun gnus-face-face-function (form type) | |
2679 | `(gnus-put-text-property | |
2680 | (point) (progn ,@form (point)) | |
2681 | 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) | |
41487370 LMI |
2682 | |
2683 | (defun gnus-max-width-function (el max-width) | |
2684 | (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) | |
231f989b LMI |
2685 | (if (symbolp el) |
2686 | `(if (> (length ,el) ,max-width) | |
2687 | (substring ,el 0 ,max-width) | |
2688 | ,el) | |
2689 | `(let ((val (eval ,el))) | |
2690 | (if (numberp val) | |
2691 | (setq val (int-to-string val))) | |
2692 | (if (> (length val) ,max-width) | |
2693 | (substring val 0 ,max-width) | |
2694 | val)))) | |
2695 | ||
2696 | (defun gnus-parse-format (format spec-alist &optional insert) | |
41487370 LMI |
2697 | ;; This function parses the FORMAT string with the help of the |
2698 | ;; SPEC-ALIST and returns a list that can be eval'ed to return the | |
2699 | ;; string. If the FORMAT string contains the specifiers %( and %) | |
2700 | ;; the text between them will have the mouse-face text property. | |
231f989b LMI |
2701 | (if (string-match |
2702 | "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" | |
2703 | format) | |
2704 | (gnus-parse-complex-format format spec-alist) | |
2705 | ;; This is a simple format. | |
2706 | (gnus-parse-simple-format format spec-alist insert))) | |
2707 | ||
2708 | (defun gnus-parse-complex-format (format spec-alist) | |
2709 | (save-excursion | |
2710 | (gnus-set-work-buffer) | |
2711 | (insert format) | |
2712 | (goto-char (point-min)) | |
2713 | (while (re-search-forward "\"" nil t) | |
2714 | (replace-match "\\\"" nil t)) | |
2715 | (goto-char (point-min)) | |
2716 | (insert "(\"") | |
2717 | (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) | |
2718 | (let ((number (if (match-beginning 1) | |
2719 | (match-string 1) "0")) | |
2720 | (delim (aref (match-string 2) 0))) | |
2721 | (if (or (= delim ?\() (= delim ?\{)) | |
2722 | (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") | |
2723 | " " number " \"")) | |
2724 | (replace-match "\")\"")))) | |
2725 | (goto-char (point-max)) | |
2726 | (insert "\")") | |
2727 | (goto-char (point-min)) | |
2728 | (let ((form (read (current-buffer)))) | |
2729 | (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) | |
2730 | ||
2731 | (defun gnus-complex-form-to-spec (form spec-alist) | |
2732 | (delq nil | |
2733 | (mapcar | |
2734 | (lambda (sform) | |
2735 | (if (stringp sform) | |
2736 | (gnus-parse-simple-format sform spec-alist t) | |
2737 | (funcall (intern (format "gnus-%s-face-function" (car sform))) | |
2738 | (gnus-complex-form-to-spec (cddr sform) spec-alist) | |
2739 | (nth 1 sform)))) | |
2740 | form))) | |
2741 | ||
2742 | (defun gnus-parse-simple-format (format spec-alist &optional insert) | |
41487370 | 2743 | ;; This function parses the FORMAT string with the help of the |
231f989b LMI |
2744 | ;; SPEC-ALIST and returns a list that can be eval'ed to return a |
2745 | ;; string. | |
41487370 | 2746 | (let ((max-width 0) |
231f989b | 2747 | spec flist fstring newspec elem beg result dontinsert) |
41487370 LMI |
2748 | (save-excursion |
2749 | (gnus-set-work-buffer) | |
2750 | (insert format) | |
2751 | (goto-char (point-min)) | |
231f989b LMI |
2752 | (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" |
2753 | nil t) | |
2754 | (if (= (setq spec (string-to-char (match-string 2))) ?%) | |
2755 | (setq newspec "%" | |
2756 | beg (1+ (match-beginning 0))) | |
2757 | ;; First check if there are any specs that look anything like | |
2758 | ;; "%12,12A", ie. with a "max width specification". These have | |
2759 | ;; to be treated specially. | |
2760 | (if (setq beg (match-beginning 1)) | |
2761 | (setq max-width | |
2762 | (string-to-int | |
2763 | (buffer-substring | |
2764 | (1+ (match-beginning 1)) (match-end 1)))) | |
2765 | (setq max-width 0) | |
2766 | (setq beg (match-beginning 2))) | |
2767 | ;; Find the specification from `spec-alist'. | |
2768 | (unless (setq elem (cdr (assq spec spec-alist))) | |
41487370 | 2769 | (setq elem '("*" ?s))) |
231f989b LMI |
2770 | ;; Treat user defined format specifiers specially. |
2771 | (when (eq (car elem) 'gnus-tmp-user-defined) | |
2772 | (setq elem | |
2773 | (list | |
2774 | (list (intern (concat "gnus-user-format-function-" | |
2775 | (match-string 3))) | |
2776 | 'gnus-tmp-header) ?s)) | |
2777 | (delete-region (match-beginning 3) (match-end 3))) | |
2778 | (if (not (zerop max-width)) | |
2779 | (let ((el (car elem))) | |
2780 | (cond ((= (cadr elem) ?c) | |
2781 | (setq el (list 'char-to-string el))) | |
2782 | ((= (cadr elem) ?d) | |
2783 | (setq el (list 'int-to-string el)))) | |
2784 | (setq flist (cons (gnus-max-width-function el max-width) | |
2785 | flist)) | |
2786 | (setq newspec ?s)) | |
2787 | (progn | |
2788 | (setq flist (cons (car elem) flist)) | |
2789 | (setq newspec (cadr elem))))) | |
41487370 LMI |
2790 | ;; Remove the old specification (and possibly a ",12" string). |
2791 | (delete-region beg (match-end 2)) | |
2792 | ;; Insert the new specification. | |
2793 | (goto-char beg) | |
2794 | (insert newspec)) | |
2795 | (setq fstring (buffer-substring 1 (point-max)))) | |
231f989b LMI |
2796 | ;; Do some postprocessing to increase efficiency. |
2797 | (setq | |
2798 | result | |
2799 | (cond | |
2800 | ;; Emptyness. | |
2801 | ((string= fstring "") | |
2802 | nil) | |
2803 | ;; Not a format string. | |
2804 | ((not (string-match "%" fstring)) | |
2805 | (list fstring)) | |
2806 | ;; A format string with just a single string spec. | |
2807 | ((string= fstring "%s") | |
2808 | (list (car flist))) | |
2809 | ;; A single character. | |
2810 | ((string= fstring "%c") | |
2811 | (list (car flist))) | |
2812 | ;; A single number. | |
2813 | ((string= fstring "%d") | |
2814 | (setq dontinsert) | |
2815 | (if insert | |
2816 | (list `(princ ,(car flist))) | |
2817 | (list `(int-to-string ,(car flist))))) | |
2818 | ;; Just lots of chars and strings. | |
2819 | ((string-match "\\`\\(%[cs]\\)+\\'" fstring) | |
2820 | (nreverse flist)) | |
2821 | ;; A single string spec at the beginning of the spec. | |
2822 | ((string-match "\\`%[sc][^%]+\\'" fstring) | |
2823 | (list (car flist) (substring fstring 2))) | |
2824 | ;; A single string spec in the middle of the spec. | |
2825 | ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) | |
2826 | (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) | |
2827 | ;; A single string spec in the end of the spec. | |
2828 | ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) | |
2829 | (list (match-string 1 fstring) (car flist))) | |
2830 | ;; A more complex spec. | |
2831 | (t | |
2832 | (list (cons 'format (cons fstring (nreverse flist))))))) | |
2833 | ||
2834 | (if insert | |
2835 | (when result | |
2836 | (if dontinsert | |
2837 | result | |
2838 | (cons 'insert result))) | |
2839 | (cond ((stringp result) | |
2840 | result) | |
2841 | ((consp result) | |
2842 | (cons 'concat result)) | |
2843 | (t ""))))) | |
2844 | ||
2845 | (defun gnus-eval-format (format &optional alist props) | |
2846 | "Eval the format variable FORMAT, using ALIST. | |
2847 | If PROPS, insert the result." | |
2848 | (let ((form (gnus-parse-format format alist props))) | |
2849 | (if props | |
2850 | (gnus-add-text-properties (point) (progn (eval form) (point)) props) | |
2851 | (eval form)))) | |
2852 | ||
2853 | (defun gnus-remove-text-with-property (prop) | |
2854 | "Delete all text in the current buffer with text property PROP." | |
2855 | (save-excursion | |
2856 | (goto-char (point-min)) | |
2857 | (while (not (eobp)) | |
2858 | (while (get-text-property (point) prop) | |
2859 | (delete-char 1)) | |
2860 | (goto-char (next-single-property-change (point) prop nil (point-max)))))) | |
41487370 LMI |
2861 | |
2862 | (defun gnus-set-work-buffer () | |
2863 | (if (get-buffer gnus-work-buffer) | |
2864 | (progn | |
2865 | (set-buffer gnus-work-buffer) | |
2866 | (erase-buffer)) | |
2867 | (set-buffer (get-buffer-create gnus-work-buffer)) | |
2868 | (kill-all-local-variables) | |
2869 | (buffer-disable-undo (current-buffer)) | |
2870 | (gnus-add-current-to-buffer-list))) | |
745bc783 | 2871 | |
41487370 | 2872 | ;; Article file names when saving. |
745bc783 | 2873 | |
41487370 LMI |
2874 | (defun gnus-Numeric-save-name (newsgroup headers &optional last-file) |
2875 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2876 | If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num. | |
2877 | Otherwise, it is like ~/News/news/group/num." | |
2878 | (let ((default | |
2879 | (expand-file-name | |
2880 | (concat (if (gnus-use-long-file-name 'not-save) | |
2881 | (gnus-capitalize-newsgroup newsgroup) | |
2882 | (gnus-newsgroup-directory-form newsgroup)) | |
2883 | "/" (int-to-string (mail-header-number headers))) | |
231f989b | 2884 | gnus-article-save-directory))) |
41487370 LMI |
2885 | (if (and last-file |
2886 | (string-equal (file-name-directory default) | |
2887 | (file-name-directory last-file)) | |
2888 | (string-match "^[0-9]+$" (file-name-nondirectory last-file))) | |
2889 | default | |
2890 | (or last-file default)))) | |
745bc783 | 2891 | |
41487370 LMI |
2892 | (defun gnus-numeric-save-name (newsgroup headers &optional last-file) |
2893 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2894 | If variable `gnus-use-long-file-name' is non-nil, it is | |
231f989b | 2895 | ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." |
41487370 LMI |
2896 | (let ((default |
2897 | (expand-file-name | |
2898 | (concat (if (gnus-use-long-file-name 'not-save) | |
2899 | newsgroup | |
2900 | (gnus-newsgroup-directory-form newsgroup)) | |
2901 | "/" (int-to-string (mail-header-number headers))) | |
231f989b | 2902 | gnus-article-save-directory))) |
41487370 LMI |
2903 | (if (and last-file |
2904 | (string-equal (file-name-directory default) | |
2905 | (file-name-directory last-file)) | |
2906 | (string-match "^[0-9]+$" (file-name-nondirectory last-file))) | |
2907 | default | |
2908 | (or last-file default)))) | |
745bc783 | 2909 | |
41487370 LMI |
2910 | (defun gnus-Plain-save-name (newsgroup headers &optional last-file) |
2911 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2912 | If variable `gnus-use-long-file-name' is non-nil, it is | |
2913 | ~/News/News.group. Otherwise, it is like ~/News/news/group/news." | |
2914 | (or last-file | |
2915 | (expand-file-name | |
2916 | (if (gnus-use-long-file-name 'not-save) | |
2917 | (gnus-capitalize-newsgroup newsgroup) | |
2918 | (concat (gnus-newsgroup-directory-form newsgroup) "/news")) | |
231f989b | 2919 | gnus-article-save-directory))) |
745bc783 | 2920 | |
41487370 LMI |
2921 | (defun gnus-plain-save-name (newsgroup headers &optional last-file) |
2922 | "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. | |
2923 | If variable `gnus-use-long-file-name' is non-nil, it is | |
2924 | ~/News/news.group. Otherwise, it is like ~/News/news/group/news." | |
2925 | (or last-file | |
2926 | (expand-file-name | |
2927 | (if (gnus-use-long-file-name 'not-save) | |
2928 | newsgroup | |
2929 | (concat (gnus-newsgroup-directory-form newsgroup) "/news")) | |
231f989b | 2930 | gnus-article-save-directory))) |
745bc783 | 2931 | |
41487370 | 2932 | ;; For subscribing new newsgroup |
745bc783 | 2933 | |
41487370 LMI |
2934 | (defun gnus-subscribe-hierarchical-interactive (groups) |
2935 | (let ((groups (sort groups 'string<)) | |
2936 | prefixes prefix start ans group starts) | |
2937 | (while groups | |
2938 | (setq prefixes (list "^")) | |
2939 | (while (and groups prefixes) | |
2940 | (while (not (string-match (car prefixes) (car groups))) | |
2941 | (setq prefixes (cdr prefixes))) | |
2942 | (setq prefix (car prefixes)) | |
2943 | (setq start (1- (length prefix))) | |
2944 | (if (and (string-match "[^\\.]\\." (car groups) start) | |
2945 | (cdr groups) | |
231f989b | 2946 | (setq prefix |
41487370 | 2947 | (concat "^" (substring (car groups) 0 (match-end 0)))) |
231f989b | 2948 | (string-match prefix (cadr groups))) |
41487370 LMI |
2949 | (progn |
2950 | (setq prefixes (cons prefix prefixes)) | |
231f989b | 2951 | (message "Descend hierarchy %s? ([y]nsq): " |
41487370 | 2952 | (substring prefix 1 (1- (length prefix)))) |
231f989b LMI |
2953 | (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q))) |
2954 | (ding) | |
2955 | (message "Descend hierarchy %s? ([y]nsq): " | |
2956 | (substring prefix 1 (1- (length prefix))))) | |
41487370 | 2957 | (cond ((= ans ?n) |
231f989b LMI |
2958 | (while (and groups |
2959 | (string-match prefix | |
41487370 | 2960 | (setq group (car groups)))) |
231f989b | 2961 | (setq gnus-killed-list |
41487370 LMI |
2962 | (cons group gnus-killed-list)) |
2963 | (gnus-sethash group group gnus-killed-hashtb) | |
2964 | (setq groups (cdr groups))) | |
2965 | (setq starts (cdr starts))) | |
2966 | ((= ans ?s) | |
231f989b LMI |
2967 | (while (and groups |
2968 | (string-match prefix | |
41487370 LMI |
2969 | (setq group (car groups)))) |
2970 | (gnus-sethash group group gnus-killed-hashtb) | |
2971 | (gnus-subscribe-alphabetically (car groups)) | |
2972 | (setq groups (cdr groups))) | |
2973 | (setq starts (cdr starts))) | |
2974 | ((= ans ?q) | |
2975 | (while groups | |
2976 | (setq group (car groups)) | |
2977 | (setq gnus-killed-list (cons group gnus-killed-list)) | |
2978 | (gnus-sethash group group gnus-killed-hashtb) | |
2979 | (setq groups (cdr groups)))) | |
2980 | (t nil))) | |
2981 | (message "Subscribe %s? ([n]yq)" (car groups)) | |
231f989b LMI |
2982 | (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n))) |
2983 | (ding) | |
2984 | (message "Subscribe %s? ([n]yq)" (car groups))) | |
41487370 LMI |
2985 | (setq group (car groups)) |
2986 | (cond ((= ans ?y) | |
2987 | (gnus-subscribe-alphabetically (car groups)) | |
2988 | (gnus-sethash group group gnus-killed-hashtb)) | |
2989 | ((= ans ?q) | |
2990 | (while groups | |
2991 | (setq group (car groups)) | |
2992 | (setq gnus-killed-list (cons group gnus-killed-list)) | |
2993 | (gnus-sethash group group gnus-killed-hashtb) | |
2994 | (setq groups (cdr groups)))) | |
231f989b | 2995 | (t |
41487370 LMI |
2996 | (setq gnus-killed-list (cons group gnus-killed-list)) |
2997 | (gnus-sethash group group gnus-killed-hashtb))) | |
2998 | (setq groups (cdr groups))))))) | |
745bc783 | 2999 | |
41487370 LMI |
3000 | (defun gnus-subscribe-randomly (newsgroup) |
3001 | "Subscribe new NEWSGROUP by making it the first newsgroup." | |
3002 | (gnus-subscribe-newsgroup newsgroup)) | |
745bc783 | 3003 | |
41487370 LMI |
3004 | (defun gnus-subscribe-alphabetically (newgroup) |
3005 | "Subscribe new NEWSGROUP and insert it in alphabetical order." | |
41487370 LMI |
3006 | (let ((groups (cdr gnus-newsrc-alist)) |
3007 | before) | |
3008 | (while (and (not before) groups) | |
231f989b LMI |
3009 | (if (string< newgroup (caar groups)) |
3010 | (setq before (caar groups)) | |
41487370 LMI |
3011 | (setq groups (cdr groups)))) |
3012 | (gnus-subscribe-newsgroup newgroup before))) | |
745bc783 | 3013 | |
41487370 LMI |
3014 | (defun gnus-subscribe-hierarchically (newgroup) |
3015 | "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." | |
3016 | ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) | |
3017 | (save-excursion | |
3018 | (set-buffer (find-file-noselect gnus-current-startup-file)) | |
3019 | (let ((groupkey newgroup) | |
3020 | before) | |
3021 | (while (and (not before) groupkey) | |
3022 | (goto-char (point-min)) | |
3023 | (let ((groupkey-re | |
3024 | (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) | |
3025 | (while (and (re-search-forward groupkey-re nil t) | |
3026 | (progn | |
231f989b | 3027 | (setq before (match-string 1)) |
41487370 LMI |
3028 | (string< before newgroup))))) |
3029 | ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) | |
3030 | (setq groupkey | |
3031 | (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) | |
3032 | (substring groupkey (match-beginning 1) (match-end 1))))) | |
564b670b LMI |
3033 | (gnus-subscribe-newsgroup newgroup before)) |
3034 | (kill-buffer (current-buffer)))) | |
41487370 | 3035 | |
231f989b LMI |
3036 | (defun gnus-subscribe-interactively (group) |
3037 | "Subscribe the new GROUP interactively. | |
3038 | It is inserted in hierarchical newsgroup order if subscribed. If not, | |
41487370 | 3039 | it is killed." |
231f989b LMI |
3040 | (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) |
3041 | (gnus-subscribe-hierarchically group) | |
3042 | (push group gnus-killed-list))) | |
3043 | ||
3044 | (defun gnus-subscribe-zombies (group) | |
3045 | "Make the new GROUP into a zombie group." | |
3046 | (push group gnus-zombie-list)) | |
41487370 | 3047 | |
231f989b LMI |
3048 | (defun gnus-subscribe-killed (group) |
3049 | "Make the new GROUP a killed group." | |
3050 | (push group gnus-killed-list)) | |
41487370 LMI |
3051 | |
3052 | (defun gnus-subscribe-newsgroup (newsgroup &optional next) | |
3053 | "Subscribe new NEWSGROUP. | |
231f989b | 3054 | If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made |
41487370 LMI |
3055 | the first newsgroup." |
3056 | ;; We subscribe the group by changing its level to `subscribed'. | |
231f989b | 3057 | (gnus-group-change-level |
41487370 LMI |
3058 | newsgroup gnus-level-default-subscribed |
3059 | gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) | |
3060 | (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)) | |
3061 | ||
3062 | ;; For directories | |
3063 | ||
3064 | (defun gnus-newsgroup-directory-form (newsgroup) | |
3065 | "Make hierarchical directory name from NEWSGROUP name." | |
b94ae5f7 | 3066 | (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) |
41487370 LMI |
3067 | (len (length newsgroup)) |
3068 | idx) | |
3069 | ;; If this is a foreign group, we don't want to translate the | |
231f989b | 3070 | ;; entire name. |
41487370 LMI |
3071 | (if (setq idx (string-match ":" newsgroup)) |
3072 | (aset newsgroup idx ?/) | |
3073 | (setq idx 0)) | |
3074 | ;; Replace all occurrences of `.' with `/'. | |
3075 | (while (< idx len) | |
3076 | (if (= (aref newsgroup idx) ?.) | |
3077 | (aset newsgroup idx ?/)) | |
3078 | (setq idx (1+ idx))) | |
3079 | newsgroup)) | |
3080 | ||
b94ae5f7 | 3081 | (defun gnus-newsgroup-savable-name (group) |
41487370 LMI |
3082 | ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) |
3083 | ;; with dots. | |
231f989b | 3084 | (nnheader-replace-chars-in-string group ?/ ?.)) |
41487370 LMI |
3085 | |
3086 | (defun gnus-make-directory (dir) | |
3087 | "Make DIRECTORY recursively." | |
231f989b | 3088 | ;; Why don't we use `(make-directory dir 'parents)'? That's just one |
41487370 LMI |
3089 | ;; of the many mysteries of the universe. |
3090 | (let* ((dir (expand-file-name dir default-directory)) | |
3091 | dirs err) | |
3092 | (if (string-match "/$" dir) | |
3093 | (setq dir (substring dir 0 (match-beginning 0)))) | |
3094 | ;; First go down the path until we find a directory that exists. | |
3095 | (while (not (file-exists-p dir)) | |
3096 | (setq dirs (cons dir dirs)) | |
3097 | (string-match "/[^/]+$" dir) | |
3098 | (setq dir (substring dir 0 (match-beginning 0)))) | |
3099 | ;; Then create all the subdirs. | |
3100 | (while (and dirs (not err)) | |
3101 | (condition-case () | |
3102 | (make-directory (car dirs)) | |
3103 | (error (setq err t))) | |
3104 | (setq dirs (cdr dirs))) | |
231f989b | 3105 | ;; We return whether we were successful or not. |
41487370 LMI |
3106 | (not dirs))) |
3107 | ||
3108 | (defun gnus-capitalize-newsgroup (newsgroup) | |
3109 | "Capitalize NEWSGROUP name." | |
3110 | (and (not (zerop (length newsgroup))) | |
3111 | (concat (char-to-string (upcase (aref newsgroup 0))) | |
3112 | (substring newsgroup 1)))) | |
3113 | ||
231f989b | 3114 | ;; Various... things. |
41487370 LMI |
3115 | |
3116 | (defun gnus-simplify-subject (subject &optional re-only) | |
3117 | "Remove `Re:' and words in parentheses. | |
231f989b | 3118 | If RE-ONLY is non-nil, strip leading `Re:'s only." |
41487370 | 3119 | (let ((case-fold-search t)) ;Ignore case. |
231f989b LMI |
3120 | ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. |
3121 | (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) | |
3122 | (setq subject (substring subject (match-end 0)))) | |
3123 | ;; Remove uninteresting prefixes. | |
3124 | (if (and (not re-only) | |
3125 | gnus-simplify-ignored-prefixes | |
3126 | (string-match gnus-simplify-ignored-prefixes subject)) | |
41487370 LMI |
3127 | (setq subject (substring subject (match-end 0)))) |
3128 | ;; Remove words in parentheses from end. | |
231f989b LMI |
3129 | (unless re-only |
3130 | (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) | |
3131 | (setq subject (substring subject 0 (match-beginning 0))))) | |
41487370 LMI |
3132 | ;; Return subject string. |
3133 | subject)) | |
3134 | ||
3135 | ;; Remove any leading "re:"s, any trailing paren phrases, and simplify | |
3136 | ;; all whitespace. | |
231f989b LMI |
3137 | ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>. |
3138 | (defun gnus-simplify-buffer-fuzzy () | |
41487370 | 3139 | (let ((case-fold-search t)) |
231f989b LMI |
3140 | (goto-char (point-min)) |
3141 | (while (search-forward "\t" nil t) | |
3142 | (replace-match " " t t)) | |
3143 | (goto-char (point-min)) | |
3144 | (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t) | |
3145 | (goto-char (match-beginning 0)) | |
3146 | (while (or | |
3147 | (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") | |
3148 | (looking-at "^[[].*: .*[]]$")) | |
3149 | (goto-char (point-min)) | |
3150 | (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" | |
3151 | nil t) | |
3152 | (replace-match "" t t)) | |
3153 | (goto-char (point-min)) | |
3154 | (while (re-search-forward "^[[].*: .*[]]$" nil t) | |
3155 | (goto-char (match-end 0)) | |
3156 | (delete-char -1) | |
3157 | (delete-region | |
3158 | (progn (goto-char (match-beginning 0))) | |
3159 | (re-search-forward ":")))) | |
3160 | (goto-char (point-min)) | |
3161 | (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t) | |
3162 | (replace-match "" t t)) | |
3163 | (goto-char (point-min)) | |
3164 | (while (re-search-forward " +" nil t) | |
3165 | (replace-match " " t t)) | |
3166 | (goto-char (point-min)) | |
3167 | (while (re-search-forward " $" nil t) | |
3168 | (replace-match "" t t)) | |
3169 | (goto-char (point-min)) | |
3170 | (while (re-search-forward "^ +" nil t) | |
3171 | (replace-match "" t t)) | |
3172 | (goto-char (point-min)) | |
3173 | (when gnus-simplify-subject-fuzzy-regexp | |
3174 | (if (listp gnus-simplify-subject-fuzzy-regexp) | |
3175 | (let ((list gnus-simplify-subject-fuzzy-regexp)) | |
3176 | (while list | |
3177 | (goto-char (point-min)) | |
3178 | (while (re-search-forward (car list) nil t) | |
3179 | (replace-match "" t t)) | |
3180 | (setq list (cdr list)))) | |
3181 | (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) | |
3182 | (replace-match "" t t)))))) | |
3183 | ||
3184 | (defun gnus-simplify-subject-fuzzy (subject) | |
3185 | "Siplify a subject string fuzzily." | |
3186 | (save-excursion | |
3187 | (gnus-set-work-buffer) | |
3188 | (let ((case-fold-search t)) | |
41487370 LMI |
3189 | (insert subject) |
3190 | (inline (gnus-simplify-buffer-fuzzy)) | |
3191 | (buffer-string)))) | |
3192 | ||
231f989b | 3193 | ;; Add the current buffer to the list of buffers to be killed on exit. |
41487370 LMI |
3194 | (defun gnus-add-current-to-buffer-list () |
3195 | (or (memq (current-buffer) gnus-buffer-list) | |
3196 | (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))) | |
3197 | ||
3198 | (defun gnus-string> (s1 s2) | |
3199 | (not (or (string< s1 s2) | |
3200 | (string= s1 s2)))) | |
3201 | ||
231f989b LMI |
3202 | (defun gnus-read-active-file-p () |
3203 | "Say whether the active file has been read from `gnus-select-method'." | |
3204 | (memq gnus-select-method gnus-have-read-active-file)) | |
41487370 LMI |
3205 | |
3206 | ;;; General various misc type functions. | |
3207 | ||
3208 | (defun gnus-clear-system () | |
3209 | "Clear all variables and buffers." | |
3210 | ;; Clear Gnus variables. | |
3211 | (let ((variables gnus-variable-list)) | |
3212 | (while variables | |
3213 | (set (car variables) nil) | |
3214 | (setq variables (cdr variables)))) | |
3215 | ;; Clear other internal variables. | |
3216 | (setq gnus-list-of-killed-groups nil | |
3217 | gnus-have-read-active-file nil | |
3218 | gnus-newsrc-alist nil | |
3219 | gnus-newsrc-hashtb nil | |
3220 | gnus-killed-list nil | |
3221 | gnus-zombie-list nil | |
3222 | gnus-killed-hashtb nil | |
3223 | gnus-active-hashtb nil | |
3224 | gnus-moderated-list nil | |
3225 | gnus-description-hashtb nil | |
231f989b LMI |
3226 | gnus-current-headers nil |
3227 | gnus-thread-indent-array nil | |
41487370 | 3228 | gnus-newsgroup-headers nil |
41487370 LMI |
3229 | gnus-newsgroup-name nil |
3230 | gnus-server-alist nil | |
231f989b LMI |
3231 | gnus-group-list-mode nil |
3232 | gnus-opened-servers nil | |
3233 | gnus-group-mark-positions nil | |
3234 | gnus-newsgroup-data nil | |
3235 | gnus-newsgroup-unreads nil | |
564b670b | 3236 | nnoo-state-alist nil |
41487370 | 3237 | gnus-current-select-method nil) |
231f989b | 3238 | (gnus-shutdown 'gnus) |
41487370 LMI |
3239 | ;; Kill the startup file. |
3240 | (and gnus-current-startup-file | |
3241 | (get-file-buffer gnus-current-startup-file) | |
3242 | (kill-buffer (get-file-buffer gnus-current-startup-file))) | |
41487370 LMI |
3243 | ;; Clear the dribble buffer. |
3244 | (gnus-dribble-clear) | |
3245 | ;; Kill global KILL file buffer. | |
231f989b LMI |
3246 | (when (get-file-buffer (gnus-newsgroup-kill-file nil)) |
3247 | (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) | |
41487370 LMI |
3248 | (gnus-kill-buffer nntp-server-buffer) |
3249 | ;; Kill Gnus buffers. | |
3250 | (while gnus-buffer-list | |
231f989b LMI |
3251 | (gnus-kill-buffer (pop gnus-buffer-list))) |
3252 | ;; Remove Gnus frames. | |
3253 | (gnus-kill-gnus-frames)) | |
3254 | ||
3255 | (defun gnus-kill-gnus-frames () | |
3256 | "Kill all frames Gnus has created." | |
3257 | (while gnus-created-frames | |
3258 | (when (frame-live-p (car gnus-created-frames)) | |
3259 | ;; We slap a condition-case around this `delete-frame' to ensure | |
3260 | ;; against errors if we try do delete the single frame that's left. | |
3261 | (condition-case () | |
3262 | (delete-frame (car gnus-created-frames)) | |
3263 | (error nil))) | |
3264 | (pop gnus-created-frames))) | |
41487370 LMI |
3265 | |
3266 | (defun gnus-windows-old-to-new (setting) | |
3267 | ;; First we take care of the really, really old Gnus 3 actions. | |
231f989b LMI |
3268 | (when (symbolp setting) |
3269 | (setq setting | |
3270 | ;; Take care of ooold GNUS 3.x values. | |
3271 | (cond ((eq setting 'SelectArticle) 'article) | |
3272 | ((memq setting '(SelectSubject ExpandSubject)) 'summary) | |
3273 | ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group) | |
3274 | (t setting)))) | |
41487370 LMI |
3275 | (if (or (listp setting) |
3276 | (not (and gnus-window-configuration | |
3277 | (memq setting '(group summary article))))) | |
3278 | setting | |
231f989b | 3279 | (let* ((setting (if (eq setting 'group) |
41487370 LMI |
3280 | (if (assq 'newsgroup gnus-window-configuration) |
3281 | 'newsgroup | |
3282 | 'newsgroups) setting)) | |
231f989b | 3283 | (elem (cadr (assq setting gnus-window-configuration))) |
41487370 LMI |
3284 | (total (apply '+ elem)) |
3285 | (types '(group summary article)) | |
3286 | (pbuf (if (eq setting 'newsgroups) 'group 'summary)) | |
3287 | (i 0) | |
3288 | perc | |
3289 | out) | |
3290 | (while (< i 3) | |
3291 | (or (not (numberp (nth i elem))) | |
3292 | (zerop (nth i elem)) | |
3293 | (progn | |
231f989b LMI |
3294 | (setq perc (if (= i 2) |
3295 | 1.0 | |
3296 | (/ (float (nth 0 elem)) total))) | |
41487370 | 3297 | (setq out (cons (if (eq pbuf (nth i types)) |
231f989b LMI |
3298 | (list (nth i types) perc 'point) |
3299 | (list (nth i types) perc)) | |
41487370 LMI |
3300 | out)))) |
3301 | (setq i (1+ i))) | |
231f989b LMI |
3302 | `(vertical 1.0 ,@(nreverse out))))) |
3303 | ||
3304 | ;;;###autoload | |
41487370 | 3305 | (defun gnus-add-configuration (conf) |
231f989b LMI |
3306 | "Add the window configuration CONF to `gnus-buffer-configuration'." |
3307 | (setq gnus-buffer-configuration | |
41487370 LMI |
3308 | (cons conf (delq (assq (car conf) gnus-buffer-configuration) |
3309 | gnus-buffer-configuration)))) | |
3310 | ||
231f989b LMI |
3311 | (defvar gnus-frame-list nil) |
3312 | ||
3313 | (defun gnus-configure-frame (split &optional window) | |
3314 | "Split WINDOW according to SPLIT." | |
3315 | (unless window | |
3316 | (setq window (get-buffer-window (current-buffer)))) | |
3317 | (select-window window) | |
3318 | ;; This might be an old-stylee buffer config. | |
3319 | (when (vectorp split) | |
3320 | (setq split (append split nil))) | |
3321 | (when (or (consp (car split)) | |
3322 | (vectorp (car split))) | |
3323 | (push 1.0 split) | |
3324 | (push 'vertical split)) | |
3325 | ;; The SPLIT might be something that is to be evaled to | |
3326 | ;; return a new SPLIT. | |
3327 | (while (and (not (assq (car split) gnus-window-to-buffer)) | |
3328 | (gnus-functionp (car split))) | |
3329 | (setq split (eval split))) | |
3330 | (let* ((type (car split)) | |
3331 | (subs (cddr split)) | |
3332 | (len (if (eq type 'horizontal) (window-width) (window-height))) | |
3333 | (total 0) | |
3334 | (window-min-width (or gnus-window-min-width window-min-width)) | |
3335 | (window-min-height (or gnus-window-min-height window-min-height)) | |
3336 | s result new-win rest comp-subs size sub) | |
3337 | (cond | |
3338 | ;; Nothing to do here. | |
3339 | ((null split)) | |
3340 | ;; Don't switch buffers. | |
3341 | ((null type) | |
3342 | (and (memq 'point split) window)) | |
3343 | ;; This is a buffer to be selected. | |
3344 | ((not (memq type '(frame horizontal vertical))) | |
3345 | (let ((buffer (cond ((stringp type) type) | |
3346 | (t (cdr (assq type gnus-window-to-buffer))))) | |
3347 | buf) | |
3348 | (unless buffer | |
3349 | (error "Illegal buffer type: %s" type)) | |
3350 | (unless (setq buf (get-buffer (if (symbolp buffer) | |
3351 | (symbol-value buffer) buffer))) | |
3352 | (setq buf (get-buffer-create (if (symbolp buffer) | |
3353 | (symbol-value buffer) buffer)))) | |
3354 | (switch-to-buffer buf) | |
3355 | ;; We return the window if it has the `point' spec. | |
3356 | (and (memq 'point split) window))) | |
3357 | ;; This is a frame split. | |
3358 | ((eq type 'frame) | |
3359 | (unless gnus-frame-list | |
3360 | (setq gnus-frame-list (list (window-frame | |
3361 | (get-buffer-window (current-buffer)))))) | |
3362 | (let ((i 0) | |
3363 | params frame fresult) | |
3364 | (while (< i (length subs)) | |
3365 | ;; Frame parameter is gotten from the sub-split. | |
3366 | (setq params (cadr (elt subs i))) | |
3367 | ;; It should be a list. | |
3368 | (unless (listp params) | |
3369 | (setq params nil)) | |
3370 | ;; Create a new frame? | |
3371 | (unless (setq frame (elt gnus-frame-list i)) | |
3372 | (nconc gnus-frame-list (list (setq frame (make-frame params)))) | |
3373 | (push frame gnus-created-frames)) | |
3374 | ;; Is the old frame still alive? | |
3375 | (unless (frame-live-p frame) | |
3376 | (setcar (nthcdr i gnus-frame-list) | |
3377 | (setq frame (make-frame params)))) | |
3378 | ;; Select the frame in question and do more splits there. | |
3379 | (select-frame frame) | |
3380 | (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) | |
3381 | (incf i)) | |
3382 | ;; Select the frame that has the selected buffer. | |
3383 | (when fresult | |
3384 | (select-frame (window-frame fresult))))) | |
3385 | ;; This is a normal split. | |
3386 | (t | |
3387 | (when (> (length subs) 0) | |
3388 | ;; First we have to compute the sizes of all new windows. | |
3389 | (while subs | |
3390 | (setq sub (append (pop subs) nil)) | |
3391 | (while (and (not (assq (car sub) gnus-window-to-buffer)) | |
3392 | (gnus-functionp (car sub))) | |
3393 | (setq sub (eval sub))) | |
3394 | (when sub | |
3395 | (push sub comp-subs) | |
3396 | (setq size (cadar comp-subs)) | |
3397 | (cond ((equal size 1.0) | |
3398 | (setq rest (car comp-subs)) | |
3399 | (setq s 0)) | |
3400 | ((floatp size) | |
3401 | (setq s (floor (* size len)))) | |
3402 | ((integerp size) | |
3403 | (setq s size)) | |
3404 | (t | |
3405 | (error "Illegal size: %s" size))) | |
3406 | ;; Try to make sure that we are inside the safe limits. | |
3407 | (cond ((zerop s)) | |
3408 | ((eq type 'horizontal) | |
3409 | (setq s (max s window-min-width))) | |
3410 | ((eq type 'vertical) | |
3411 | (setq s (max s window-min-height)))) | |
3412 | (setcar (cdar comp-subs) s) | |
3413 | (incf total s))) | |
3414 | ;; Take care of the "1.0" spec. | |
3415 | (if rest | |
3416 | (setcar (cdr rest) (- len total)) | |
3417 | (error "No 1.0 specs in %s" split)) | |
3418 | ;; The we do the actual splitting in a nice recursive | |
3419 | ;; fashion. | |
3420 | (setq comp-subs (nreverse comp-subs)) | |
3421 | (while comp-subs | |
3422 | (if (null (cdr comp-subs)) | |
3423 | (setq new-win window) | |
3424 | (setq new-win | |
3425 | (split-window window (cadar comp-subs) | |
3426 | (eq type 'horizontal)))) | |
3427 | (setq result (or (gnus-configure-frame | |
3428 | (car comp-subs) window) result)) | |
3429 | (select-window new-win) | |
3430 | (setq window new-win) | |
3431 | (setq comp-subs (cdr comp-subs)))) | |
3432 | ;; Return the proper window, if any. | |
3433 | (when result | |
3434 | (select-window result)))))) | |
3435 | ||
3436 | (defvar gnus-frame-split-p nil) | |
3437 | ||
41487370 LMI |
3438 | (defun gnus-configure-windows (setting &optional force) |
3439 | (setq setting (gnus-windows-old-to-new setting)) | |
231f989b LMI |
3440 | (let ((split (if (symbolp setting) |
3441 | (cadr (assq setting gnus-buffer-configuration)) | |
3442 | setting)) | |
3443 | all-visible) | |
3444 | ||
3445 | (setq gnus-frame-split-p nil) | |
3446 | ||
3447 | (unless split | |
3448 | (error "No such setting: %s" setting)) | |
3449 | ||
3450 | (if (and (setq all-visible (gnus-all-windows-visible-p split)) | |
3451 | (not force)) | |
41487370 LMI |
3452 | ;; All the windows mentioned are already visible, so we just |
3453 | ;; put point in the assigned buffer, and do not touch the | |
231f989b LMI |
3454 | ;; winconf. |
3455 | (select-window all-visible) | |
41487370 LMI |
3456 | |
3457 | ;; Either remove all windows or just remove all Gnus windows. | |
231f989b LMI |
3458 | (let ((frame (selected-frame))) |
3459 | (unwind-protect | |
3460 | (if gnus-use-full-window | |
3461 | ;; We want to remove all other windows. | |
3462 | (if (not gnus-frame-split-p) | |
3463 | ;; This is not a `frame' split, so we ignore the | |
3464 | ;; other frames. | |
3465 | (delete-other-windows) | |
3466 | ;; This is a `frame' split, so we delete all windows | |
3467 | ;; on all frames. | |
3468 | (mapcar | |
3469 | (lambda (frame) | |
3470 | (unless (eq (cdr (assq 'minibuffer | |
3471 | (frame-parameters frame))) | |
3472 | 'only) | |
3473 | (select-frame frame) | |
3474 | (delete-other-windows))) | |
3475 | (frame-list))) | |
3476 | ;; Just remove some windows. | |
3477 | (gnus-remove-some-windows) | |
3478 | (switch-to-buffer nntp-server-buffer)) | |
3479 | (select-frame frame))) | |
3480 | ||
3481 | (switch-to-buffer nntp-server-buffer) | |
3482 | (gnus-configure-frame split (get-buffer-window (current-buffer)))))) | |
3483 | ||
3484 | (defun gnus-all-windows-visible-p (split) | |
3485 | "Say whether all buffers in SPLIT are currently visible. | |
3486 | In particular, the value returned will be the window that | |
3487 | should have point." | |
3488 | (let ((stack (list split)) | |
3489 | (all-visible t) | |
3490 | type buffer win buf) | |
3491 | (while (and (setq split (pop stack)) | |
3492 | all-visible) | |
3493 | ;; Be backwards compatible. | |
3494 | (when (vectorp split) | |
3495 | (setq split (append split nil))) | |
3496 | (when (or (consp (car split)) | |
3497 | (vectorp (car split))) | |
3498 | (push 1.0 split) | |
3499 | (push 'vertical split)) | |
3500 | ;; The SPLIT might be something that is to be evaled to | |
3501 | ;; return a new SPLIT. | |
3502 | (while (and (not (assq (car split) gnus-window-to-buffer)) | |
3503 | (gnus-functionp (car split))) | |
3504 | (setq split (eval split))) | |
3505 | ||
3506 | (setq type (elt split 0)) | |
3507 | (cond | |
3508 | ;; Nothing here. | |
3509 | ((null split) t) | |
3510 | ;; A buffer. | |
3511 | ((not (memq type '(horizontal vertical frame))) | |
3512 | (setq buffer (cond ((stringp type) type) | |
3513 | (t (cdr (assq type gnus-window-to-buffer))))) | |
3514 | (unless buffer | |
3515 | (error "Illegal buffer type: %s" type)) | |
3516 | (when (setq buf (get-buffer (if (symbolp buffer) | |
3517 | (symbol-value buffer) | |
3518 | buffer))) | |
3519 | (setq win (get-buffer-window buf t))) | |
3520 | (if win | |
3521 | (when (memq 'point split) | |
3522 | (setq all-visible win)) | |
3523 | (setq all-visible nil))) | |
3524 | (t | |
3525 | (when (eq type 'frame) | |
3526 | (setq gnus-frame-split-p t)) | |
3527 | (setq stack (append (cddr split) stack))))) | |
3528 | (unless (eq all-visible t) | |
3529 | all-visible))) | |
41487370 LMI |
3530 | |
3531 | (defun gnus-window-top-edge (&optional window) | |
3532 | (nth 1 (window-edges window))) | |
3533 | ||
3534 | (defun gnus-remove-some-windows () | |
3535 | (let ((buffers gnus-window-to-buffer) | |
3536 | buf bufs lowest-buf lowest) | |
3537 | (save-excursion | |
3538 | ;; Remove windows on all known Gnus buffers. | |
3539 | (while buffers | |
231f989b | 3540 | (setq buf (cdar buffers)) |
41487370 LMI |
3541 | (if (symbolp buf) |
3542 | (setq buf (and (boundp buf) (symbol-value buf)))) | |
231f989b | 3543 | (and buf |
41487370 LMI |
3544 | (get-buffer-window buf) |
3545 | (progn | |
3546 | (setq bufs (cons buf bufs)) | |
3547 | (pop-to-buffer buf) | |
3548 | (if (or (not lowest) | |
3549 | (< (gnus-window-top-edge) lowest)) | |
3550 | (progn | |
3551 | (setq lowest (gnus-window-top-edge)) | |
3552 | (setq lowest-buf buf))))) | |
3553 | (setq buffers (cdr buffers))) | |
3554 | ;; Remove windows on *all* summary buffers. | |
231f989b LMI |
3555 | (walk-windows |
3556 | (lambda (win) | |
3557 | (let ((buf (window-buffer win))) | |
3558 | (if (string-match "^\\*Summary" (buffer-name buf)) | |
3559 | (progn | |
3560 | (setq bufs (cons buf bufs)) | |
3561 | (pop-to-buffer buf) | |
3562 | (if (or (not lowest) | |
3563 | (< (gnus-window-top-edge) lowest)) | |
3564 | (progn | |
3565 | (setq lowest-buf buf) | |
3566 | (setq lowest (gnus-window-top-edge))))))))) | |
3567 | (and lowest-buf | |
41487370 LMI |
3568 | (progn |
3569 | (pop-to-buffer lowest-buf) | |
3570 | (switch-to-buffer nntp-server-buffer))) | |
3571 | (while bufs | |
3572 | (and (not (eq (car bufs) lowest-buf)) | |
3573 | (delete-windows-on (car bufs))) | |
3574 | (setq bufs (cdr bufs)))))) | |
231f989b LMI |
3575 | |
3576 | (defun gnus-version (&optional arg) | |
3577 | "Version number of this version of Gnus. | |
3578 | If ARG, insert string at point." | |
3579 | (interactive "P") | |
41487370 LMI |
3580 | (let ((methods gnus-valid-select-methods) |
3581 | (mess gnus-version) | |
3582 | meth) | |
3583 | ;; Go through all the legal select methods and add their version | |
231f989b | 3584 | ;; numbers to the total version string. Only the backends that are |
41487370 | 3585 | ;; currently in use will have their message numbers taken into |
231f989b | 3586 | ;; consideration. |
41487370 | 3587 | (while methods |
231f989b | 3588 | (setq meth (intern (concat (caar methods) "-version"))) |
41487370 LMI |
3589 | (and (boundp meth) |
3590 | (stringp (symbol-value meth)) | |
3591 | (setq mess (concat mess "; " (symbol-value meth)))) | |
3592 | (setq methods (cdr methods))) | |
231f989b LMI |
3593 | (if arg |
3594 | (insert (message mess)) | |
3595 | (message mess)))) | |
41487370 LMI |
3596 | |
3597 | (defun gnus-info-find-node () | |
3598 | "Find Info documentation of Gnus." | |
3599 | (interactive) | |
3600 | ;; Enlarge info window if needed. | |
231f989b LMI |
3601 | (let ((mode major-mode) |
3602 | gnus-info-buffer) | |
3603 | (Info-goto-node (cadr (assq mode gnus-info-nodes))) | |
3604 | (setq gnus-info-buffer (current-buffer)) | |
3605 | (gnus-configure-windows 'info))) | |
41487370 LMI |
3606 | |
3607 | (defun gnus-days-between (date1 date2) | |
3608 | ;; Return the number of days between date1 and date2. | |
3609 | (- (gnus-day-number date1) (gnus-day-number date2))) | |
3610 | ||
3611 | (defun gnus-day-number (date) | |
3612 | (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) | |
3613 | (timezone-parse-date date)))) | |
231f989b | 3614 | (timezone-absolute-from-gregorian |
41487370 LMI |
3615 | (nth 1 dat) (nth 2 dat) (car dat)))) |
3616 | ||
231f989b LMI |
3617 | (defun gnus-encode-date (date) |
3618 | "Convert DATE to internal time." | |
3619 | (let* ((parse (timezone-parse-date date)) | |
3620 | (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) | |
3621 | (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) | |
3622 | (encode-time (caddr time) (cadr time) (car time) | |
3623 | (caddr date) (cadr date) (car date) (nth 4 date)))) | |
3624 | ||
3625 | (defun gnus-time-minus (t1 t2) | |
3626 | "Subtract two internal times." | |
3627 | (let ((borrow (< (cadr t1) (cadr t2)))) | |
3628 | (list (- (car t1) (car t2) (if borrow 1 0)) | |
3629 | (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) | |
41487370 LMI |
3630 | |
3631 | (defun gnus-file-newer-than (file date) | |
3632 | (let ((fdate (nth 5 (file-attributes file)))) | |
3633 | (or (> (car fdate) (car date)) | |
3634 | (and (= (car fdate) (car date)) | |
3635 | (> (nth 1 fdate) (nth 1 date)))))) | |
3636 | ||
231f989b LMI |
3637 | (defmacro gnus-local-set-keys (&rest plist) |
3638 | "Set the keys in PLIST in the current keymap." | |
3639 | `(gnus-define-keys-1 (current-local-map) ',plist)) | |
3640 | ||
3641 | (defmacro gnus-define-keys (keymap &rest plist) | |
3642 | "Define all keys in PLIST in KEYMAP." | |
3643 | `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) | |
3644 | ||
3645 | (put 'gnus-define-keys 'lisp-indent-function 1) | |
3646 | (put 'gnus-define-keys 'lisp-indent-hook 1) | |
3647 | (put 'gnus-define-keymap 'lisp-indent-function 1) | |
3648 | (put 'gnus-define-keymap 'lisp-indent-hook 1) | |
3649 | ||
3650 | (defmacro gnus-define-keymap (keymap &rest plist) | |
3651 | "Define all keys in PLIST in KEYMAP." | |
3652 | `(gnus-define-keys-1 ,keymap (quote ,plist))) | |
3653 | ||
3654 | (defun gnus-define-keys-1 (keymap plist) | |
3655 | (when (null keymap) | |
3656 | (error "Can't set keys in a null keymap")) | |
3657 | (cond ((symbolp keymap) | |
3658 | (setq keymap (symbol-value keymap))) | |
3659 | ((keymapp keymap)) | |
3660 | ((listp keymap) | |
3661 | (set (car keymap) nil) | |
3662 | (define-prefix-command (car keymap)) | |
3663 | (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) | |
3664 | (setq keymap (symbol-value (car keymap))))) | |
3665 | (let (key) | |
3666 | (while plist | |
3667 | (when (symbolp (setq key (pop plist))) | |
3668 | (setq key (symbol-value key))) | |
3669 | (define-key keymap key (pop plist))))) | |
3670 | ||
41487370 LMI |
3671 | (defun gnus-group-read-only-p (&optional group) |
3672 | "Check whether GROUP supports editing or not. | |
231f989b | 3673 | If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note |
41487370 LMI |
3674 | that that variable is buffer-local to the summary buffers." |
3675 | (let ((group (or group gnus-newsgroup-name))) | |
3676 | (not (gnus-check-backend-function 'request-replace-article group)))) | |
3677 | ||
231f989b LMI |
3678 | (defun gnus-group-total-expirable-p (group) |
3679 | "Check whether GROUP is total-expirable or not." | |
3680 | (let ((params (gnus-info-params (gnus-get-info group)))) | |
3681 | (or (memq 'total-expire params) | |
3682 | (cdr (assq 'total-expire params)) ; (total-expire . t) | |
3683 | (and gnus-total-expirable-newsgroups ; Check var. | |
3684 | (string-match gnus-total-expirable-newsgroups group))))) | |
3685 | ||
3686 | (defun gnus-group-auto-expirable-p (group) | |
3687 | "Check whether GROUP is total-expirable or not." | |
3688 | (let ((params (gnus-info-params (gnus-get-info group)))) | |
3689 | (or (memq 'auto-expire params) | |
3690 | (cdr (assq 'auto-expire params)) ; (auto-expire . t) | |
3691 | (and gnus-auto-expirable-newsgroups ; Check var. | |
3692 | (string-match gnus-auto-expirable-newsgroups group))))) | |
3693 | ||
3694 | (defun gnus-virtual-group-p (group) | |
3695 | "Say whether GROUP is virtual or not." | |
3696 | (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) | |
3697 | gnus-valid-select-methods))) | |
3698 | ||
3699 | (defun gnus-news-group-p (group &optional article) | |
3700 | "Return non-nil if GROUP (and ARTICLE) come from a news server." | |
3701 | (or (gnus-member-of-valid 'post group) ; Ordinary news group. | |
3702 | (and (gnus-member-of-valid 'post-mail group) ; Combined group. | |
3703 | (eq (gnus-request-type group article) 'news)))) | |
3704 | ||
3705 | (defsubst gnus-simplify-subject-fully (subject) | |
3706 | "Simplify a subject string according to the user's wishes." | |
3707 | (cond | |
3708 | ((null gnus-summary-gather-subject-limit) | |
3709 | (gnus-simplify-subject-re subject)) | |
3710 | ((eq gnus-summary-gather-subject-limit 'fuzzy) | |
3711 | (gnus-simplify-subject-fuzzy subject)) | |
3712 | ((numberp gnus-summary-gather-subject-limit) | |
3713 | (gnus-limit-string (gnus-simplify-subject-re subject) | |
3714 | gnus-summary-gather-subject-limit)) | |
3715 | (t | |
3716 | subject))) | |
3717 | ||
3718 | (defsubst gnus-subject-equal (s1 s2 &optional simple-first) | |
3719 | "Check whether two subjects are equal. If optional argument | |
3720 | simple-first is t, first argument is already simplified." | |
3721 | (cond | |
3722 | ((null simple-first) | |
3723 | (equal (gnus-simplify-subject-fully s1) | |
3724 | (gnus-simplify-subject-fully s2))) | |
3725 | (t | |
3726 | (equal s1 | |
3727 | (gnus-simplify-subject-fully s2))))) | |
3728 | ||
3729 | ;; Returns a list of writable groups. | |
3730 | (defun gnus-writable-groups () | |
3731 | (let ((alist gnus-newsrc-alist) | |
3732 | groups group) | |
3733 | (while (setq group (car (pop alist))) | |
3734 | (unless (gnus-group-read-only-p group) | |
3735 | (push group groups))) | |
3736 | (nreverse groups))) | |
3737 | ||
3738 | (defun gnus-completing-read (default prompt &rest args) | |
3739 | ;; Like `completing-read', except that DEFAULT is the default argument. | |
3740 | (let* ((prompt (if default | |
3741 | (concat prompt " (default " default ") ") | |
3742 | (concat prompt " "))) | |
3743 | (answer (apply 'completing-read prompt args))) | |
3744 | (if (or (null answer) (zerop (length answer))) | |
3745 | default | |
3746 | answer))) | |
3747 | ||
41487370 LMI |
3748 | ;; Two silly functions to ensure that all `y-or-n-p' questions clear |
3749 | ;; the echo area. | |
3750 | (defun gnus-y-or-n-p (prompt) | |
3751 | (prog1 | |
3752 | (y-or-n-p prompt) | |
3753 | (message ""))) | |
3754 | ||
3755 | (defun gnus-yes-or-no-p (prompt) | |
3756 | (prog1 | |
3757 | (yes-or-no-p prompt) | |
3758 | (message ""))) | |
3759 | ||
3760 | ;; Check whether to use long file names. | |
3761 | (defun gnus-use-long-file-name (symbol) | |
3762 | ;; The variable has to be set... | |
3763 | (and gnus-use-long-file-name | |
3764 | ;; If it isn't a list, then we return t. | |
3765 | (or (not (listp gnus-use-long-file-name)) | |
3766 | ;; If it is a list, and the list contains `symbol', we | |
231f989b | 3767 | ;; return nil. |
41487370 LMI |
3768 | (not (memq symbol gnus-use-long-file-name))))) |
3769 | ||
3770 | ;; I suspect there's a better way, but I haven't taken the time to do | |
3771 | ;; it yet. -erik selberg@cs.washington.edu | |
3772 | (defun gnus-dd-mmm (messy-date) | |
3773 | "Return a string like DD-MMM from a big messy string" | |
231f989b LMI |
3774 | (let ((datevec (condition-case () (timezone-parse-date messy-date) |
3775 | (error nil)))) | |
3776 | (if (not datevec) | |
3777 | "??-???" | |
3778 | (format "%2s-%s" | |
3779 | (condition-case () | |
3780 | ;; Make sure leading zeroes are stripped. | |
3781 | (number-to-string (string-to-number (aref datevec 2))) | |
3782 | (error "??")) | |
3783 | (capitalize | |
3784 | (or (car | |
3785 | (nth (1- (string-to-number (aref datevec 1))) | |
3786 | timezone-months-assoc)) | |
3787 | "???")))))) | |
3788 | ||
3789 | (defun gnus-mode-string-quote (string) | |
3790 | "Quote all \"%\" in STRING." | |
3791 | (save-excursion | |
3792 | (gnus-set-work-buffer) | |
3793 | (insert string) | |
3794 | (goto-char (point-min)) | |
3795 | (while (search-forward "%" nil t) | |
3796 | (insert "%")) | |
3797 | (buffer-string))) | |
41487370 LMI |
3798 | |
3799 | ;; Make a hash table (default and minimum size is 255). | |
3800 | ;; Optional argument HASHSIZE specifies the table size. | |
3801 | (defun gnus-make-hashtable (&optional hashsize) | |
3802 | (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0)) | |
3803 | ||
3804 | ;; Make a number that is suitable for hashing; bigger than MIN and one | |
3805 | ;; less than 2^x. | |
3806 | (defun gnus-create-hash-size (min) | |
3807 | (let ((i 1)) | |
3808 | (while (< i min) | |
3809 | (setq i (* 2 i))) | |
3810 | (1- i))) | |
3811 | ||
231f989b LMI |
3812 | ;; Show message if message has a lower level than `gnus-verbose'. |
3813 | ;; Guideline for numbers: | |
41487370 LMI |
3814 | ;; 1 - error messages, 3 - non-serious error messages, 5 - messages |
3815 | ;; for things that take a long time, 7 - not very important messages | |
3816 | ;; on stuff, 9 - messages inside loops. | |
3817 | (defun gnus-message (level &rest args) | |
3818 | (if (<= level gnus-verbose) | |
3819 | (apply 'message args) | |
b94ae5f7 | 3820 | ;; We have to do this format thingy here even if the result isn't |
41487370 LMI |
3821 | ;; shown - the return value has to be the same as the return value |
3822 | ;; from `message'. | |
3823 | (apply 'format args))) | |
3824 | ||
231f989b | 3825 | (defun gnus-error (level &rest args) |
564b670b | 3826 | "Beep an error if LEVEL is equal to or less than `gnus-verbose'." |
231f989b LMI |
3827 | (when (<= (floor level) gnus-verbose) |
3828 | (apply 'message args) | |
3829 | (ding) | |
3830 | (let (duration) | |
3831 | (when (and (floatp level) | |
3832 | (not (zerop (setq duration (* 10 (- level (floor level))))))) | |
3833 | (sit-for duration)))) | |
3834 | nil) | |
3835 | ||
41487370 LMI |
3836 | ;; Generate a unique new group name. |
3837 | (defun gnus-generate-new-group-name (leaf) | |
3838 | (let ((name leaf) | |
3839 | (num 0)) | |
3840 | (while (gnus-gethash name gnus-newsrc-hashtb) | |
3841 | (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) | |
3842 | name)) | |
3843 | ||
231f989b LMI |
3844 | (defsubst gnus-hide-text (b e props) |
3845 | "Set text PROPS on the B to E region, extending `intangible' 1 past B." | |
3846 | (gnus-add-text-properties b e props) | |
3847 | (when (memq 'intangible props) | |
3848 | (gnus-put-text-property (max (1- b) (point-min)) | |
3849 | b 'intangible (cddr (memq 'intangible props))))) | |
3850 | ||
3851 | (defsubst gnus-unhide-text (b e) | |
3852 | "Remove hidden text properties from region between B and E." | |
3853 | (remove-text-properties b e gnus-hidden-properties) | |
3854 | (when (memq 'intangible gnus-hidden-properties) | |
3855 | (gnus-put-text-property (max (1- b) (point-min)) | |
3856 | b 'intangible nil))) | |
3857 | ||
3858 | (defun gnus-hide-text-type (b e type) | |
3859 | "Hide text of TYPE between B and E." | |
3860 | (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties)))) | |
3861 | ||
3862 | (defun gnus-parent-headers (headers &optional generation) | |
3863 | "Return the headers of the GENERATIONeth parent of HEADERS." | |
3864 | (unless generation | |
3865 | (setq generation 1)) | |
3866 | (let (references parent) | |
3867 | (while (and headers (not (zerop generation))) | |
3868 | (setq references (mail-header-references headers)) | |
3869 | (when (and references | |
3870 | (setq parent (gnus-parent-id references)) | |
3871 | (setq headers (car (gnus-id-to-thread parent)))) | |
3872 | (decf generation))) | |
3873 | headers)) | |
3874 | ||
3875 | (defun gnus-parent-id (references) | |
3876 | "Return the last Message-ID in REFERENCES." | |
3877 | (when (and references | |
3878 | (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references)) | |
3879 | (substring references (match-beginning 1) (match-end 1)))) | |
3880 | ||
3881 | (defun gnus-split-references (references) | |
3882 | "Return a list of Message-IDs in REFERENCES." | |
3883 | (let ((beg 0) | |
3884 | ids) | |
3885 | (while (string-match "<[^>]+>" references beg) | |
3886 | (push (substring references (match-beginning 0) (setq beg (match-end 0))) | |
3887 | ids)) | |
3888 | (nreverse ids))) | |
3889 | ||
3890 | (defun gnus-buffer-live-p (buffer) | |
3891 | "Say whether BUFFER is alive or not." | |
3892 | (and buffer | |
3893 | (get-buffer buffer) | |
3894 | (buffer-name (get-buffer buffer)))) | |
3895 | ||
41487370 LMI |
3896 | (defun gnus-ephemeral-group-p (group) |
3897 | "Say whether GROUP is ephemeral or not." | |
231f989b | 3898 | (gnus-group-get-parameter group 'quit-config)) |
41487370 LMI |
3899 | |
3900 | (defun gnus-group-quit-config (group) | |
3901 | "Return the quit-config of GROUP." | |
231f989b | 3902 | (gnus-group-get-parameter group 'quit-config)) |
41487370 | 3903 | |
a828a776 LMI |
3904 | (defun gnus-simplify-mode-line () |
3905 | "Make mode lines a bit simpler." | |
3906 | (setq mode-line-modified "-- ") | |
231f989b LMI |
3907 | (when (listp mode-line-format) |
3908 | (make-local-variable 'mode-line-format) | |
3909 | (setq mode-line-format (copy-sequence mode-line-format)) | |
3910 | (when (equal (nth 3 mode-line-format) " ") | |
3911 | (setcar (nthcdr 3 mode-line-format) " ")))) | |
a828a776 | 3912 | |
41487370 LMI |
3913 | ;;; List and range functions |
3914 | ||
3915 | (defun gnus-last-element (list) | |
3916 | "Return last element of LIST." | |
3917 | (while (cdr list) | |
3918 | (setq list (cdr list))) | |
3919 | (car list)) | |
3920 | ||
3921 | (defun gnus-copy-sequence (list) | |
3922 | "Do a complete, total copy of a list." | |
3923 | (if (and (consp list) (not (consp (cdr list)))) | |
3924 | (cons (car list) (cdr list)) | |
231f989b | 3925 | (mapcar (lambda (elem) (if (consp elem) |
41487370 LMI |
3926 | (if (consp (cdr elem)) |
3927 | (gnus-copy-sequence elem) | |
3928 | (cons (car elem) (cdr elem))) | |
3929 | elem)) | |
3930 | list))) | |
3931 | ||
3932 | (defun gnus-set-difference (list1 list2) | |
3933 | "Return a list of elements of LIST1 that do not appear in LIST2." | |
3934 | (let ((list1 (copy-sequence list1))) | |
3935 | (while list2 | |
3936 | (setq list1 (delq (car list2) list1)) | |
3937 | (setq list2 (cdr list2))) | |
3938 | list1)) | |
3939 | ||
3940 | (defun gnus-sorted-complement (list1 list2) | |
3941 | "Return a list of elements of LIST1 that do not appear in LIST2. | |
3942 | Both lists have to be sorted over <." | |
3943 | (let (out) | |
3944 | (if (or (null list1) (null list2)) | |
3945 | (or list1 list2) | |
3946 | (while (and list1 list2) | |
3947 | (cond ((= (car list1) (car list2)) | |
3948 | (setq list1 (cdr list1) | |
3949 | list2 (cdr list2))) | |
3950 | ((< (car list1) (car list2)) | |
3951 | (setq out (cons (car list1) out)) | |
3952 | (setq list1 (cdr list1))) | |
3953 | (t | |
3954 | (setq out (cons (car list2) out)) | |
3955 | (setq list2 (cdr list2))))) | |
3956 | (nconc (nreverse out) (or list1 list2))))) | |
3957 | ||
231f989b | 3958 | (defun gnus-intersection (list1 list2) |
41487370 LMI |
3959 | (let ((result nil)) |
3960 | (while list2 | |
3961 | (if (memq (car list2) list1) | |
3962 | (setq result (cons (car list2) result))) | |
3963 | (setq list2 (cdr list2))) | |
3964 | result)) | |
3965 | ||
3966 | (defun gnus-sorted-intersection (list1 list2) | |
3967 | ;; LIST1 and LIST2 have to be sorted over <. | |
3968 | (let (out) | |
3969 | (while (and list1 list2) | |
3970 | (cond ((= (car list1) (car list2)) | |
3971 | (setq out (cons (car list1) out) | |
3972 | list1 (cdr list1) | |
3973 | list2 (cdr list2))) | |
3974 | ((< (car list1) (car list2)) | |
3975 | (setq list1 (cdr list1))) | |
3976 | (t | |
3977 | (setq list2 (cdr list2))))) | |
3978 | (nreverse out))) | |
3979 | ||
3980 | (defun gnus-set-sorted-intersection (list1 list2) | |
3981 | ;; LIST1 and LIST2 have to be sorted over <. | |
3982 | ;; This function modifies LIST1. | |
3983 | (let* ((top (cons nil list1)) | |
3984 | (prev top)) | |
3985 | (while (and list1 list2) | |
3986 | (cond ((= (car list1) (car list2)) | |
3987 | (setq prev list1 | |
3988 | list1 (cdr list1) | |
3989 | list2 (cdr list2))) | |
3990 | ((< (car list1) (car list2)) | |
3991 | (setcdr prev (cdr list1)) | |
3992 | (setq list1 (cdr list1))) | |
3993 | (t | |
3994 | (setq list2 (cdr list2))))) | |
3995 | (setcdr prev nil) | |
3996 | (cdr top))) | |
3997 | ||
3998 | (defun gnus-compress-sequence (numbers &optional always-list) | |
3999 | "Convert list of numbers to a list of ranges or a single range. | |
4000 | If ALWAYS-LIST is non-nil, this function will always release a list of | |
4001 | ranges." | |
4002 | (let* ((first (car numbers)) | |
4003 | (last (car numbers)) | |
4004 | result) | |
4005 | (if (null numbers) | |
4006 | nil | |
4007 | (if (not (listp (cdr numbers))) | |
4008 | numbers | |
4009 | (while numbers | |
4010 | (cond ((= last (car numbers)) nil) ;Omit duplicated number | |
4011 | ((= (1+ last) (car numbers)) ;Still in sequence | |
4012 | (setq last (car numbers))) | |
4013 | (t ;End of one sequence | |
231f989b | 4014 | (setq result |
41487370 LMI |
4015 | (cons (if (= first last) first |
4016 | (cons first last)) result)) | |
4017 | (setq first (car numbers)) | |
4018 | (setq last (car numbers)))) | |
4019 | (setq numbers (cdr numbers))) | |
4020 | (if (and (not always-list) (null result)) | |
4021 | (if (= first last) (list first) (cons first last)) | |
4022 | (nreverse (cons (if (= first last) first (cons first last)) | |
4023 | result))))))) | |
4024 | ||
4025 | (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) | |
4026 | (defun gnus-uncompress-range (ranges) | |
4027 | "Expand a list of ranges into a list of numbers. | |
4028 | RANGES is either a single range on the form `(num . num)' or a list of | |
4029 | these ranges." | |
4030 | (let (first last result) | |
231f989b | 4031 | (cond |
41487370 LMI |
4032 | ((null ranges) |
4033 | nil) | |
4034 | ((not (listp (cdr ranges))) | |
4035 | (setq first (car ranges)) | |
4036 | (setq last (cdr ranges)) | |
4037 | (while (<= first last) | |
4038 | (setq result (cons first result)) | |
4039 | (setq first (1+ first))) | |
4040 | (nreverse result)) | |
4041 | (t | |
4042 | (while ranges | |
4043 | (if (atom (car ranges)) | |
4044 | (if (numberp (car ranges)) | |
4045 | (setq result (cons (car ranges) result))) | |
231f989b LMI |
4046 | (setq first (caar ranges)) |
4047 | (setq last (cdar ranges)) | |
41487370 LMI |
4048 | (while (<= first last) |
4049 | (setq result (cons first result)) | |
4050 | (setq first (1+ first)))) | |
4051 | (setq ranges (cdr ranges))) | |
4052 | (nreverse result))))) | |
4053 | ||
4054 | (defun gnus-add-to-range (ranges list) | |
4055 | "Return a list of ranges that has all articles from both RANGES and LIST. | |
4056 | Note: LIST has to be sorted over `<'." | |
4057 | (if (not ranges) | |
4058 | (gnus-compress-sequence list t) | |
4059 | (setq list (copy-sequence list)) | |
4060 | (or (listp (cdr ranges)) | |
4061 | (setq ranges (list ranges))) | |
4062 | (let ((out ranges) | |
4063 | ilist lowest highest temp) | |
4064 | (while (and ranges list) | |
4065 | (setq ilist list) | |
4066 | (setq lowest (or (and (atom (car ranges)) (car ranges)) | |
231f989b LMI |
4067 | (caar ranges))) |
4068 | (while (and list (cdr list) (< (cadr list) lowest)) | |
41487370 LMI |
4069 | (setq list (cdr list))) |
4070 | (if (< (car ilist) lowest) | |
4071 | (progn | |
4072 | (setq temp list) | |
4073 | (setq list (cdr list)) | |
4074 | (setcdr temp nil) | |
4075 | (setq out (nconc (gnus-compress-sequence ilist t) out)))) | |
4076 | (setq highest (or (and (atom (car ranges)) (car ranges)) | |
231f989b | 4077 | (cdar ranges))) |
41487370 LMI |
4078 | (while (and list (<= (car list) highest)) |
4079 | (setq list (cdr list))) | |
4080 | (setq ranges (cdr ranges))) | |
4081 | (if list | |
4082 | (setq out (nconc (gnus-compress-sequence list t) out))) | |
231f989b | 4083 | (setq out (sort out (lambda (r1 r2) |
41487370 LMI |
4084 | (< (or (and (atom r1) r1) (car r1)) |
4085 | (or (and (atom r2) r2) (car r2)))))) | |
4086 | (setq ranges out) | |
4087 | (while ranges | |
4088 | (if (atom (car ranges)) | |
4089 | (if (cdr ranges) | |
231f989b LMI |
4090 | (if (atom (cadr ranges)) |
4091 | (if (= (1+ (car ranges)) (cadr ranges)) | |
41487370 | 4092 | (progn |
231f989b LMI |
4093 | (setcar ranges (cons (car ranges) |
4094 | (cadr ranges))) | |
4095 | (setcdr ranges (cddr ranges)))) | |
4096 | (if (= (1+ (car ranges)) (caadr ranges)) | |
41487370 | 4097 | (progn |
231f989b LMI |
4098 | (setcar (cadr ranges) (car ranges)) |
4099 | (setcar ranges (cadr ranges)) | |
4100 | (setcdr ranges (cddr ranges)))))) | |
41487370 | 4101 | (if (cdr ranges) |
231f989b LMI |
4102 | (if (atom (cadr ranges)) |
4103 | (if (= (1+ (cdar ranges)) (cadr ranges)) | |
41487370 | 4104 | (progn |
231f989b LMI |
4105 | (setcdr (car ranges) (cadr ranges)) |
4106 | (setcdr ranges (cddr ranges)))) | |
4107 | (if (= (1+ (cdar ranges)) (caadr ranges)) | |
41487370 | 4108 | (progn |
231f989b LMI |
4109 | (setcdr (car ranges) (cdadr ranges)) |
4110 | (setcdr ranges (cddr ranges))))))) | |
41487370 LMI |
4111 | (setq ranges (cdr ranges))) |
4112 | out))) | |
4113 | ||
4114 | (defun gnus-remove-from-range (ranges list) | |
4115 | "Return a list of ranges that has all articles from LIST removed from RANGES. | |
4116 | Note: LIST has to be sorted over `<'." | |
4117 | ;; !!! This function shouldn't look like this, but I've got a headache. | |
231f989b | 4118 | (gnus-compress-sequence |
41487370 LMI |
4119 | (gnus-sorted-complement |
4120 | (gnus-uncompress-range ranges) list))) | |
4121 | ||
4122 | (defun gnus-member-of-range (number ranges) | |
4123 | (if (not (listp (cdr ranges))) | |
231f989b | 4124 | (and (>= number (car ranges)) |
41487370 LMI |
4125 | (<= number (cdr ranges))) |
4126 | (let ((not-stop t)) | |
231f989b | 4127 | (while (and ranges |
41487370 LMI |
4128 | (if (numberp (car ranges)) |
4129 | (>= number (car ranges)) | |
231f989b | 4130 | (>= number (caar ranges))) |
41487370 LMI |
4131 | not-stop) |
4132 | (if (if (numberp (car ranges)) | |
4133 | (= number (car ranges)) | |
231f989b LMI |
4134 | (and (>= number (caar ranges)) |
4135 | (<= number (cdar ranges)))) | |
41487370 LMI |
4136 | (setq not-stop nil)) |
4137 | (setq ranges (cdr ranges))) | |
4138 | (not not-stop)))) | |
4139 | ||
231f989b LMI |
4140 | (defun gnus-range-length (range) |
4141 | "Return the length RANGE would have if uncompressed." | |
4142 | (length (gnus-uncompress-range range))) | |
4143 | ||
4144 | (defun gnus-sublist-p (list sublist) | |
4145 | "Test whether all elements in SUBLIST are members of LIST." | |
4146 | (let ((sublistp t)) | |
4147 | (while sublist | |
4148 | (unless (memq (pop sublist) list) | |
4149 | (setq sublistp nil | |
4150 | sublist nil))) | |
4151 | sublistp)) | |
4152 | ||
41487370 LMI |
4153 | \f |
4154 | ;;; | |
4155 | ;;; Gnus group mode | |
4156 | ;;; | |
4157 | ||
4158 | (defvar gnus-group-mode-map nil) | |
41487370 LMI |
4159 | (put 'gnus-group-mode 'mode-class 'special) |
4160 | ||
231f989b | 4161 | (unless gnus-group-mode-map |
41487370 LMI |
4162 | (setq gnus-group-mode-map (make-keymap)) |
4163 | (suppress-keymap gnus-group-mode-map) | |
231f989b LMI |
4164 | |
4165 | (gnus-define-keys gnus-group-mode-map | |
4166 | " " gnus-group-read-group | |
4167 | "=" gnus-group-select-group | |
4168 | "\r" gnus-group-select-group | |
4169 | "\M-\r" gnus-group-quick-select-group | |
4170 | "j" gnus-group-jump-to-group | |
4171 | "n" gnus-group-next-unread-group | |
4172 | "p" gnus-group-prev-unread-group | |
4173 | "\177" gnus-group-prev-unread-group | |
4174 | [delete] gnus-group-prev-unread-group | |
4175 | "N" gnus-group-next-group | |
4176 | "P" gnus-group-prev-group | |
4177 | "\M-n" gnus-group-next-unread-group-same-level | |
4178 | "\M-p" gnus-group-prev-unread-group-same-level | |
4179 | "," gnus-group-best-unread-group | |
4180 | "." gnus-group-first-unread-group | |
4181 | "u" gnus-group-unsubscribe-current-group | |
4182 | "U" gnus-group-unsubscribe-group | |
4183 | "c" gnus-group-catchup-current | |
4184 | "C" gnus-group-catchup-current-all | |
4185 | "l" gnus-group-list-groups | |
4186 | "L" gnus-group-list-all-groups | |
4187 | "m" gnus-group-mail | |
4188 | "g" gnus-group-get-new-news | |
4189 | "\M-g" gnus-group-get-new-news-this-group | |
4190 | "R" gnus-group-restart | |
4191 | "r" gnus-group-read-init-file | |
4192 | "B" gnus-group-browse-foreign-server | |
4193 | "b" gnus-group-check-bogus-groups | |
4194 | "F" gnus-find-new-newsgroups | |
4195 | "\C-c\C-d" gnus-group-describe-group | |
4196 | "\M-d" gnus-group-describe-all-groups | |
4197 | "\C-c\C-a" gnus-group-apropos | |
4198 | "\C-c\M-\C-a" gnus-group-description-apropos | |
4199 | "a" gnus-group-post-news | |
4200 | "\ek" gnus-group-edit-local-kill | |
4201 | "\eK" gnus-group-edit-global-kill | |
4202 | "\C-k" gnus-group-kill-group | |
4203 | "\C-y" gnus-group-yank-group | |
4204 | "\C-w" gnus-group-kill-region | |
4205 | "\C-x\C-t" gnus-group-transpose-groups | |
4206 | "\C-c\C-l" gnus-group-list-killed | |
4207 | "\C-c\C-x" gnus-group-expire-articles | |
4208 | "\C-c\M-\C-x" gnus-group-expire-all-groups | |
4209 | "V" gnus-version | |
4210 | "s" gnus-group-save-newsrc | |
4211 | "z" gnus-group-suspend | |
4212 | ; "Z" gnus-group-clear-dribble | |
4213 | "q" gnus-group-exit | |
4214 | "Q" gnus-group-quit | |
4215 | "?" gnus-group-describe-briefly | |
4216 | "\C-c\C-i" gnus-info-find-node | |
4217 | "\M-e" gnus-group-edit-group-method | |
4218 | "^" gnus-group-enter-server-mode | |
4219 | gnus-mouse-2 gnus-mouse-pick-group | |
4220 | "<" beginning-of-buffer | |
4221 | ">" end-of-buffer | |
4222 | "\C-c\C-b" gnus-bug | |
4223 | "\C-c\C-s" gnus-group-sort-groups | |
4224 | "t" gnus-topic-mode | |
4225 | "\C-c\M-g" gnus-activate-all-groups | |
4226 | "\M-&" gnus-group-universal-argument | |
4227 | "#" gnus-group-mark-group | |
4228 | "\M-#" gnus-group-unmark-group) | |
4229 | ||
4230 | (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) | |
4231 | "m" gnus-group-mark-group | |
4232 | "u" gnus-group-unmark-group | |
4233 | "w" gnus-group-mark-region | |
4234 | "m" gnus-group-mark-buffer | |
4235 | "r" gnus-group-mark-regexp | |
4236 | "U" gnus-group-unmark-all-groups) | |
4237 | ||
4238 | (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) | |
4239 | "d" gnus-group-make-directory-group | |
4240 | "h" gnus-group-make-help-group | |
4241 | "a" gnus-group-make-archive-group | |
4242 | "k" gnus-group-make-kiboze-group | |
4243 | "m" gnus-group-make-group | |
4244 | "E" gnus-group-edit-group | |
4245 | "e" gnus-group-edit-group-method | |
4246 | "p" gnus-group-edit-group-parameters | |
4247 | "v" gnus-group-add-to-virtual | |
4248 | "V" gnus-group-make-empty-virtual | |
4249 | "D" gnus-group-enter-directory | |
4250 | "f" gnus-group-make-doc-group | |
4251 | "r" gnus-group-rename-group | |
4252 | "\177" gnus-group-delete-group | |
4253 | [delete] gnus-group-delete-group) | |
4254 | ||
4255 | (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) | |
4256 | "b" gnus-group-brew-soup | |
4257 | "w" gnus-soup-save-areas | |
4258 | "s" gnus-soup-send-replies | |
4259 | "p" gnus-soup-pack-packet | |
4260 | "r" nnsoup-pack-replies) | |
4261 | ||
4262 | (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) | |
4263 | "s" gnus-group-sort-groups | |
4264 | "a" gnus-group-sort-groups-by-alphabet | |
4265 | "u" gnus-group-sort-groups-by-unread | |
4266 | "l" gnus-group-sort-groups-by-level | |
4267 | "v" gnus-group-sort-groups-by-score | |
4268 | "r" gnus-group-sort-groups-by-rank | |
4269 | "m" gnus-group-sort-groups-by-method) | |
4270 | ||
4271 | (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) | |
4272 | "k" gnus-group-list-killed | |
4273 | "z" gnus-group-list-zombies | |
4274 | "s" gnus-group-list-groups | |
4275 | "u" gnus-group-list-all-groups | |
4276 | "A" gnus-group-list-active | |
4277 | "a" gnus-group-apropos | |
4278 | "d" gnus-group-description-apropos | |
4279 | "m" gnus-group-list-matching | |
4280 | "M" gnus-group-list-all-matching | |
4281 | "l" gnus-group-list-level) | |
4282 | ||
4283 | (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) | |
4284 | "f" gnus-score-flush-cache) | |
4285 | ||
4286 | (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) | |
4287 | "f" gnus-group-fetch-faq) | |
4288 | ||
4289 | (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) | |
4290 | "l" gnus-group-set-current-level | |
4291 | "t" gnus-group-unsubscribe-current-group | |
4292 | "s" gnus-group-unsubscribe-group | |
4293 | "k" gnus-group-kill-group | |
4294 | "y" gnus-group-yank-group | |
4295 | "w" gnus-group-kill-region | |
4296 | "\C-k" gnus-group-kill-level | |
4297 | "z" gnus-group-kill-all-zombies)) | |
b027f415 RS |
4298 | |
4299 | (defun gnus-group-mode () | |
41487370 LMI |
4300 | "Major mode for reading news. |
4301 | ||
4302 | All normal editing commands are switched off. | |
4303 | \\<gnus-group-mode-map> | |
231f989b | 4304 | The group buffer lists (some of) the groups available. For instance, |
41487370 | 4305 | `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' |
231f989b | 4306 | lists all zombie groups. |
41487370 | 4307 | |
231f989b LMI |
4308 | Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe |
4309 | to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. | |
41487370 | 4310 | |
231f989b | 4311 | For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). |
41487370 LMI |
4312 | |
4313 | The following commands are available: | |
4314 | ||
4315 | \\{gnus-group-mode-map}" | |
745bc783 | 4316 | (interactive) |
231f989b LMI |
4317 | (when (and menu-bar-mode |
4318 | (gnus-visual-p 'group-menu 'menu)) | |
4319 | (gnus-group-make-menu-bar)) | |
745bc783 | 4320 | (kill-all-local-variables) |
a828a776 | 4321 | (gnus-simplify-mode-line) |
b027f415 | 4322 | (setq major-mode 'gnus-group-mode) |
41487370 LMI |
4323 | (setq mode-name "Group") |
4324 | (gnus-group-set-mode-line) | |
745bc783 | 4325 | (setq mode-line-process nil) |
b027f415 | 4326 | (use-local-map gnus-group-mode-map) |
41487370 LMI |
4327 | (buffer-disable-undo (current-buffer)) |
4328 | (setq truncate-lines t) | |
4329 | (setq buffer-read-only t) | |
231f989b LMI |
4330 | (gnus-make-local-hook 'post-command-hook) |
4331 | (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) | |
b027f415 | 4332 | (run-hooks 'gnus-group-mode-hook)) |
745bc783 | 4333 | |
231f989b LMI |
4334 | (defun gnus-clear-inboxes-moved () |
4335 | (setq nnmail-moved-inboxes nil)) | |
4336 | ||
7f410bb7 | 4337 | (defun gnus-mouse-pick-group (e) |
231f989b | 4338 | "Enter the group under the mouse pointer." |
7f410bb7 RS |
4339 | (interactive "e") |
4340 | (mouse-set-point e) | |
4341 | (gnus-group-read-group nil)) | |
4342 | ||
41487370 LMI |
4343 | ;; Look at LEVEL and find out what the level is really supposed to be. |
4344 | ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens | |
4345 | ;; will depend on whether `gnus-group-use-permanent-levels' is used. | |
4346 | (defun gnus-group-default-level (&optional level number-or-nil) | |
231f989b | 4347 | (cond |
41487370 | 4348 | (gnus-group-use-permanent-levels |
231f989b LMI |
4349 | (or (setq gnus-group-use-permanent-levels |
4350 | (or level (if (numberp gnus-group-use-permanent-levels) | |
4351 | gnus-group-use-permanent-levels | |
4352 | (or gnus-group-default-list-level | |
4353 | gnus-level-subscribed)))) | |
4354 | gnus-group-default-list-level gnus-level-subscribed)) | |
41487370 LMI |
4355 | (number-or-nil |
4356 | level) | |
4357 | (t | |
4358 | (or level gnus-group-default-list-level gnus-level-subscribed)))) | |
41487370 | 4359 | |
231f989b LMI |
4360 | ;;;###autoload |
4361 | (defun gnus-slave-no-server (&optional arg) | |
4362 | "Read network news as a slave, without connecting to local server" | |
4363 | (interactive "P") | |
4364 | (gnus-no-server arg t)) | |
41487370 LMI |
4365 | |
4366 | ;;;###autoload | |
231f989b | 4367 | (defun gnus-no-server (&optional arg slave) |
41487370 LMI |
4368 | "Read network news. |
4369 | If ARG is a positive number, Gnus will use that as the | |
231f989b | 4370 | startup level. If ARG is nil, Gnus will be started at level 2. |
41487370 LMI |
4371 | If ARG is non-nil and not a positive number, Gnus will |
4372 | prompt the user for the name of an NNTP server to use. | |
4373 | As opposed to `gnus', this command will not connect to the local server." | |
4374 | (interactive "P") | |
231f989b LMI |
4375 | (let ((val (or arg (1- gnus-level-default-subscribed)))) |
4376 | (gnus val t slave) | |
4377 | (make-local-variable 'gnus-group-use-permanent-levels) | |
4378 | (setq gnus-group-use-permanent-levels val))) | |
4379 | ||
4380 | ;;;###autoload | |
4381 | (defun gnus-slave (&optional arg) | |
4382 | "Read news as a slave." | |
4383 | (interactive "P") | |
4384 | (gnus arg nil 'slave)) | |
41487370 | 4385 | |
bba2dbcb | 4386 | ;;;###autoload |
231f989b LMI |
4387 | (defun gnus-other-frame (&optional arg) |
4388 | "Pop up a frame to read news." | |
4389 | (interactive "P") | |
4390 | (if (get-buffer gnus-group-buffer) | |
4391 | (let ((pop-up-frames t)) | |
4392 | (gnus arg)) | |
4393 | (select-frame (make-frame)) | |
4394 | (gnus arg))) | |
bba2dbcb | 4395 | |
745bc783 | 4396 | ;;;###autoload |
231f989b | 4397 | (defun gnus (&optional arg dont-connect slave) |
745bc783 | 4398 | "Read network news. |
41487370 | 4399 | If ARG is non-nil and a positive number, Gnus will use that as the |
231f989b | 4400 | startup level. If ARG is non-nil and not a positive number, Gnus will |
41487370 | 4401 | prompt the user for the name of an NNTP server to use." |
745bc783 | 4402 | (interactive "P") |
231f989b | 4403 | |
41487370 | 4404 | (if (get-buffer gnus-group-buffer) |
745bc783 | 4405 | (progn |
41487370 LMI |
4406 | (switch-to-buffer gnus-group-buffer) |
4407 | (gnus-group-get-new-news)) | |
4408 | ||
4409 | (gnus-clear-system) | |
41487370 | 4410 | (nnheader-init-server-buffer) |
41487370 | 4411 | (gnus-read-init-file) |
231f989b | 4412 | (setq gnus-slave slave) |
41487370 LMI |
4413 | |
4414 | (gnus-group-setup-buffer) | |
4415 | (let ((buffer-read-only nil)) | |
4416 | (erase-buffer) | |
4417 | (if (not gnus-inhibit-startup-message) | |
4418 | (progn | |
4419 | (gnus-group-startup-message) | |
4420 | (sit-for 0)))) | |
231f989b LMI |
4421 | |
4422 | (let ((level (and (numberp arg) (> arg 0) arg)) | |
41487370 LMI |
4423 | did-connect) |
4424 | (unwind-protect | |
4425 | (progn | |
231f989b | 4426 | (or dont-connect |
41487370 LMI |
4427 | (setq did-connect |
4428 | (gnus-start-news-server (and arg (not level)))))) | |
231f989b | 4429 | (if (and (not dont-connect) |
41487370 LMI |
4430 | (not did-connect)) |
4431 | (gnus-group-quit) | |
4432 | (run-hooks 'gnus-startup-hook) | |
231f989b | 4433 | ;; NNTP server is successfully open. |
41487370 LMI |
4434 | |
4435 | ;; Find the current startup file name. | |
231f989b | 4436 | (setq gnus-current-startup-file |
41487370 LMI |
4437 | (gnus-make-newsrc-file gnus-startup-file)) |
4438 | ||
4439 | ;; Read the dribble file. | |
231f989b LMI |
4440 | (when (or gnus-slave gnus-use-dribble-file) |
4441 | (gnus-dribble-read-file)) | |
4442 | ||
4443 | ;; Allow using GroupLens predictions. | |
4444 | (when gnus-use-grouplens | |
4445 | (bbb-login) | |
4446 | (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) | |
41487370 LMI |
4447 | |
4448 | (gnus-summary-make-display-table) | |
231f989b LMI |
4449 | ;; Do the actual startup. |
4450 | (gnus-setup-news nil level dont-connect) | |
4451 | ;; Generate the group buffer. | |
41487370 | 4452 | (gnus-group-list-groups level) |
231f989b LMI |
4453 | (gnus-group-first-unread-group) |
4454 | (gnus-configure-windows 'group) | |
4455 | (gnus-group-set-mode-line)))))) | |
41487370 LMI |
4456 | |
4457 | (defun gnus-unload () | |
4458 | "Unload all Gnus features." | |
4459 | (interactive) | |
4460 | (or (boundp 'load-history) | |
4461 | (error "Sorry, `gnus-unload' is not implemented in this Emacs version.")) | |
4462 | (let ((history load-history) | |
4463 | feature) | |
4464 | (while history | |
231f989b | 4465 | (and (string-match "^\\(gnus\\|nn\\)" (caar history)) |
41487370 LMI |
4466 | (setq feature (cdr (assq 'provide (car history)))) |
4467 | (unload-feature feature 'force)) | |
4468 | (setq history (cdr history))))) | |
4469 | ||
231f989b LMI |
4470 | (defun gnus-compile () |
4471 | "Byte-compile the user-defined format specs." | |
4472 | (interactive) | |
4473 | (let ((entries gnus-format-specs) | |
4474 | entry gnus-tmp-func) | |
4475 | (save-excursion | |
4476 | (gnus-message 7 "Compiling format specs...") | |
4477 | ||
4478 | (while entries | |
4479 | (setq entry (pop entries)) | |
4480 | (if (eq (car entry) 'version) | |
4481 | (setq gnus-format-specs (delq entry gnus-format-specs)) | |
4482 | (when (and (listp (caddr entry)) | |
4483 | (not (eq 'byte-code (caaddr entry)))) | |
4484 | (fset 'gnus-tmp-func | |
4485 | `(lambda () ,(caddr entry))) | |
4486 | (byte-compile 'gnus-tmp-func) | |
4487 | (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) | |
4488 | ||
4489 | (push (cons 'version emacs-version) gnus-format-specs) | |
4490 | ||
4491 | (gnus-message 7 "Compiling user specs...done")))) | |
4492 | ||
4493 | (defun gnus-indent-rigidly (start end arg) | |
4494 | "Indent rigidly using only spaces and no tabs." | |
4495 | (save-excursion | |
4496 | (save-restriction | |
4497 | (narrow-to-region start end) | |
4498 | (indent-rigidly start end arg) | |
4499 | (goto-char (point-min)) | |
4500 | (while (search-forward "\t" nil t) | |
4501 | (replace-match " " t t))))) | |
4502 | ||
41487370 | 4503 | (defun gnus-group-startup-message (&optional x y) |
745bc783 JB |
4504 | "Insert startup message in current buffer." |
4505 | ;; Insert the message. | |
41487370 | 4506 | (erase-buffer) |
44cdca98 | 4507 | (insert |
231f989b LMI |
4508 | (format " %s |
4509 | _ ___ _ _ | |
4510 | _ ___ __ ___ __ _ ___ | |
4511 | __ _ ___ __ ___ | |
4512 | _ ___ _ | |
4513 | _ _ __ _ | |
4514 | ___ __ _ | |
4515 | __ _ | |
4516 | _ _ _ | |
4517 | _ _ _ | |
4518 | _ _ _ | |
4519 | __ ___ | |
4520 | _ _ _ _ | |
4521 | _ _ | |
4522 | _ _ | |
4523 | _ _ | |
4524 | _ | |
4525 | __ | |
4526 | ||
4527 | " | |
4528 | "")) | |
41487370 | 4529 | ;; And then hack it. |
231f989b LMI |
4530 | (gnus-indent-rigidly (point-min) (point-max) |
4531 | (/ (max (- (window-width) (or x 46)) 0) 2)) | |
41487370 | 4532 | (goto-char (point-min)) |
231f989b | 4533 | (forward-line 1) |
41487370 LMI |
4534 | (let* ((pheight (count-lines (point-min) (point-max))) |
4535 | (wheight (window-height)) | |
231f989b | 4536 | (rest (- wheight pheight))) |
41487370 | 4537 | (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) |
41487370 LMI |
4538 | ;; Fontify some. |
4539 | (goto-char (point-min)) | |
231f989b LMI |
4540 | (and (search-forward "Praxis" nil t) |
4541 | (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) | |
41487370 | 4542 | (goto-char (point-min)) |
231f989b LMI |
4543 | (let* ((mode-string (gnus-group-set-mode-line))) |
4544 | (setq mode-line-buffer-identification | |
4545 | (list (concat gnus-version (substring (car mode-string) 4)))) | |
4546 | (set-buffer-modified-p t))) | |
41487370 LMI |
4547 | |
4548 | (defun gnus-group-setup-buffer () | |
4549 | (or (get-buffer gnus-group-buffer) | |
4550 | (progn | |
4551 | (switch-to-buffer gnus-group-buffer) | |
4552 | (gnus-add-current-to-buffer-list) | |
4553 | (gnus-group-mode) | |
4554 | (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) | |
4555 | ||
231f989b | 4556 | (defun gnus-group-list-groups (&optional level unread lowest) |
41487370 LMI |
4557 | "List newsgroups with level LEVEL or lower that have unread articles. |
4558 | Default is all subscribed groups. | |
4559 | If argument UNREAD is non-nil, groups with no unread articles are also | |
231f989b | 4560 | listed." |
41487370 LMI |
4561 | (interactive (list (if current-prefix-arg |
4562 | (prefix-numeric-value current-prefix-arg) | |
4563 | (or | |
4564 | (gnus-group-default-level nil t) | |
4565 | gnus-group-default-list-level | |
4566 | gnus-level-subscribed)))) | |
4567 | (or level | |
4568 | (setq level (car gnus-group-list-mode) | |
4569 | unread (cdr gnus-group-list-mode))) | |
4570 | (setq level (gnus-group-default-level level)) | |
4571 | (gnus-group-setup-buffer) ;May call from out of group buffer | |
231f989b | 4572 | (gnus-update-format-specifications) |
b027f415 | 4573 | (let ((case-fold-search nil) |
231f989b | 4574 | (props (text-properties-at (gnus-point-at-bol))) |
41487370 | 4575 | (group (gnus-group-group-name))) |
231f989b LMI |
4576 | (set-buffer gnus-group-buffer) |
4577 | (funcall gnus-group-prepare-function level unread lowest) | |
745bc783 | 4578 | (if (zerop (buffer-size)) |
41487370 | 4579 | (gnus-message 5 gnus-no-groups-message) |
231f989b LMI |
4580 | (goto-char (point-max)) |
4581 | (when (or (not gnus-group-goto-next-group-function) | |
4582 | (not (funcall gnus-group-goto-next-group-function | |
4583 | group props))) | |
4584 | (if (not group) | |
4585 | ;; Go to the first group with unread articles. | |
4586 | (gnus-group-search-forward t) | |
4587 | ;; Find the right group to put point on. If the current group | |
4588 | ;; has disappeared in the new listing, try to find the next | |
4589 | ;; one. If no next one can be found, just leave point at the | |
4590 | ;; first newsgroup in the buffer. | |
4591 | (if (not (gnus-goto-char | |
4592 | (text-property-any | |
4593 | (point-min) (point-max) | |
4594 | 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) | |
4595 | (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) | |
4596 | (while (and newsrc | |
4597 | (not (gnus-goto-char | |
4598 | (text-property-any | |
4599 | (point-min) (point-max) 'gnus-group | |
4600 | (gnus-intern-safe | |
4601 | (caar newsrc) gnus-active-hashtb))))) | |
4602 | (setq newsrc (cdr newsrc))) | |
4603 | (or newsrc (progn (goto-char (point-max)) | |
4604 | (forward-line -1))))))) | |
745bc783 | 4605 | ;; Adjust cursor point. |
231f989b LMI |
4606 | (gnus-group-position-point)))) |
4607 | ||
4608 | (defun gnus-group-list-level (level &optional all) | |
4609 | "List groups on LEVEL. | |
4610 | If ALL (the prefix), also list groups that have no unread articles." | |
4611 | (interactive "nList groups on level: \nP") | |
4612 | (gnus-group-list-groups level all level)) | |
41487370 | 4613 | |
231f989b | 4614 | (defun gnus-group-prepare-flat (level &optional all lowest regexp) |
41487370 LMI |
4615 | "List all newsgroups with unread articles of level LEVEL or lower. |
4616 | If ALL is non-nil, list groups that have no unread articles. | |
4617 | If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. | |
4618 | If REGEXP, only list groups matching REGEXP." | |
4619 | (set-buffer gnus-group-buffer) | |
745bc783 | 4620 | (let ((buffer-read-only nil) |
41487370 LMI |
4621 | (newsrc (cdr gnus-newsrc-alist)) |
4622 | (lowest (or lowest 1)) | |
231f989b | 4623 | info clevel unread group params) |
745bc783 | 4624 | (erase-buffer) |
41487370 LMI |
4625 | (if (< lowest gnus-level-zombie) |
4626 | ;; List living groups. | |
4627 | (while newsrc | |
4628 | (setq info (car newsrc) | |
231f989b LMI |
4629 | group (gnus-info-group info) |
4630 | params (gnus-info-params info) | |
41487370 LMI |
4631 | newsrc (cdr newsrc) |
4632 | unread (car (gnus-gethash group gnus-newsrc-hashtb))) | |
4633 | (and unread ; This group might be bogus | |
4634 | (or (not regexp) | |
4635 | (string-match regexp group)) | |
231f989b | 4636 | (<= (setq clevel (gnus-info-level info)) level) |
41487370 LMI |
4637 | (>= clevel lowest) |
4638 | (or all ; We list all groups? | |
231f989b LMI |
4639 | (if (eq unread t) ; Unactivated? |
4640 | gnus-group-list-inactive-groups ; We list unactivated | |
4641 | (> unread 0)) ; We list groups with unread articles | |
4642 | (and gnus-list-groups-with-ticked-articles | |
4643 | (cdr (assq 'tick (gnus-info-marks info)))) | |
4644 | ; And groups with tickeds | |
4645 | ;; Check for permanent visibility. | |
4646 | (and gnus-permanently-visible-groups | |
4647 | (string-match gnus-permanently-visible-groups | |
4648 | group)) | |
4649 | (memq 'visible params) | |
4650 | (cdr (assq 'visible params))) | |
4651 | (gnus-group-insert-group-line | |
4652 | group (gnus-info-level info) | |
4653 | (gnus-info-marks info) unread (gnus-info-method info))))) | |
41487370 LMI |
4654 | |
4655 | ;; List dead groups. | |
4656 | (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) | |
231f989b LMI |
4657 | (gnus-group-prepare-flat-list-dead |
4658 | (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) | |
41487370 LMI |
4659 | gnus-level-zombie ?Z |
4660 | regexp)) | |
4661 | (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) | |
231f989b LMI |
4662 | (gnus-group-prepare-flat-list-dead |
4663 | (setq gnus-killed-list (sort gnus-killed-list 'string<)) | |
41487370 LMI |
4664 | gnus-level-killed ?K regexp)) |
4665 | ||
4666 | (gnus-group-set-mode-line) | |
4667 | (setq gnus-group-list-mode (cons level all)) | |
4668 | (run-hooks 'gnus-group-prepare-hook))) | |
4669 | ||
4670 | (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) | |
b94ae5f7 | 4671 | ;; List zombies and killed lists somewhat faster, which was |
231f989b | 4672 | ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does |
41487370 | 4673 | ;; this by ignoring the group format specification altogether. |
231f989b LMI |
4674 | (let (group) |
4675 | (if regexp | |
4676 | ;; This loop is used when listing groups that match some | |
4677 | ;; regexp. | |
4678 | (while groups | |
4679 | (setq group (pop groups)) | |
4680 | (when (string-match regexp group) | |
4681 | (gnus-add-text-properties | |
4682 | (point) (prog1 (1+ (point)) | |
4683 | (insert " " mark " *: " group "\n")) | |
4684 | (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | |
41487370 | 4685 | 'gnus-unread t |
231f989b LMI |
4686 | 'gnus-level level)))) |
4687 | ;; This loop is used when listing all groups. | |
4688 | (while groups | |
4689 | (gnus-add-text-properties | |
4690 | (point) (prog1 (1+ (point)) | |
4691 | (insert " " mark " *: " | |
4692 | (setq group (pop groups)) "\n")) | |
4693 | (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | |
4694 | 'gnus-unread t | |
4695 | 'gnus-level level)))))) | |
4696 | ||
4697 | (defmacro gnus-group-real-name (group) | |
41487370 | 4698 | "Find the real name of a foreign newsgroup." |
231f989b LMI |
4699 | `(let ((gname ,group)) |
4700 | (if (string-match ":[^:]+$" gname) | |
4701 | (substring gname (1+ (match-beginning 0))) | |
4702 | gname))) | |
4703 | ||
4704 | (defsubst gnus-server-add-address (method) | |
4705 | (let ((method-name (symbol-name (car method)))) | |
4706 | (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) | |
4707 | (not (assq (intern (concat method-name "-address")) method))) | |
4708 | (append method (list (list (intern (concat method-name "-address")) | |
4709 | (nth 1 method)))) | |
4710 | method))) | |
4711 | ||
4712 | (defsubst gnus-server-get-method (group method) | |
4713 | ;; Input either a server name, and extended server name, or a | |
4714 | ;; select method, and return a select method. | |
4715 | (cond ((stringp method) | |
4716 | (gnus-server-to-method method)) | |
4717 | ((equal method gnus-select-method) | |
4718 | gnus-select-method) | |
4719 | ((and (stringp (car method)) group) | |
4720 | (gnus-server-extend-method group method)) | |
4721 | ((and method (not group) | |
4722 | (equal (cadr method) "")) | |
4723 | method) | |
4724 | (t | |
4725 | (gnus-server-add-address method)))) | |
4726 | ||
4727 | (defun gnus-server-to-method (server) | |
4728 | "Map virtual server names to select methods." | |
4729 | (or | |
4730 | ;; Is this a method, perhaps? | |
4731 | (and server (listp server) server) | |
4732 | ;; Perhaps this is the native server? | |
4733 | (and (equal server "native") gnus-select-method) | |
4734 | ;; It should be in the server alist. | |
4735 | (cdr (assoc server gnus-server-alist)) | |
4736 | ;; If not, we look through all the opened server | |
4737 | ;; to see whether we can find it there. | |
4738 | (let ((opened gnus-opened-servers)) | |
4739 | (while (and opened | |
4740 | (not (equal server (format "%s:%s" (caaar opened) | |
4741 | (cadaar opened))))) | |
4742 | (pop opened)) | |
4743 | (caar opened)))) | |
4744 | ||
4745 | (defmacro gnus-method-equal (ss1 ss2) | |
4746 | "Say whether two servers are equal." | |
4747 | `(let ((s1 ,ss1) | |
4748 | (s2 ,ss2)) | |
4749 | (or (equal s1 s2) | |
4750 | (and (= (length s1) (length s2)) | |
4751 | (progn | |
4752 | (while (and s1 (member (car s1) s2)) | |
4753 | (setq s1 (cdr s1))) | |
4754 | (null s1)))))) | |
4755 | ||
4756 | (defun gnus-server-equal (m1 m2) | |
4757 | "Say whether two methods are equal." | |
4758 | (let ((m1 (cond ((null m1) gnus-select-method) | |
4759 | ((stringp m1) (gnus-server-to-method m1)) | |
4760 | (t m1))) | |
4761 | (m2 (cond ((null m2) gnus-select-method) | |
4762 | ((stringp m2) (gnus-server-to-method m2)) | |
4763 | (t m2)))) | |
4764 | (gnus-method-equal m1 m2))) | |
4765 | ||
4766 | (defun gnus-servers-using-backend (backend) | |
4767 | "Return a list of known servers using BACKEND." | |
4768 | (let ((opened gnus-opened-servers) | |
4769 | out) | |
4770 | (while opened | |
4771 | (when (eq backend (caaar opened)) | |
4772 | (push (caar opened) out)) | |
4773 | (pop opened)) | |
4774 | out)) | |
41487370 | 4775 | |
564b670b LMI |
4776 | (defun gnus-archive-server-wanted-p () |
4777 | "Say whether the user wants to use the archive server." | |
4778 | (cond | |
4779 | ((or (not gnus-message-archive-method) | |
4780 | (not gnus-message-archive-group)) | |
4781 | nil) | |
4782 | ((and gnus-message-archive-method gnus-message-archive-group) | |
4783 | t) | |
4784 | (t | |
4785 | (let ((active (cadr (assq 'nnfolder-active-file | |
4786 | gnus-message-archive-method)))) | |
4787 | (and active | |
4788 | (file-exists-p active)))))) | |
4789 | ||
41487370 LMI |
4790 | (defun gnus-group-prefixed-name (group method) |
4791 | "Return the whole name from GROUP and METHOD." | |
4792 | (and (stringp method) (setq method (gnus-server-to-method method))) | |
4793 | (concat (format "%s" (car method)) | |
231f989b LMI |
4794 | (if (and |
4795 | (or (assoc (format "%s" (car method)) | |
4796 | (gnus-methods-using 'address)) | |
4797 | (gnus-server-equal method gnus-message-archive-method)) | |
4798 | (nth 1 method) | |
41487370 LMI |
4799 | (not (string= (nth 1 method) ""))) |
4800 | (concat "+" (nth 1 method))) | |
4801 | ":" group)) | |
4802 | ||
4803 | (defun gnus-group-real-prefix (group) | |
4804 | "Return the prefix of the current group name." | |
4805 | (if (string-match "^[^:]+:" group) | |
4806 | (substring group 0 (match-end 0)) | |
4807 | "")) | |
4808 | ||
231f989b LMI |
4809 | (defun gnus-group-method (group) |
4810 | "Return the server or method used for selecting GROUP." | |
41487370 LMI |
4811 | (let ((prefix (gnus-group-real-prefix group))) |
4812 | (if (equal prefix "") | |
4813 | gnus-select-method | |
231f989b LMI |
4814 | (let ((servers gnus-opened-servers) |
4815 | (server "") | |
4816 | backend possible found) | |
4817 | (if (string-match "^[^\\+]+\\+" prefix) | |
4818 | (setq backend (intern (substring prefix 0 (1- (match-end 0)))) | |
4819 | server (substring prefix (match-end 0) (1- (length prefix)))) | |
4820 | (setq backend (intern (substring prefix 0 (1- (length prefix)))))) | |
4821 | (while servers | |
4822 | (when (eq (caaar servers) backend) | |
4823 | (setq possible (caar servers)) | |
4824 | (when (equal (cadaar servers) server) | |
4825 | (setq found (caar servers)))) | |
4826 | (pop servers)) | |
4827 | (or (car (rassoc found gnus-server-alist)) | |
4828 | found | |
4829 | (car (rassoc possible gnus-server-alist)) | |
4830 | possible | |
4831 | (list backend server)))))) | |
4832 | ||
4833 | (defsubst gnus-secondary-method-p (method) | |
4834 | "Return whether METHOD is a secondary select method." | |
4835 | (let ((methods gnus-secondary-select-methods) | |
4836 | (gmethod (gnus-server-get-method nil method))) | |
4837 | (while (and methods | |
4838 | (not (equal (gnus-server-get-method nil (car methods)) | |
4839 | gmethod))) | |
4840 | (setq methods (cdr methods))) | |
4841 | methods)) | |
41487370 LMI |
4842 | |
4843 | (defun gnus-group-foreign-p (group) | |
231f989b LMI |
4844 | "Say whether a group is foreign or not." |
4845 | (and (not (gnus-group-native-p group)) | |
4846 | (not (gnus-group-secondary-p group)))) | |
4847 | ||
4848 | (defun gnus-group-native-p (group) | |
4849 | "Say whether the group is native or not." | |
4850 | (not (string-match ":" group))) | |
4851 | ||
4852 | (defun gnus-group-secondary-p (group) | |
4853 | "Say whether the group is secondary or not." | |
4854 | (gnus-secondary-method-p (gnus-find-method-for-group group))) | |
4855 | ||
4856 | (defun gnus-group-get-parameter (group &optional symbol) | |
4857 | "Returns the group parameters for GROUP. | |
4858 | If SYMBOL, return the value of that symbol in the group parameters." | |
4859 | (let ((params (gnus-info-params (gnus-get-info group)))) | |
4860 | (if symbol | |
4861 | (gnus-group-parameter-value params symbol) | |
4862 | params))) | |
4863 | ||
4864 | (defun gnus-group-parameter-value (params symbol) | |
4865 | "Return the value of SYMBOL in group PARAMS." | |
4866 | (or (car (memq symbol params)) ; It's either a simple symbol | |
4867 | (cdr (assq symbol params)))) ; or a cons. | |
4868 | ||
4869 | (defun gnus-group-add-parameter (group param) | |
4870 | "Add parameter PARAM to GROUP." | |
4871 | (let ((info (gnus-get-info group))) | |
4872 | (if (not info) | |
4873 | () ; This is a dead group. We just ignore it. | |
4874 | ;; Cons the new param to the old one and update. | |
4875 | (gnus-group-set-info (cons param (gnus-info-params info)) | |
4876 | group 'params)))) | |
4877 | ||
4878 | (defun gnus-group-set-parameter (group name value) | |
4879 | "Set parameter NAME to VALUE in GROUP." | |
4880 | (let ((info (gnus-get-info group))) | |
4881 | (if (not info) | |
4882 | () ; This is a dead group. We just ignore it. | |
4883 | (let ((old-params (gnus-info-params info)) | |
4884 | (new-params (list (cons name value)))) | |
4885 | (while old-params | |
4886 | (if (or (not (listp (car old-params))) | |
4887 | (not (eq (caar old-params) name))) | |
4888 | (setq new-params (append new-params (list (car old-params))))) | |
4889 | (setq old-params (cdr old-params))) | |
4890 | (gnus-group-set-info new-params group 'params))))) | |
4891 | ||
4892 | (defun gnus-group-add-score (group &optional score) | |
4893 | "Add SCORE to the GROUP score. | |
4894 | If SCORE is nil, add 1 to the score of GROUP." | |
4895 | (let ((info (gnus-get-info group))) | |
4896 | (when info | |
4897 | (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) | |
4898 | ||
4899 | (defun gnus-summary-bubble-group () | |
4900 | "Increase the score of the current group. | |
4901 | This is a handy function to add to `gnus-summary-exit-hook' to | |
4902 | increase the score of each group you read." | |
4903 | (gnus-group-add-score gnus-newsgroup-name)) | |
41487370 LMI |
4904 | |
4905 | (defun gnus-group-set-info (info &optional method-only-group part) | |
4906 | (let* ((entry (gnus-gethash | |
231f989b LMI |
4907 | (or method-only-group (gnus-info-group info)) |
4908 | gnus-newsrc-hashtb)) | |
41487370 | 4909 | (part-info info) |
231f989b LMI |
4910 | (info (if method-only-group (nth 2 entry) info)) |
4911 | method) | |
4912 | (when method-only-group | |
4913 | (unless entry | |
4914 | (error "Trying to change non-existent group %s" method-only-group)) | |
b94ae5f7 | 4915 | ;; We have received parts of the actual group info - either the |
231f989b | 4916 | ;; select method or the group parameters. We first check |
41487370 LMI |
4917 | ;; whether we have to extend the info, and if so, do that. |
4918 | (let ((len (length info)) | |
4919 | (total (if (eq part 'method) 5 6))) | |
231f989b LMI |
4920 | (when (< len total) |
4921 | (setcdr (nthcdr (1- len) info) | |
4922 | (make-list (- total len) nil))) | |
41487370 LMI |
4923 | ;; Then we enter the new info. |
4924 | (setcar (nthcdr (1- total) info) part-info))) | |
231f989b | 4925 | (unless entry |
41487370 LMI |
4926 | ;; This is a new group, so we just create it. |
4927 | (save-excursion | |
4928 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
4929 | (setq method (gnus-info-method info)) |
4930 | (when (gnus-server-equal method "native") | |
4931 | (setq method nil)) | |
4932 | (save-excursion | |
4933 | (set-buffer gnus-group-buffer) | |
4934 | (if method | |
4935 | ;; It's a foreign group... | |
4936 | (gnus-group-make-group | |
4937 | (gnus-group-real-name (gnus-info-group info)) | |
4938 | (if (stringp method) method | |
4939 | (prin1-to-string (car method))) | |
4940 | (and (consp method) | |
4941 | (nth 1 (gnus-info-method info)))) | |
4942 | ;; It's a native group. | |
4943 | (gnus-group-make-group (gnus-info-group info)))) | |
41487370 | 4944 | (gnus-message 6 "Note: New group created") |
231f989b LMI |
4945 | (setq entry |
4946 | (gnus-gethash (gnus-group-prefixed-name | |
4947 | (gnus-group-real-name (gnus-info-group info)) | |
4948 | (or (gnus-info-method info) gnus-select-method)) | |
41487370 LMI |
4949 | gnus-newsrc-hashtb)))) |
4950 | ;; Whether it was a new group or not, we now have the entry, so we | |
4951 | ;; can do the update. | |
4952 | (if entry | |
4953 | (progn | |
4954 | (setcar (nthcdr 2 entry) info) | |
231f989b LMI |
4955 | (when (and (not (eq (car entry) t)) |
4956 | (gnus-active (gnus-info-group info))) | |
4957 | (setcar entry (length (gnus-list-of-unread-articles (car info)))))) | |
4958 | (error "No such group: %s" (gnus-info-group info))))) | |
41487370 LMI |
4959 | |
4960 | (defun gnus-group-set-method-info (group select-method) | |
4961 | (gnus-group-set-info select-method group 'method)) | |
4962 | ||
4963 | (defun gnus-group-set-params-info (group params) | |
4964 | (gnus-group-set-info params group 'params)) | |
4965 | ||
4966 | (defun gnus-group-update-group-line () | |
231f989b | 4967 | "Update the current line in the group buffer." |
41487370 LMI |
4968 | (let* ((buffer-read-only nil) |
4969 | (group (gnus-group-group-name)) | |
231f989b LMI |
4970 | (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) |
4971 | gnus-group-indentation) | |
4972 | (when group | |
4973 | (and entry | |
4974 | (not (gnus-ephemeral-group-p group)) | |
4975 | (gnus-dribble-enter | |
4976 | (concat "(gnus-group-set-info '" | |
4977 | (prin1-to-string (nth 2 entry)) ")"))) | |
4978 | (setq gnus-group-indentation (gnus-group-group-indentation)) | |
4979 | (gnus-delete-line) | |
4980 | (gnus-group-insert-group-line-info group) | |
4981 | (forward-line -1) | |
4982 | (gnus-group-position-point)))) | |
41487370 LMI |
4983 | |
4984 | (defun gnus-group-insert-group-line-info (group) | |
231f989b LMI |
4985 | "Insert GROUP on the current line." |
4986 | (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) | |
41487370 LMI |
4987 | active info) |
4988 | (if entry | |
de032aaa | 4989 | (progn |
231f989b | 4990 | ;; (Un)subscribed group. |
41487370 | 4991 | (setq info (nth 2 entry)) |
231f989b LMI |
4992 | (gnus-group-insert-group-line |
4993 | group (gnus-info-level info) (gnus-info-marks info) | |
4994 | (or (car entry) t) (gnus-info-method info))) | |
4995 | ;; This group is dead. | |
4996 | (gnus-group-insert-group-line | |
4997 | group | |
41487370 | 4998 | (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) |
231f989b LMI |
4999 | nil |
5000 | (if (setq active (gnus-active group)) | |
5001 | (- (1+ (cdr active)) (car active)) 0) | |
5002 | nil)))) | |
5003 | ||
5004 | (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level | |
5005 | gnus-tmp-marked number | |
5006 | gnus-tmp-method) | |
5007 | "Insert a group line in the group buffer." | |
5008 | (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) | |
5009 | (gnus-tmp-number-total | |
5010 | (if gnus-tmp-active | |
5011 | (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) | |
5012 | 0)) | |
5013 | (gnus-tmp-number-of-unread | |
41487370 LMI |
5014 | (if (numberp number) (int-to-string (max 0 number)) |
5015 | "*")) | |
231f989b | 5016 | (gnus-tmp-number-of-read |
41487370 | 5017 | (if (numberp number) |
231f989b | 5018 | (int-to-string (max 0 (- gnus-tmp-number-total number))) |
41487370 | 5019 | "*")) |
231f989b LMI |
5020 | (gnus-tmp-subscribed |
5021 | (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) | |
5022 | ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) | |
5023 | ((= gnus-tmp-level gnus-level-zombie) ?Z) | |
5024 | (t ?K))) | |
5025 | (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) | |
5026 | (gnus-tmp-newsgroup-description | |
41487370 | 5027 | (if gnus-description-hashtb |
231f989b | 5028 | (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") |
41487370 | 5029 | "")) |
231f989b LMI |
5030 | (gnus-tmp-moderated |
5031 | (if (member gnus-tmp-group gnus-moderated-list) ?m ? )) | |
5032 | (gnus-tmp-moderated-string | |
5033 | (if (eq gnus-tmp-moderated ?m) "(m)" "")) | |
5034 | (gnus-tmp-method | |
5035 | (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) | |
5036 | (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) | |
5037 | (gnus-tmp-news-method (or (car gnus-tmp-method) "")) | |
5038 | (gnus-tmp-news-method-string | |
5039 | (if gnus-tmp-method | |
5040 | (format "(%s:%s)" (car gnus-tmp-method) | |
5041 | (cadr gnus-tmp-method)) "")) | |
5042 | (gnus-tmp-marked-mark | |
5043 | (if (and (numberp number) | |
5044 | (zerop number) | |
5045 | (cdr (assq 'tick gnus-tmp-marked))) | |
5046 | ?* ? )) | |
5047 | (gnus-tmp-process-marked | |
5048 | (if (member gnus-tmp-group gnus-group-marked) | |
5049 | gnus-process-mark ? )) | |
5050 | (gnus-tmp-grouplens | |
5051 | (or (and gnus-use-grouplens | |
5052 | (bbb-grouplens-group-p gnus-tmp-group)) | |
5053 | "")) | |
41487370 | 5054 | (buffer-read-only nil) |
231f989b | 5055 | header gnus-tmp-header) ; passed as parameter to user-funcs. |
41487370 | 5056 | (beginning-of-line) |
231f989b LMI |
5057 | (gnus-add-text-properties |
5058 | (point) | |
5059 | (prog1 (1+ (point)) | |
5060 | ;; Insert the text. | |
5061 | (eval gnus-group-line-format-spec)) | |
5062 | `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) | |
5063 | gnus-unread ,(if (numberp number) | |
5064 | (string-to-int gnus-tmp-number-of-unread) | |
5065 | t) | |
5066 | gnus-marked ,gnus-tmp-marked-mark | |
5067 | gnus-indentation ,gnus-group-indentation | |
5068 | gnus-level ,gnus-tmp-level)) | |
5069 | (when (inline (gnus-visual-p 'group-highlight 'highlight)) | |
5070 | (forward-line -1) | |
5071 | (run-hooks 'gnus-group-update-hook) | |
5072 | (forward-line)) | |
5073 | ;; Allow XEmacs to remove front-sticky text properties. | |
5074 | (gnus-group-remove-excess-properties))) | |
745bc783 | 5075 | |
b027f415 | 5076 | (defun gnus-group-update-group (group &optional visible-only) |
231f989b LMI |
5077 | "Update all lines where GROUP appear. |
5078 | If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't | |
5079 | already." | |
41487370 LMI |
5080 | (save-excursion |
5081 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
5082 | ;; The buffer may be narrowed. |
5083 | (save-restriction | |
5084 | (widen) | |
5085 | (let ((ident (gnus-intern-safe group gnus-active-hashtb)) | |
5086 | (loc (point-min)) | |
5087 | found buffer-read-only) | |
5088 | ;; Enter the current status into the dribble buffer. | |
5089 | (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) | |
5090 | (if (and entry (not (gnus-ephemeral-group-p group))) | |
5091 | (gnus-dribble-enter | |
5092 | (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) | |
5093 | ")")))) | |
5094 | ;; Find all group instances. If topics are in use, each group | |
5095 | ;; may be listed in more than once. | |
5096 | (while (setq loc (text-property-any | |
5097 | loc (point-max) 'gnus-group ident)) | |
5098 | (setq found t) | |
5099 | (goto-char loc) | |
5100 | (let ((gnus-group-indentation (gnus-group-group-indentation))) | |
5101 | (gnus-delete-line) | |
5102 | (gnus-group-insert-group-line-info group) | |
5103 | (save-excursion | |
5104 | (forward-line -1) | |
5105 | (run-hooks 'gnus-group-update-group-hook))) | |
5106 | (setq loc (1+ loc))) | |
5107 | (unless (or found visible-only) | |
41487370 LMI |
5108 | ;; No such line in the buffer, find out where it's supposed to |
5109 | ;; go, and insert it there (or at the end of the buffer). | |
231f989b LMI |
5110 | (if gnus-goto-missing-group-function |
5111 | (funcall gnus-goto-missing-group-function group) | |
5112 | (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) | |
5113 | (while (and entry (car entry) | |
5114 | (not | |
5115 | (gnus-goto-char | |
5116 | (text-property-any | |
5117 | (point-min) (point-max) | |
5118 | 'gnus-group (gnus-intern-safe | |
5119 | (caar entry) gnus-active-hashtb))))) | |
5120 | (setq entry (cdr entry))) | |
5121 | (or entry (goto-char (point-max))))) | |
5122 | ;; Finally insert the line. | |
5123 | (let ((gnus-group-indentation (gnus-group-group-indentation))) | |
5124 | (gnus-group-insert-group-line-info group) | |
5125 | (save-excursion | |
5126 | (forward-line -1) | |
5127 | (run-hooks 'gnus-group-update-group-hook)))) | |
5128 | (gnus-group-set-mode-line))))) | |
41487370 LMI |
5129 | |
5130 | (defun gnus-group-set-mode-line () | |
231f989b LMI |
5131 | "Update the mode line in the group buffer." |
5132 | (when (memq 'group gnus-updated-mode-lines) | |
5133 | ;; Yes, we want to keep this mode line updated. | |
5134 | (save-excursion | |
5135 | (set-buffer gnus-group-buffer) | |
41487370 LMI |
5136 | (let* ((gformat (or gnus-group-mode-line-format-spec |
5137 | (setq gnus-group-mode-line-format-spec | |
231f989b LMI |
5138 | (gnus-parse-format |
5139 | gnus-group-mode-line-format | |
41487370 | 5140 | gnus-group-mode-line-format-alist)))) |
231f989b LMI |
5141 | (gnus-tmp-news-server (cadr gnus-select-method)) |
5142 | (gnus-tmp-news-method (car gnus-select-method)) | |
5143 | (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) | |
41487370 | 5144 | (max-len 60) |
231f989b LMI |
5145 | gnus-tmp-header ;Dummy binding for user-defined formats |
5146 | ;; Get the resulting string. | |
5147 | (modified | |
5148 | (and gnus-dribble-buffer | |
5149 | (buffer-name gnus-dribble-buffer) | |
5150 | (buffer-modified-p gnus-dribble-buffer) | |
5151 | (save-excursion | |
5152 | (set-buffer gnus-dribble-buffer) | |
5153 | (not (zerop (buffer-size)))))) | |
41487370 | 5154 | (mode-string (eval gformat))) |
231f989b LMI |
5155 | ;; Say whether the dribble buffer has been modified. |
5156 | (setq mode-line-modified | |
5157 | (if modified "---*- " "----- ")) | |
5158 | ;; If the line is too long, we chop it off. | |
5159 | (when (> (length mode-string) max-len) | |
5160 | (setq mode-string (substring mode-string 0 (- max-len 4)))) | |
5161 | (prog1 | |
5162 | (setq mode-line-buffer-identification | |
5163 | (gnus-mode-line-buffer-identification | |
5164 | (list mode-string))) | |
5165 | (set-buffer-modified-p modified)))))) | |
745bc783 | 5166 | |
b027f415 | 5167 | (defun gnus-group-group-name () |
41487370 LMI |
5168 | "Get the name of the newsgroup on the current line." |
5169 | (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) | |
5170 | (and group (symbol-name group)))) | |
5171 | ||
5172 | (defun gnus-group-group-level () | |
5173 | "Get the level of the newsgroup on the current line." | |
5174 | (get-text-property (gnus-point-at-bol) 'gnus-level)) | |
5175 | ||
231f989b LMI |
5176 | (defun gnus-group-group-indentation () |
5177 | "Get the indentation of the newsgroup on the current line." | |
5178 | (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) | |
5179 | (and gnus-group-indentation-function | |
5180 | (funcall gnus-group-indentation-function)) | |
5181 | "")) | |
5182 | ||
41487370 LMI |
5183 | (defun gnus-group-group-unread () |
5184 | "Get the number of unread articles of the newsgroup on the current line." | |
5185 | (get-text-property (gnus-point-at-bol) 'gnus-unread)) | |
5186 | ||
5187 | (defun gnus-group-search-forward (&optional backward all level first-too) | |
5188 | "Find the next newsgroup with unread articles. | |
5189 | If BACKWARD is non-nil, find the previous newsgroup instead. | |
5190 | If ALL is non-nil, just find any newsgroup. | |
5191 | If LEVEL is non-nil, find group with level LEVEL, or higher if no such | |
5192 | group exists. | |
5193 | If FIRST-TOO, the current line is also eligible as a target." | |
5194 | (let ((way (if backward -1 1)) | |
5195 | (low gnus-level-killed) | |
5196 | (beg (point)) | |
5197 | pos found lev) | |
5198 | (if (and backward (progn (beginning-of-line)) (bobp)) | |
5199 | nil | |
5200 | (or first-too (forward-line way)) | |
231f989b | 5201 | (while (and |
41487370 | 5202 | (not (eobp)) |
231f989b LMI |
5203 | (not (setq |
5204 | found | |
41487370 LMI |
5205 | (and (or all |
5206 | (and | |
231f989b | 5207 | (let ((unread |
41487370 | 5208 | (get-text-property (point) 'gnus-unread))) |
231f989b | 5209 | (and (numberp unread) (> unread 0))) |
41487370 LMI |
5210 | (setq lev (get-text-property (point) |
5211 | 'gnus-level)) | |
5212 | (<= lev gnus-level-subscribed))) | |
5213 | (or (not level) | |
5214 | (and (setq lev (get-text-property (point) | |
5215 | 'gnus-level)) | |
5216 | (or (= lev level) | |
5217 | (and (< lev low) | |
5218 | (< level lev) | |
5219 | (progn | |
5220 | (setq low lev) | |
5221 | (setq pos (point)) | |
5222 | nil)))))))) | |
5223 | (zerop (forward-line way))))) | |
231f989b LMI |
5224 | (if found |
5225 | (progn (gnus-group-position-point) t) | |
41487370 LMI |
5226 | (goto-char (or pos beg)) |
5227 | (and pos t)))) | |
5228 | ||
5229 | ;;; Gnus group mode commands | |
5230 | ||
5231 | ;; Group marking. | |
5232 | ||
5233 | (defun gnus-group-mark-group (n &optional unmark no-advance) | |
5234 | "Mark the current group." | |
5235 | (interactive "p") | |
5236 | (let ((buffer-read-only nil) | |
5237 | group) | |
231f989b LMI |
5238 | (while (and (> n 0) |
5239 | (not (eobp))) | |
5240 | (when (setq group (gnus-group-group-name)) | |
5241 | ;; Update the mark. | |
5242 | (beginning-of-line) | |
5243 | (forward-char | |
5244 | (or (cdr (assq 'process gnus-group-mark-positions)) 2)) | |
5245 | (delete-char 1) | |
5246 | (if unmark | |
5247 | (progn | |
5248 | (insert " ") | |
5249 | (setq gnus-group-marked (delete group gnus-group-marked))) | |
5250 | (insert "#") | |
5251 | (setq gnus-group-marked | |
5252 | (cons group (delete group gnus-group-marked))))) | |
5253 | (or no-advance (gnus-group-next-group 1)) | |
5254 | (decf n)) | |
5255 | (gnus-summary-position-point) | |
41487370 LMI |
5256 | n)) |
5257 | ||
5258 | (defun gnus-group-unmark-group (n) | |
5259 | "Remove the mark from the current group." | |
5260 | (interactive "p") | |
231f989b LMI |
5261 | (gnus-group-mark-group n 'unmark) |
5262 | (gnus-group-position-point)) | |
5263 | ||
5264 | (defun gnus-group-unmark-all-groups () | |
5265 | "Unmark all groups." | |
5266 | (interactive) | |
5267 | (let ((groups gnus-group-marked)) | |
5268 | (save-excursion | |
5269 | (while groups | |
5270 | (gnus-group-remove-mark (pop groups))))) | |
5271 | (gnus-group-position-point)) | |
b027f415 | 5272 | |
41487370 LMI |
5273 | (defun gnus-group-mark-region (unmark beg end) |
5274 | "Mark all groups between point and mark. | |
5275 | If UNMARK, remove the mark instead." | |
5276 | (interactive "P\nr") | |
5277 | (let ((num (count-lines beg end))) | |
5278 | (save-excursion | |
5279 | (goto-char beg) | |
5280 | (- num (gnus-group-mark-group num unmark))))) | |
b027f415 | 5281 | |
231f989b LMI |
5282 | (defun gnus-group-mark-buffer (&optional unmark) |
5283 | "Mark all groups in the buffer. | |
5284 | If UNMARK, remove the mark instead." | |
5285 | (interactive "P") | |
5286 | (gnus-group-mark-region unmark (point-min) (point-max))) | |
5287 | ||
5288 | (defun gnus-group-mark-regexp (regexp) | |
5289 | "Mark all groups that match some regexp." | |
5290 | (interactive "sMark (regexp): ") | |
5291 | (let ((alist (cdr gnus-newsrc-alist)) | |
5292 | group) | |
5293 | (while alist | |
5294 | (when (string-match regexp (setq group (gnus-info-group (pop alist)))) | |
5295 | (gnus-group-set-mark group)))) | |
5296 | (gnus-group-position-point)) | |
5297 | ||
41487370 | 5298 | (defun gnus-group-remove-mark (group) |
231f989b LMI |
5299 | "Remove the process mark from GROUP and move point there. |
5300 | Return nil if the group isn't displayed." | |
5301 | (if (gnus-group-goto-group group) | |
5302 | (save-excursion | |
5303 | (gnus-group-mark-group 1 'unmark t) | |
5304 | t) | |
5305 | (setq gnus-group-marked | |
5306 | (delete group gnus-group-marked)) | |
5307 | nil)) | |
5308 | ||
5309 | (defun gnus-group-set-mark (group) | |
5310 | "Set the process mark on GROUP." | |
5311 | (if (gnus-group-goto-group group) | |
5312 | (save-excursion | |
5313 | (gnus-group-mark-group 1 nil t)) | |
5314 | (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) | |
5315 | ||
5316 | (defun gnus-group-universal-argument (arg &optional groups func) | |
5317 | "Perform any command on all groups accoring to the process/prefix convention." | |
5318 | (interactive "P") | |
5319 | (let ((groups (or groups (gnus-group-process-prefix arg))) | |
5320 | group func) | |
5321 | (if (eq (setq func (or func | |
5322 | (key-binding | |
5323 | (read-key-sequence | |
5324 | (substitute-command-keys | |
5325 | "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]"))))) | |
5326 | 'undefined) | |
5327 | (gnus-error 1 "Undefined key") | |
5328 | (while groups | |
5329 | (gnus-group-remove-mark (setq group (pop groups))) | |
5330 | (command-execute func)))) | |
5331 | (gnus-group-position-point)) | |
41487370 | 5332 | |
41487370 | 5333 | (defun gnus-group-process-prefix (n) |
231f989b LMI |
5334 | "Return a list of groups to work on. |
5335 | Take into consideration N (the prefix) and the list of marked groups." | |
5336 | (cond | |
5337 | (n | |
5338 | (setq n (prefix-numeric-value n)) | |
5339 | ;; There is a prefix, so we return a list of the N next | |
5340 | ;; groups. | |
5341 | (let ((way (if (< n 0) -1 1)) | |
5342 | (n (abs n)) | |
5343 | group groups) | |
5344 | (save-excursion | |
5345 | (while (and (> n 0) | |
5346 | (setq group (gnus-group-group-name))) | |
5347 | (setq groups (cons group groups)) | |
5348 | (setq n (1- n)) | |
5349 | (gnus-group-next-group way))) | |
5350 | (nreverse groups))) | |
5351 | ((and (boundp 'transient-mark-mode) | |
5352 | transient-mark-mode | |
5353 | (boundp 'mark-active) | |
5354 | mark-active) | |
5355 | ;; Work on the region between point and mark. | |
5356 | (let ((max (max (point) (mark))) | |
5357 | groups) | |
5358 | (save-excursion | |
5359 | (goto-char (min (point) (mark))) | |
5360 | (while | |
5361 | (and | |
5362 | (push (gnus-group-group-name) groups) | |
5363 | (zerop (gnus-group-next-group 1)) | |
5364 | (< (point) max))) | |
5365 | (nreverse groups)))) | |
5366 | (gnus-group-marked | |
5367 | ;; No prefix, but a list of marked articles. | |
5368 | (reverse gnus-group-marked)) | |
5369 | (t | |
5370 | ;; Neither marked articles or a prefix, so we return the | |
5371 | ;; current group. | |
5372 | (let ((group (gnus-group-group-name))) | |
5373 | (and group (list group)))))) | |
41487370 LMI |
5374 | |
5375 | ;; Selecting groups. | |
5376 | ||
5377 | (defun gnus-group-read-group (&optional all no-article group) | |
5378 | "Read news in this newsgroup. | |
5379 | If the prefix argument ALL is non-nil, already read articles become | |
231f989b LMI |
5380 | readable. IF ALL is a number, fetch this number of articles. If the |
5381 | optional argument NO-ARTICLE is non-nil, no article will be | |
5382 | auto-selected upon group entry. If GROUP is non-nil, fetch that | |
5383 | group." | |
41487370 LMI |
5384 | (interactive "P") |
5385 | (let ((group (or group (gnus-group-group-name))) | |
5386 | number active marked entry) | |
5387 | (or group (error "No group on current line")) | |
231f989b LMI |
5388 | (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash |
5389 | group gnus-newsrc-hashtb))))) | |
5390 | ;; This group might be a dead group. In that case we have to get | |
41487370 | 5391 | ;; the number of unread articles from `gnus-active-hashtb'. |
231f989b LMI |
5392 | (setq number |
5393 | (cond ((numberp all) all) | |
5394 | (entry (car entry)) | |
5395 | ((setq active (gnus-active group)) | |
5396 | (- (1+ (cdr active)) (car active))))) | |
5397 | (gnus-summary-read-group | |
5398 | group (or all (and (numberp number) | |
05066a92 LMI |
5399 | (zerop (+ number (gnus-range-length |
5400 | (cdr (assq 'tick marked))) | |
5401 | (gnus-range-length | |
5402 | (cdr (assq 'dormant marked))))))) | |
41487370 LMI |
5403 | no-article))) |
5404 | ||
5405 | (defun gnus-group-select-group (&optional all) | |
5406 | "Select this newsgroup. | |
745bc783 | 5407 | No article is selected automatically. |
231f989b LMI |
5408 | If ALL is non-nil, already read articles become readable. |
5409 | If ALL is a number, fetch this number of articles." | |
745bc783 | 5410 | (interactive "P") |
b027f415 | 5411 | (gnus-group-read-group all t)) |
745bc783 | 5412 | |
231f989b LMI |
5413 | (defun gnus-group-quick-select-group (&optional all) |
5414 | "Select the current group \"quickly\". | |
5415 | This means that no highlighting or scoring will be performed." | |
5416 | (interactive "P") | |
5417 | (let (gnus-visual | |
5418 | gnus-score-find-score-files-function | |
5419 | gnus-apply-kill-hook | |
5420 | gnus-summary-expunge-below) | |
5421 | (gnus-group-read-group all t))) | |
5422 | ||
5423 | (defun gnus-group-visible-select-group (&optional all) | |
5424 | "Select the current group without hiding any articles." | |
5425 | (interactive "P") | |
5426 | (let ((gnus-inhibit-limiting t)) | |
5427 | (gnus-group-read-group all t))) | |
5428 | ||
5429 | ;;;###autoload | |
5430 | (defun gnus-fetch-group (group) | |
5431 | "Start Gnus if necessary and enter GROUP. | |
5432 | Returns whether the fetching was successful or not." | |
5433 | (interactive "sGroup name: ") | |
5434 | (or (get-buffer gnus-group-buffer) | |
5435 | (gnus)) | |
5436 | (gnus-group-read-group nil nil group)) | |
41487370 | 5437 | |
231f989b | 5438 | ;; Enter a group that is not in the group buffer. Non-nil is returned |
41487370 | 5439 | ;; if selection was successful. |
231f989b | 5440 | (defun gnus-group-read-ephemeral-group |
41487370 LMI |
5441 | (group method &optional activate quit-config) |
5442 | (let ((group (if (gnus-group-foreign-p group) group | |
5443 | (gnus-group-prefixed-name group method)))) | |
231f989b | 5444 | (gnus-sethash |
41487370 | 5445 | group |
231f989b LMI |
5446 | `(t nil (,group ,gnus-level-default-subscribed nil nil ,method |
5447 | ((quit-config . ,(if quit-config quit-config | |
5448 | (cons (current-buffer) 'summary)))))) | |
41487370 LMI |
5449 | gnus-newsrc-hashtb) |
5450 | (set-buffer gnus-group-buffer) | |
5451 | (or (gnus-check-server method) | |
5452 | (error "Unable to contact server: %s" (gnus-status-message method))) | |
5453 | (if activate (or (gnus-request-group group) | |
5454 | (error "Couldn't request group"))) | |
5455 | (condition-case () | |
5456 | (gnus-group-read-group t t group) | |
5457 | (error nil) | |
231f989b LMI |
5458 | (quit nil)))) |
5459 | ||
b027f415 | 5460 | (defun gnus-group-jump-to-group (group) |
745bc783 | 5461 | "Jump to newsgroup GROUP." |
231f989b LMI |
5462 | (interactive |
5463 | (list (completing-read | |
5464 | "Group: " gnus-active-hashtb nil | |
5465 | (gnus-read-active-file-p) | |
5466 | nil | |
5467 | 'gnus-group-history))) | |
5468 | ||
5469 | (when (equal group "") | |
5470 | (error "Empty group name")) | |
5471 | ||
5472 | (when (string-match "[\000-\032]" group) | |
5473 | (error "Control characters in group: %s" group)) | |
5474 | ||
5475 | (let ((b (text-property-any | |
5476 | (point-min) (point-max) | |
5477 | 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) | |
5478 | (unless (gnus-ephemeral-group-p group) | |
5479 | (if b | |
5480 | ;; Either go to the line in the group buffer... | |
5481 | (goto-char b) | |
5482 | ;; ... or insert the line. | |
5483 | (or | |
5484 | (gnus-active group) | |
5485 | (gnus-activate-group group) | |
5486 | (error "%s error: %s" group (gnus-status-message group))) | |
5487 | ||
5488 | (gnus-group-update-group group) | |
5489 | (goto-char (text-property-any | |
5490 | (point-min) (point-max) | |
5491 | 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) | |
5492 | ;; Adjust cursor point. | |
5493 | (gnus-group-position-point))) | |
41487370 LMI |
5494 | |
5495 | (defun gnus-group-goto-group (group) | |
5496 | "Goto to newsgroup GROUP." | |
231f989b LMI |
5497 | (when group |
5498 | (let ((b (text-property-any (point-min) (point-max) | |
5499 | 'gnus-group (gnus-intern-safe | |
5500 | group gnus-active-hashtb)))) | |
5501 | (and b (goto-char b))))) | |
745bc783 | 5502 | |
b027f415 | 5503 | (defun gnus-group-next-group (n) |
41487370 LMI |
5504 | "Go to next N'th newsgroup. |
5505 | If N is negative, search backward instead. | |
5506 | Returns the difference between N and the number of skips actually | |
5507 | done." | |
745bc783 | 5508 | (interactive "p") |
41487370 LMI |
5509 | (gnus-group-next-unread-group n t)) |
5510 | ||
5511 | (defun gnus-group-next-unread-group (n &optional all level) | |
5512 | "Go to next N'th unread newsgroup. | |
5513 | If N is negative, search backward instead. | |
5514 | If ALL is non-nil, choose any newsgroup, unread or not. | |
5515 | If LEVEL is non-nil, choose the next group with level LEVEL, or, if no | |
5516 | such group can be found, the next group with a level higher than | |
5517 | LEVEL. | |
5518 | Returns the difference between N and the number of skips actually | |
5519 | made." | |
745bc783 | 5520 | (interactive "p") |
41487370 LMI |
5521 | (let ((backward (< n 0)) |
5522 | (n (abs n))) | |
5523 | (while (and (> n 0) | |
231f989b | 5524 | (gnus-group-search-forward |
41487370 LMI |
5525 | backward (or (not gnus-group-goto-unread) all) level)) |
5526 | (setq n (1- n))) | |
5527 | (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") | |
5528 | (if level " on this level or higher" ""))) | |
5529 | n)) | |
745bc783 | 5530 | |
b027f415 | 5531 | (defun gnus-group-prev-group (n) |
41487370 LMI |
5532 | "Go to previous N'th newsgroup. |
5533 | Returns the difference between N and the number of skips actually | |
5534 | done." | |
745bc783 | 5535 | (interactive "p") |
41487370 | 5536 | (gnus-group-next-unread-group (- n) t)) |
745bc783 | 5537 | |
b027f415 | 5538 | (defun gnus-group-prev-unread-group (n) |
41487370 LMI |
5539 | "Go to previous N'th unread newsgroup. |
5540 | Returns the difference between N and the number of skips actually | |
231f989b | 5541 | done." |
745bc783 | 5542 | (interactive "p") |
41487370 | 5543 | (gnus-group-next-unread-group (- n))) |
745bc783 | 5544 | |
41487370 LMI |
5545 | (defun gnus-group-next-unread-group-same-level (n) |
5546 | "Go to next N'th unread newsgroup on the same level. | |
5547 | If N is negative, search backward instead. | |
5548 | Returns the difference between N and the number of skips actually | |
5549 | done." | |
5550 | (interactive "p") | |
5551 | (gnus-group-next-unread-group n t (gnus-group-group-level)) | |
231f989b | 5552 | (gnus-group-position-point)) |
41487370 LMI |
5553 | |
5554 | (defun gnus-group-prev-unread-group-same-level (n) | |
5555 | "Go to next N'th unread newsgroup on the same level. | |
5556 | Returns the difference between N and the number of skips actually | |
5557 | done." | |
5558 | (interactive "p") | |
5559 | (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) | |
231f989b | 5560 | (gnus-group-position-point)) |
41487370 LMI |
5561 | |
5562 | (defun gnus-group-best-unread-group (&optional exclude-group) | |
5563 | "Go to the group with the highest level. | |
5564 | If EXCLUDE-GROUP, do not go to that group." | |
5565 | (interactive) | |
5566 | (goto-char (point-min)) | |
5567 | (let ((best 100000) | |
5568 | unread best-point) | |
231f989b LMI |
5569 | (while (not (eobp)) |
5570 | (setq unread (get-text-property (point) 'gnus-unread)) | |
41487370 LMI |
5571 | (if (and (numberp unread) (> unread 0)) |
5572 | (progn | |
231f989b LMI |
5573 | (if (and (get-text-property (point) 'gnus-level) |
5574 | (< (get-text-property (point) 'gnus-level) best) | |
41487370 LMI |
5575 | (or (not exclude-group) |
5576 | (not (equal exclude-group (gnus-group-group-name))))) | |
231f989b | 5577 | (progn |
41487370 LMI |
5578 | (setq best (get-text-property (point) 'gnus-level)) |
5579 | (setq best-point (point)))))) | |
5580 | (forward-line 1)) | |
5581 | (if best-point (goto-char best-point)) | |
231f989b | 5582 | (gnus-summary-position-point) |
41487370 LMI |
5583 | (and best-point (gnus-group-group-name)))) |
5584 | ||
5585 | (defun gnus-group-first-unread-group () | |
5586 | "Go to the first group with unread articles." | |
5587 | (interactive) | |
5588 | (prog1 | |
5589 | (let ((opoint (point)) | |
5590 | unread) | |
5591 | (goto-char (point-min)) | |
5592 | (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. | |
231f989b LMI |
5593 | (and (numberp unread) ; Not a topic. |
5594 | (not (zerop unread))) ; Has unread articles. | |
41487370 LMI |
5595 | (zerop (gnus-group-next-unread-group 1))) ; Next unread group. |
5596 | (point) ; Success. | |
5597 | (goto-char opoint) | |
5598 | nil)) ; Not success. | |
231f989b | 5599 | (gnus-group-position-point))) |
41487370 LMI |
5600 | |
5601 | (defun gnus-group-enter-server-mode () | |
5602 | "Jump to the server buffer." | |
745bc783 | 5603 | (interactive) |
231f989b | 5604 | (gnus-enter-server-buffer)) |
41487370 LMI |
5605 | |
5606 | (defun gnus-group-make-group (name &optional method address) | |
5607 | "Add a new newsgroup. | |
5608 | The user will be prompted for a NAME, for a select METHOD, and an | |
5609 | ADDRESS." | |
5610 | (interactive | |
231f989b | 5611 | (cons |
41487370 LMI |
5612 | (read-string "Group name: ") |
5613 | (let ((method | |
231f989b | 5614 | (completing-read |
41487370 | 5615 | "Method: " (append gnus-valid-select-methods gnus-server-alist) |
231f989b LMI |
5616 | nil t nil 'gnus-method-history))) |
5617 | (cond ((assoc method gnus-valid-select-methods) | |
5618 | (list method | |
5619 | (if (memq 'prompt-address | |
5620 | (assoc method gnus-valid-select-methods)) | |
5621 | (read-string "Address: ") | |
5622 | ""))) | |
5623 | ((assoc method gnus-server-alist) | |
5624 | (list method)) | |
5625 | (t | |
5626 | (list method "")))))) | |
5627 | ||
5628 | (let* ((meth (and method (if address (list (intern method) address) | |
5629 | method))) | |
41487370 | 5630 | (nname (if method (gnus-group-prefixed-name name meth) name)) |
231f989b LMI |
5631 | backend info) |
5632 | (when (gnus-gethash nname gnus-newsrc-hashtb) | |
5633 | (error "Group %s already exists" nname)) | |
5634 | ;; Subscribe to the new group. | |
5635 | (gnus-group-change-level | |
41487370 | 5636 | (setq info (list t nname gnus-level-default-subscribed nil nil meth)) |
231f989b | 5637 | gnus-level-default-subscribed gnus-level-killed |
41487370 LMI |
5638 | (and (gnus-group-group-name) |
5639 | (gnus-gethash (gnus-group-group-name) | |
5640 | gnus-newsrc-hashtb)) | |
5641 | t) | |
231f989b LMI |
5642 | ;; Make it active. |
5643 | (gnus-set-active nname (cons 1 0)) | |
41487370 | 5644 | (or (gnus-ephemeral-group-p name) |
231f989b | 5645 | (gnus-dribble-enter |
41487370 | 5646 | (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) |
231f989b | 5647 | ;; Insert the line. |
41487370 | 5648 | (gnus-group-insert-group-line-info nname) |
231f989b LMI |
5649 | (forward-line -1) |
5650 | (gnus-group-position-point) | |
5651 | ||
5652 | ;; Load the backend and try to make the backend create | |
5653 | ;; the group as well. | |
5654 | (when (assoc (symbol-name (setq backend (car (gnus-server-get-method | |
5655 | nil meth)))) | |
5656 | gnus-valid-select-methods) | |
5657 | (require backend)) | |
5658 | (gnus-check-server meth) | |
41487370 | 5659 | (and (gnus-check-backend-function 'request-create-group nname) |
231f989b LMI |
5660 | (gnus-request-create-group nname)) |
5661 | t)) | |
5662 | ||
5663 | (defun gnus-group-delete-group (group &optional force) | |
5664 | "Delete the current group. Only meaningful with mail groups. | |
5665 | If FORCE (the prefix) is non-nil, all the articles in the group will | |
5666 | be deleted. This is \"deleted\" as in \"removed forever from the face | |
5667 | of the Earth\". There is no undo. The user will be prompted before | |
5668 | doing the deletion." | |
5669 | (interactive | |
5670 | (list (gnus-group-group-name) | |
5671 | current-prefix-arg)) | |
5672 | (or group (error "No group to rename")) | |
5673 | (or (gnus-check-backend-function 'request-delete-group group) | |
5674 | (error "This backend does not support group deletion")) | |
5675 | (prog1 | |
5676 | (if (not (gnus-yes-or-no-p | |
5677 | (format | |
5678 | "Do you really want to delete %s%s? " | |
5679 | group (if force " and all its contents" "")))) | |
5680 | () ; Whew! | |
5681 | (gnus-message 6 "Deleting group %s..." group) | |
5682 | (if (not (gnus-request-delete-group group force)) | |
5683 | (gnus-error 3 "Couldn't delete group %s" group) | |
5684 | (gnus-message 6 "Deleting group %s...done" group) | |
5685 | (gnus-group-goto-group group) | |
5686 | (gnus-group-kill-group 1 t) | |
5687 | (gnus-sethash group nil gnus-active-hashtb) | |
5688 | t)) | |
5689 | (gnus-group-position-point))) | |
5690 | ||
5691 | (defun gnus-group-rename-group (group new-name) | |
5692 | (interactive | |
5693 | (list | |
5694 | (gnus-group-group-name) | |
5695 | (progn | |
5696 | (or (gnus-check-backend-function | |
5697 | 'request-rename-group (gnus-group-group-name)) | |
5698 | (error "This backend does not support renaming groups")) | |
5699 | (read-string "New group name: ")))) | |
5700 | ||
5701 | (or (gnus-check-backend-function 'request-rename-group group) | |
5702 | (error "This backend does not support renaming groups")) | |
5703 | ||
5704 | (or group (error "No group to rename")) | |
5705 | (and (string-match "^[ \t]*$" new-name) | |
5706 | (error "Not a valid group name")) | |
5707 | ||
5708 | ;; We find the proper prefixed name. | |
5709 | (setq new-name | |
5710 | (gnus-group-prefixed-name | |
5711 | (gnus-group-real-name new-name) | |
5712 | (gnus-info-method (gnus-get-info group)))) | |
5713 | ||
5714 | (gnus-message 6 "Renaming group %s to %s..." group new-name) | |
5715 | (prog1 | |
5716 | (if (not (gnus-request-rename-group group new-name)) | |
5717 | (gnus-error 3 "Couldn't rename group %s to %s" group new-name) | |
5718 | ;; We rename the group internally by killing it... | |
5719 | (gnus-group-goto-group group) | |
5720 | (gnus-group-kill-group) | |
5721 | ;; ... changing its name ... | |
5722 | (setcar (cdar gnus-list-of-killed-groups) new-name) | |
5723 | ;; ... and then yanking it. Magic! | |
5724 | (gnus-group-yank-group) | |
5725 | (gnus-set-active new-name (gnus-active group)) | |
5726 | (gnus-message 6 "Renaming group %s to %s...done" group new-name) | |
5727 | new-name) | |
5728 | (gnus-group-position-point))) | |
41487370 LMI |
5729 | |
5730 | (defun gnus-group-edit-group (group &optional part) | |
5731 | "Edit the group on the current line." | |
5732 | (interactive (list (gnus-group-group-name))) | |
231f989b LMI |
5733 | (let* ((part (or part 'info)) |
5734 | (done-func `(lambda () | |
5735 | "Exit editing mode and update the information." | |
5736 | (interactive) | |
5737 | (gnus-group-edit-group-done ',part ,group))) | |
5738 | (winconf (current-window-configuration)) | |
5739 | info) | |
41487370 | 5740 | (or group (error "No group on current line")) |
231f989b | 5741 | (or (setq info (gnus-get-info group)) |
41487370 LMI |
5742 | (error "Killed group; can't be edited")) |
5743 | (set-buffer (get-buffer-create gnus-group-edit-buffer)) | |
5744 | (gnus-configure-windows 'edit-group) | |
5745 | (gnus-add-current-to-buffer-list) | |
5746 | (emacs-lisp-mode) | |
5747 | ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. | |
5748 | (use-local-map (copy-keymap emacs-lisp-mode-map)) | |
5749 | (local-set-key "\C-c\C-c" done-func) | |
5750 | (make-local-variable 'gnus-prev-winconf) | |
5751 | (setq gnus-prev-winconf winconf) | |
41487370 LMI |
5752 | (erase-buffer) |
5753 | (insert | |
231f989b | 5754 | (cond |
41487370 LMI |
5755 | ((eq part 'method) |
5756 | ";; Type `C-c C-c' after editing the select method.\n\n") | |
5757 | ((eq part 'params) | |
5758 | ";; Type `C-c C-c' after editing the group parameters.\n\n") | |
5759 | ((eq part 'info) | |
5760 | ";; Type `C-c C-c' after editing the group info.\n\n"))) | |
231f989b LMI |
5761 | (insert |
5762 | (pp-to-string | |
5763 | (cond ((eq part 'method) | |
5764 | (or (gnus-info-method info) "native")) | |
5765 | ((eq part 'params) | |
5766 | (gnus-info-params info)) | |
5767 | (t info))) | |
5768 | "\n"))) | |
41487370 LMI |
5769 | |
5770 | (defun gnus-group-edit-group-method (group) | |
5771 | "Edit the select method of GROUP." | |
5772 | (interactive (list (gnus-group-group-name))) | |
5773 | (gnus-group-edit-group group 'method)) | |
5774 | ||
5775 | (defun gnus-group-edit-group-parameters (group) | |
5776 | "Edit the group parameters of GROUP." | |
5777 | (interactive (list (gnus-group-group-name))) | |
5778 | (gnus-group-edit-group group 'params)) | |
5779 | ||
5780 | (defun gnus-group-edit-group-done (part group) | |
5781 | "Get info from buffer, update variables and jump to the group buffer." | |
5782 | (set-buffer (get-buffer-create gnus-group-edit-buffer)) | |
5783 | (goto-char (point-min)) | |
231f989b LMI |
5784 | (let* ((form (read (current-buffer))) |
5785 | (winconf gnus-prev-winconf) | |
5786 | (method (cond ((eq part 'info) (nth 4 form)) | |
5787 | ((eq part 'method) form) | |
5788 | (t nil))) | |
5789 | (info (cond ((eq part 'info) form) | |
5790 | ((eq part 'method) (gnus-get-info group)) | |
5791 | (t nil))) | |
5792 | (new-group (if info | |
5793 | (if (or (not method) | |
5794 | (gnus-server-equal | |
5795 | gnus-select-method method)) | |
5796 | (gnus-group-real-name (car info)) | |
5797 | (gnus-group-prefixed-name | |
5798 | (gnus-group-real-name (car info)) method)) | |
5799 | nil))) | |
5800 | (when (and new-group | |
5801 | (not (equal new-group group))) | |
5802 | (when (gnus-group-goto-group group) | |
5803 | (gnus-group-kill-group 1)) | |
5804 | (gnus-activate-group new-group)) | |
5805 | ;; Set the info. | |
5806 | (if (and info new-group) | |
5807 | (progn | |
5808 | (setq info (gnus-copy-sequence info)) | |
5809 | (setcar info new-group) | |
5810 | (unless (gnus-server-equal method "native") | |
5811 | (unless (nthcdr 3 info) | |
5812 | (nconc info (list nil nil))) | |
5813 | (unless (nthcdr 4 info) | |
5814 | (nconc info (list nil))) | |
5815 | (gnus-info-set-method info method)) | |
5816 | (gnus-group-set-info info)) | |
5817 | (gnus-group-set-info form (or new-group group) part)) | |
41487370 LMI |
5818 | (kill-buffer (current-buffer)) |
5819 | (and winconf (set-window-configuration winconf)) | |
5820 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
5821 | (gnus-group-update-group (or new-group group)) |
5822 | (gnus-group-position-point))) | |
745bc783 | 5823 | |
41487370 LMI |
5824 | (defun gnus-group-make-help-group () |
5825 | "Create the Gnus documentation group." | |
745bc783 | 5826 | (interactive) |
231f989b | 5827 | (let ((path load-path) |
41487370 | 5828 | (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) |
231f989b | 5829 | file dir) |
41487370 LMI |
5830 | (and (gnus-gethash name gnus-newsrc-hashtb) |
5831 | (error "Documentation group already exists")) | |
231f989b LMI |
5832 | (while path |
5833 | (setq dir (file-name-as-directory (expand-file-name (pop path))) | |
5834 | file nil) | |
5835 | (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt"))) | |
5836 | (file-exists-p | |
5837 | (setq file (concat (file-name-directory | |
5838 | (directory-file-name dir)) | |
5839 | "etc/gnus-tut.txt")))) | |
5840 | (setq path nil))) | |
5841 | (if (not file) | |
5842 | (gnus-message 1 "Couldn't find doc group") | |
5843 | (gnus-group-make-group | |
41487370 | 5844 | (gnus-group-real-name name) |
231f989b | 5845 | (list 'nndoc "gnus-help" |
41487370 LMI |
5846 | (list 'nndoc-address file) |
5847 | (list 'nndoc-article-type 'mbox))))) | |
231f989b | 5848 | (gnus-group-position-point)) |
41487370 LMI |
5849 | |
5850 | (defun gnus-group-make-doc-group (file type) | |
5851 | "Create a group that uses a single file as the source." | |
231f989b LMI |
5852 | (interactive |
5853 | (list (read-file-name "File name: ") | |
5854 | (and current-prefix-arg 'ask))) | |
5855 | (when (eq type 'ask) | |
5856 | (let ((err "") | |
5857 | char found) | |
5858 | (while (not found) | |
5859 | (message | |
5860 | "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: " | |
5861 | err) | |
5862 | (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) | |
5863 | ((= char ?b) 'babyl) | |
5864 | ((= char ?d) 'digest) | |
5865 | ((= char ?f) 'forward) | |
5866 | ((= char ?a) 'mmfd) | |
5867 | (t (setq err (format "%c unknown. " char)) | |
5868 | nil)))) | |
5869 | (setq type found))) | |
41487370 LMI |
5870 | (let* ((file (expand-file-name file)) |
5871 | (name (gnus-generate-new-group-name | |
5872 | (gnus-group-prefixed-name | |
5873 | (file-name-nondirectory file) '(nndoc ""))))) | |
231f989b | 5874 | (gnus-group-make-group |
41487370 | 5875 | (gnus-group-real-name name) |
231f989b | 5876 | (list 'nndoc (file-name-nondirectory file) |
41487370 | 5877 | (list 'nndoc-address file) |
231f989b | 5878 | (list 'nndoc-article-type (or type 'guess)))))) |
41487370 LMI |
5879 | |
5880 | (defun gnus-group-make-archive-group (&optional all) | |
5881 | "Create the (ding) Gnus archive group of the most recent articles. | |
5882 | Given a prefix, create a full group." | |
5883 | (interactive "P") | |
231f989b | 5884 | (let ((group (gnus-group-prefixed-name |
41487370 LMI |
5885 | (if all "ding.archives" "ding.recent") '(nndir "")))) |
5886 | (and (gnus-gethash group gnus-newsrc-hashtb) | |
5887 | (error "Archive group already exists")) | |
5888 | (gnus-group-make-group | |
5889 | (gnus-group-real-name group) | |
231f989b LMI |
5890 | (list 'nndir (if all "hpc" "edu") |
5891 | (list 'nndir-directory | |
5892 | (if all gnus-group-archive-directory | |
5893 | gnus-group-recent-archive-directory)))))) | |
41487370 LMI |
5894 | |
5895 | (defun gnus-group-make-directory-group (dir) | |
5896 | "Create an nndir group. | |
231f989b LMI |
5897 | The user will be prompted for a directory. The contents of this |
5898 | directory will be used as a newsgroup. The directory should contain | |
41487370 LMI |
5899 | mail messages or news articles in files that have numeric names." |
5900 | (interactive | |
5901 | (list (read-file-name "Create group from directory: "))) | |
5902 | (or (file-exists-p dir) (error "No such directory")) | |
5903 | (or (file-directory-p dir) (error "Not a directory")) | |
231f989b LMI |
5904 | (let ((ext "") |
5905 | (i 0) | |
5906 | group) | |
5907 | (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) | |
5908 | (setq group | |
5909 | (gnus-group-prefixed-name | |
5910 | (concat (file-name-as-directory (directory-file-name dir)) | |
5911 | ext) | |
5912 | '(nndir ""))) | |
5913 | (setq ext (format "<%d>" (setq i (1+ i))))) | |
5914 | (gnus-group-make-group | |
5915 | (gnus-group-real-name group) | |
5916 | (list 'nndir group (list 'nndir-directory dir))))) | |
41487370 LMI |
5917 | |
5918 | (defun gnus-group-make-kiboze-group (group address scores) | |
5919 | "Create an nnkiboze group. | |
5920 | The user will be prompted for a name, a regexp to match groups, and | |
5921 | score file entries for articles to include in the group." | |
5922 | (interactive | |
5923 | (list | |
5924 | (read-string "nnkiboze group name: ") | |
5925 | (read-string "Source groups (regexp): ") | |
5926 | (let ((headers (mapcar (lambda (group) (list group)) | |
5927 | '("subject" "from" "number" "date" "message-id" | |
231f989b LMI |
5928 | "references" "chars" "lines" "xref" |
5929 | "followup" "all" "body" "head"))) | |
41487370 | 5930 | scores header regexp regexps) |
231f989b | 5931 | (while (not (equal "" (setq header (completing-read |
41487370 LMI |
5932 | "Match on header: " headers nil t)))) |
5933 | (setq regexps nil) | |
231f989b | 5934 | (while (not (equal "" (setq regexp (read-string |
41487370 LMI |
5935 | (format "Match on %s (string): " |
5936 | header))))) | |
5937 | (setq regexps (cons (list regexp nil nil 'r) regexps))) | |
5938 | (setq scores (cons (cons header regexps) scores))) | |
5939 | scores))) | |
5940 | (gnus-group-make-group group "nnkiboze" address) | |
231f989b | 5941 | (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) |
41487370 | 5942 | (let (emacs-lisp-mode-hook) |
231f989b | 5943 | (pp scores (current-buffer))))) |
41487370 LMI |
5944 | |
5945 | (defun gnus-group-add-to-virtual (n vgroup) | |
5946 | "Add the current group to a virtual group." | |
5947 | (interactive | |
5948 | (list current-prefix-arg | |
5949 | (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t | |
5950 | "nnvirtual:"))) | |
5951 | (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) | |
5952 | (error "%s is not an nnvirtual group" vgroup)) | |
5953 | (let* ((groups (gnus-group-process-prefix n)) | |
231f989b | 5954 | (method (gnus-info-method (gnus-get-info vgroup)))) |
41487370 | 5955 | (setcar (cdr method) |
231f989b | 5956 | (concat |
41487370 | 5957 | (nth 1 method) "\\|" |
231f989b LMI |
5958 | (mapconcat |
5959 | (lambda (s) | |
41487370 LMI |
5960 | (gnus-group-remove-mark s) |
5961 | (concat "\\(^" (regexp-quote s) "$\\)")) | |
5962 | groups "\\|")))) | |
231f989b | 5963 | (gnus-group-position-point)) |
41487370 LMI |
5964 | |
5965 | (defun gnus-group-make-empty-virtual (group) | |
5966 | "Create a new, fresh, empty virtual group." | |
5967 | (interactive "sCreate new, empty virtual group: ") | |
5968 | (let* ((method (list 'nnvirtual "^$")) | |
5969 | (pgroup (gnus-group-prefixed-name group method))) | |
5970 | ;; Check whether it exists already. | |
5971 | (and (gnus-gethash pgroup gnus-newsrc-hashtb) | |
5972 | (error "Group %s already exists." pgroup)) | |
5973 | ;; Subscribe the new group after the group on the current line. | |
5974 | (gnus-subscribe-group pgroup (gnus-group-group-name) method) | |
5975 | (gnus-group-update-group pgroup) | |
5976 | (forward-line -1) | |
231f989b | 5977 | (gnus-group-position-point))) |
41487370 LMI |
5978 | |
5979 | (defun gnus-group-enter-directory (dir) | |
5980 | "Enter an ephemeral nneething group." | |
5981 | (interactive "DDirectory to read: ") | |
a081f202 | 5982 | (let* ((method (list 'nneething dir '(nneething-read-only t))) |
41487370 LMI |
5983 | (leaf (gnus-group-prefixed-name |
5984 | (file-name-nondirectory (directory-file-name dir)) | |
5985 | method)) | |
5986 | (name (gnus-generate-new-group-name leaf))) | |
c415589d LMI |
5987 | (unless (gnus-group-read-ephemeral-group |
5988 | name method t | |
5989 | (cons (current-buffer) | |
5990 | (if (eq major-mode 'gnus-summary-mode) | |
5991 | 'summary 'group))) | |
5992 | (error "Couldn't enter %s" dir)))) | |
41487370 LMI |
5993 | |
5994 | ;; Group sorting commands | |
5995 | ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. | |
5996 | ||
231f989b LMI |
5997 | (defun gnus-group-sort-groups (func &optional reverse) |
5998 | "Sort the group buffer according to FUNC. | |
5999 | If REVERSE, reverse the sorting order." | |
6000 | (interactive (list gnus-group-sort-function | |
6001 | current-prefix-arg)) | |
6002 | (let ((func (cond | |
6003 | ((not (listp func)) func) | |
6004 | ((null func) func) | |
6005 | ((= 1 (length func)) (car func)) | |
6006 | (t `(lambda (t1 t2) | |
6007 | ,(gnus-make-sort-function | |
6008 | (reverse func))))))) | |
6009 | ;; We peel off the dummy group from the alist. | |
6010 | (when func | |
6011 | (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") | |
6012 | (pop gnus-newsrc-alist)) | |
6013 | ;; Do the sorting. | |
6014 | (setq gnus-newsrc-alist | |
6015 | (sort gnus-newsrc-alist func)) | |
6016 | (when reverse | |
6017 | (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) | |
6018 | ;; Regenerate the hash table. | |
6019 | (gnus-make-hashtable-from-newsrc-alist) | |
6020 | (gnus-group-list-groups)))) | |
6021 | ||
6022 | (defun gnus-group-sort-groups-by-alphabet (&optional reverse) | |
6023 | "Sort the group buffer alphabetically by group name. | |
6024 | If REVERSE, sort in reverse order." | |
6025 | (interactive "P") | |
6026 | (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) | |
6027 | ||
6028 | (defun gnus-group-sort-groups-by-unread (&optional reverse) | |
6029 | "Sort the group buffer by number of unread articles. | |
6030 | If REVERSE, sort in reverse order." | |
6031 | (interactive "P") | |
6032 | (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) | |
6033 | ||
6034 | (defun gnus-group-sort-groups-by-level (&optional reverse) | |
6035 | "Sort the group buffer by group level. | |
6036 | If REVERSE, sort in reverse order." | |
6037 | (interactive "P") | |
6038 | (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) | |
6039 | ||
6040 | (defun gnus-group-sort-groups-by-score (&optional reverse) | |
6041 | "Sort the group buffer by group score. | |
6042 | If REVERSE, sort in reverse order." | |
6043 | (interactive "P") | |
6044 | (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) | |
6045 | ||
6046 | (defun gnus-group-sort-groups-by-rank (&optional reverse) | |
6047 | "Sort the group buffer by group rank. | |
6048 | If REVERSE, sort in reverse order." | |
6049 | (interactive "P") | |
6050 | (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) | |
6051 | ||
6052 | (defun gnus-group-sort-groups-by-method (&optional reverse) | |
6053 | "Sort the group buffer alphabetically by backend name. | |
6054 | If REVERSE, sort in reverse order." | |
6055 | (interactive "P") | |
6056 | (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) | |
745bc783 | 6057 | |
41487370 | 6058 | (defun gnus-group-sort-by-alphabet (info1 info2) |
231f989b LMI |
6059 | "Sort alphabetically." |
6060 | (string< (gnus-info-group info1) (gnus-info-group info2))) | |
41487370 LMI |
6061 | |
6062 | (defun gnus-group-sort-by-unread (info1 info2) | |
231f989b LMI |
6063 | "Sort by number of unread articles." |
6064 | (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) | |
6065 | (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) | |
41487370 LMI |
6066 | (< (or (and (numberp n1) n1) 0) |
6067 | (or (and (numberp n2) n2) 0)))) | |
6068 | ||
6069 | (defun gnus-group-sort-by-level (info1 info2) | |
231f989b LMI |
6070 | "Sort by level." |
6071 | (< (gnus-info-level info1) (gnus-info-level info2))) | |
6072 | ||
6073 | (defun gnus-group-sort-by-method (info1 info2) | |
6074 | "Sort alphabetically by backend name." | |
6075 | (string< (symbol-name (car (gnus-find-method-for-group | |
6076 | (gnus-info-group info1) info1))) | |
6077 | (symbol-name (car (gnus-find-method-for-group | |
6078 | (gnus-info-group info2) info2))))) | |
6079 | ||
6080 | (defun gnus-group-sort-by-score (info1 info2) | |
6081 | "Sort by group score." | |
6082 | (< (gnus-info-score info1) (gnus-info-score info2))) | |
6083 | ||
6084 | (defun gnus-group-sort-by-rank (info1 info2) | |
6085 | "Sort by level and score." | |
6086 | (let ((level1 (gnus-info-level info1)) | |
6087 | (level2 (gnus-info-level info2))) | |
6088 | (or (< level1 level2) | |
6089 | (and (= level1 level2) | |
6090 | (> (gnus-info-score info1) (gnus-info-score info2)))))) | |
41487370 LMI |
6091 | |
6092 | ;; Group catching up. | |
6093 | ||
231f989b LMI |
6094 | (defun gnus-group-clear-data (n) |
6095 | "Clear all marks and read ranges from the current group." | |
6096 | (interactive "P") | |
6097 | (let ((groups (gnus-group-process-prefix n)) | |
6098 | group info) | |
6099 | (while (setq group (pop groups)) | |
6100 | (setq info (gnus-get-info group)) | |
6101 | (gnus-info-set-read info nil) | |
6102 | (when (gnus-info-marks info) | |
6103 | (gnus-info-set-marks info nil)) | |
6104 | (gnus-get-unread-articles-in-group info (gnus-active group) t) | |
6105 | (when (gnus-group-goto-group group) | |
6106 | (gnus-group-remove-mark group) | |
6107 | (gnus-group-update-group-line))))) | |
6108 | ||
41487370 LMI |
6109 | (defun gnus-group-catchup-current (&optional n all) |
6110 | "Mark all articles not marked as unread in current newsgroup as read. | |
6111 | If prefix argument N is numeric, the ARG next newsgroups will be | |
231f989b LMI |
6112 | caught up. If ALL is non-nil, marked articles will also be marked as |
6113 | read. Cross references (Xref: header) of articles are ignored. | |
41487370 LMI |
6114 | The difference between N and actual number of newsgroups that were |
6115 | caught up is returned." | |
6116 | (interactive "P") | |
231f989b LMI |
6117 | (unless (gnus-group-group-name) |
6118 | (error "No group on the current line")) | |
41487370 LMI |
6119 | (if (not (or (not gnus-interactive-catchup) ;Without confirmation? |
6120 | gnus-expert-user | |
6121 | (gnus-y-or-n-p | |
6122 | (if all | |
6123 | "Do you really want to mark all articles as read? " | |
6124 | "Mark all unread articles as read? ")))) | |
6125 | n | |
6126 | (let ((groups (gnus-group-process-prefix n)) | |
6127 | (ret 0)) | |
6128 | (while groups | |
231f989b | 6129 | ;; Virtual groups have to be given special treatment. |
41487370 LMI |
6130 | (let ((method (gnus-find-method-for-group (car groups)))) |
6131 | (if (eq 'nnvirtual (car method)) | |
6132 | (nnvirtual-catchup-group | |
6133 | (gnus-group-real-name (car groups)) (nth 1 method) all))) | |
6134 | (gnus-group-remove-mark (car groups)) | |
231f989b LMI |
6135 | (if (>= (gnus-group-group-level) gnus-level-zombie) |
6136 | (gnus-message 2 "Dead groups can't be caught up") | |
6137 | (if (prog1 | |
6138 | (gnus-group-goto-group (car groups)) | |
6139 | (gnus-group-catchup (car groups) all)) | |
6140 | (gnus-group-update-group-line) | |
6141 | (setq ret (1+ ret)))) | |
41487370 LMI |
6142 | (setq groups (cdr groups))) |
6143 | (gnus-group-next-unread-group 1) | |
6144 | ret))) | |
6145 | ||
6146 | (defun gnus-group-catchup-current-all (&optional n) | |
6147 | "Mark all articles in current newsgroup as read. | |
6148 | Cross references (Xref: header) of articles are ignored." | |
6149 | (interactive "P") | |
6150 | (gnus-group-catchup-current n 'all)) | |
6151 | ||
6152 | (defun gnus-group-catchup (group &optional all) | |
6153 | "Mark all articles in GROUP as read. | |
6154 | If ALL is non-nil, all articles are marked as read. | |
6155 | The return value is the number of articles that were marked as read, | |
6156 | or nil if no action could be taken." | |
6157 | (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) | |
231f989b LMI |
6158 | (num (car entry))) |
6159 | ;; Do the updating only if the newsgroup isn't killed. | |
41487370 LMI |
6160 | (if (not (numberp (car entry))) |
6161 | (gnus-message 1 "Can't catch up; non-active group") | |
231f989b LMI |
6162 | ;; Do auto-expirable marks if that's required. |
6163 | (when (gnus-group-auto-expirable-p group) | |
6164 | (gnus-add-marked-articles | |
6165 | group 'expire (gnus-list-of-unread-articles group)) | |
6166 | (when all | |
6167 | (let ((marks (nth 3 (nth 2 entry)))) | |
6168 | (gnus-add-marked-articles | |
6169 | group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) | |
6170 | (gnus-add-marked-articles | |
6171 | group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) | |
6172 | (when entry | |
6173 | (gnus-update-read-articles group nil) | |
6174 | ;; Also nix out the lists of marks and dormants. | |
6175 | (when all | |
6176 | (gnus-add-marked-articles group 'tick nil nil 'force) | |
6177 | (gnus-add-marked-articles group 'dormant nil nil 'force)) | |
6178 | (run-hooks 'gnus-group-catchup-group-hook) | |
6179 | num)))) | |
41487370 LMI |
6180 | |
6181 | (defun gnus-group-expire-articles (&optional n) | |
6182 | "Expire all expirable articles in the current newsgroup." | |
6183 | (interactive "P") | |
6184 | (let ((groups (gnus-group-process-prefix n)) | |
6185 | group) | |
231f989b LMI |
6186 | (unless groups |
6187 | (error "No groups to expire")) | |
6188 | (while (setq group (pop groups)) | |
41487370 | 6189 | (gnus-group-remove-mark group) |
231f989b LMI |
6190 | (when (gnus-check-backend-function 'request-expire-articles group) |
6191 | (gnus-message 6 "Expiring articles in %s..." group) | |
6192 | (let* ((info (gnus-get-info group)) | |
6193 | (expirable (if (gnus-group-total-expirable-p group) | |
41487370 | 6194 | (cons nil (gnus-list-of-read-articles group)) |
231f989b LMI |
6195 | (assq 'expire (gnus-info-marks info)))) |
6196 | (expiry-wait (gnus-group-get-parameter group 'expiry-wait))) | |
6197 | (when expirable | |
6198 | (setcdr | |
6199 | expirable | |
6200 | (gnus-compress-sequence | |
6201 | (if expiry-wait | |
6202 | ;; We set the expiry variables to the groupp | |
6203 | ;; parameter. | |
6204 | (let ((nnmail-expiry-wait-function nil) | |
6205 | (nnmail-expiry-wait expiry-wait)) | |
6206 | (gnus-request-expire-articles | |
6207 | (gnus-uncompress-sequence (cdr expirable)) group)) | |
6208 | ;; Just expire using the normal expiry values. | |
6209 | (gnus-request-expire-articles | |
6210 | (gnus-uncompress-sequence (cdr expirable)) group)))) | |
6211 | (gnus-close-group group)) | |
6212 | (gnus-message 6 "Expiring articles in %s...done" group))) | |
6213 | (gnus-group-position-point)))) | |
41487370 LMI |
6214 | |
6215 | (defun gnus-group-expire-all-groups () | |
6216 | "Expire all expirable articles in all newsgroups." | |
6217 | (interactive) | |
6218 | (save-excursion | |
6219 | (gnus-message 5 "Expiring...") | |
231f989b | 6220 | (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) |
41487370 LMI |
6221 | (cdr gnus-newsrc-alist)))) |
6222 | (gnus-group-expire-articles nil))) | |
231f989b | 6223 | (gnus-group-position-point) |
41487370 LMI |
6224 | (gnus-message 5 "Expiring...done")) |
6225 | ||
6226 | (defun gnus-group-set-current-level (n level) | |
6227 | "Set the level of the next N groups to LEVEL." | |
231f989b LMI |
6228 | (interactive |
6229 | (list | |
6230 | current-prefix-arg | |
6231 | (string-to-int | |
6232 | (let ((s (read-string | |
6233 | (format "Level (default %s): " | |
6234 | (or (gnus-group-group-level) | |
6235 | gnus-level-default-subscribed))))) | |
6236 | (if (string-match "^\\s-*$" s) | |
6237 | (int-to-string (or (gnus-group-group-level) | |
6238 | gnus-level-default-subscribed)) | |
6239 | s))))) | |
41487370 LMI |
6240 | (or (and (>= level 1) (<= level gnus-level-killed)) |
6241 | (error "Illegal level: %d" level)) | |
6242 | (let ((groups (gnus-group-process-prefix n)) | |
6243 | group) | |
231f989b | 6244 | (while (setq group (pop groups)) |
41487370 | 6245 | (gnus-group-remove-mark group) |
231f989b LMI |
6246 | (gnus-message 6 "Changed level of %s from %d to %d" |
6247 | group (or (gnus-group-group-level) gnus-level-killed) | |
6248 | level) | |
6249 | (gnus-group-change-level | |
6250 | group level (or (gnus-group-group-level) gnus-level-killed)) | |
41487370 | 6251 | (gnus-group-update-group-line))) |
231f989b | 6252 | (gnus-group-position-point)) |
41487370 LMI |
6253 | |
6254 | (defun gnus-group-unsubscribe-current-group (&optional n) | |
6255 | "Toggle subscription of the current group. | |
6256 | If given numerical prefix, toggle the N next groups." | |
6257 | (interactive "P") | |
6258 | (let ((groups (gnus-group-process-prefix n)) | |
6259 | group) | |
6260 | (while groups | |
6261 | (setq group (car groups) | |
6262 | groups (cdr groups)) | |
6263 | (gnus-group-remove-mark group) | |
6264 | (gnus-group-unsubscribe-group | |
6265 | group (if (<= (gnus-group-group-level) gnus-level-subscribed) | |
6266 | gnus-level-default-unsubscribed | |
231f989b | 6267 | gnus-level-default-subscribed) t) |
41487370 LMI |
6268 | (gnus-group-update-group-line)) |
6269 | (gnus-group-next-group 1))) | |
6270 | ||
231f989b LMI |
6271 | (defun gnus-group-unsubscribe-group (group &optional level silent) |
6272 | "Toggle subscription to GROUP. | |
6273 | Killed newsgroups are subscribed. If SILENT, don't try to update the | |
6274 | group line." | |
745bc783 | 6275 | (interactive |
41487370 | 6276 | (list (completing-read |
231f989b LMI |
6277 | "Group: " gnus-active-hashtb nil |
6278 | (gnus-read-active-file-p) | |
6279 | nil | |
6280 | 'gnus-group-history))) | |
b027f415 | 6281 | (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) |
41487370 LMI |
6282 | (cond |
6283 | ((string-match "^[ \t]$" group) | |
6284 | (error "Empty group name")) | |
6285 | (newsrc | |
6286 | ;; Toggle subscription flag. | |
231f989b LMI |
6287 | (gnus-group-change-level |
6288 | newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) | |
6289 | gnus-level-subscribed) | |
41487370 LMI |
6290 | (1+ gnus-level-subscribed) |
6291 | gnus-level-default-subscribed))) | |
231f989b LMI |
6292 | (unless silent |
6293 | (gnus-group-update-group group))) | |
41487370 | 6294 | ((and (stringp group) |
231f989b LMI |
6295 | (or (not (gnus-read-active-file-p)) |
6296 | (gnus-active group))) | |
41487370 | 6297 | ;; Add new newsgroup. |
231f989b LMI |
6298 | (gnus-group-change-level |
6299 | group | |
6300 | (if level level gnus-level-default-subscribed) | |
6301 | (or (and (member group gnus-zombie-list) | |
6302 | gnus-level-zombie) | |
41487370 LMI |
6303 | gnus-level-killed) |
6304 | (and (gnus-group-group-name) | |
6305 | (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) | |
231f989b LMI |
6306 | (unless silent |
6307 | (gnus-group-update-group group))) | |
41487370 | 6308 | (t (error "No such newsgroup: %s" group))) |
231f989b | 6309 | (gnus-group-position-point))) |
41487370 LMI |
6310 | |
6311 | (defun gnus-group-transpose-groups (n) | |
6312 | "Move the current newsgroup up N places. | |
231f989b LMI |
6313 | If given a negative prefix, move down instead. The difference between |
6314 | N and the number of steps taken is returned." | |
41487370 LMI |
6315 | (interactive "p") |
6316 | (or (gnus-group-group-name) | |
6317 | (error "No group on current line")) | |
6318 | (gnus-group-kill-group 1) | |
6319 | (prog1 | |
6320 | (forward-line (- n)) | |
6321 | (gnus-group-yank-group) | |
231f989b | 6322 | (gnus-group-position-point))) |
41487370 LMI |
6323 | |
6324 | (defun gnus-group-kill-all-zombies () | |
6325 | "Kill all zombie newsgroups." | |
745bc783 | 6326 | (interactive) |
41487370 LMI |
6327 | (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) |
6328 | (setq gnus-zombie-list nil) | |
6329 | (gnus-group-list-groups)) | |
745bc783 | 6330 | |
41487370 LMI |
6331 | (defun gnus-group-kill-region (begin end) |
6332 | "Kill newsgroups in current region (excluding current point). | |
6333 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." | |
6334 | (interactive "r") | |
6335 | (let ((lines | |
6336 | ;; Count lines. | |
6337 | (save-excursion | |
6338 | (count-lines | |
6339 | (progn | |
6340 | (goto-char begin) | |
6341 | (beginning-of-line) | |
6342 | (point)) | |
6343 | (progn | |
6344 | (goto-char end) | |
6345 | (beginning-of-line) | |
6346 | (point)))))) | |
6347 | (goto-char begin) | |
6348 | (beginning-of-line) ;Important when LINES < 1 | |
6349 | (gnus-group-kill-group lines))) | |
6350 | ||
231f989b LMI |
6351 | (defun gnus-group-kill-group (&optional n discard) |
6352 | "Kill the next N groups. | |
41487370 | 6353 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. |
231f989b | 6354 | However, only groups that were alive can be yanked; already killed |
41487370 | 6355 | groups or zombie groups can't be yanked. |
231f989b LMI |
6356 | The return value is the name of the group that was killed, or a list |
6357 | of groups killed." | |
41487370 LMI |
6358 | (interactive "P") |
6359 | (let ((buffer-read-only nil) | |
6360 | (groups (gnus-group-process-prefix n)) | |
231f989b LMI |
6361 | group entry level out) |
6362 | (if (< (length groups) 10) | |
6363 | ;; This is faster when there are few groups. | |
6364 | (while groups | |
6365 | (push (setq group (pop groups)) out) | |
6366 | (gnus-group-remove-mark group) | |
6367 | (setq level (gnus-group-group-level)) | |
6368 | (gnus-delete-line) | |
6369 | (when (and (not discard) | |
6370 | (setq entry (gnus-gethash group gnus-newsrc-hashtb))) | |
6371 | (push (cons (car entry) (nth 2 entry)) | |
6372 | gnus-list-of-killed-groups)) | |
6373 | (gnus-group-change-level | |
6374 | (if entry entry group) gnus-level-killed (if entry nil level))) | |
6375 | ;; If there are lots and lots of groups to be killed, we use | |
6376 | ;; this thing instead. | |
6377 | (let (entry) | |
6378 | (setq groups (nreverse groups)) | |
6379 | (while groups | |
6380 | (gnus-group-remove-mark (setq group (pop groups))) | |
6381 | (gnus-delete-line) | |
6382 | (push group gnus-killed-list) | |
6383 | (setq gnus-newsrc-alist | |
6384 | (delq (assoc group gnus-newsrc-alist) | |
6385 | gnus-newsrc-alist)) | |
6386 | (when gnus-group-change-level-function | |
6387 | (funcall gnus-group-change-level-function group 9 3)) | |
6388 | (cond | |
6389 | ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) | |
6390 | (push (cons (car entry) (nth 2 entry)) | |
6391 | gnus-list-of-killed-groups) | |
6392 | (setcdr (cdr entry) (cdddr entry))) | |
6393 | ((member group gnus-zombie-list) | |
6394 | (setq gnus-zombie-list (delete group gnus-zombie-list))))) | |
6395 | (gnus-make-hashtable-from-newsrc-alist))) | |
6396 | ||
6397 | (gnus-group-position-point) | |
6398 | (if (< (length out) 2) (car out) (nreverse out)))) | |
41487370 LMI |
6399 | |
6400 | (defun gnus-group-yank-group (&optional arg) | |
6401 | "Yank the last newsgroups killed with \\[gnus-group-kill-group], | |
6402 | inserting it before the current newsgroup. The numeric ARG specifies | |
231f989b LMI |
6403 | how many newsgroups are to be yanked. The name of the newsgroup yanked |
6404 | is returned, or (if several groups are yanked) a list of yanked groups | |
6405 | is returned." | |
41487370 | 6406 | (interactive "p") |
231f989b LMI |
6407 | (setq arg (or arg 1)) |
6408 | (let (info group prev out) | |
6409 | (while (>= (decf arg) 0) | |
6410 | (if (not (setq info (pop gnus-list-of-killed-groups))) | |
41487370 | 6411 | (error "No more newsgroups to yank")) |
231f989b | 6412 | (push (setq group (nth 1 info)) out) |
41487370 | 6413 | ;; Find which newsgroup to insert this one before - search |
231f989b | 6414 | ;; backward until something suitable is found. If there are no |
41487370 LMI |
6415 | ;; other newsgroups in this buffer, just make this newsgroup the |
6416 | ;; first newsgroup. | |
6417 | (setq prev (gnus-group-group-name)) | |
231f989b LMI |
6418 | (gnus-group-change-level |
6419 | info (gnus-info-level (cdr info)) gnus-level-killed | |
41487370 LMI |
6420 | (and prev (gnus-gethash prev gnus-newsrc-hashtb)) |
6421 | t) | |
231f989b | 6422 | (gnus-group-insert-group-line-info group)) |
41487370 | 6423 | (forward-line -1) |
231f989b LMI |
6424 | (gnus-group-position-point) |
6425 | (if (< (length out) 2) (car out) (nreverse out)))) | |
6426 | ||
6427 | (defun gnus-group-kill-level (level) | |
6428 | "Kill all groups that is on a certain LEVEL." | |
6429 | (interactive "nKill all groups on level: ") | |
6430 | (cond | |
6431 | ((= level gnus-level-zombie) | |
6432 | (setq gnus-killed-list | |
6433 | (nconc gnus-zombie-list gnus-killed-list)) | |
6434 | (setq gnus-zombie-list nil)) | |
6435 | ((and (< level gnus-level-zombie) | |
6436 | (> level 0) | |
6437 | (or gnus-expert-user | |
6438 | (gnus-yes-or-no-p | |
6439 | (format | |
6440 | "Do you really want to kill all groups on level %d? " | |
6441 | level)))) | |
6442 | (let* ((prev gnus-newsrc-alist) | |
6443 | (alist (cdr prev))) | |
6444 | (while alist | |
564b670b LMI |
6445 | (if (= (gnus-info-level (car alist)) level) |
6446 | (progn | |
6447 | (push (gnus-info-group (car alist)) gnus-killed-list) | |
6448 | (setcdr prev (cdr alist))) | |
231f989b LMI |
6449 | (setq prev alist)) |
6450 | (setq alist (cdr alist))) | |
6451 | (gnus-make-hashtable-from-newsrc-alist) | |
6452 | (gnus-group-list-groups))) | |
6453 | (t | |
6454 | (error "Can't kill; illegal level: %d" level)))) | |
6455 | ||
41487370 LMI |
6456 | (defun gnus-group-list-all-groups (&optional arg) |
6457 | "List all newsgroups with level ARG or lower. | |
6458 | Default is gnus-level-unsubscribed, which lists all subscribed and most | |
6459 | unsubscribed groups." | |
6460 | (interactive "P") | |
6461 | (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) | |
745bc783 | 6462 | |
231f989b LMI |
6463 | ;; Redefine this to list ALL killed groups if prefix arg used. |
6464 | ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). | |
6465 | (defun gnus-group-list-killed (&optional arg) | |
6466 | "List all killed newsgroups in the group buffer. | |
6467 | If ARG is non-nil, list ALL killed groups known to Gnus. This may | |
6468 | entail asking the server for the groups." | |
6469 | (interactive "P") | |
6470 | ;; Find all possible killed newsgroups if arg. | |
6471 | (when arg | |
6472 | (gnus-get-killed-groups)) | |
41487370 LMI |
6473 | (if (not gnus-killed-list) |
6474 | (gnus-message 6 "No killed groups") | |
6475 | (let (gnus-group-list-mode) | |
231f989b | 6476 | (funcall gnus-group-prepare-function |
41487370 LMI |
6477 | gnus-level-killed t gnus-level-killed)) |
6478 | (goto-char (point-min))) | |
231f989b | 6479 | (gnus-group-position-point)) |
41487370 LMI |
6480 | |
6481 | (defun gnus-group-list-zombies () | |
6482 | "List all zombie newsgroups in the group buffer." | |
6483 | (interactive) | |
6484 | (if (not gnus-zombie-list) | |
6485 | (gnus-message 6 "No zombie groups") | |
6486 | (let (gnus-group-list-mode) | |
6487 | (funcall gnus-group-prepare-function | |
6488 | gnus-level-zombie t gnus-level-zombie)) | |
6489 | (goto-char (point-min))) | |
231f989b | 6490 | (gnus-group-position-point)) |
41487370 | 6491 | |
231f989b LMI |
6492 | (defun gnus-group-list-active () |
6493 | "List all groups that are available from the server(s)." | |
6494 | (interactive) | |
6495 | ;; First we make sure that we have really read the active file. | |
6496 | (unless (gnus-read-active-file-p) | |
6497 | (let ((gnus-read-active-file t)) | |
6498 | (gnus-read-active-file))) | |
6499 | ;; Find all groups and sort them. | |
6500 | (let ((groups | |
6501 | (sort | |
6502 | (let (list) | |
6503 | (mapatoms | |
6504 | (lambda (sym) | |
6505 | (and (boundp sym) | |
6506 | (symbol-value sym) | |
6507 | (setq list (cons (symbol-name sym) list)))) | |
6508 | gnus-active-hashtb) | |
6509 | list) | |
6510 | 'string<)) | |
6511 | (buffer-read-only nil)) | |
6512 | (erase-buffer) | |
6513 | (while groups | |
6514 | (gnus-group-insert-group-line-info (pop groups))) | |
6515 | (goto-char (point-min)))) | |
6516 | ||
6517 | (defun gnus-activate-all-groups (level) | |
6518 | "Activate absolutely all groups." | |
6519 | (interactive (list 7)) | |
6520 | (let ((gnus-activate-level level) | |
6521 | (gnus-activate-foreign-newsgroups level)) | |
6522 | (gnus-group-get-new-news))) | |
6523 | ||
6524 | (defun gnus-group-get-new-news (&optional arg) | |
6525 | "Get newly arrived articles. | |
6526 | If ARG is a number, it specifies which levels you are interested in | |
6527 | re-scanning. If ARG is non-nil and not a number, this will force | |
6528 | \"hard\" re-reading of the active files from all servers." | |
41487370 LMI |
6529 | (interactive "P") |
6530 | (run-hooks 'gnus-get-new-news-hook) | |
231f989b LMI |
6531 | ;; We might read in new NoCeM messages here. |
6532 | (when (and gnus-use-nocem | |
6533 | (null arg)) | |
6534 | (gnus-nocem-scan-groups)) | |
6535 | ;; If ARG is not a number, then we read the active file. | |
6536 | (when (and arg (not (numberp arg))) | |
6537 | (let ((gnus-read-active-file t)) | |
6538 | (gnus-read-active-file)) | |
6539 | (setq arg nil)) | |
6540 | ||
41487370 LMI |
6541 | (setq arg (gnus-group-default-level arg t)) |
6542 | (if (and gnus-read-active-file (not arg)) | |
6543 | (progn | |
6544 | (gnus-read-active-file) | |
231f989b | 6545 | (gnus-get-unread-articles arg)) |
41487370 | 6546 | (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) |
231f989b LMI |
6547 | (gnus-get-unread-articles arg))) |
6548 | (run-hooks 'gnus-after-getting-new-news-hook) | |
41487370 LMI |
6549 | (gnus-group-list-groups)) |
6550 | ||
6551 | (defun gnus-group-get-new-news-this-group (&optional n) | |
6552 | "Check for newly arrived news in the current group (and the N-1 next groups). | |
6553 | The difference between N and the number of newsgroup checked is returned. | |
6554 | If N is negative, this group and the N-1 previous groups will be checked." | |
6555 | (interactive "P") | |
6556 | (let* ((groups (gnus-group-process-prefix n)) | |
6557 | (ret (if (numberp n) (- n (length groups)) 0)) | |
231f989b | 6558 | (beg (unless n (point))) |
41487370 | 6559 | group) |
231f989b | 6560 | (while (setq group (pop groups)) |
41487370 | 6561 | (gnus-group-remove-mark group) |
231f989b LMI |
6562 | (if (gnus-activate-group group 'scan) |
6563 | (progn | |
6564 | (gnus-get-unread-articles-in-group | |
6565 | (gnus-get-info group) (gnus-active group) t) | |
6566 | (unless (gnus-virtual-group-p group) | |
6567 | (gnus-close-group group)) | |
6568 | (gnus-group-update-group group)) | |
564b670b LMI |
6569 | (if (eq (gnus-server-status (gnus-find-method-for-group group)) |
6570 | 'denied) | |
6571 | (gnus-error "Server denied access") | |
6572 | (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) | |
231f989b LMI |
6573 | (when beg (goto-char beg)) |
6574 | (when gnus-goto-next-group-when-activating | |
6575 | (gnus-group-next-unread-group 1 t)) | |
6576 | (gnus-summary-position-point) | |
41487370 LMI |
6577 | ret)) |
6578 | ||
231f989b | 6579 | (defun gnus-group-fetch-faq (group &optional faq-dir) |
41487370 | 6580 | "Fetch the FAQ for the current group." |
231f989b LMI |
6581 | (interactive |
6582 | (list | |
6583 | (and (gnus-group-group-name) | |
6584 | (gnus-group-real-name (gnus-group-group-name))) | |
6585 | (cond (current-prefix-arg | |
6586 | (completing-read | |
6587 | "Faq dir: " (and (listp gnus-group-faq-directory) | |
6588 | (mapcar (lambda (file) (list file)) | |
6589 | gnus-group-faq-directory))))))) | |
6590 | (or faq-dir | |
6591 | (setq faq-dir (if (listp gnus-group-faq-directory) | |
6592 | (car gnus-group-faq-directory) | |
6593 | gnus-group-faq-directory))) | |
41487370 | 6594 | (or group (error "No group name given")) |
231f989b LMI |
6595 | (let ((file (concat (file-name-as-directory faq-dir) |
6596 | (gnus-group-real-name group)))) | |
41487370 LMI |
6597 | (if (not (file-exists-p file)) |
6598 | (error "No such file: %s" file) | |
6599 | (find-file file)))) | |
231f989b | 6600 | |
41487370 LMI |
6601 | (defun gnus-group-describe-group (force &optional group) |
6602 | "Display a description of the current newsgroup." | |
6603 | (interactive (list current-prefix-arg (gnus-group-group-name))) | |
564b670b LMI |
6604 | (let* ((method (gnus-find-method-for-group group)) |
6605 | (mname (gnus-group-prefixed-name "" method)) | |
6606 | desc) | |
6607 | (when (and force | |
6608 | gnus-description-hashtb) | |
6609 | (gnus-sethash mname nil gnus-description-hashtb)) | |
41487370 LMI |
6610 | (or group (error "No group name given")) |
6611 | (and (or (and gnus-description-hashtb | |
6612 | ;; We check whether this group's method has been | |
231f989b | 6613 | ;; queried for a description file. |
564b670b | 6614 | (gnus-gethash mname gnus-description-hashtb)) |
41487370 LMI |
6615 | (setq desc (gnus-group-get-description group)) |
6616 | (gnus-read-descriptions-file method)) | |
231f989b | 6617 | (gnus-message 1 |
41487370 LMI |
6618 | (or desc (gnus-gethash group gnus-description-hashtb) |
6619 | "No description available"))))) | |
6620 | ||
6621 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. | |
6622 | (defun gnus-group-describe-all-groups (&optional force) | |
6623 | "Pop up a buffer with descriptions of all newsgroups." | |
6624 | (interactive "P") | |
6625 | (and force (setq gnus-description-hashtb nil)) | |
6626 | (if (not (or gnus-description-hashtb | |
6627 | (gnus-read-all-descriptions-files))) | |
6628 | (error "Couldn't request descriptions file")) | |
6629 | (let ((buffer-read-only nil) | |
6630 | b) | |
6631 | (erase-buffer) | |
6632 | (mapatoms | |
6633 | (lambda (group) | |
6634 | (setq b (point)) | |
6635 | (insert (format " *: %-20s %s\n" (symbol-name group) | |
6636 | (symbol-value group))) | |
231f989b | 6637 | (gnus-add-text-properties |
41487370 LMI |
6638 | b (1+ b) (list 'gnus-group group |
6639 | 'gnus-unread t 'gnus-marked nil | |
6640 | 'gnus-level (1+ gnus-level-subscribed)))) | |
6641 | gnus-description-hashtb) | |
6642 | (goto-char (point-min)) | |
231f989b | 6643 | (gnus-group-position-point))) |
41487370 LMI |
6644 | |
6645 | ;; Suggested by by Daniel Quinlan <quinlan@best.com>. | |
6646 | (defun gnus-group-apropos (regexp &optional search-description) | |
6647 | "List all newsgroups that have names that match a regexp." | |
6648 | (interactive "sGnus apropos (regexp): ") | |
6649 | (let ((prev "") | |
6650 | (obuf (current-buffer)) | |
6651 | groups des) | |
6652 | ;; Go through all newsgroups that are known to Gnus. | |
231f989b | 6653 | (mapatoms |
41487370 LMI |
6654 | (lambda (group) |
6655 | (and (symbol-name group) | |
6656 | (string-match regexp (symbol-name group)) | |
6657 | (setq groups (cons (symbol-name group) groups)))) | |
6658 | gnus-active-hashtb) | |
231f989b LMI |
6659 | ;; Also go through all descriptions that are known to Gnus. |
6660 | (when search-description | |
6661 | (mapatoms | |
6662 | (lambda (group) | |
6663 | (and (string-match regexp (symbol-value group)) | |
6664 | (gnus-active (symbol-name group)) | |
6665 | (setq groups (cons (symbol-name group) groups)))) | |
6666 | gnus-description-hashtb)) | |
41487370 LMI |
6667 | (if (not groups) |
6668 | (gnus-message 3 "No groups matched \"%s\"." regexp) | |
6669 | ;; Print out all the groups. | |
6670 | (save-excursion | |
6671 | (pop-to-buffer "*Gnus Help*") | |
6672 | (buffer-disable-undo (current-buffer)) | |
6673 | (erase-buffer) | |
6674 | (setq groups (sort groups 'string<)) | |
6675 | (while groups | |
6676 | ;; Groups may be entered twice into the list of groups. | |
6677 | (if (not (string= (car groups) prev)) | |
6678 | (progn | |
6679 | (insert (setq prev (car groups)) "\n") | |
6680 | (if (and gnus-description-hashtb | |
231f989b | 6681 | (setq des (gnus-gethash (car groups) |
41487370 LMI |
6682 | gnus-description-hashtb))) |
6683 | (insert " " des "\n")))) | |
6684 | (setq groups (cdr groups))) | |
6685 | (goto-char (point-min)))) | |
6686 | (pop-to-buffer obuf))) | |
6687 | ||
6688 | (defun gnus-group-description-apropos (regexp) | |
6689 | "List all newsgroups that have names or descriptions that match a regexp." | |
6690 | (interactive "sGnus description apropos (regexp): ") | |
6691 | (if (not (or gnus-description-hashtb | |
6692 | (gnus-read-all-descriptions-files))) | |
6693 | (error "Couldn't request descriptions file")) | |
6694 | (gnus-group-apropos regexp t)) | |
6695 | ||
6696 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. | |
231f989b | 6697 | (defun gnus-group-list-matching (level regexp &optional all lowest) |
41487370 LMI |
6698 | "List all groups with unread articles that match REGEXP. |
6699 | If the prefix LEVEL is non-nil, it should be a number that says which | |
231f989b | 6700 | level to cut off listing groups. |
41487370 | 6701 | If ALL, also list groups with no unread articles. |
231f989b LMI |
6702 | If LOWEST, don't list groups with level lower than LOWEST. |
6703 | ||
6704 | This command may read the active file." | |
41487370 | 6705 | (interactive "P\nsList newsgroups matching: ") |
231f989b LMI |
6706 | ;; First make sure active file has been read. |
6707 | (when (and level | |
6708 | (> (prefix-numeric-value level) gnus-level-killed)) | |
6709 | (gnus-get-killed-groups)) | |
41487370 LMI |
6710 | (gnus-group-prepare-flat (or level gnus-level-subscribed) |
6711 | all (or lowest 1) regexp) | |
6712 | (goto-char (point-min)) | |
231f989b | 6713 | (gnus-group-position-point)) |
41487370 | 6714 | |
231f989b | 6715 | (defun gnus-group-list-all-matching (level regexp &optional lowest) |
41487370 LMI |
6716 | "List all groups that match REGEXP. |
6717 | If the prefix LEVEL is non-nil, it should be a number that says which | |
231f989b | 6718 | level to cut off listing groups. |
41487370 LMI |
6719 | If LOWEST, don't list groups with level lower than LOWEST." |
6720 | (interactive "P\nsList newsgroups matching: ") | |
6721 | (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) | |
6722 | ||
6723 | ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. | |
231f989b LMI |
6724 | (defun gnus-group-save-newsrc (&optional force) |
6725 | "Save the Gnus startup files. | |
6726 | If FORCE, force saving whether it is necessary or not." | |
6727 | (interactive "P") | |
6728 | (gnus-save-newsrc-file force)) | |
41487370 LMI |
6729 | |
6730 | (defun gnus-group-restart (&optional arg) | |
6731 | "Force Gnus to read the .newsrc file." | |
6732 | (interactive "P") | |
231f989b LMI |
6733 | (when (gnus-yes-or-no-p |
6734 | (format "Are you sure you want to read %s? " | |
6735 | gnus-current-startup-file)) | |
6736 | (gnus-save-newsrc-file) | |
6737 | (gnus-setup-news 'force) | |
6738 | (gnus-group-list-groups arg))) | |
745bc783 | 6739 | |
41487370 LMI |
6740 | (defun gnus-group-read-init-file () |
6741 | "Read the Gnus elisp init file." | |
745bc783 | 6742 | (interactive) |
41487370 | 6743 | (gnus-read-init-file)) |
745bc783 | 6744 | |
41487370 LMI |
6745 | (defun gnus-group-check-bogus-groups (&optional silent) |
6746 | "Check bogus newsgroups. | |
6747 | If given a prefix, don't ask for confirmation before removing a bogus | |
6748 | group." | |
6749 | (interactive "P") | |
6750 | (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) | |
6751 | (gnus-group-list-groups)) | |
745bc783 | 6752 | |
41487370 LMI |
6753 | (defun gnus-group-edit-global-kill (&optional article group) |
6754 | "Edit the global kill file. | |
6755 | If GROUP, edit that local kill file instead." | |
6756 | (interactive "P") | |
6757 | (setq gnus-current-kill-article article) | |
6758 | (gnus-kill-file-edit-file group) | |
231f989b | 6759 | (gnus-message |
41487370 | 6760 | 6 |
745bc783 | 6761 | (substitute-command-keys |
231f989b LMI |
6762 | (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" |
6763 | (if group "local" "global"))))) | |
745bc783 | 6764 | |
41487370 LMI |
6765 | (defun gnus-group-edit-local-kill (article group) |
6766 | "Edit a local kill file." | |
6767 | (interactive (list nil (gnus-group-group-name))) | |
6768 | (gnus-group-edit-global-kill article group)) | |
745bc783 | 6769 | |
b027f415 | 6770 | (defun gnus-group-force-update () |
ef97d5a2 | 6771 | "Update `.newsrc' file." |
745bc783 JB |
6772 | (interactive) |
6773 | (gnus-save-newsrc-file)) | |
6774 | ||
b027f415 | 6775 | (defun gnus-group-suspend () |
41487370 LMI |
6776 | "Suspend the current Gnus session. |
6777 | In fact, cleanup buffers except for group mode buffer. | |
6778 | The hook gnus-suspend-gnus-hook is called before actually suspending." | |
745bc783 | 6779 | (interactive) |
b027f415 | 6780 | (run-hooks 'gnus-suspend-gnus-hook) |
41487370 | 6781 | ;; Kill Gnus buffers except for group mode buffer. |
231f989b LMI |
6782 | (let* ((group-buf (get-buffer gnus-group-buffer)) |
6783 | ;; Do this on a separate list in case the user does a ^G before we finish | |
6784 | (gnus-buffer-list | |
6785 | (delete group-buf (delete gnus-dribble-buffer | |
6786 | (append gnus-buffer-list nil))))) | |
6787 | (while gnus-buffer-list | |
6788 | (gnus-kill-buffer (pop gnus-buffer-list))) | |
6789 | (gnus-kill-gnus-frames) | |
6790 | (when group-buf | |
6791 | (setq gnus-buffer-list (list group-buf)) | |
6792 | (bury-buffer group-buf) | |
6793 | (delete-windows-on group-buf t)))) | |
41487370 LMI |
6794 | |
6795 | (defun gnus-group-clear-dribble () | |
6796 | "Clear all information from the dribble buffer." | |
6797 | (interactive) | |
231f989b LMI |
6798 | (gnus-dribble-clear) |
6799 | (gnus-message 7 "Cleared dribble buffer")) | |
745bc783 | 6800 | |
b027f415 | 6801 | (defun gnus-group-exit () |
41487370 LMI |
6802 | "Quit reading news after updating .newsrc.eld and .newsrc. |
6803 | The hook `gnus-exit-gnus-hook' is called before actually exiting." | |
745bc783 | 6804 | (interactive) |
231f989b LMI |
6805 | (when |
6806 | (or noninteractive ;For gnus-batch-kill | |
b027f415 | 6807 | (not gnus-interactive-exit) ;Without confirmation |
41487370 LMI |
6808 | gnus-expert-user |
6809 | (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) | |
231f989b LMI |
6810 | (run-hooks 'gnus-exit-gnus-hook) |
6811 | ;; Offer to save data from non-quitted summary buffers. | |
6812 | (gnus-offer-save-summaries) | |
6813 | ;; Save the newsrc file(s). | |
6814 | (gnus-save-newsrc-file) | |
6815 | ;; Kill-em-all. | |
6816 | (gnus-close-backends) | |
6817 | ;; Reset everything. | |
6818 | (gnus-clear-system) | |
6819 | ;; Allow the user to do things after cleaning up. | |
6820 | (run-hooks 'gnus-after-exiting-gnus-hook))) | |
41487370 LMI |
6821 | |
6822 | (defun gnus-close-backends () | |
231f989b | 6823 | ;; Send a close request to all backends that support such a request. |
41487370 LMI |
6824 | (let ((methods gnus-valid-select-methods) |
6825 | func) | |
6826 | (while methods | |
231f989b | 6827 | (if (fboundp (setq func (intern (concat (caar methods) |
41487370 LMI |
6828 | "-request-close")))) |
6829 | (funcall func)) | |
6830 | (setq methods (cdr methods))))) | |
745bc783 | 6831 | |
b027f415 | 6832 | (defun gnus-group-quit () |
41487370 LMI |
6833 | "Quit reading news without updating .newsrc.eld or .newsrc. |
6834 | The hook `gnus-exit-gnus-hook' is called before actually exiting." | |
745bc783 | 6835 | (interactive) |
231f989b LMI |
6836 | (when (or noninteractive ;For gnus-batch-kill |
6837 | (zerop (buffer-size)) | |
6838 | (not (gnus-server-opened gnus-select-method)) | |
6839 | gnus-expert-user | |
6840 | (not gnus-current-startup-file) | |
6841 | (gnus-yes-or-no-p | |
6842 | (format "Quit reading news without saving %s? " | |
6843 | (file-name-nondirectory gnus-current-startup-file)))) | |
6844 | (run-hooks 'gnus-exit-gnus-hook) | |
6845 | (if gnus-use-full-window | |
6846 | (delete-other-windows) | |
6847 | (gnus-remove-some-windows)) | |
6848 | (gnus-dribble-save) | |
6849 | (gnus-close-backends) | |
6850 | (gnus-clear-system) | |
6851 | ;; Allow the user to do things after cleaning up. | |
6852 | (run-hooks 'gnus-after-exiting-gnus-hook))) | |
41487370 LMI |
6853 | |
6854 | (defun gnus-offer-save-summaries () | |
231f989b | 6855 | "Offer to save all active summary buffers." |
41487370 | 6856 | (save-excursion |
231f989b | 6857 | (let ((buflist (buffer-list)) |
41487370 | 6858 | buffers bufname) |
231f989b | 6859 | ;; Go through all buffers and find all summaries. |
41487370 LMI |
6860 | (while buflist |
6861 | (and (setq bufname (buffer-name (car buflist))) | |
6862 | (string-match "Summary" bufname) | |
6863 | (save-excursion | |
6864 | (set-buffer bufname) | |
6865 | ;; We check that this is, indeed, a summary buffer. | |
231f989b LMI |
6866 | (and (eq major-mode 'gnus-summary-mode) |
6867 | ;; Also make sure this isn't bogus. | |
6868 | gnus-newsgroup-prepared)) | |
6869 | (push bufname buffers)) | |
41487370 | 6870 | (setq buflist (cdr buflist))) |
231f989b LMI |
6871 | ;; Go through all these summary buffers and offer to save them. |
6872 | (when buffers | |
6873 | (map-y-or-n-p | |
6874 | "Update summary buffer %s? " | |
6875 | (lambda (buf) (set-buffer buf) (gnus-summary-exit)) | |
6876 | buffers))))) | |
745bc783 | 6877 | |
b027f415 | 6878 | (defun gnus-group-describe-briefly () |
41487370 LMI |
6879 | "Give a one line description of the group mode commands." |
6880 | (interactive) | |
6881 | (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"))) | |
6882 | ||
6883 | (defun gnus-group-browse-foreign-server (method) | |
6884 | "Browse a foreign news server. | |
6885 | If called interactively, this function will ask for a select method | |
231f989b | 6886 | (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). |
41487370 LMI |
6887 | If not, METHOD should be a list where the first element is the method |
6888 | and the second element is the address." | |
6889 | (interactive | |
231f989b | 6890 | (list (let ((how (completing-read |
41487370 LMI |
6891 | "Which backend: " |
6892 | (append gnus-valid-select-methods gnus-server-alist) | |
231f989b | 6893 | nil t (cons "nntp" 0) 'gnus-method-history))) |
41487370 LMI |
6894 | ;; We either got a backend name or a virtual server name. |
6895 | ;; If the first, we also need an address. | |
6896 | (if (assoc how gnus-valid-select-methods) | |
6897 | (list (intern how) | |
6898 | ;; Suggested by mapjph@bath.ac.uk. | |
231f989b LMI |
6899 | (completing-read |
6900 | "Address: " | |
41487370 LMI |
6901 | (mapcar (lambda (server) (list server)) |
6902 | gnus-secondary-servers))) | |
6903 | ;; We got a server name, so we find the method. | |
6904 | (gnus-server-to-method how))))) | |
6905 | (gnus-browse-foreign-server method)) | |
6906 | ||
6907 | \f | |
745bc783 | 6908 | ;;; |
41487370 | 6909 | ;;; Gnus summary mode |
745bc783 JB |
6910 | ;;; |
6911 | ||
41487370 | 6912 | (defvar gnus-summary-mode-map nil) |
41487370 LMI |
6913 | |
6914 | (put 'gnus-summary-mode 'mode-class 'special) | |
6915 | ||
231f989b | 6916 | (unless gnus-summary-mode-map |
b027f415 RS |
6917 | (setq gnus-summary-mode-map (make-keymap)) |
6918 | (suppress-keymap gnus-summary-mode-map) | |
41487370 LMI |
6919 | |
6920 | ;; Non-orthogonal keys | |
6921 | ||
231f989b LMI |
6922 | (gnus-define-keys gnus-summary-mode-map |
6923 | " " gnus-summary-next-page | |
6924 | "\177" gnus-summary-prev-page | |
6925 | [delete] gnus-summary-prev-page | |
6926 | "\r" gnus-summary-scroll-up | |
6927 | "n" gnus-summary-next-unread-article | |
6928 | "p" gnus-summary-prev-unread-article | |
6929 | "N" gnus-summary-next-article | |
6930 | "P" gnus-summary-prev-article | |
6931 | "\M-\C-n" gnus-summary-next-same-subject | |
6932 | "\M-\C-p" gnus-summary-prev-same-subject | |
6933 | "\M-n" gnus-summary-next-unread-subject | |
6934 | "\M-p" gnus-summary-prev-unread-subject | |
6935 | "." gnus-summary-first-unread-article | |
6936 | "," gnus-summary-best-unread-article | |
6937 | "\M-s" gnus-summary-search-article-forward | |
6938 | "\M-r" gnus-summary-search-article-backward | |
6939 | "<" gnus-summary-beginning-of-article | |
6940 | ">" gnus-summary-end-of-article | |
6941 | "j" gnus-summary-goto-article | |
6942 | "^" gnus-summary-refer-parent-article | |
6943 | "\M-^" gnus-summary-refer-article | |
6944 | "u" gnus-summary-tick-article-forward | |
6945 | "!" gnus-summary-tick-article-forward | |
6946 | "U" gnus-summary-tick-article-backward | |
6947 | "d" gnus-summary-mark-as-read-forward | |
6948 | "D" gnus-summary-mark-as-read-backward | |
6949 | "E" gnus-summary-mark-as-expirable | |
6950 | "\M-u" gnus-summary-clear-mark-forward | |
6951 | "\M-U" gnus-summary-clear-mark-backward | |
6952 | "k" gnus-summary-kill-same-subject-and-select | |
6953 | "\C-k" gnus-summary-kill-same-subject | |
6954 | "\M-\C-k" gnus-summary-kill-thread | |
6955 | "\M-\C-l" gnus-summary-lower-thread | |
6956 | "e" gnus-summary-edit-article | |
6957 | "#" gnus-summary-mark-as-processable | |
6958 | "\M-#" gnus-summary-unmark-as-processable | |
6959 | "\M-\C-t" gnus-summary-toggle-threads | |
6960 | "\M-\C-s" gnus-summary-show-thread | |
6961 | "\M-\C-h" gnus-summary-hide-thread | |
6962 | "\M-\C-f" gnus-summary-next-thread | |
6963 | "\M-\C-b" gnus-summary-prev-thread | |
6964 | "\M-\C-u" gnus-summary-up-thread | |
6965 | "\M-\C-d" gnus-summary-down-thread | |
6966 | "&" gnus-summary-execute-command | |
6967 | "c" gnus-summary-catchup-and-exit | |
6968 | "\C-w" gnus-summary-mark-region-as-read | |
6969 | "\C-t" gnus-summary-toggle-truncation | |
6970 | "?" gnus-summary-mark-as-dormant | |
6971 | "\C-c\M-\C-s" gnus-summary-limit-include-expunged | |
6972 | "\C-c\C-s\C-n" gnus-summary-sort-by-number | |
6973 | "\C-c\C-s\C-a" gnus-summary-sort-by-author | |
6974 | "\C-c\C-s\C-s" gnus-summary-sort-by-subject | |
6975 | "\C-c\C-s\C-d" gnus-summary-sort-by-date | |
6976 | "\C-c\C-s\C-i" gnus-summary-sort-by-score | |
6977 | "=" gnus-summary-expand-window | |
6978 | "\C-x\C-s" gnus-summary-reselect-current-group | |
6979 | "\M-g" gnus-summary-rescan-group | |
6980 | "w" gnus-summary-stop-page-breaking | |
6981 | "\C-c\C-r" gnus-summary-caesar-message | |
6982 | "\M-t" gnus-summary-toggle-mime | |
6983 | "f" gnus-summary-followup | |
6984 | "F" gnus-summary-followup-with-original | |
6985 | "C" gnus-summary-cancel-article | |
6986 | "r" gnus-summary-reply | |
6987 | "R" gnus-summary-reply-with-original | |
6988 | "\C-c\C-f" gnus-summary-mail-forward | |
6989 | "o" gnus-summary-save-article | |
6990 | "\C-o" gnus-summary-save-article-mail | |
6991 | "|" gnus-summary-pipe-output | |
6992 | "\M-k" gnus-summary-edit-local-kill | |
6993 | "\M-K" gnus-summary-edit-global-kill | |
6994 | "V" gnus-version | |
6995 | "\C-c\C-d" gnus-summary-describe-group | |
6996 | "q" gnus-summary-exit | |
6997 | "Q" gnus-summary-exit-no-update | |
6998 | "\C-c\C-i" gnus-info-find-node | |
6999 | gnus-mouse-2 gnus-mouse-pick-article | |
7000 | "m" gnus-summary-mail-other-window | |
7001 | "a" gnus-summary-post-news | |
7002 | "x" gnus-summary-limit-to-unread | |
7003 | "s" gnus-summary-isearch-article | |
7004 | "t" gnus-article-hide-headers | |
7005 | "g" gnus-summary-show-article | |
7006 | "l" gnus-summary-goto-last-article | |
7007 | "\C-c\C-v\C-v" gnus-uu-decode-uu-view | |
7008 | "\C-d" gnus-summary-enter-digest-group | |
7009 | "\C-c\C-b" gnus-bug | |
7010 | "*" gnus-cache-enter-article | |
7011 | "\M-*" gnus-cache-remove-article | |
7012 | "\M-&" gnus-summary-universal-argument | |
7013 | "\C-l" gnus-recenter | |
7014 | "I" gnus-summary-increase-score | |
7015 | "L" gnus-summary-lower-score | |
7016 | ||
7017 | "V" gnus-summary-score-map | |
7018 | "X" gnus-uu-extract-map | |
7019 | "S" gnus-summary-send-map) | |
41487370 LMI |
7020 | |
7021 | ;; Sort of orthogonal keymap | |
231f989b LMI |
7022 | (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) |
7023 | "t" gnus-summary-tick-article-forward | |
7024 | "!" gnus-summary-tick-article-forward | |
7025 | "d" gnus-summary-mark-as-read-forward | |
7026 | "r" gnus-summary-mark-as-read-forward | |
7027 | "c" gnus-summary-clear-mark-forward | |
7028 | " " gnus-summary-clear-mark-forward | |
7029 | "e" gnus-summary-mark-as-expirable | |
7030 | "x" gnus-summary-mark-as-expirable | |
7031 | "?" gnus-summary-mark-as-dormant | |
7032 | "b" gnus-summary-set-bookmark | |
7033 | "B" gnus-summary-remove-bookmark | |
7034 | "#" gnus-summary-mark-as-processable | |
7035 | "\M-#" gnus-summary-unmark-as-processable | |
7036 | "S" gnus-summary-limit-include-expunged | |
7037 | "C" gnus-summary-catchup | |
7038 | "H" gnus-summary-catchup-to-here | |
7039 | "\C-c" gnus-summary-catchup-all | |
7040 | "k" gnus-summary-kill-same-subject-and-select | |
7041 | "K" gnus-summary-kill-same-subject | |
7042 | "P" gnus-uu-mark-map) | |
7043 | ||
7044 | (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map) | |
7045 | "c" gnus-summary-clear-above | |
7046 | "u" gnus-summary-tick-above | |
7047 | "m" gnus-summary-mark-above | |
7048 | "k" gnus-summary-kill-below) | |
7049 | ||
7050 | (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) | |
7051 | "/" gnus-summary-limit-to-subject | |
7052 | "n" gnus-summary-limit-to-articles | |
7053 | "w" gnus-summary-pop-limit | |
7054 | "s" gnus-summary-limit-to-subject | |
7055 | "a" gnus-summary-limit-to-author | |
7056 | "u" gnus-summary-limit-to-unread | |
7057 | "m" gnus-summary-limit-to-marks | |
7058 | "v" gnus-summary-limit-to-score | |
7059 | "D" gnus-summary-limit-include-dormant | |
7060 | "d" gnus-summary-limit-exclude-dormant | |
7061 | ;; "t" gnus-summary-limit-exclude-thread | |
7062 | "E" gnus-summary-limit-include-expunged | |
7063 | "c" gnus-summary-limit-exclude-childless-dormant | |
7064 | "C" gnus-summary-limit-mark-excluded-as-read) | |
7065 | ||
7066 | (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) | |
7067 | "n" gnus-summary-next-unread-article | |
7068 | "p" gnus-summary-prev-unread-article | |
7069 | "N" gnus-summary-next-article | |
7070 | "P" gnus-summary-prev-article | |
7071 | "\C-n" gnus-summary-next-same-subject | |
7072 | "\C-p" gnus-summary-prev-same-subject | |
7073 | "\M-n" gnus-summary-next-unread-subject | |
7074 | "\M-p" gnus-summary-prev-unread-subject | |
7075 | "f" gnus-summary-first-unread-article | |
7076 | "b" gnus-summary-best-unread-article | |
7077 | "j" gnus-summary-goto-article | |
7078 | "g" gnus-summary-goto-subject | |
7079 | "l" gnus-summary-goto-last-article | |
7080 | "p" gnus-summary-pop-article) | |
7081 | ||
7082 | (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) | |
7083 | "k" gnus-summary-kill-thread | |
7084 | "l" gnus-summary-lower-thread | |
7085 | "i" gnus-summary-raise-thread | |
7086 | "T" gnus-summary-toggle-threads | |
7087 | "t" gnus-summary-rethread-current | |
7088 | "^" gnus-summary-reparent-thread | |
7089 | "s" gnus-summary-show-thread | |
7090 | "S" gnus-summary-show-all-threads | |
7091 | "h" gnus-summary-hide-thread | |
7092 | "H" gnus-summary-hide-all-threads | |
7093 | "n" gnus-summary-next-thread | |
7094 | "p" gnus-summary-prev-thread | |
7095 | "u" gnus-summary-up-thread | |
7096 | "o" gnus-summary-top-thread | |
7097 | "d" gnus-summary-down-thread | |
7098 | "#" gnus-uu-mark-thread | |
7099 | "\M-#" gnus-uu-unmark-thread) | |
7100 | ||
7101 | (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) | |
7102 | "c" gnus-summary-catchup-and-exit | |
7103 | "C" gnus-summary-catchup-all-and-exit | |
7104 | "E" gnus-summary-exit-no-update | |
7105 | "Q" gnus-summary-exit | |
7106 | "Z" gnus-summary-exit | |
7107 | "n" gnus-summary-catchup-and-goto-next-group | |
7108 | "R" gnus-summary-reselect-current-group | |
7109 | "G" gnus-summary-rescan-group | |
7110 | "N" gnus-summary-next-group | |
7111 | "P" gnus-summary-prev-group) | |
7112 | ||
7113 | (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) | |
7114 | " " gnus-summary-next-page | |
7115 | "n" gnus-summary-next-page | |
7116 | "\177" gnus-summary-prev-page | |
7117 | [delete] gnus-summary-prev-page | |
7118 | "p" gnus-summary-prev-page | |
7119 | "\r" gnus-summary-scroll-up | |
7120 | "<" gnus-summary-beginning-of-article | |
7121 | ">" gnus-summary-end-of-article | |
7122 | "b" gnus-summary-beginning-of-article | |
7123 | "e" gnus-summary-end-of-article | |
7124 | "^" gnus-summary-refer-parent-article | |
7125 | "r" gnus-summary-refer-parent-article | |
7126 | "R" gnus-summary-refer-references | |
7127 | "g" gnus-summary-show-article | |
7128 | "s" gnus-summary-isearch-article) | |
7129 | ||
7130 | (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) | |
7131 | "b" gnus-article-add-buttons | |
7132 | "B" gnus-article-add-buttons-to-head | |
7133 | "o" gnus-article-treat-overstrike | |
7134 | ;; "w" gnus-article-word-wrap | |
7135 | "w" gnus-article-fill-cited-article | |
7136 | "c" gnus-article-remove-cr | |
7137 | "L" gnus-article-remove-trailing-blank-lines | |
7138 | "q" gnus-article-de-quoted-unreadable | |
7139 | "f" gnus-article-display-x-face | |
7140 | "l" gnus-summary-stop-page-breaking | |
7141 | "r" gnus-summary-caesar-message | |
7142 | "t" gnus-article-hide-headers | |
7143 | "v" gnus-summary-verbose-headers | |
7144 | "m" gnus-summary-toggle-mime) | |
7145 | ||
7146 | (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) | |
7147 | "a" gnus-article-hide | |
7148 | "h" gnus-article-hide-headers | |
7149 | "b" gnus-article-hide-boring-headers | |
7150 | "s" gnus-article-hide-signature | |
7151 | "c" gnus-article-hide-citation | |
7152 | "p" gnus-article-hide-pgp | |
7153 | "\C-c" gnus-article-hide-citation-maybe) | |
7154 | ||
7155 | (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) | |
7156 | "a" gnus-article-highlight | |
7157 | "h" gnus-article-highlight-headers | |
7158 | "c" gnus-article-highlight-citation | |
7159 | "s" gnus-article-highlight-signature) | |
7160 | ||
7161 | (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) | |
7162 | "z" gnus-article-date-ut | |
7163 | "u" gnus-article-date-ut | |
7164 | "l" gnus-article-date-local | |
7165 | "e" gnus-article-date-lapsed | |
7166 | "o" gnus-article-date-original) | |
7167 | ||
7168 | (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) | |
7169 | "v" gnus-version | |
7170 | "f" gnus-summary-fetch-faq | |
7171 | "d" gnus-summary-describe-group | |
7172 | "h" gnus-summary-describe-briefly | |
7173 | "i" gnus-info-find-node) | |
7174 | ||
7175 | (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) | |
7176 | "e" gnus-summary-expire-articles | |
7177 | "\M-\C-e" gnus-summary-expire-articles-now | |
7178 | "\177" gnus-summary-delete-article | |
7179 | [delete] gnus-summary-delete-article | |
7180 | "m" gnus-summary-move-article | |
7181 | "r" gnus-summary-respool-article | |
7182 | "w" gnus-summary-edit-article | |
7183 | "c" gnus-summary-copy-article | |
7184 | "B" gnus-summary-crosspost-article | |
7185 | "q" gnus-summary-respool-query | |
7186 | "i" gnus-summary-import-article) | |
7187 | ||
7188 | (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) | |
7189 | "o" gnus-summary-save-article | |
7190 | "m" gnus-summary-save-article-mail | |
7191 | "r" gnus-summary-save-article-rmail | |
7192 | "f" gnus-summary-save-article-file | |
7193 | "b" gnus-summary-save-article-body-file | |
7194 | "h" gnus-summary-save-article-folder | |
7195 | "v" gnus-summary-save-article-vm | |
7196 | "p" gnus-summary-pipe-output | |
7197 | "s" gnus-soup-add-article) | |
ef97d5a2 | 7198 | ) |
41487370 | 7199 | |
ef97d5a2 | 7200 | \f |
b027f415 | 7201 | |
41487370 LMI |
7202 | (defun gnus-summary-mode (&optional group) |
7203 | "Major mode for reading articles. | |
7204 | ||
7205 | All normal editing commands are switched off. | |
7206 | \\<gnus-summary-mode-map> | |
7207 | Each line in this buffer represents one article. To read an | |
7208 | article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards | |
231f989b | 7209 | and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', |
41487370 LMI |
7210 | respectively. |
7211 | ||
231f989b LMI |
7212 | You can also post articles and send mail from this buffer. To |
7213 | follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author | |
41487370 LMI |
7214 | of an article, type `\\[gnus-summary-reply]'. |
7215 | ||
231f989b LMI |
7216 | There are approx. one gazillion commands you can execute in this |
7217 | buffer; read the info pages for more information (`\\[gnus-info-find-node]'). | |
41487370 LMI |
7218 | |
7219 | The following commands are available: | |
7220 | ||
7221 | \\{gnus-summary-mode-map}" | |
745bc783 | 7222 | (interactive) |
231f989b LMI |
7223 | (when (and menu-bar-mode |
7224 | (gnus-visual-p 'summary-menu 'menu)) | |
7225 | (gnus-summary-make-menu-bar)) | |
745bc783 | 7226 | (kill-all-local-variables) |
231f989b | 7227 | (gnus-summary-make-local-variables) |
41487370 | 7228 | (gnus-make-thread-indent-array) |
a828a776 | 7229 | (gnus-simplify-mode-line) |
b027f415 RS |
7230 | (setq major-mode 'gnus-summary-mode) |
7231 | (setq mode-name "Summary") | |
745bc783 | 7232 | (make-local-variable 'minor-mode-alist) |
b027f415 | 7233 | (use-local-map gnus-summary-mode-map) |
41487370 | 7234 | (buffer-disable-undo (current-buffer)) |
745bc783 | 7235 | (setq buffer-read-only t) ;Disable modification |
41487370 | 7236 | (setq truncate-lines t) |
745bc783 JB |
7237 | (setq selective-display t) |
7238 | (setq selective-display-ellipses t) ;Display `...' | |
41487370 LMI |
7239 | (setq buffer-display-table gnus-summary-display-table) |
7240 | (setq gnus-newsgroup-name group) | |
231f989b LMI |
7241 | (make-local-variable 'gnus-summary-line-format) |
7242 | (make-local-variable 'gnus-summary-line-format-spec) | |
7243 | (make-local-variable 'gnus-summary-mark-positions) | |
564b670b LMI |
7244 | (gnus-make-local-hook 'post-command-hook) |
7245 | (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) | |
b027f415 RS |
7246 | (run-hooks 'gnus-summary-mode-hook)) |
7247 | ||
231f989b LMI |
7248 | (defun gnus-summary-make-local-variables () |
7249 | "Make all the local summary buffer variables." | |
7250 | (let ((locals gnus-summary-local-variables) | |
7251 | global local) | |
7252 | (while (setq local (pop locals)) | |
7253 | (if (consp local) | |
7254 | (progn | |
7255 | (if (eq (cdr local) 'global) | |
7256 | ;; Copy the global value of the variable. | |
7257 | (setq global (symbol-value (car local))) | |
7258 | ;; Use the value from the list. | |
7259 | (setq global (eval (cdr local)))) | |
7260 | (make-local-variable (car local)) | |
7261 | (set (car local) global)) | |
7262 | ;; Simple nil-valued local variable. | |
7263 | (make-local-variable local) | |
7264 | (set local nil))))) | |
7265 | ||
41487370 | 7266 | (defun gnus-summary-make-display-table () |
231f989b | 7267 | ;; Change the display table. Odd characters have a tendency to mess |
41487370 LMI |
7268 | ;; up nicely formatted displays - we make all possible glyphs |
7269 | ;; display only a single character. | |
7270 | ||
7271 | ;; We start from the standard display table, if any. | |
231f989b | 7272 | (setq gnus-summary-display-table |
41487370 LMI |
7273 | (or (copy-sequence standard-display-table) |
7274 | (make-display-table))) | |
7275 | ;; Nix out all the control chars... | |
7276 | (let ((i 32)) | |
7277 | (while (>= (setq i (1- i)) 0) | |
7278 | (aset gnus-summary-display-table i [??]))) | |
7279 | ;; ... but not newline and cr, of course. (cr is necessary for the | |
231f989b | 7280 | ;; selective display). |
41487370 LMI |
7281 | (aset gnus-summary-display-table ?\n nil) |
7282 | (aset gnus-summary-display-table ?\r nil) | |
231f989b | 7283 | ;; We nix out any glyphs over 126 that are not set already. |
41487370 LMI |
7284 | (let ((i 256)) |
7285 | (while (>= (setq i (1- i)) 127) | |
7286 | ;; Only modify if the entry is nil. | |
231f989b | 7287 | (or (aref gnus-summary-display-table i) |
41487370 LMI |
7288 | (aset gnus-summary-display-table i [??]))))) |
7289 | ||
7290 | (defun gnus-summary-clear-local-variables () | |
7291 | (let ((locals gnus-summary-local-variables)) | |
7292 | (while locals | |
7293 | (if (consp (car locals)) | |
231f989b LMI |
7294 | (and (vectorp (caar locals)) |
7295 | (set (caar locals) nil)) | |
41487370 LMI |
7296 | (and (vectorp (car locals)) |
7297 | (set (car locals) nil))) | |
7298 | (setq locals (cdr locals))))) | |
7299 | ||
231f989b LMI |
7300 | ;; Summary data functions. |
7301 | ||
7302 | (defmacro gnus-data-number (data) | |
7303 | `(car ,data)) | |
7304 | ||
7305 | (defmacro gnus-data-set-number (data number) | |
7306 | `(setcar ,data ,number)) | |
7307 | ||
7308 | (defmacro gnus-data-mark (data) | |
7309 | `(nth 1 ,data)) | |
7310 | ||
7311 | (defmacro gnus-data-set-mark (data mark) | |
7312 | `(setcar (nthcdr 1 ,data) ,mark)) | |
7313 | ||
7314 | (defmacro gnus-data-pos (data) | |
7315 | `(nth 2 ,data)) | |
7316 | ||
7317 | (defmacro gnus-data-set-pos (data pos) | |
7318 | `(setcar (nthcdr 2 ,data) ,pos)) | |
7319 | ||
7320 | (defmacro gnus-data-header (data) | |
7321 | `(nth 3 ,data)) | |
7322 | ||
7323 | (defmacro gnus-data-level (data) | |
7324 | `(nth 4 ,data)) | |
7325 | ||
7326 | (defmacro gnus-data-unread-p (data) | |
7327 | `(= (nth 1 ,data) gnus-unread-mark)) | |
7328 | ||
7329 | (defmacro gnus-data-pseudo-p (data) | |
7330 | `(consp (nth 3 ,data))) | |
7331 | ||
7332 | (defmacro gnus-data-find (number) | |
7333 | `(assq ,number gnus-newsgroup-data)) | |
7334 | ||
7335 | (defmacro gnus-data-find-list (number &optional data) | |
7336 | `(let ((bdata ,(or data 'gnus-newsgroup-data))) | |
7337 | (memq (assq ,number bdata) | |
7338 | bdata))) | |
7339 | ||
7340 | (defmacro gnus-data-make (number mark pos header level) | |
7341 | `(list ,number ,mark ,pos ,header ,level)) | |
7342 | ||
7343 | (defun gnus-data-enter (after-article number mark pos header level offset) | |
7344 | (let ((data (gnus-data-find-list after-article))) | |
7345 | (or data (error "No such article: %d" after-article)) | |
7346 | (setcdr data (cons (gnus-data-make number mark pos header level) | |
7347 | (cdr data))) | |
7348 | (setq gnus-newsgroup-data-reverse nil) | |
7349 | (gnus-data-update-list (cddr data) offset))) | |
7350 | ||
7351 | (defun gnus-data-enter-list (after-article list &optional offset) | |
7352 | (when list | |
7353 | (let ((data (and after-article (gnus-data-find-list after-article))) | |
7354 | (ilist list)) | |
7355 | (or data (not after-article) (error "No such article: %d" after-article)) | |
7356 | ;; Find the last element in the list to be spliced into the main | |
7357 | ;; list. | |
7358 | (while (cdr list) | |
7359 | (setq list (cdr list))) | |
7360 | (if (not data) | |
7361 | (progn | |
7362 | (setcdr list gnus-newsgroup-data) | |
7363 | (setq gnus-newsgroup-data ilist) | |
7364 | (and offset (gnus-data-update-list (cdr list) offset))) | |
7365 | (setcdr list (cdr data)) | |
7366 | (setcdr data ilist) | |
7367 | (and offset (gnus-data-update-list (cdr data) offset))) | |
7368 | (setq gnus-newsgroup-data-reverse nil)))) | |
7369 | ||
7370 | (defun gnus-data-remove (article &optional offset) | |
7371 | (let ((data gnus-newsgroup-data)) | |
7372 | (if (= (gnus-data-number (car data)) article) | |
7373 | (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) | |
7374 | gnus-newsgroup-data-reverse nil) | |
7375 | (while (cdr data) | |
7376 | (and (= (gnus-data-number (cadr data)) article) | |
7377 | (progn | |
7378 | (setcdr data (cddr data)) | |
7379 | (and offset (gnus-data-update-list (cdr data) offset)) | |
7380 | (setq data nil | |
7381 | gnus-newsgroup-data-reverse nil))) | |
7382 | (setq data (cdr data)))))) | |
7383 | ||
7384 | (defmacro gnus-data-list (backward) | |
7385 | `(if ,backward | |
7386 | (or gnus-newsgroup-data-reverse | |
7387 | (setq gnus-newsgroup-data-reverse | |
7388 | (reverse gnus-newsgroup-data))) | |
7389 | gnus-newsgroup-data)) | |
7390 | ||
7391 | (defun gnus-data-update-list (data offset) | |
7392 | "Add OFFSET to the POS of all data entries in DATA." | |
7393 | (while data | |
7394 | (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) | |
7395 | (setq data (cdr data)))) | |
7396 | ||
7397 | (defun gnus-data-compute-positions () | |
7398 | "Compute the positions of all articles." | |
7399 | (let ((data gnus-newsgroup-data) | |
7400 | pos) | |
7401 | (while data | |
7402 | (when (setq pos (text-property-any | |
7403 | (point-min) (point-max) | |
7404 | 'gnus-number (gnus-data-number (car data)))) | |
7405 | (gnus-data-set-pos (car data) (+ pos 3))) | |
7406 | (setq data (cdr data))))) | |
7407 | ||
7408 | (defun gnus-summary-article-pseudo-p (article) | |
7409 | "Say whether this article is a pseudo article or not." | |
7410 | (not (vectorp (gnus-data-header (gnus-data-find article))))) | |
7411 | ||
7412 | (defun gnus-article-parent-p (number) | |
7413 | "Say whether this article is a parent or not." | |
7414 | (let ((data (gnus-data-find-list number))) | |
7415 | (and (cdr data) ; There has to be an article after... | |
7416 | (< (gnus-data-level (car data)) ; And it has to have a higher level. | |
7417 | (gnus-data-level (nth 1 data)))))) | |
7418 | ||
7419 | (defun gnus-article-children (number) | |
7420 | "Return a list of all children to NUMBER." | |
7421 | (let* ((data (gnus-data-find-list number)) | |
7422 | (level (gnus-data-level (car data))) | |
7423 | children) | |
7424 | (setq data (cdr data)) | |
7425 | (while (and data | |
7426 | (= (gnus-data-level (car data)) (1+ level))) | |
7427 | (push (gnus-data-number (car data)) children) | |
7428 | (setq data (cdr data))) | |
7429 | children)) | |
7430 | ||
7431 | (defmacro gnus-summary-skip-intangible () | |
7432 | "If the current article is intangible, then jump to a different article." | |
7433 | '(let ((to (get-text-property (point) 'gnus-intangible))) | |
7434 | (and to (gnus-summary-goto-subject to)))) | |
7435 | ||
7436 | (defmacro gnus-summary-article-intangible-p () | |
7437 | "Say whether this article is intangible or not." | |
7438 | '(get-text-property (point) 'gnus-intangible)) | |
7439 | ||
41487370 LMI |
7440 | ;; Some summary mode macros. |
7441 | ||
231f989b | 7442 | (defmacro gnus-summary-article-number () |
41487370 LMI |
7443 | "The article number of the article on the current line. |
7444 | If there isn's an article number here, then we return the current | |
7445 | article number." | |
231f989b LMI |
7446 | '(progn |
7447 | (gnus-summary-skip-intangible) | |
7448 | (or (get-text-property (point) 'gnus-number) | |
7449 | (gnus-summary-last-subject)))) | |
7450 | ||
7451 | (defmacro gnus-summary-article-header (&optional number) | |
7452 | `(gnus-data-header (gnus-data-find | |
7453 | ,(or number '(gnus-summary-article-number))))) | |
7454 | ||
7455 | (defmacro gnus-summary-thread-level (&optional number) | |
7456 | `(if (and (eq gnus-summary-make-false-root 'dummy) | |
7457 | (get-text-property (point) 'gnus-intangible)) | |
7458 | 0 | |
7459 | (gnus-data-level (gnus-data-find | |
7460 | ,(or number '(gnus-summary-article-number)))))) | |
7461 | ||
7462 | (defmacro gnus-summary-article-mark (&optional number) | |
7463 | `(gnus-data-mark (gnus-data-find | |
7464 | ,(or number '(gnus-summary-article-number))))) | |
7465 | ||
7466 | (defmacro gnus-summary-article-pos (&optional number) | |
7467 | `(gnus-data-pos (gnus-data-find | |
7468 | ,(or number '(gnus-summary-article-number))))) | |
7469 | ||
7470 | (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) | |
7471 | (defmacro gnus-summary-article-subject (&optional number) | |
745bc783 | 7472 | "Return current subject string or nil if nothing." |
231f989b LMI |
7473 | `(let ((headers |
7474 | ,(if number | |
7475 | `(gnus-data-header (assq ,number gnus-newsgroup-data)) | |
7476 | '(gnus-data-header (assq (gnus-summary-article-number) | |
7477 | gnus-newsgroup-data))))) | |
7478 | (and headers | |
7479 | (vectorp headers) | |
7480 | (mail-header-subject headers)))) | |
7481 | ||
7482 | (defmacro gnus-summary-article-score (&optional number) | |
7483 | "Return current article score." | |
7484 | `(or (cdr (assq ,(or number '(gnus-summary-article-number)) | |
7485 | gnus-newsgroup-scored)) | |
7486 | gnus-summary-default-score 0)) | |
7487 | ||
7488 | (defun gnus-summary-article-children (&optional number) | |
7489 | (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) | |
7490 | (level (gnus-data-level (car data))) | |
7491 | l children) | |
7492 | (while (and (setq data (cdr data)) | |
7493 | (> (setq l (gnus-data-level (car data))) level)) | |
7494 | (and (= (1+ level) l) | |
7495 | (setq children (cons (gnus-data-number (car data)) | |
7496 | children)))) | |
7497 | (nreverse children))) | |
7498 | ||
7499 | (defun gnus-summary-article-parent (&optional number) | |
7500 | (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) | |
7501 | (gnus-data-list t))) | |
7502 | (level (gnus-data-level (car data)))) | |
7503 | (if (zerop level) | |
7504 | () ; This is a root. | |
7505 | ;; We search until we find an article with a level less than | |
7506 | ;; this one. That function has to be the parent. | |
7507 | (while (and (setq data (cdr data)) | |
7508 | (not (< (gnus-data-level (car data)) level)))) | |
7509 | (and data (gnus-data-number (car data)))))) | |
7510 | ||
7511 | (defun gnus-unread-mark-p (mark) | |
7512 | "Say whether MARK is the unread mark." | |
7513 | (= mark gnus-unread-mark)) | |
7514 | ||
7515 | (defun gnus-read-mark-p (mark) | |
7516 | "Say whether MARK is one of the marks that mark as read. | |
7517 | This is all marks except unread, ticked, dormant, and expirable." | |
7518 | (not (or (= mark gnus-unread-mark) | |
7519 | (= mark gnus-ticked-mark) | |
7520 | (= mark gnus-dormant-mark) | |
7521 | (= mark gnus-expirable-mark)))) | |
7522 | ||
7523 | ;; Saving hidden threads. | |
7524 | ||
7525 | (put 'gnus-save-hidden-threads 'lisp-indent-function 0) | |
7526 | (put 'gnus-save-hidden-threads 'lisp-indent-hook 0) | |
7527 | (put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) | |
7528 | ||
7529 | (defmacro gnus-save-hidden-threads (&rest forms) | |
7530 | "Save hidden threads, eval FORMS, and restore the hidden threads." | |
7531 | (let ((config (make-symbol "config"))) | |
7532 | `(let ((,config (gnus-hidden-threads-configuration))) | |
7533 | (unwind-protect | |
7534 | (progn | |
7535 | ,@forms) | |
7536 | (gnus-restore-hidden-threads-configuration ,config))))) | |
7537 | ||
7538 | (defun gnus-hidden-threads-configuration () | |
7539 | "Return the current hidden threads configuration." | |
7540 | (save-excursion | |
7541 | (let (config) | |
7542 | (goto-char (point-min)) | |
7543 | (while (search-forward "\r" nil t) | |
7544 | (push (1- (point)) config)) | |
7545 | config))) | |
7546 | ||
7547 | (defun gnus-restore-hidden-threads-configuration (config) | |
7548 | "Restore hidden threads configuration from CONFIG." | |
7549 | (let (point buffer-read-only) | |
7550 | (while (setq point (pop config)) | |
7551 | (when (and (< point (point-max)) | |
7552 | (goto-char point) | |
7553 | (= (following-char) ?\n)) | |
7554 | (subst-char-in-region point (1+ point) ?\n ?\r))))) | |
745bc783 | 7555 | |
41487370 | 7556 | ;; Various summary mode internalish functions. |
745bc783 | 7557 | |
41487370 LMI |
7558 | (defun gnus-mouse-pick-article (e) |
7559 | (interactive "e") | |
7560 | (mouse-set-point e) | |
7561 | (gnus-summary-next-page nil t)) | |
745bc783 | 7562 | |
41487370 LMI |
7563 | (defun gnus-summary-setup-buffer (group) |
7564 | "Initialize summary buffer." | |
7565 | (let ((buffer (concat "*Summary " group "*"))) | |
7566 | (if (get-buffer buffer) | |
745bc783 | 7567 | (progn |
41487370 | 7568 | (set-buffer buffer) |
231f989b LMI |
7569 | (setq gnus-summary-buffer (current-buffer)) |
7570 | (not gnus-newsgroup-prepared)) | |
41487370 LMI |
7571 | ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> |
7572 | (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) | |
7573 | (gnus-add-current-to-buffer-list) | |
7574 | (gnus-summary-mode group) | |
231f989b LMI |
7575 | (when gnus-carpal |
7576 | (gnus-carpal-setup-buffer 'summary)) | |
7577 | (unless gnus-single-article-buffer | |
7578 | (make-local-variable 'gnus-article-buffer) | |
7579 | (make-local-variable 'gnus-article-current) | |
7580 | (make-local-variable 'gnus-original-article-buffer)) | |
41487370 LMI |
7581 | (setq gnus-newsgroup-name group) |
7582 | t))) | |
7583 | ||
7584 | (defun gnus-set-global-variables () | |
7585 | ;; Set the global equivalents of the summary buffer-local variables | |
231f989b | 7586 | ;; to the latest values they had. These reflect the summary buffer |
41487370 | 7587 | ;; that was in action when the last article was fetched. |
231f989b LMI |
7588 | (when (eq major-mode 'gnus-summary-mode) |
7589 | (setq gnus-summary-buffer (current-buffer)) | |
7590 | (let ((name gnus-newsgroup-name) | |
7591 | (marked gnus-newsgroup-marked) | |
7592 | (unread gnus-newsgroup-unreads) | |
7593 | (headers gnus-current-headers) | |
7594 | (data gnus-newsgroup-data) | |
7595 | (summary gnus-summary-buffer) | |
7596 | (article-buffer gnus-article-buffer) | |
7597 | (original gnus-original-article-buffer) | |
7598 | (gac gnus-article-current) | |
7599 | (score-file gnus-current-score-file)) | |
7600 | (save-excursion | |
7601 | (set-buffer gnus-group-buffer) | |
7602 | (setq gnus-newsgroup-name name) | |
7603 | (setq gnus-newsgroup-marked marked) | |
7604 | (setq gnus-newsgroup-unreads unread) | |
7605 | (setq gnus-current-headers headers) | |
7606 | (setq gnus-newsgroup-data data) | |
7607 | (setq gnus-article-current gac) | |
7608 | (setq gnus-summary-buffer summary) | |
7609 | (setq gnus-article-buffer article-buffer) | |
7610 | (setq gnus-original-article-buffer original) | |
7611 | (setq gnus-current-score-file score-file))))) | |
7612 | ||
7613 | (defun gnus-summary-last-article-p (&optional article) | |
7614 | "Return whether ARTICLE is the last article in the buffer." | |
7615 | (if (not (setq article (or article (gnus-summary-article-number)))) | |
7616 | t ; All non-existant numbers are the last article. :-) | |
7617 | (not (cdr (gnus-data-find-list article))))) | |
7618 | ||
7619 | (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) | |
7620 | "Insert a dummy root in the summary buffer." | |
7621 | (beginning-of-line) | |
7622 | (gnus-add-text-properties | |
7623 | (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) | |
7624 | (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) | |
41487370 | 7625 | |
41487370 LMI |
7626 | (defun gnus-make-thread-indent-array () |
7627 | (let ((n 200)) | |
231f989b LMI |
7628 | (unless (and gnus-thread-indent-array |
7629 | (= gnus-thread-indent-level gnus-thread-indent-array-level)) | |
41487370 LMI |
7630 | (setq gnus-thread-indent-array (make-vector 201 "") |
7631 | gnus-thread-indent-array-level gnus-thread-indent-level) | |
7632 | (while (>= n 0) | |
7633 | (aset gnus-thread-indent-array n | |
7634 | (make-string (* n gnus-thread-indent-level) ? )) | |
7635 | (setq n (1- n)))))) | |
7636 | ||
231f989b LMI |
7637 | (defun gnus-summary-insert-line |
7638 | (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread | |
7639 | gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil | |
7640 | &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) | |
7641 | (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) | |
7642 | (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) | |
7643 | (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) | |
7644 | (gnus-tmp-score-char | |
41487370 | 7645 | (if (or (null gnus-summary-default-score) |
231f989b | 7646 | (<= (abs (- gnus-tmp-score gnus-summary-default-score)) |
41487370 | 7647 | gnus-summary-zcore-fuzz)) ? |
231f989b | 7648 | (if (< gnus-tmp-score gnus-summary-default-score) |
41487370 | 7649 | gnus-score-below-mark gnus-score-over-mark))) |
231f989b LMI |
7650 | (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) |
7651 | ((memq gnus-tmp-current gnus-newsgroup-cached) | |
7652 | gnus-cached-mark) | |
7653 | (gnus-tmp-replied gnus-replied-mark) | |
7654 | ((memq gnus-tmp-current gnus-newsgroup-saved) | |
7655 | gnus-saved-mark) | |
7656 | (t gnus-unread-mark))) | |
7657 | (gnus-tmp-from (mail-header-from gnus-tmp-header)) | |
7658 | (gnus-tmp-name | |
7659 | (cond | |
7660 | ((string-match "(.+)" gnus-tmp-from) | |
7661 | (substring gnus-tmp-from | |
7662 | (1+ (match-beginning 0)) (1- (match-end 0)))) | |
7663 | ((string-match "<[^>]+> *$" gnus-tmp-from) | |
7664 | (let ((beg (match-beginning 0))) | |
7665 | (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) | |
7666 | (substring gnus-tmp-from (1+ (match-beginning 0)) | |
7667 | (1- (match-end 0)))) | |
7668 | (substring gnus-tmp-from 0 beg)))) | |
7669 | (t gnus-tmp-from))) | |
7670 | (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) | |
7671 | (gnus-tmp-number (mail-header-number gnus-tmp-header)) | |
7672 | (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) | |
7673 | (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) | |
7674 | (buffer-read-only nil)) | |
7675 | (when (string= gnus-tmp-name "") | |
7676 | (setq gnus-tmp-name gnus-tmp-from)) | |
7677 | (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) | |
7678 | (gnus-put-text-property | |
7679 | (point) | |
7680 | (progn (eval gnus-summary-line-format-spec) (point)) | |
7681 | 'gnus-number gnus-tmp-number) | |
7682 | (when (gnus-visual-p 'summary-highlight 'highlight) | |
7683 | (forward-line -1) | |
7684 | (run-hooks 'gnus-summary-update-hook) | |
7685 | (forward-line 1)))) | |
41487370 LMI |
7686 | |
7687 | (defun gnus-summary-update-line (&optional dont-update) | |
7688 | ;; Update summary line after change. | |
231f989b LMI |
7689 | (when (and gnus-summary-default-score |
7690 | (not gnus-summary-inhibit-highlight)) | |
7691 | (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. | |
7692 | (article (gnus-summary-article-number)) | |
7693 | (score (gnus-summary-article-score article))) | |
7694 | (unless dont-update | |
7695 | (if (and gnus-summary-mark-below | |
7696 | (< (gnus-summary-article-score) | |
7697 | gnus-summary-mark-below)) | |
7698 | ;; This article has a low score, so we mark it as read. | |
7699 | (when (memq article gnus-newsgroup-unreads) | |
7700 | (gnus-summary-mark-article-as-read gnus-low-score-mark)) | |
7701 | (when (eq (gnus-summary-article-mark) gnus-low-score-mark) | |
7702 | ;; This article was previously marked as read on account | |
7703 | ;; of a low score, but now it has risen, so we mark it as | |
7704 | ;; unread. | |
7705 | (gnus-summary-mark-article-as-unread gnus-unread-mark))) | |
7706 | (gnus-summary-update-mark | |
7707 | (if (or (null gnus-summary-default-score) | |
7708 | (<= (abs (- score gnus-summary-default-score)) | |
7709 | gnus-summary-zcore-fuzz)) ? | |
7710 | (if (< score gnus-summary-default-score) | |
7711 | gnus-score-below-mark gnus-score-over-mark)) 'score)) | |
7712 | ;; Do visual highlighting. | |
7713 | (when (gnus-visual-p 'summary-highlight 'highlight) | |
7714 | (run-hooks 'gnus-summary-update-hook))))) | |
7715 | ||
7716 | (defvar gnus-tmp-new-adopts nil) | |
7717 | ||
7718 | (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) | |
41487370 LMI |
7719 | ;; Sum up all elements (and sub-elements) in a list. |
7720 | (let* ((number | |
7721 | ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>. | |
231f989b LMI |
7722 | (cond |
7723 | ((and (consp thread) (cdr thread)) | |
7724 | (apply | |
7725 | '+ 1 (mapcar | |
7726 | 'gnus-summary-number-of-articles-in-thread (cdr thread)))) | |
7727 | ((null thread) | |
7728 | 1) | |
7729 | ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) | |
7730 | 1) | |
7731 | (t 0)))) | |
7732 | (when (and level (zerop level) gnus-tmp-new-adopts) | |
7733 | (incf number | |
7734 | (apply '+ (mapcar | |
7735 | 'gnus-summary-number-of-articles-in-thread | |
7736 | gnus-tmp-new-adopts)))) | |
7737 | (if char | |
41487370 LMI |
7738 | (if (> number 1) gnus-not-empty-thread-mark |
7739 | gnus-empty-thread-mark) | |
7740 | number))) | |
7741 | ||
231f989b LMI |
7742 | (defun gnus-summary-set-local-parameters (group) |
7743 | "Go through the local params of GROUP and set all variable specs in that list." | |
7744 | (let ((params (gnus-info-params (gnus-get-info group))) | |
7745 | elem) | |
7746 | (while params | |
7747 | (setq elem (car params) | |
7748 | params (cdr params)) | |
7749 | (and (consp elem) ; Has to be a cons. | |
7750 | (consp (cdr elem)) ; The cdr has to be a list. | |
7751 | (symbolp (car elem)) ; Has to be a symbol in there. | |
7752 | (not (memq (car elem) | |
7753 | '(quit-config to-address to-list to-group))) | |
7754 | (progn ; So we set it. | |
7755 | (make-local-variable (car elem)) | |
7756 | (set (car elem) (eval (nth 1 elem)))))))) | |
7757 | ||
7758 | (defun gnus-summary-read-group (group &optional show-all no-article | |
7759 | kill-buffer no-display) | |
41487370 LMI |
7760 | "Start reading news in newsgroup GROUP. |
7761 | If SHOW-ALL is non-nil, already read articles are also listed. | |
231f989b LMI |
7762 | If NO-ARTICLE is non-nil, no article is selected initially. |
7763 | If NO-DISPLAY, don't generate a summary buffer." | |
41487370 LMI |
7764 | (gnus-message 5 "Retrieving newsgroup: %s..." group) |
7765 | (let* ((new-group (gnus-summary-setup-buffer group)) | |
7766 | (quit-config (gnus-group-quit-config group)) | |
7767 | (did-select (and new-group (gnus-select-newsgroup group show-all)))) | |
231f989b LMI |
7768 | (cond |
7769 | ;; This summary buffer exists already, so we just select it. | |
41487370 LMI |
7770 | ((not new-group) |
7771 | (gnus-set-global-variables) | |
231f989b LMI |
7772 | (when kill-buffer |
7773 | (gnus-kill-or-deaden-summary kill-buffer)) | |
41487370 LMI |
7774 | (gnus-configure-windows 'summary 'force) |
7775 | (gnus-set-mode-line 'summary) | |
231f989b | 7776 | (gnus-summary-position-point) |
41487370 LMI |
7777 | (message "") |
7778 | t) | |
231f989b LMI |
7779 | ;; We couldn't select this group. |
7780 | ((null did-select) | |
7781 | (when (and (eq major-mode 'gnus-summary-mode) | |
7782 | (not (equal (current-buffer) kill-buffer))) | |
7783 | (kill-buffer (current-buffer)) | |
7784 | (if (not quit-config) | |
7785 | (progn | |
7786 | (set-buffer gnus-group-buffer) | |
7787 | (gnus-group-jump-to-group group) | |
7788 | (gnus-group-next-unread-group 1)) | |
7789 | (if (not (buffer-name (car quit-config))) | |
7790 | (gnus-configure-windows 'group 'force) | |
7791 | (set-buffer (car quit-config)) | |
7792 | (and (eq major-mode 'gnus-summary-mode) | |
7793 | (gnus-set-global-variables)) | |
7794 | (gnus-configure-windows (cdr quit-config))))) | |
7795 | (gnus-message 3 "Can't select group") | |
41487370 | 7796 | nil) |
231f989b LMI |
7797 | ;; The user did a `C-g' while prompting for number of articles, |
7798 | ;; so we exit this group. | |
41487370 LMI |
7799 | ((eq did-select 'quit) |
7800 | (and (eq major-mode 'gnus-summary-mode) | |
7801 | (not (equal (current-buffer) kill-buffer)) | |
7802 | (kill-buffer (current-buffer))) | |
231f989b LMI |
7803 | (when kill-buffer |
7804 | (gnus-kill-or-deaden-summary kill-buffer)) | |
41487370 LMI |
7805 | (if (not quit-config) |
7806 | (progn | |
7807 | (set-buffer gnus-group-buffer) | |
7808 | (gnus-group-jump-to-group group) | |
7809 | (gnus-group-next-unread-group 1) | |
7810 | (gnus-configure-windows 'group 'force)) | |
7811 | (if (not (buffer-name (car quit-config))) | |
7812 | (gnus-configure-windows 'group 'force) | |
7813 | (set-buffer (car quit-config)) | |
7814 | (and (eq major-mode 'gnus-summary-mode) | |
7815 | (gnus-set-global-variables)) | |
7816 | (gnus-configure-windows (cdr quit-config)))) | |
231f989b | 7817 | ;; Finally signal the quit. |
41487370 | 7818 | (signal 'quit nil)) |
231f989b | 7819 | ;; The group was successfully selected. |
41487370 LMI |
7820 | (t |
7821 | (gnus-set-global-variables) | |
7822 | ;; Save the active value in effect when the group was entered. | |
231f989b | 7823 | (setq gnus-newsgroup-active |
41487370 | 7824 | (gnus-copy-sequence |
231f989b LMI |
7825 | (gnus-active gnus-newsgroup-name))) |
7826 | ;; You can change the summary buffer in some way with this hook. | |
41487370 | 7827 | (run-hooks 'gnus-select-group-hook) |
231f989b LMI |
7828 | ;; Set any local variables in the group parameters. |
7829 | (gnus-summary-set-local-parameters gnus-newsgroup-name) | |
41487370 | 7830 | (gnus-update-format-specifications) |
231f989b LMI |
7831 | ;; Do score processing. |
7832 | (when gnus-use-scoring | |
7833 | (gnus-possibly-score-headers)) | |
7834 | ;; Check whether to fill in the gaps in the threads. | |
7835 | (when gnus-build-sparse-threads | |
7836 | (gnus-build-sparse-threads)) | |
7837 | ;; Find the initial limit. | |
7838 | (if gnus-show-threads | |
7839 | (if show-all | |
7840 | (let ((gnus-newsgroup-dormant nil)) | |
7841 | (gnus-summary-initial-limit show-all)) | |
7842 | (gnus-summary-initial-limit show-all)) | |
7843 | (setq gnus-newsgroup-limit | |
7844 | (mapcar | |
7845 | (lambda (header) (mail-header-number header)) | |
7846 | gnus-newsgroup-headers))) | |
41487370 | 7847 | ;; Generate the summary buffer. |
231f989b LMI |
7848 | (unless no-display |
7849 | (gnus-summary-prepare)) | |
7850 | (when gnus-use-trees | |
7851 | (gnus-tree-open group) | |
7852 | (setq gnus-summary-highlight-line-function | |
7853 | 'gnus-tree-highlight-article)) | |
7854 | ;; If the summary buffer is empty, but there are some low-scored | |
7855 | ;; articles or some excluded dormants, we include these in the | |
7856 | ;; buffer. | |
7857 | (when (and (zerop (buffer-size)) | |
7858 | (not no-display)) | |
7859 | (cond (gnus-newsgroup-dormant | |
7860 | (gnus-summary-limit-include-dormant)) | |
7861 | ((and gnus-newsgroup-scored show-all) | |
7862 | (gnus-summary-limit-include-expunged)))) | |
41487370 LMI |
7863 | ;; Function `gnus-apply-kill-file' must be called in this hook. |
7864 | (run-hooks 'gnus-apply-kill-hook) | |
231f989b LMI |
7865 | (if (and (zerop (buffer-size)) |
7866 | (not no-display)) | |
41487370 LMI |
7867 | (progn |
7868 | ;; This newsgroup is empty. | |
7869 | (gnus-summary-catchup-and-exit nil t) ;Without confirmations. | |
7870 | (gnus-message 6 "No unread news") | |
231f989b LMI |
7871 | (when kill-buffer |
7872 | (gnus-kill-or-deaden-summary kill-buffer)) | |
7873 | ;; Return nil from this function. | |
41487370 | 7874 | nil) |
41487370 LMI |
7875 | ;; Hide conversation thread subtrees. We cannot do this in |
7876 | ;; gnus-summary-prepare-hook since kill processing may not | |
7877 | ;; work with hidden articles. | |
7878 | (and gnus-show-threads | |
7879 | gnus-thread-hide-subtree | |
7880 | (gnus-summary-hide-all-threads)) | |
7881 | ;; Show first unread article if requested. | |
41487370 | 7882 | (if (and (not no-article) |
231f989b LMI |
7883 | (not no-display) |
7884 | gnus-newsgroup-unreads | |
7885 | gnus-auto-select-first) | |
7886 | (unless (if (eq gnus-auto-select-first 'best) | |
7887 | (gnus-summary-best-unread-article) | |
7888 | (gnus-summary-first-unread-article)) | |
7889 | (gnus-configure-windows 'summary)) | |
7890 | ;; Don't select any articles, just move point to the first | |
7891 | ;; article in the group. | |
7892 | (goto-char (point-min)) | |
7893 | (gnus-summary-position-point) | |
7894 | (gnus-set-mode-line 'summary) | |
41487370 | 7895 | (gnus-configure-windows 'summary 'force)) |
231f989b LMI |
7896 | ;; If we are in async mode, we send some info to the backend. |
7897 | (when gnus-newsgroup-async | |
7898 | (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data)) | |
7899 | (when kill-buffer | |
7900 | (gnus-kill-or-deaden-summary kill-buffer)) | |
7901 | (when (get-buffer-window gnus-group-buffer t) | |
7902 | ;; Gotta use windows, because recenter does wierd stuff if | |
41487370 | 7903 | ;; the current buffer ain't the displayed window. |
231f989b LMI |
7904 | (let ((owin (selected-window))) |
7905 | (select-window (get-buffer-window gnus-group-buffer t)) | |
7906 | (when (gnus-group-goto-group group) | |
7907 | (recenter)) | |
7908 | (select-window owin)))) | |
7909 | ;; Mark this buffer as "prepared". | |
7910 | (setq gnus-newsgroup-prepared t) | |
41487370 LMI |
7911 | t)))) |
7912 | ||
7913 | (defun gnus-summary-prepare () | |
231f989b | 7914 | "Generate the summary buffer." |
41487370 LMI |
7915 | (let ((buffer-read-only nil)) |
7916 | (erase-buffer) | |
231f989b LMI |
7917 | (setq gnus-newsgroup-data nil |
7918 | gnus-newsgroup-data-reverse nil) | |
7919 | (run-hooks 'gnus-summary-generate-hook) | |
7920 | ;; Generate the buffer, either with threads or without. | |
7921 | (when gnus-newsgroup-headers | |
7922 | (gnus-summary-prepare-threads | |
7923 | (if gnus-show-threads | |
7924 | (gnus-sort-gathered-threads | |
7925 | (funcall gnus-summary-thread-gathering-function | |
7926 | (gnus-sort-threads | |
7927 | (gnus-cut-threads (gnus-make-threads))))) | |
7928 | ;; Unthreaded display. | |
7929 | (gnus-sort-articles gnus-newsgroup-headers)))) | |
7930 | (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) | |
41487370 | 7931 | ;; Call hooks for modifying summary buffer. |
41487370 LMI |
7932 | (goto-char (point-min)) |
7933 | (run-hooks 'gnus-summary-prepare-hook))) | |
7934 | ||
231f989b LMI |
7935 | (defun gnus-gather-threads-by-subject (threads) |
7936 | "Gather threads by looking at Subject headers." | |
41487370 | 7937 | (if (not gnus-summary-make-false-root) |
231f989b | 7938 | threads |
41487370 LMI |
7939 | (let ((hashtb (gnus-make-hashtable 1023)) |
7940 | (prev threads) | |
7941 | (result threads) | |
7942 | subject hthread whole-subject) | |
7943 | (while threads | |
231f989b LMI |
7944 | (setq whole-subject (mail-header-subject (caar threads))) |
7945 | (setq subject | |
7946 | (cond | |
7947 | ;; Truncate the subject. | |
7948 | ((numberp gnus-summary-gather-subject-limit) | |
7949 | (setq subject (gnus-simplify-subject-re whole-subject)) | |
7950 | (if (> (length subject) gnus-summary-gather-subject-limit) | |
7951 | (substring subject 0 gnus-summary-gather-subject-limit) | |
7952 | subject)) | |
7953 | ;; Fuzzily simplify it. | |
7954 | ((eq 'fuzzy gnus-summary-gather-subject-limit) | |
7955 | (gnus-simplify-subject-fuzzy whole-subject)) | |
7956 | ;; Just remove the leading "Re:". | |
7957 | (t | |
7958 | (gnus-simplify-subject-re whole-subject)))) | |
7959 | ||
7960 | (if (and gnus-summary-gather-exclude-subject | |
7961 | (string-match gnus-summary-gather-exclude-subject | |
7962 | subject)) | |
7963 | () ; We don't want to do anything with this article. | |
7964 | ;; We simplify the subject before looking it up in the | |
7965 | ;; hash table. | |
7966 | ||
7967 | (if (setq hthread (gnus-gethash subject hashtb)) | |
7968 | (progn | |
7969 | ;; We enter a dummy root into the thread, if we | |
7970 | ;; haven't done that already. | |
7971 | (unless (stringp (caar hthread)) | |
41487370 | 7972 | (setcar hthread (list whole-subject (car hthread)))) |
231f989b LMI |
7973 | ;; We add this new gathered thread to this gathered |
7974 | ;; thread. | |
7975 | (setcdr (car hthread) | |
7976 | (nconc (cdar hthread) (list (car threads)))) | |
7977 | ;; Remove it from the list of threads. | |
7978 | (setcdr prev (cdr threads)) | |
7979 | (setq threads prev)) | |
7980 | ;; Enter this thread into the hash table. | |
7981 | (gnus-sethash subject threads hashtb))) | |
41487370 LMI |
7982 | (setq prev threads) |
7983 | (setq threads (cdr threads))) | |
7984 | result))) | |
7985 | ||
231f989b LMI |
7986 | (defun gnus-gather-threads-by-references (threads) |
7987 | "Gather threads by looking at References headers." | |
7988 | (let ((idhashtb (gnus-make-hashtable 1023)) | |
7989 | (thhashtb (gnus-make-hashtable 1023)) | |
7990 | (prev threads) | |
7991 | (result threads) | |
7992 | ids references id gthread gid entered) | |
7993 | (while threads | |
7994 | (when (setq references (mail-header-references (caar threads))) | |
7995 | (setq id (mail-header-id (caar threads))) | |
7996 | (setq ids (gnus-split-references references)) | |
7997 | (setq entered nil) | |
7998 | (while ids | |
7999 | (if (not (setq gid (gnus-gethash (car ids) idhashtb))) | |
8000 | (progn | |
8001 | (gnus-sethash (car ids) id idhashtb) | |
8002 | (gnus-sethash id threads thhashtb)) | |
8003 | (setq gthread (gnus-gethash gid thhashtb)) | |
8004 | (unless entered | |
8005 | ;; We enter a dummy root into the thread, if we | |
8006 | ;; haven't done that already. | |
8007 | (unless (stringp (caar gthread)) | |
8008 | (setcar gthread (list (mail-header-subject (caar gthread)) | |
8009 | (car gthread)))) | |
8010 | ;; We add this new gathered thread to this gathered | |
8011 | ;; thread. | |
8012 | (setcdr (car gthread) | |
8013 | (nconc (cdar gthread) (list (car threads))))) | |
8014 | ;; Add it into the thread hash table. | |
8015 | (gnus-sethash id gthread thhashtb) | |
8016 | (setq entered t) | |
8017 | ;; Remove it from the list of threads. | |
8018 | (setcdr prev (cdr threads)) | |
8019 | (setq threads prev)) | |
8020 | (setq ids (cdr ids)))) | |
8021 | (setq prev threads) | |
8022 | (setq threads (cdr threads))) | |
8023 | result)) | |
41487370 | 8024 | |
231f989b LMI |
8025 | (defun gnus-sort-gathered-threads (threads) |
8026 | "Sort subtreads inside each gathered thread by article number." | |
8027 | (let ((result threads)) | |
8028 | (while threads | |
8029 | (when (stringp (caar threads)) | |
8030 | (setcdr (car threads) | |
8031 | (sort (cdar threads) 'gnus-thread-sort-by-number))) | |
8032 | (setq threads (cdr threads))) | |
8033 | result)) | |
41487370 | 8034 | |
231f989b LMI |
8035 | (defun gnus-make-threads () |
8036 | "Go through the dependency hashtb and find the roots. Return all threads." | |
8037 | (let (threads) | |
41487370 LMI |
8038 | (mapatoms |
8039 | (lambda (refs) | |
231f989b LMI |
8040 | (unless (car (symbol-value refs)) |
8041 | ;; These threads do not refer back to any other articles, | |
8042 | ;; so they're roots. | |
8043 | (setq threads (append (cdr (symbol-value refs)) threads)))) | |
41487370 | 8044 | gnus-newsgroup-dependencies) |
231f989b LMI |
8045 | threads)) |
8046 | ||
8047 | (defun gnus-build-sparse-threads () | |
8048 | (let ((headers gnus-newsgroup-headers) | |
8049 | (deps gnus-newsgroup-dependencies) | |
8050 | header references generation relations | |
8051 | cthread subject child end pthread relation) | |
8052 | ;; First we create an alist of generations/relations, where | |
8053 | ;; generations is how much we trust the ralation, and the relation | |
8054 | ;; is parent/child. | |
8055 | (gnus-message 7 "Making sparse threads...") | |
8056 | (save-excursion | |
8057 | (nnheader-set-temp-buffer " *gnus sparse threads*") | |
8058 | (while (setq header (pop headers)) | |
8059 | (when (and (setq references (mail-header-references header)) | |
8060 | (not (string= references ""))) | |
8061 | (insert references) | |
8062 | (setq child (mail-header-id header) | |
8063 | subject (mail-header-subject header)) | |
8064 | (setq generation 0) | |
8065 | (while (search-backward ">" nil t) | |
8066 | (setq end (1+ (point))) | |
8067 | (when (search-backward "<" nil t) | |
8068 | (push (list (incf generation) | |
8069 | child (setq child (buffer-substring (point) end)) | |
8070 | subject) | |
8071 | relations))) | |
8072 | (push (list (1+ generation) child nil subject) relations) | |
8073 | (erase-buffer))) | |
8074 | (kill-buffer (current-buffer))) | |
8075 | ;; Sort over trustworthiness. | |
8076 | (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2))))) | |
8077 | (while (setq relation (pop relations)) | |
8078 | (when (if (boundp (setq cthread (intern (cadr relation) deps))) | |
8079 | (unless (car (symbol-value cthread)) | |
8080 | ;; Make this article the parent of these threads. | |
8081 | (setcar (symbol-value cthread) | |
8082 | (vector gnus-reffed-article-number | |
8083 | (cadddr relation) | |
8084 | "" "" | |
8085 | (cadr relation) | |
8086 | (or (caddr relation) "") 0 0 ""))) | |
8087 | (set cthread (list (vector gnus-reffed-article-number | |
8088 | (cadddr relation) | |
8089 | "" "" (cadr relation) | |
8090 | (or (caddr relation) "") 0 0 "")))) | |
8091 | (push gnus-reffed-article-number gnus-newsgroup-limit) | |
8092 | (push gnus-reffed-article-number gnus-newsgroup-sparse) | |
8093 | (push (cons gnus-reffed-article-number gnus-sparse-mark) | |
8094 | gnus-newsgroup-reads) | |
8095 | (decf gnus-reffed-article-number) | |
8096 | ;; Make this new thread the child of its parent. | |
8097 | (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) | |
8098 | (setcdr (symbol-value pthread) | |
8099 | (nconc (cdr (symbol-value pthread)) | |
8100 | (list (symbol-value cthread)))) | |
8101 | (set pthread (list nil (symbol-value cthread)))))) | |
8102 | (gnus-message 7 "Making sparse threads...done"))) | |
41487370 LMI |
8103 | |
8104 | (defun gnus-build-old-threads () | |
8105 | ;; Look at all the articles that refer back to old articles, and | |
231f989b | 8106 | ;; fetch the headers for the articles that aren't there. This will |
41487370 LMI |
8107 | ;; build complete threads - if the roots haven't been expired by the |
8108 | ;; server, that is. | |
8109 | (let (id heads) | |
8110 | (mapatoms | |
8111 | (lambda (refs) | |
231f989b LMI |
8112 | (when (not (car (symbol-value refs))) |
8113 | (setq heads (cdr (symbol-value refs))) | |
8114 | (while heads | |
8115 | (if (memq (mail-header-number (caar heads)) | |
8116 | gnus-newsgroup-dormant) | |
8117 | (setq heads (cdr heads)) | |
8118 | (setq id (symbol-name refs)) | |
8119 | (while (and (setq id (gnus-build-get-header id)) | |
8120 | (not (car (gnus-gethash | |
8121 | id gnus-newsgroup-dependencies))))) | |
8122 | (setq heads nil))))) | |
41487370 LMI |
8123 | gnus-newsgroup-dependencies))) |
8124 | ||
8125 | (defun gnus-build-get-header (id) | |
8126 | ;; Look through the buffer of NOV lines and find the header to | |
231f989b | 8127 | ;; ID. Enter this line into the dependencies hash table, and return |
41487370 LMI |
8128 | ;; the id of the parent article (if any). |
8129 | (let ((deps gnus-newsgroup-dependencies) | |
8130 | found header) | |
8131 | (prog1 | |
8132 | (save-excursion | |
8133 | (set-buffer nntp-server-buffer) | |
8134 | (goto-char (point-min)) | |
8135 | (while (and (not found) (search-forward id nil t)) | |
8136 | (beginning-of-line) | |
231f989b | 8137 | (setq found (looking-at |
41487370 LMI |
8138 | (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" |
8139 | (regexp-quote id)))) | |
8140 | (or found (beginning-of-line 2))) | |
231f989b LMI |
8141 | (when found |
8142 | (beginning-of-line) | |
8143 | (and | |
8144 | (setq header (gnus-nov-parse-line | |
8145 | (read (current-buffer)) deps)) | |
8146 | (gnus-parent-id (mail-header-references header))))) | |
8147 | (when header | |
8148 | (let ((number (mail-header-number header))) | |
8149 | (push number gnus-newsgroup-limit) | |
8150 | (push header gnus-newsgroup-headers) | |
8151 | (if (memq number gnus-newsgroup-unselected) | |
8152 | (progn | |
8153 | (push number gnus-newsgroup-unreads) | |
8154 | (setq gnus-newsgroup-unselected | |
8155 | (delq number gnus-newsgroup-unselected))) | |
8156 | (push number gnus-newsgroup-ancient))))))) | |
8157 | ||
8158 | (defun gnus-summary-update-article (article &optional iheader) | |
8159 | "Update ARTICLE in the summary buffer." | |
8160 | (set-buffer gnus-summary-buffer) | |
8161 | (let* ((header (or iheader (gnus-summary-article-header article))) | |
8162 | (id (mail-header-id header)) | |
8163 | (data (gnus-data-find article)) | |
8164 | (thread (gnus-id-to-thread id)) | |
8165 | (references (mail-header-references header)) | |
8166 | (parent | |
8167 | (gnus-id-to-thread | |
8168 | (or (gnus-parent-id | |
8169 | (if (and references | |
8170 | (not (equal "" references))) | |
8171 | references)) | |
8172 | "none"))) | |
8173 | (buffer-read-only nil) | |
8174 | (old (car thread)) | |
8175 | (number (mail-header-number header)) | |
8176 | pos) | |
8177 | (when thread | |
8178 | ;; !!! Should this be in or not? | |
8179 | (unless iheader | |
8180 | (setcar thread nil)) | |
8181 | (when parent | |
8182 | (delq thread parent)) | |
8183 | (if (gnus-summary-insert-subject id header iheader) | |
8184 | ;; Set the (possibly) new article number in the data structure. | |
8185 | (gnus-data-set-number data (gnus-id-to-article id)) | |
8186 | (setcar thread old) | |
8187 | nil)))) | |
8188 | ||
41487370 | 8189 | (defun gnus-rebuild-thread (id) |
231f989b LMI |
8190 | "Rebuild the thread containing ID." |
8191 | (let ((buffer-read-only nil) | |
8192 | current thread data) | |
8193 | (if (not gnus-show-threads) | |
8194 | (setq thread (list (car (gnus-id-to-thread id)))) | |
8195 | ;; Get the thread this article is part of. | |
8196 | (setq thread (gnus-remove-thread id))) | |
8197 | (setq current (save-excursion | |
8198 | (and (zerop (forward-line -1)) | |
8199 | (gnus-summary-article-number)))) | |
8200 | ;; If this is a gathered thread, we have to go some re-gathering. | |
8201 | (when (stringp (car thread)) | |
8202 | (let ((subject (car thread)) | |
8203 | roots thr) | |
8204 | (setq thread (cdr thread)) | |
8205 | (while thread | |
8206 | (unless (memq (setq thr (gnus-id-to-thread | |
8207 | (gnus-root-id | |
8208 | (mail-header-id (caar thread))))) | |
8209 | roots) | |
8210 | (push thr roots)) | |
8211 | (setq thread (cdr thread))) | |
8212 | ;; We now have all (unique) roots. | |
8213 | (if (= (length roots) 1) | |
8214 | ;; All the loose roots are now one solid root. | |
8215 | (setq thread (car roots)) | |
8216 | (setq thread (cons subject (gnus-sort-threads roots)))))) | |
8217 | (let (threads) | |
8218 | ;; We then insert this thread into the summary buffer. | |
8219 | (let (gnus-newsgroup-data gnus-newsgroup-threads) | |
8220 | (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) | |
8221 | (setq data (nreverse gnus-newsgroup-data)) | |
8222 | (setq threads gnus-newsgroup-threads)) | |
8223 | ;; We splice the new data into the data structure. | |
8224 | (gnus-data-enter-list current data) | |
8225 | (gnus-data-compute-positions) | |
8226 | (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) | |
8227 | ||
8228 | (defun gnus-number-to-header (number) | |
8229 | "Return the header for article NUMBER." | |
8230 | (let ((headers gnus-newsgroup-headers)) | |
8231 | (while (and headers | |
8232 | (not (= number (mail-header-number (car headers))))) | |
8233 | (pop headers)) | |
8234 | (when headers | |
8235 | (car headers)))) | |
8236 | ||
8237 | (defun gnus-id-to-thread (id) | |
8238 | "Return the (sub-)thread where ID appears." | |
8239 | (gnus-gethash id gnus-newsgroup-dependencies)) | |
8240 | ||
8241 | (defun gnus-id-to-article (id) | |
8242 | "Return the article number of ID." | |
8243 | (let ((thread (gnus-id-to-thread id))) | |
8244 | (when (and thread | |
8245 | (car thread)) | |
8246 | (mail-header-number (car thread))))) | |
8247 | ||
8248 | (defun gnus-id-to-header (id) | |
8249 | "Return the article headers of ID." | |
8250 | (car (gnus-id-to-thread id))) | |
8251 | ||
8252 | (defun gnus-article-displayed-root-p (article) | |
8253 | "Say whether ARTICLE is a root(ish) article." | |
8254 | (let ((level (gnus-summary-thread-level article)) | |
8255 | (refs (mail-header-references (gnus-summary-article-header article))) | |
8256 | particle) | |
8257 | (cond | |
8258 | ((null level) nil) | |
8259 | ((zerop level) t) | |
8260 | ((null refs) t) | |
8261 | ((null (gnus-parent-id refs)) t) | |
8262 | ((and (= 1 level) | |
8263 | (null (setq particle (gnus-id-to-article | |
8264 | (gnus-parent-id refs)))) | |
8265 | (null (gnus-summary-thread-level particle))))))) | |
8266 | ||
8267 | (defun gnus-root-id (id) | |
8268 | "Return the id of the root of the thread where ID appears." | |
8269 | (let (last-id prev) | |
8270 | (while (and id (setq prev (car (gnus-gethash | |
8271 | id gnus-newsgroup-dependencies)))) | |
8272 | (setq last-id id | |
8273 | id (gnus-parent-id (mail-header-references prev)))) | |
8274 | last-id)) | |
8275 | ||
8276 | (defun gnus-remove-thread (id &optional dont-remove) | |
8277 | "Remove the thread that has ID in it." | |
41487370 | 8278 | (let ((dep gnus-newsgroup-dependencies) |
231f989b LMI |
8279 | headers thread last-id) |
8280 | ;; First go up in this thread until we find the root. | |
8281 | (setq last-id (gnus-root-id id)) | |
8282 | (setq headers (list (car (gnus-id-to-thread last-id)) | |
8283 | (caadr (gnus-id-to-thread last-id)))) | |
8284 | ;; We have now found the real root of this thread. It might have | |
8285 | ;; been gathered into some loose thread, so we have to search | |
8286 | ;; through the threads to find the thread we wanted. | |
8287 | (let ((threads gnus-newsgroup-threads) | |
8288 | sub) | |
8289 | (while threads | |
8290 | (setq sub (car threads)) | |
8291 | (if (stringp (car sub)) | |
8292 | ;; This is a gathered threads, so we look at the roots | |
8293 | ;; below it to find whether this article in in this | |
8294 | ;; gathered root. | |
8295 | (progn | |
8296 | (setq sub (cdr sub)) | |
8297 | (while sub | |
8298 | (when (member (caar sub) headers) | |
8299 | (setq thread (car threads) | |
8300 | threads nil | |
8301 | sub nil)) | |
8302 | (setq sub (cdr sub)))) | |
8303 | ;; It's an ordinary thread, so we check it. | |
8304 | (when (eq (car sub) (car headers)) | |
8305 | (setq thread sub | |
8306 | threads nil))) | |
8307 | (setq threads (cdr threads))) | |
8308 | ;; If this article is in no thread, then it's a root. | |
8309 | (if thread | |
8310 | (unless dont-remove | |
8311 | (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) | |
8312 | (setq thread (gnus-gethash last-id dep))) | |
8313 | (when thread | |
8314 | (prog1 | |
8315 | thread ; We return this thread. | |
8316 | (unless dont-remove | |
8317 | (if (stringp (car thread)) | |
8318 | (progn | |
8319 | ;; If we use dummy roots, then we have to remove the | |
8320 | ;; dummy root as well. | |
8321 | (when (eq gnus-summary-make-false-root 'dummy) | |
8322 | ;; Uhm. | |
8323 | ) | |
8324 | (setq thread (cdr thread)) | |
8325 | (while thread | |
8326 | (gnus-remove-thread-1 (car thread)) | |
8327 | (setq thread (cdr thread)))) | |
8328 | (gnus-remove-thread-1 thread)))))))) | |
8329 | ||
8330 | (defun gnus-remove-thread-1 (thread) | |
8331 | "Remove the thread THREAD recursively." | |
8332 | (let ((number (mail-header-number (car thread))) | |
8333 | pos) | |
8334 | (when (setq pos (text-property-any | |
8335 | (point-min) (point-max) 'gnus-number number)) | |
8336 | (goto-char pos) | |
8337 | (gnus-delete-line) | |
8338 | (gnus-data-remove number)) | |
8339 | (setq thread (cdr thread)) | |
8340 | (while thread | |
8341 | (gnus-remove-thread-1 (pop thread))))) | |
41487370 LMI |
8342 | |
8343 | (defun gnus-sort-threads (threads) | |
231f989b LMI |
8344 | "Sort THREADS." |
8345 | (if (not gnus-thread-sort-functions) | |
8346 | threads | |
8347 | (let ((func (if (= 1 (length gnus-thread-sort-functions)) | |
8348 | (car gnus-thread-sort-functions) | |
8349 | `(lambda (t1 t2) | |
8350 | ,(gnus-make-sort-function | |
8351 | (reverse gnus-thread-sort-functions)))))) | |
8352 | (gnus-message 7 "Sorting threads...") | |
8353 | (prog1 | |
8354 | (sort threads func) | |
8355 | (gnus-message 7 "Sorting threads...done"))))) | |
8356 | ||
8357 | (defun gnus-sort-articles (articles) | |
8358 | "Sort ARTICLES." | |
8359 | (when gnus-article-sort-functions | |
8360 | (let ((func (if (= 1 (length gnus-article-sort-functions)) | |
8361 | (car gnus-article-sort-functions) | |
8362 | `(lambda (t1 t2) | |
8363 | ,(gnus-make-sort-function | |
8364 | (reverse gnus-article-sort-functions)))))) | |
8365 | (gnus-message 7 "Sorting articles...") | |
8366 | (prog1 | |
8367 | (setq gnus-newsgroup-headers (sort articles func)) | |
8368 | (gnus-message 7 "Sorting articles...done"))))) | |
8369 | ||
8370 | (defun gnus-make-sort-function (funs) | |
8371 | "Return a composite sort condition based on the functions in FUNC." | |
8372 | (if (cdr funs) | |
8373 | `(or (,(car funs) t1 t2) | |
8374 | (and (not (,(car funs) t2 t1)) | |
8375 | ,(gnus-make-sort-function (cdr funs)))) | |
8376 | `(,(car funs) t1 t2))) | |
8377 | ||
41487370 LMI |
8378 | ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. |
8379 | (defmacro gnus-thread-header (thread) | |
8380 | ;; Return header of first article in THREAD. | |
231f989b | 8381 | ;; Note that THREAD must never, ever be anything else than a variable - |
41487370 LMI |
8382 | ;; using some other form will lead to serious barfage. |
8383 | (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) | |
8384 | ;; (8% speedup to gnus-summary-prepare, just for fun :-) | |
231f989b | 8385 | (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; |
41487370 LMI |
8386 | (vector thread) 2)) |
8387 | ||
231f989b LMI |
8388 | (defsubst gnus-article-sort-by-number (h1 h2) |
8389 | "Sort articles by article number." | |
8390 | (< (mail-header-number h1) | |
8391 | (mail-header-number h2))) | |
8392 | ||
41487370 LMI |
8393 | (defun gnus-thread-sort-by-number (h1 h2) |
8394 | "Sort threads by root article number." | |
231f989b LMI |
8395 | (gnus-article-sort-by-number |
8396 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
41487370 | 8397 | |
231f989b LMI |
8398 | (defsubst gnus-article-sort-by-author (h1 h2) |
8399 | "Sort articles by root author." | |
41487370 | 8400 | (string-lessp |
231f989b | 8401 | (let ((extract (funcall |
41487370 | 8402 | gnus-extract-address-components |
231f989b | 8403 | (mail-header-from h1)))) |
41487370 LMI |
8404 | (or (car extract) (cdr extract))) |
8405 | (let ((extract (funcall | |
231f989b LMI |
8406 | gnus-extract-address-components |
8407 | (mail-header-from h2)))) | |
41487370 LMI |
8408 | (or (car extract) (cdr extract))))) |
8409 | ||
231f989b LMI |
8410 | (defun gnus-thread-sort-by-author (h1 h2) |
8411 | "Sort threads by root author." | |
8412 | (gnus-article-sort-by-author | |
8413 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
8414 | ||
8415 | (defsubst gnus-article-sort-by-subject (h1 h2) | |
8416 | "Sort articles by root subject." | |
8417 | (string-lessp | |
8418 | (downcase (gnus-simplify-subject-re (mail-header-subject h1))) | |
8419 | (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) | |
8420 | ||
41487370 LMI |
8421 | (defun gnus-thread-sort-by-subject (h1 h2) |
8422 | "Sort threads by root subject." | |
231f989b LMI |
8423 | (gnus-article-sort-by-subject |
8424 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
8425 | ||
8426 | (defsubst gnus-article-sort-by-date (h1 h2) | |
8427 | "Sort articles by root article date." | |
41487370 | 8428 | (string-lessp |
231f989b LMI |
8429 | (inline (gnus-sortable-date (mail-header-date h1))) |
8430 | (inline (gnus-sortable-date (mail-header-date h2))))) | |
41487370 LMI |
8431 | |
8432 | (defun gnus-thread-sort-by-date (h1 h2) | |
8433 | "Sort threads by root article date." | |
231f989b LMI |
8434 | (gnus-article-sort-by-date |
8435 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
41487370 | 8436 | |
231f989b LMI |
8437 | (defsubst gnus-article-sort-by-score (h1 h2) |
8438 | "Sort articles by root article score. | |
41487370 | 8439 | Unscored articles will be counted as having a score of zero." |
231f989b | 8440 | (> (or (cdr (assq (mail-header-number h1) |
41487370 LMI |
8441 | gnus-newsgroup-scored)) |
8442 | gnus-summary-default-score 0) | |
231f989b | 8443 | (or (cdr (assq (mail-header-number h2) |
41487370 LMI |
8444 | gnus-newsgroup-scored)) |
8445 | gnus-summary-default-score 0))) | |
8446 | ||
231f989b LMI |
8447 | (defun gnus-thread-sort-by-score (h1 h2) |
8448 | "Sort threads by root article score." | |
8449 | (gnus-article-sort-by-score | |
8450 | (gnus-thread-header h1) (gnus-thread-header h2))) | |
8451 | ||
41487370 LMI |
8452 | (defun gnus-thread-sort-by-total-score (h1 h2) |
8453 | "Sort threads by the sum of all scores in the thread. | |
8454 | Unscored articles will be counted as having a score of zero." | |
8455 | (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) | |
8456 | ||
8457 | (defun gnus-thread-total-score (thread) | |
8458 | ;; This function find the total score of THREAD. | |
231f989b LMI |
8459 | (cond ((null thread) |
8460 | 0) | |
8461 | ((consp thread) | |
8462 | (if (stringp (car thread)) | |
8463 | (apply gnus-thread-score-function 0 | |
8464 | (mapcar 'gnus-thread-total-score-1 (cdr thread))) | |
8465 | (gnus-thread-total-score-1 thread))) | |
8466 | (t | |
8467 | (gnus-thread-total-score-1 (list thread))))) | |
41487370 LMI |
8468 | |
8469 | (defun gnus-thread-total-score-1 (root) | |
8470 | ;; This function find the total score of the thread below ROOT. | |
8471 | (setq root (car root)) | |
8472 | (apply gnus-thread-score-function | |
564b670b LMI |
8473 | (or (append |
8474 | (mapcar 'gnus-thread-total-score | |
8475 | (cdr (gnus-gethash (mail-header-id root) | |
8476 | gnus-newsgroup-dependencies))) | |
8477 | (if (> (mail-header-number root) 0) | |
8478 | (list (or (cdr (assq (mail-header-number root) | |
8479 | gnus-newsgroup-scored)) | |
8480 | gnus-summary-default-score 0)))) | |
8481 | (list gnus-summary-default-score) | |
8482 | '(0)))) | |
41487370 LMI |
8483 | |
8484 | ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. | |
231f989b LMI |
8485 | (defvar gnus-tmp-prev-subject nil) |
8486 | (defvar gnus-tmp-false-parent nil) | |
8487 | (defvar gnus-tmp-root-expunged nil) | |
8488 | (defvar gnus-tmp-dummy-line nil) | |
8489 | ||
8490 | (defun gnus-summary-prepare-threads (threads) | |
8491 | "Prepare summary buffer from THREADS and indentation LEVEL. | |
8492 | THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' | |
41487370 | 8493 | or a straight list of headers." |
231f989b LMI |
8494 | (gnus-message 7 "Generating summary...") |
8495 | ||
8496 | (setq gnus-newsgroup-threads threads) | |
8497 | (beginning-of-line) | |
8498 | ||
8499 | (let ((gnus-tmp-level 0) | |
8500 | (default-score (or gnus-summary-default-score 0)) | |
8501 | (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) | |
8502 | thread number subject stack state gnus-tmp-gathered beg-match | |
8503 | new-roots gnus-tmp-new-adopts thread-end | |
8504 | gnus-tmp-header gnus-tmp-unread | |
8505 | gnus-tmp-replied gnus-tmp-subject-or-nil | |
8506 | gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score | |
8507 | gnus-tmp-score-char gnus-tmp-from gnus-tmp-name | |
8508 | gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) | |
8509 | ||
8510 | (setq gnus-tmp-prev-subject nil) | |
8511 | ||
41487370 LMI |
8512 | (if (vectorp (car threads)) |
8513 | ;; If this is a straight (sic) list of headers, then a | |
8514 | ;; threaded summary display isn't required, so we just create | |
8515 | ;; an unthreaded one. | |
231f989b | 8516 | (gnus-summary-prepare-unthreaded threads) |
41487370 LMI |
8517 | |
8518 | ;; Do the threaded display. | |
8519 | ||
231f989b LMI |
8520 | (while (or threads stack gnus-tmp-new-adopts new-roots) |
8521 | ||
8522 | (if (and (= gnus-tmp-level 0) | |
8523 | (not (setq gnus-tmp-dummy-line nil)) | |
8524 | (or (not stack) | |
8525 | (= (caar stack) 0)) | |
8526 | (not gnus-tmp-false-parent) | |
8527 | (or gnus-tmp-new-adopts new-roots)) | |
8528 | (if gnus-tmp-new-adopts | |
8529 | (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) | |
8530 | thread (list (car gnus-tmp-new-adopts)) | |
8531 | gnus-tmp-header (caar thread) | |
8532 | gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) | |
8533 | (if new-roots | |
8534 | (setq thread (list (car new-roots)) | |
8535 | gnus-tmp-header (caar thread) | |
8536 | new-roots (cdr new-roots)))) | |
8537 | ||
8538 | (if threads | |
8539 | ;; If there are some threads, we do them before the | |
8540 | ;; threads on the stack. | |
8541 | (setq thread threads | |
8542 | gnus-tmp-header (caar thread)) | |
8543 | ;; There were no current threads, so we pop something off | |
8544 | ;; the stack. | |
8545 | (setq state (car stack) | |
8546 | gnus-tmp-level (car state) | |
8547 | thread (cdr state) | |
8548 | stack (cdr stack) | |
8549 | gnus-tmp-header (caar thread)))) | |
8550 | ||
8551 | (setq gnus-tmp-false-parent nil) | |
8552 | (setq gnus-tmp-root-expunged nil) | |
8553 | (setq thread-end nil) | |
8554 | ||
8555 | (if (stringp gnus-tmp-header) | |
8556 | ;; The header is a dummy root. | |
8557 | (cond | |
8558 | ((eq gnus-summary-make-false-root 'adopt) | |
8559 | ;; We let the first article adopt the rest. | |
8560 | (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts | |
8561 | (cddar thread))) | |
8562 | (setq gnus-tmp-gathered | |
8563 | (nconc (mapcar | |
8564 | (lambda (h) (mail-header-number (car h))) | |
8565 | (cddar thread)) | |
8566 | gnus-tmp-gathered)) | |
8567 | (setq thread (cons (list (caar thread) | |
8568 | (cadar thread)) | |
8569 | (cdr thread))) | |
8570 | (setq gnus-tmp-level -1 | |
8571 | gnus-tmp-false-parent t)) | |
8572 | ((eq gnus-summary-make-false-root 'empty) | |
8573 | ;; We print adopted articles with empty subject fields. | |
8574 | (setq gnus-tmp-gathered | |
8575 | (nconc (mapcar | |
8576 | (lambda (h) (mail-header-number (car h))) | |
8577 | (cddar thread)) | |
8578 | gnus-tmp-gathered)) | |
8579 | (setq gnus-tmp-level -1)) | |
8580 | ((eq gnus-summary-make-false-root 'dummy) | |
8581 | ;; We remember that we probably want to output a dummy | |
8582 | ;; root. | |
8583 | (setq gnus-tmp-dummy-line gnus-tmp-header) | |
8584 | (setq gnus-tmp-prev-subject gnus-tmp-header)) | |
8585 | (t | |
8586 | ;; We do not make a root for the gathered | |
8587 | ;; sub-threads at all. | |
8588 | (setq gnus-tmp-level -1))) | |
8589 | ||
8590 | (setq number (mail-header-number gnus-tmp-header) | |
8591 | subject (mail-header-subject gnus-tmp-header)) | |
8592 | ||
8593 | (cond | |
8594 | ;; If the thread has changed subject, we might want to make | |
8595 | ;; this subthread into a root. | |
8596 | ((and (null gnus-thread-ignore-subject) | |
8597 | (not (zerop gnus-tmp-level)) | |
8598 | gnus-tmp-prev-subject | |
8599 | (not (inline | |
8600 | (gnus-subject-equal gnus-tmp-prev-subject subject)))) | |
8601 | (setq new-roots (nconc new-roots (list (car thread))) | |
8602 | thread-end t | |
8603 | gnus-tmp-header nil)) | |
8604 | ;; If the article lies outside the current limit, | |
8605 | ;; then we do not display it. | |
8606 | ((and (not (memq number gnus-newsgroup-limit)) | |
22e46c65 | 8607 | (not gnus-tmp-dummy-line)) |
231f989b LMI |
8608 | (setq gnus-tmp-gathered |
8609 | (nconc (mapcar | |
8610 | (lambda (h) (mail-header-number (car h))) | |
8611 | (cdar thread)) | |
8612 | gnus-tmp-gathered)) | |
8613 | (setq gnus-tmp-new-adopts (if (cdar thread) | |
8614 | (append gnus-tmp-new-adopts | |
8615 | (cdar thread)) | |
8616 | gnus-tmp-new-adopts) | |
8617 | thread-end t | |
8618 | gnus-tmp-header nil) | |
8619 | (when (zerop gnus-tmp-level) | |
8620 | (setq gnus-tmp-root-expunged t))) | |
8621 | ;; Perhaps this article is to be marked as read? | |
8622 | ((and gnus-summary-mark-below | |
8623 | (< (or (cdr (assq number gnus-newsgroup-scored)) | |
8624 | default-score) | |
8625 | gnus-summary-mark-below) | |
8626 | ;; Don't touch sparse articles. | |
8627 | (not (memq number gnus-newsgroup-sparse)) | |
8628 | (not (memq number gnus-newsgroup-ancient))) | |
8629 | (setq gnus-newsgroup-unreads | |
8630 | (delq number gnus-newsgroup-unreads)) | |
8631 | (if gnus-newsgroup-auto-expire | |
8632 | (push number gnus-newsgroup-expirable) | |
8633 | (push (cons number gnus-low-score-mark) | |
8634 | gnus-newsgroup-reads)))) | |
8635 | ||
8636 | (when gnus-tmp-header | |
8637 | ;; We may have an old dummy line to output before this | |
8638 | ;; article. | |
8639 | (when gnus-tmp-dummy-line | |
8640 | (gnus-summary-insert-dummy-line | |
8641 | gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) | |
8642 | (setq gnus-tmp-dummy-line nil)) | |
8643 | ||
8644 | ;; Compute the mark. | |
8645 | (setq | |
8646 | gnus-tmp-unread | |
8647 | (cond | |
8648 | ((memq number gnus-newsgroup-unreads) gnus-unread-mark) | |
8649 | ((memq number gnus-newsgroup-marked) gnus-ticked-mark) | |
8650 | ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) | |
8651 | ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) | |
8652 | (t (or (cdr (assq number gnus-newsgroup-reads)) | |
8653 | gnus-ancient-mark)))) | |
8654 | ||
8655 | (push (gnus-data-make number gnus-tmp-unread (1+ (point)) | |
8656 | gnus-tmp-header gnus-tmp-level) | |
8657 | gnus-newsgroup-data) | |
8658 | ||
8659 | ;; Actually insert the line. | |
8660 | (setq | |
8661 | gnus-tmp-subject-or-nil | |
8662 | (cond | |
8663 | ((and gnus-thread-ignore-subject | |
8664 | gnus-tmp-prev-subject | |
8665 | (not (inline (gnus-subject-equal | |
8666 | gnus-tmp-prev-subject subject)))) | |
8667 | subject) | |
8668 | ((zerop gnus-tmp-level) | |
8669 | (if (and (eq gnus-summary-make-false-root 'empty) | |
8670 | (memq number gnus-tmp-gathered) | |
8671 | gnus-tmp-prev-subject | |
8672 | (inline (gnus-subject-equal | |
8673 | gnus-tmp-prev-subject subject))) | |
8674 | gnus-summary-same-subject | |
8675 | subject)) | |
8676 | (t gnus-summary-same-subject))) | |
8677 | (if (and (eq gnus-summary-make-false-root 'adopt) | |
8678 | (= gnus-tmp-level 1) | |
41487370 | 8679 | (memq number gnus-tmp-gathered)) |
231f989b LMI |
8680 | (setq gnus-tmp-opening-bracket ?\< |
8681 | gnus-tmp-closing-bracket ?\>) | |
8682 | (setq gnus-tmp-opening-bracket ?\[ | |
8683 | gnus-tmp-closing-bracket ?\])) | |
8684 | (setq | |
8685 | gnus-tmp-indentation | |
8686 | (aref gnus-thread-indent-array gnus-tmp-level) | |
8687 | gnus-tmp-lines (mail-header-lines gnus-tmp-header) | |
8688 | gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) | |
8689 | gnus-summary-default-score 0) | |
8690 | gnus-tmp-score-char | |
8691 | (if (or (null gnus-summary-default-score) | |
8692 | (<= (abs (- gnus-tmp-score gnus-summary-default-score)) | |
8693 | gnus-summary-zcore-fuzz)) ? | |
8694 | (if (< gnus-tmp-score gnus-summary-default-score) | |
8695 | gnus-score-below-mark gnus-score-over-mark)) | |
8696 | gnus-tmp-replied | |
8697 | (cond ((memq number gnus-newsgroup-processable) | |
8698 | gnus-process-mark) | |
8699 | ((memq number gnus-newsgroup-cached) | |
8700 | gnus-cached-mark) | |
8701 | ((memq number gnus-newsgroup-replied) | |
8702 | gnus-replied-mark) | |
8703 | ((memq number gnus-newsgroup-saved) | |
8704 | gnus-saved-mark) | |
8705 | (t gnus-unread-mark)) | |
8706 | gnus-tmp-from (mail-header-from gnus-tmp-header) | |
8707 | gnus-tmp-name | |
8708 | (cond | |
8709 | ((string-match "(.+)" gnus-tmp-from) | |
8710 | (substring gnus-tmp-from | |
8711 | (1+ (match-beginning 0)) (1- (match-end 0)))) | |
8712 | ((string-match "<[^>]+> *$" gnus-tmp-from) | |
8713 | (setq beg-match (match-beginning 0)) | |
8714 | (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) | |
8715 | (substring gnus-tmp-from (1+ (match-beginning 0)) | |
8716 | (1- (match-end 0)))) | |
8717 | (substring gnus-tmp-from 0 beg-match))) | |
8718 | (t gnus-tmp-from))) | |
8719 | (when (string= gnus-tmp-name "") | |
8720 | (setq gnus-tmp-name gnus-tmp-from)) | |
8721 | (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) | |
8722 | (gnus-put-text-property | |
8723 | (point) | |
8724 | (progn (eval gnus-summary-line-format-spec) (point)) | |
8725 | 'gnus-number number) | |
8726 | (when gnus-visual-p | |
8727 | (forward-line -1) | |
8728 | (run-hooks 'gnus-summary-update-hook) | |
8729 | (forward-line 1)) | |
8730 | ||
8731 | (setq gnus-tmp-prev-subject subject))) | |
8732 | ||
8733 | (when (nth 1 thread) | |
8734 | (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) | |
8735 | (incf gnus-tmp-level) | |
8736 | (setq threads (if thread-end nil (cdar thread))) | |
8737 | (unless threads | |
8738 | (setq gnus-tmp-level 0))))) | |
8739 | (gnus-message 7 "Generating summary...done")) | |
8740 | ||
8741 | (defun gnus-summary-prepare-unthreaded (headers) | |
8742 | "Generate an unthreaded summary buffer based on HEADERS." | |
8743 | (let (header number mark) | |
41487370 LMI |
8744 | |
8745 | (while headers | |
41487370 | 8746 | ;; We may have to root out some bad articles... |
231f989b LMI |
8747 | (when (memq (setq number (mail-header-number |
8748 | (setq header (pop headers)))) | |
8749 | gnus-newsgroup-limit) | |
8750 | ;; Mark article as read when it has a low score. | |
8751 | (when (and gnus-summary-mark-below | |
8752 | (< (or (cdr (assq number gnus-newsgroup-scored)) | |
8753 | gnus-summary-default-score 0) | |
8754 | gnus-summary-mark-below) | |
8755 | (not (memq number gnus-newsgroup-ancient))) | |
8756 | (setq gnus-newsgroup-unreads | |
8757 | (delq number gnus-newsgroup-unreads)) | |
8758 | (if gnus-newsgroup-auto-expire | |
8759 | (push number gnus-newsgroup-expirable) | |
8760 | (push (cons number gnus-low-score-mark) | |
8761 | gnus-newsgroup-reads))) | |
8762 | ||
8763 | (setq mark | |
8764 | (cond | |
8765 | ((memq number gnus-newsgroup-marked) gnus-ticked-mark) | |
41487370 LMI |
8766 | ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) |
8767 | ((memq number gnus-newsgroup-unreads) gnus-unread-mark) | |
8768 | ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) | |
8769 | (t (or (cdr (assq number gnus-newsgroup-reads)) | |
231f989b LMI |
8770 | gnus-ancient-mark)))) |
8771 | (setq gnus-newsgroup-data | |
8772 | (cons (gnus-data-make number mark (1+ (point)) header 0) | |
8773 | gnus-newsgroup-data)) | |
8774 | (gnus-summary-insert-line | |
8775 | header 0 nil mark (memq number gnus-newsgroup-replied) | |
41487370 LMI |
8776 | (memq number gnus-newsgroup-expirable) |
8777 | (mail-header-subject header) nil | |
8778 | (cdr (assq number gnus-newsgroup-scored)) | |
231f989b | 8779 | (memq number gnus-newsgroup-processable)))))) |
41487370 LMI |
8780 | |
8781 | (defun gnus-select-newsgroup (group &optional read-all) | |
8782 | "Select newsgroup GROUP. | |
8783 | If READ-ALL is non-nil, all articles in the group are selected." | |
8784 | (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) | |
8785 | (info (nth 2 entry)) | |
231f989b | 8786 | articles fetched-articles cached) |
41487370 LMI |
8787 | |
8788 | (or (gnus-check-server | |
8789 | (setq gnus-current-select-method (gnus-find-method-for-group group))) | |
8790 | (error "Couldn't open server")) | |
231f989b | 8791 | |
41487370 | 8792 | (or (and entry (not (eq (car entry) t))) ; Either it's active... |
231f989b LMI |
8793 | (gnus-activate-group group) ; Or we can activate it... |
8794 | (progn ; Or we bug out. | |
8795 | (when (equal major-mode 'gnus-summary-mode) | |
8796 | (kill-buffer (current-buffer))) | |
8797 | (error "Couldn't request group %s: %s" | |
41487370 LMI |
8798 | group (gnus-status-message group)))) |
8799 | ||
231f989b LMI |
8800 | (unless (gnus-request-group group t) |
8801 | (when (equal major-mode 'gnus-summary-mode) | |
8802 | (kill-buffer (current-buffer))) | |
8803 | (error "Couldn't request group %s: %s" | |
8804 | group (gnus-status-message group))) | |
8805 | ||
41487370 LMI |
8806 | (setq gnus-newsgroup-name group) |
8807 | (setq gnus-newsgroup-unselected nil) | |
8808 | (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) | |
8809 | ||
8810 | (and gnus-asynchronous | |
231f989b | 8811 | (gnus-check-backend-function |
41487370 LMI |
8812 | 'request-asynchronous gnus-newsgroup-name) |
8813 | (setq gnus-newsgroup-async | |
8814 | (gnus-request-asynchronous gnus-newsgroup-name))) | |
8815 | ||
231f989b LMI |
8816 | ;; Adjust and set lists of article marks. |
8817 | (when info | |
8818 | (gnus-adjust-marked-articles info)) | |
8819 | ||
8820 | ;; Kludge to avoid having cached articles nixed out in virtual groups. | |
8821 | (when (gnus-virtual-group-p group) | |
8822 | (setq cached gnus-newsgroup-cached)) | |
8823 | ||
8824 | (setq gnus-newsgroup-unreads | |
8825 | (gnus-set-difference | |
8826 | (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) | |
8827 | gnus-newsgroup-dormant)) | |
8828 | ||
8829 | (setq gnus-newsgroup-processable nil) | |
8830 | ||
41487370 LMI |
8831 | (setq articles (gnus-articles-to-read group read-all)) |
8832 | ||
231f989b LMI |
8833 | (cond |
8834 | ((null articles) | |
8835 | ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") | |
41487370 LMI |
8836 | 'quit) |
8837 | ((eq articles 0) nil) | |
8838 | (t | |
8839 | ;; Init the dependencies hash table. | |
231f989b | 8840 | (setq gnus-newsgroup-dependencies |
41487370 LMI |
8841 | (gnus-make-hashtable (length articles))) |
8842 | ;; Retrieve the headers and read them in. | |
231f989b LMI |
8843 | (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) |
8844 | (setq gnus-newsgroup-headers | |
8845 | (if (eq 'nov | |
8846 | (setq gnus-headers-retrieved-by | |
8847 | (gnus-retrieve-headers | |
8848 | articles gnus-newsgroup-name | |
8849 | ;; We might want to fetch old headers, but | |
8850 | ;; not if there is only 1 article. | |
8851 | (and gnus-fetch-old-headers | |
8852 | (or (and | |
8853 | (not (eq gnus-fetch-old-headers 'some)) | |
8854 | (not (numberp gnus-fetch-old-headers))) | |
8855 | (> (length articles) 1)))))) | |
8856 | (gnus-get-newsgroup-headers-xover articles) | |
41487370 | 8857 | (gnus-get-newsgroup-headers))) |
231f989b LMI |
8858 | (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) |
8859 | ||
8860 | ;; Kludge to avoid having cached articles nixed out in virtual groups. | |
8861 | (when cached | |
8862 | (setq gnus-newsgroup-cached cached)) | |
8863 | ||
8864 | ;; Set the initial limit. | |
8865 | (setq gnus-newsgroup-limit (copy-sequence articles)) | |
41487370 LMI |
8866 | ;; Remove canceled articles from the list of unread articles. |
8867 | (setq gnus-newsgroup-unreads | |
231f989b | 8868 | (gnus-set-sorted-intersection |
41487370 | 8869 | gnus-newsgroup-unreads |
231f989b LMI |
8870 | (setq fetched-articles |
8871 | (mapcar (lambda (headers) (mail-header-number headers)) | |
8872 | gnus-newsgroup-headers)))) | |
8873 | ;; Removed marked articles that do not exist. | |
8874 | (gnus-update-missing-marks | |
8875 | (gnus-sorted-complement fetched-articles articles)) | |
8876 | ;; We might want to build some more threads first. | |
8877 | (and gnus-fetch-old-headers | |
8878 | (eq gnus-headers-retrieved-by 'nov) | |
8879 | (gnus-build-old-threads)) | |
41487370 LMI |
8880 | ;; Check whether auto-expire is to be done in this group. |
8881 | (setq gnus-newsgroup-auto-expire | |
231f989b LMI |
8882 | (gnus-group-auto-expirable-p group)) |
8883 | ;; Set up the article buffer now, if necessary. | |
8884 | (unless gnus-single-article-buffer | |
8885 | (gnus-article-setup-buffer)) | |
41487370 | 8886 | ;; First and last article in this newsgroup. |
231f989b LMI |
8887 | (when gnus-newsgroup-headers |
8888 | (setq gnus-newsgroup-begin | |
8889 | (mail-header-number (car gnus-newsgroup-headers)) | |
8890 | gnus-newsgroup-end | |
8891 | (mail-header-number | |
8892 | (gnus-last-element gnus-newsgroup-headers)))) | |
41487370 LMI |
8893 | (setq gnus-reffed-article-number -1) |
8894 | ;; GROUP is successfully selected. | |
8895 | (or gnus-newsgroup-headers t))))) | |
8896 | ||
8897 | (defun gnus-articles-to-read (group read-all) | |
8898 | ;; Find out what articles the user wants to read. | |
8899 | (let* ((articles | |
231f989b LMI |
8900 | ;; Select all articles if `read-all' is non-nil, or if there |
8901 | ;; are no unread articles. | |
41487370 | 8902 | (if (or read-all |
231f989b LMI |
8903 | (and (zerop (length gnus-newsgroup-marked)) |
8904 | (zerop (length gnus-newsgroup-unreads)))) | |
8905 | (gnus-uncompress-range (gnus-active group)) | |
8906 | (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked | |
8907 | (copy-sequence gnus-newsgroup-unreads)) | |
8908 | '<))) | |
41487370 LMI |
8909 | (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) |
8910 | (scored (length scored-list)) | |
8911 | (number (length articles)) | |
8912 | (marked (+ (length gnus-newsgroup-marked) | |
8913 | (length gnus-newsgroup-dormant))) | |
8914 | (select | |
231f989b | 8915 | (cond |
41487370 LMI |
8916 | ((numberp read-all) |
8917 | read-all) | |
8918 | (t | |
8919 | (condition-case () | |
231f989b LMI |
8920 | (cond |
8921 | ((and (or (<= scored marked) (= scored number)) | |
8922 | (numberp gnus-large-newsgroup) | |
8923 | (> number gnus-large-newsgroup)) | |
8924 | (let ((input | |
8925 | (read-string | |
8926 | (format | |
8927 | "How many articles from %s (default %d): " | |
8928 | gnus-newsgroup-name number)))) | |
8929 | (if (string-match "^[ \t]*$" input) number input))) | |
8930 | ((and (> scored marked) (< scored number) | |
8931 | (> (- scored number) 20)) | |
8932 | (let ((input | |
8933 | (read-string | |
8934 | (format "%s %s (%d scored, %d total): " | |
8935 | "How many articles from" | |
8936 | group scored number)))) | |
8937 | (if (string-match "^[ \t]*$" input) | |
8938 | number input))) | |
8939 | (t number)) | |
41487370 LMI |
8940 | (quit nil)))))) |
8941 | (setq select (if (stringp select) (string-to-number select) select)) | |
8942 | (if (or (null select) (zerop select)) | |
8943 | select | |
8944 | (if (and (not (zerop scored)) (<= (abs select) scored)) | |
8945 | (progn | |
8946 | (setq articles (sort scored-list '<)) | |
8947 | (setq number (length articles))) | |
8948 | (setq articles (copy-sequence articles))) | |
8949 | ||
8950 | (if (< (abs select) number) | |
231f989b | 8951 | (if (< select 0) |
41487370 LMI |
8952 | ;; Select the N oldest articles. |
8953 | (setcdr (nthcdr (1- (abs select)) articles) nil) | |
8954 | ;; Select the N most recent articles. | |
8955 | (setq articles (nthcdr (- number select) articles)))) | |
8956 | (setq gnus-newsgroup-unselected | |
8957 | (gnus-sorted-intersection | |
8958 | gnus-newsgroup-unreads | |
8959 | (gnus-sorted-complement gnus-newsgroup-unreads articles))) | |
8960 | articles))) | |
8961 | ||
8962 | (defun gnus-killed-articles (killed articles) | |
8963 | (let (out) | |
8964 | (while articles | |
8965 | (if (inline (gnus-member-of-range (car articles) killed)) | |
8966 | (setq out (cons (car articles) out))) | |
8967 | (setq articles (cdr articles))) | |
8968 | out)) | |
8969 | ||
231f989b LMI |
8970 | (defun gnus-uncompress-marks (marks) |
8971 | "Uncompress the mark ranges in MARKS." | |
8972 | (let ((uncompressed '(score bookmark)) | |
8973 | out) | |
8974 | (while marks | |
8975 | (if (memq (caar marks) uncompressed) | |
8976 | (push (car marks) out) | |
8977 | (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) | |
8978 | (setq marks (cdr marks))) | |
8979 | out)) | |
8980 | ||
8981 | (defun gnus-adjust-marked-articles (info) | |
8982 | "Set all article lists and remove all marks that are no longer legal." | |
8983 | (let* ((marked-lists (gnus-info-marks info)) | |
8984 | (active (gnus-active (gnus-info-group info))) | |
8985 | (min (car active)) | |
8986 | (max (cdr active)) | |
8987 | (types gnus-article-mark-lists) | |
564b670b | 8988 | (uncompressed '(score bookmark killed)) |
231f989b LMI |
8989 | marks var articles article mark) |
8990 | ||
41487370 | 8991 | (while marked-lists |
231f989b LMI |
8992 | (setq marks (pop marked-lists)) |
8993 | (set (setq var (intern (format "gnus-newsgroup-%s" | |
8994 | (car (rassq (setq mark (car marks)) | |
8995 | types))))) | |
8996 | (if (memq (car marks) uncompressed) (cdr marks) | |
8997 | (gnus-uncompress-range (cdr marks)))) | |
8998 | ||
8999 | (setq articles (symbol-value var)) | |
9000 | ||
9001 | ;; All articles have to be subsets of the active articles. | |
9002 | (cond | |
9003 | ;; Adjust "simple" lists. | |
564b670b | 9004 | ((memq mark '(tick dormant expirable reply save)) |
231f989b LMI |
9005 | (while articles |
9006 | (when (or (< (setq article (pop articles)) min) (> article max)) | |
9007 | (set var (delq article (symbol-value var)))))) | |
9008 | ;; Adjust assocs. | |
564b670b | 9009 | ((memq mark uncompressed) |
231f989b LMI |
9010 | (while articles |
9011 | (when (or (not (consp (setq article (pop articles)))) | |
9012 | (< (car article) min) | |
9013 | (> (car article) max)) | |
9014 | (set var (delq article (symbol-value var)))))))))) | |
9015 | ||
9016 | (defun gnus-update-missing-marks (missing) | |
9017 | "Go through the list of MISSING articles and remove them mark lists." | |
9018 | (when missing | |
9019 | (let ((types gnus-article-mark-lists) | |
9020 | var m) | |
9021 | ;; Go through all types. | |
9022 | (while types | |
9023 | (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) | |
9024 | (when (symbol-value var) | |
9025 | ;; This list has articles. So we delete all missing articles | |
9026 | ;; from it. | |
9027 | (setq m missing) | |
41487370 | 9028 | (while m |
231f989b LMI |
9029 | (set var (delq (pop m) (symbol-value var))))))))) |
9030 | ||
9031 | (defun gnus-update-marks () | |
41487370 | 9032 | "Enter the various lists of marked articles into the newsgroup info list." |
231f989b LMI |
9033 | (let ((types gnus-article-mark-lists) |
9034 | (info (gnus-get-info gnus-newsgroup-name)) | |
9035 | (uncompressed '(score bookmark killed)) | |
9036 | type list newmarked symbol) | |
9037 | (when info | |
9038 | ;; Add all marks lists that are non-nil to the list of marks lists. | |
9039 | (while types | |
9040 | (setq type (pop types)) | |
9041 | (when (setq list (symbol-value | |
9042 | (setq symbol | |
9043 | (intern (format "gnus-newsgroup-%s" | |
9044 | (car type)))))) | |
9045 | (push (cons (cdr type) | |
9046 | (if (memq (cdr type) uncompressed) list | |
9047 | (gnus-compress-sequence | |
9048 | (set symbol (sort list '<)) t))) | |
9049 | newmarked))) | |
9050 | ||
9051 | ;; Enter these new marks into the info of the group. | |
9052 | (if (nthcdr 3 info) | |
41487370 | 9053 | (setcar (nthcdr 3 info) newmarked) |
231f989b LMI |
9054 | ;; Add the marks lists to the end of the info. |
9055 | (when newmarked | |
9056 | (setcdr (nthcdr 2 info) (list newmarked)))) | |
9057 | ||
9058 | ;; Cut off the end of the info if there's nothing else there. | |
9059 | (let ((i 5)) | |
9060 | (while (and (> i 2) | |
9061 | (not (nth i info))) | |
9062 | (when (nthcdr (decf i) info) | |
9063 | (setcdr (nthcdr i info) nil))))))) | |
41487370 LMI |
9064 | |
9065 | (defun gnus-add-marked-articles (group type articles &optional info force) | |
9066 | ;; Add ARTICLES of TYPE to the info of GROUP. | |
231f989b | 9067 | ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't |
41487370 | 9068 | ;; add, but replace marked articles of TYPE with ARTICLES. |
231f989b LMI |
9069 | (let ((info (or info (gnus-get-info group))) |
9070 | (uncompressed '(score bookmark killed)) | |
41487370 LMI |
9071 | marked m) |
9072 | (or (not info) | |
9073 | (and (not (setq marked (nthcdr 3 info))) | |
231f989b LMI |
9074 | (or (null articles) |
9075 | (setcdr (nthcdr 2 info) | |
9076 | (list (list (cons type (gnus-compress-sequence | |
9077 | articles t))))))) | |
41487370 | 9078 | (and (not (setq m (assq type (car marked)))) |
231f989b LMI |
9079 | (or (null articles) |
9080 | (setcar marked | |
9081 | (cons (cons type (gnus-compress-sequence articles t) ) | |
9082 | (car marked))))) | |
41487370 | 9083 | (if force |
231f989b LMI |
9084 | (if (null articles) |
9085 | (setcar (nthcdr 3 info) | |
9086 | (delq (assq type (car marked)) (car marked))) | |
9087 | (setcdr m (gnus-compress-sequence articles t))) | |
9088 | (setcdr m (gnus-compress-sequence | |
9089 | (sort (nconc (gnus-uncompress-range (cdr m)) | |
9090 | (copy-sequence articles)) '<) t)))))) | |
9091 | ||
41487370 LMI |
9092 | (defun gnus-set-mode-line (where) |
9093 | "This function sets the mode line of the article or summary buffers. | |
9094 | If WHERE is `summary', the summary mode line format will be used." | |
231f989b LMI |
9095 | ;; Is this mode line one we keep updated? |
9096 | (when (memq where gnus-updated-mode-lines) | |
9097 | (let (mode-string) | |
9098 | (save-excursion | |
9099 | ;; We evaluate this in the summary buffer since these | |
9100 | ;; variables are buffer-local to that buffer. | |
9101 | (set-buffer gnus-summary-buffer) | |
9102 | ;; We bind all these variables that are used in the `eval' form | |
9103 | ;; below. | |
9104 | (let* ((mformat (symbol-value | |
9105 | (intern | |
9106 | (format "gnus-%s-mode-line-format-spec" where)))) | |
9107 | (gnus-tmp-group-name gnus-newsgroup-name) | |
9108 | (gnus-tmp-article-number (or gnus-current-article 0)) | |
9109 | (gnus-tmp-unread gnus-newsgroup-unreads) | |
9110 | (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) | |
9111 | (gnus-tmp-unselected (length gnus-newsgroup-unselected)) | |
9112 | (gnus-tmp-unread-and-unselected | |
9113 | (cond ((and (zerop gnus-tmp-unread-and-unticked) | |
9114 | (zerop gnus-tmp-unselected)) "") | |
9115 | ((zerop gnus-tmp-unselected) | |
9116 | (format "{%d more}" gnus-tmp-unread-and-unticked)) | |
9117 | (t (format "{%d(+%d) more}" | |
9118 | gnus-tmp-unread-and-unticked | |
9119 | gnus-tmp-unselected)))) | |
9120 | (gnus-tmp-subject | |
9121 | (if (and gnus-current-headers | |
9122 | (vectorp gnus-current-headers)) | |
9123 | (gnus-mode-string-quote | |
9124 | (mail-header-subject gnus-current-headers)) "")) | |
9125 | max-len | |
9126 | gnus-tmp-header);; passed as argument to any user-format-funcs | |
9127 | (setq mode-string (eval mformat)) | |
9128 | (setq max-len (max 4 (if gnus-mode-non-string-length | |
9129 | (- (window-width) | |
9130 | gnus-mode-non-string-length) | |
9131 | (length mode-string)))) | |
9132 | ;; We might have to chop a bit of the string off... | |
9133 | (when (> (length mode-string) max-len) | |
9134 | (setq mode-string | |
9135 | (concat (gnus-truncate-string mode-string (- max-len 3)) | |
9136 | "..."))) | |
9137 | ;; Pad the mode string a bit. | |
9138 | (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) | |
9139 | ;; Update the mode line. | |
9140 | (setq mode-line-buffer-identification | |
9141 | (gnus-mode-line-buffer-identification | |
9142 | (list mode-string))) | |
9143 | (set-buffer-modified-p t)))) | |
41487370 LMI |
9144 | |
9145 | (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) | |
9146 | "Go through the HEADERS list and add all Xrefs to a hash table. | |
9147 | The resulting hash table is returned, or nil if no Xrefs were found." | |
231f989b LMI |
9148 | (let* ((virtual (gnus-virtual-group-p from-newsgroup)) |
9149 | (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) | |
41487370 LMI |
9150 | (xref-hashtb (make-vector 63 0)) |
9151 | start group entry number xrefs header) | |
9152 | (while headers | |
231f989b LMI |
9153 | (setq header (pop headers)) |
9154 | (when (and (setq xrefs (mail-header-xref header)) | |
9155 | (not (memq (setq number (mail-header-number header)) | |
9156 | unreads))) | |
9157 | (setq start 0) | |
9158 | (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) | |
9159 | (setq start (match-end 0)) | |
9160 | (setq group (if prefix | |
9161 | (concat prefix (substring xrefs (match-beginning 1) | |
9162 | (match-end 1))) | |
9163 | (substring xrefs (match-beginning 1) (match-end 1)))) | |
9164 | (setq number | |
9165 | (string-to-int (substring xrefs (match-beginning 2) | |
9166 | (match-end 2)))) | |
9167 | (if (setq entry (gnus-gethash group xref-hashtb)) | |
9168 | (setcdr entry (cons number (cdr entry))) | |
9169 | (gnus-sethash group (cons number nil) xref-hashtb))))) | |
9170 | (and start xref-hashtb))) | |
9171 | ||
9172 | (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) | |
41487370 | 9173 | "Look through all the headers and mark the Xrefs as read." |
231f989b LMI |
9174 | (let ((virtual (gnus-virtual-group-p from-newsgroup)) |
9175 | name entry info xref-hashtb idlist method nth4) | |
41487370 LMI |
9176 | (save-excursion |
9177 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
9178 | (when (setq xref-hashtb |
9179 | (gnus-create-xref-hashtb from-newsgroup headers unreads)) | |
9180 | (mapatoms | |
9181 | (lambda (group) | |
9182 | (unless (string= from-newsgroup (setq name (symbol-name group))) | |
9183 | (setq idlist (symbol-value group)) | |
9184 | ;; Dead groups are not updated. | |
9185 | (and (prog1 | |
9186 | (setq entry (gnus-gethash name gnus-newsrc-hashtb) | |
9187 | info (nth 2 entry)) | |
9188 | (if (stringp (setq nth4 (gnus-info-method info))) | |
9189 | (setq nth4 (gnus-server-to-method nth4)))) | |
9190 | ;; Only do the xrefs if the group has the same | |
9191 | ;; select method as the group we have just read. | |
9192 | (or (gnus-methods-equal-p | |
9193 | nth4 (gnus-find-method-for-group from-newsgroup)) | |
9194 | virtual | |
9195 | (equal nth4 (setq method (gnus-find-method-for-group | |
9196 | from-newsgroup))) | |
9197 | (and (equal (car nth4) (car method)) | |
9198 | (equal (nth 1 nth4) (nth 1 method)))) | |
9199 | gnus-use-cross-reference | |
9200 | (or (not (eq gnus-use-cross-reference t)) | |
9201 | virtual | |
9202 | ;; Only do cross-references on subscribed | |
9203 | ;; groups, if that is what is wanted. | |
9204 | (<= (gnus-info-level info) gnus-level-subscribed)) | |
9205 | (gnus-group-make-articles-read name idlist)))) | |
9206 | xref-hashtb))))) | |
9207 | ||
9208 | (defun gnus-group-make-articles-read (group articles) | |
41487370 LMI |
9209 | (let* ((num 0) |
9210 | (entry (gnus-gethash group gnus-newsrc-hashtb)) | |
9211 | (info (nth 2 entry)) | |
231f989b LMI |
9212 | (active (gnus-active group)) |
9213 | range) | |
41487370 LMI |
9214 | ;; First peel off all illegal article numbers. |
9215 | (if active | |
9216 | (let ((ids articles) | |
41487370 | 9217 | id first) |
41487370 LMI |
9218 | (while ids |
9219 | (setq id (car ids)) | |
9220 | (if (and first (> id (cdr active))) | |
9221 | (progn | |
9222 | ;; We'll end up in this situation in one particular | |
231f989b | 9223 | ;; obscure situation. If you re-scan a group and get |
41487370 LMI |
9224 | ;; a new article that is cross-posted to a different |
9225 | ;; group that has not been re-scanned, you might get | |
9226 | ;; crossposted article that has a higher number than | |
231f989b LMI |
9227 | ;; Gnus believes possible. So we re-activate this |
9228 | ;; group as well. This might mean doing the | |
b94ae5f7 | 9229 | ;; crossposting thingy will *increase* the number |
231f989b | 9230 | ;; of articles in some groups. Tsk, tsk. |
41487370 LMI |
9231 | (setq active (or (gnus-activate-group group) active)))) |
9232 | (if (or (> id (cdr active)) | |
231f989b | 9233 | (< id (car active))) |
41487370 | 9234 | (setq articles (delq id articles))) |
41487370 | 9235 | (setq ids (cdr ids))))) |
231f989b | 9236 | ;; If the read list is nil, we init it. |
41487370 | 9237 | (and active |
231f989b | 9238 | (null (gnus-info-read info)) |
41487370 | 9239 | (> (car active) 1) |
231f989b LMI |
9240 | (gnus-info-set-read info (cons 1 (1- (car active))))) |
9241 | ;; Then we add the read articles to the range. | |
9242 | (gnus-info-set-read | |
9243 | info | |
9244 | (setq range | |
9245 | (gnus-add-to-range | |
9246 | (gnus-info-read info) (setq articles (sort articles '<))))) | |
41487370 LMI |
9247 | ;; Then we have to re-compute how many unread |
9248 | ;; articles there are in this group. | |
9249 | (if active | |
9250 | (progn | |
231f989b | 9251 | (cond |
41487370 LMI |
9252 | ((not range) |
9253 | (setq num (- (1+ (cdr active)) (car active)))) | |
9254 | ((not (listp (cdr range))) | |
231f989b | 9255 | (setq num (- (cdr active) (- (1+ (cdr range)) |
41487370 LMI |
9256 | (car range))))) |
9257 | (t | |
9258 | (while range | |
9259 | (if (numberp (car range)) | |
9260 | (setq num (1+ num)) | |
231f989b | 9261 | (setq num (+ num (- (1+ (cdar range)) (caar range))))) |
41487370 LMI |
9262 | (setq range (cdr range))) |
9263 | (setq num (- (cdr active) num)))) | |
9264 | ;; Update the number of unread articles. | |
231f989b | 9265 | (setcar entry num) |
41487370 LMI |
9266 | ;; Update the group buffer. |
9267 | (gnus-group-update-group group t))))) | |
9268 | ||
9269 | (defun gnus-methods-equal-p (m1 m2) | |
9270 | (let ((m1 (or m1 gnus-select-method)) | |
9271 | (m2 (or m2 gnus-select-method))) | |
9272 | (or (equal m1 m2) | |
9273 | (and (eq (car m1) (car m2)) | |
9274 | (or (not (memq 'address (assoc (symbol-name (car m1)) | |
9275 | gnus-valid-select-methods))) | |
9276 | (equal (nth 1 m1) (nth 1 m2))))))) | |
9277 | ||
9278 | (defsubst gnus-header-value () | |
9279 | (buffer-substring (match-end 0) (gnus-point-at-eol))) | |
9280 | ||
9281 | (defvar gnus-newsgroup-none-id 0) | |
9282 | ||
231f989b | 9283 | (defun gnus-get-newsgroup-headers (&optional dependencies force-new) |
41487370 | 9284 | (let ((cur nntp-server-buffer) |
231f989b LMI |
9285 | (dependencies |
9286 | (or dependencies | |
9287 | (save-excursion (set-buffer gnus-summary-buffer) | |
9288 | gnus-newsgroup-dependencies))) | |
9289 | headers id id-dep ref-dep end ref) | |
41487370 LMI |
9290 | (save-excursion |
9291 | (set-buffer nntp-server-buffer) | |
7e988fb6 | 9292 | (run-hooks 'gnus-parse-headers-hook) |
231f989b LMI |
9293 | (let ((case-fold-search t) |
9294 | in-reply-to header p lines) | |
9295 | (goto-char (point-min)) | |
9296 | ;; Search to the beginning of the next header. Error messages | |
9297 | ;; do not begin with 2 or 3. | |
9298 | (while (re-search-forward "^[23][0-9]+ " nil t) | |
41487370 LMI |
9299 | (setq id nil |
9300 | ref nil) | |
41487370 LMI |
9301 | ;; This implementation of this function, with nine |
9302 | ;; search-forwards instead of the one re-search-forward and | |
9303 | ;; a case (which basically was the old function) is actually | |
231f989b LMI |
9304 | ;; about twice as fast, even though it looks messier. You |
9305 | ;; can't have everything, I guess. Speed and elegance | |
9306 | ;; doesn't always go hand in hand. | |
9307 | (setq | |
9308 | header | |
9309 | (vector | |
9310 | ;; Number. | |
9311 | (prog1 | |
9312 | (read cur) | |
9313 | (end-of-line) | |
9314 | (setq p (point)) | |
9315 | (narrow-to-region (point) | |
9316 | (or (and (search-forward "\n.\n" nil t) | |
9317 | (- (point) 2)) | |
9318 | (point)))) | |
9319 | ;; Subject. | |
9320 | (progn | |
9321 | (goto-char p) | |
9322 | (if (search-forward "\nsubject: " nil t) | |
9323 | (gnus-header-value) "(none)")) | |
9324 | ;; From. | |
9325 | (progn | |
9326 | (goto-char p) | |
9327 | (if (search-forward "\nfrom: " nil t) | |
9328 | (gnus-header-value) "(nobody)")) | |
9329 | ;; Date. | |
9330 | (progn | |
9331 | (goto-char p) | |
9332 | (if (search-forward "\ndate: " nil t) | |
9333 | (gnus-header-value) "")) | |
9334 | ;; Message-ID. | |
9335 | (progn | |
9336 | (goto-char p) | |
9337 | (if (search-forward "\nmessage-id: " nil t) | |
9338 | (setq id (gnus-header-value)) | |
9339 | ;; If there was no message-id, we just fake one to make | |
9340 | ;; subsequent routines simpler. | |
9341 | (setq id (concat "none+" | |
9342 | (int-to-string | |
9343 | (setq gnus-newsgroup-none-id | |
9344 | (1+ gnus-newsgroup-none-id))))))) | |
9345 | ;; References. | |
9346 | (progn | |
9347 | (goto-char p) | |
9348 | (if (search-forward "\nreferences: " nil t) | |
41487370 | 9349 | (progn |
231f989b LMI |
9350 | (setq end (point)) |
9351 | (prog1 | |
9352 | (gnus-header-value) | |
9353 | (setq ref | |
9354 | (buffer-substring | |
9355 | (progn | |
9356 | (end-of-line) | |
9357 | (search-backward ">" end t) | |
9358 | (1+ (point))) | |
9359 | (progn | |
9360 | (search-backward "<" end t) | |
9361 | (point)))))) | |
9362 | ;; Get the references from the in-reply-to header if there | |
9363 | ;; were no references and the in-reply-to header looks | |
9364 | ;; promising. | |
9365 | (if (and (search-forward "\nin-reply-to: " nil t) | |
9366 | (setq in-reply-to (gnus-header-value)) | |
9367 | (string-match "<[^>]+>" in-reply-to)) | |
9368 | (setq ref (substring in-reply-to (match-beginning 0) | |
9369 | (match-end 0))) | |
9370 | (setq ref "")))) | |
9371 | ;; Chars. | |
9372 | 0 | |
9373 | ;; Lines. | |
9374 | (progn | |
9375 | (goto-char p) | |
9376 | (if (search-forward "\nlines: " nil t) | |
9377 | (if (numberp (setq lines (read cur))) | |
9378 | lines 0) | |
9379 | 0)) | |
9380 | ;; Xref. | |
9381 | (progn | |
9382 | (goto-char p) | |
9383 | (and (search-forward "\nxref: " nil t) | |
9384 | (gnus-header-value))))) | |
9385 | ;; We do the threading while we read the headers. The | |
9386 | ;; message-id and the last reference are both entered into | |
9387 | ;; the same hash table. Some tippy-toeing around has to be | |
9388 | ;; done in case an article has arrived before the article | |
9389 | ;; which it refers to. | |
9390 | (if (boundp (setq id-dep (intern id dependencies))) | |
9391 | (if (and (car (symbol-value id-dep)) | |
9392 | (not force-new)) | |
9393 | ;; An article with this Message-ID has already | |
9394 | ;; been seen, so we ignore this one, except we add | |
9395 | ;; any additional Xrefs (in case the two articles | |
9396 | ;; came from different servers). | |
9397 | (progn | |
9398 | (mail-header-set-xref | |
9399 | (car (symbol-value id-dep)) | |
9400 | (concat (or (mail-header-xref | |
9401 | (car (symbol-value id-dep))) "") | |
9402 | (or (mail-header-xref header) ""))) | |
9403 | (setq header nil)) | |
9404 | (setcar (symbol-value id-dep) header)) | |
9405 | (set id-dep (list header))) | |
9406 | (when header | |
9407 | (if (boundp (setq ref-dep (intern ref dependencies))) | |
9408 | (setcdr (symbol-value ref-dep) | |
9409 | (nconc (cdr (symbol-value ref-dep)) | |
9410 | (list (symbol-value id-dep)))) | |
9411 | (set ref-dep (list nil (symbol-value id-dep)))) | |
9412 | (setq headers (cons header headers))) | |
9413 | (goto-char (point-max)) | |
9414 | (widen)) | |
9415 | (nreverse headers))))) | |
41487370 LMI |
9416 | |
9417 | ;; The following macros and functions were written by Felix Lee | |
231f989b | 9418 | ;; <flee@cse.psu.edu>. |
41487370 LMI |
9419 | |
9420 | (defmacro gnus-nov-read-integer () | |
9421 | '(prog1 | |
9422 | (if (= (following-char) ?\t) | |
9423 | 0 | |
9424 | (let ((num (condition-case nil (read buffer) (error nil)))) | |
9425 | (if (numberp num) num 0))) | |
9426 | (or (eobp) (forward-char 1)))) | |
9427 | ||
9428 | (defmacro gnus-nov-skip-field () | |
9429 | '(search-forward "\t" eol 'move)) | |
9430 | ||
9431 | (defmacro gnus-nov-field () | |
9432 | '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) | |
9433 | ||
9434 | ;; Goes through the xover lines and returns a list of vectors | |
231f989b LMI |
9435 | (defun gnus-get-newsgroup-headers-xover (sequence &optional |
9436 | force-new dependencies) | |
41487370 LMI |
9437 | "Parse the news overview data in the server buffer, and return a |
9438 | list of headers that match SEQUENCE (see `nntp-retrieve-headers')." | |
9439 | ;; Get the Xref when the users reads the articles since most/some | |
9440 | ;; NNTP servers do not include Xrefs when using XOVER. | |
9441 | (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) | |
9442 | (let ((cur nntp-server-buffer) | |
231f989b | 9443 | (dependencies (or dependencies gnus-newsgroup-dependencies)) |
41487370 LMI |
9444 | number headers header) |
9445 | (save-excursion | |
9446 | (set-buffer nntp-server-buffer) | |
7e988fb6 LMI |
9447 | ;; Allow the user to mangle the headers before parsing them. |
9448 | (run-hooks 'gnus-parse-headers-hook) | |
41487370 LMI |
9449 | (goto-char (point-min)) |
9450 | (while (and sequence (not (eobp))) | |
9451 | (setq number (read cur)) | |
9452 | (while (and sequence (< (car sequence) number)) | |
9453 | (setq sequence (cdr sequence))) | |
231f989b | 9454 | (and sequence |
41487370 LMI |
9455 | (eq number (car sequence)) |
9456 | (progn | |
9457 | (setq sequence (cdr sequence)) | |
231f989b LMI |
9458 | (if (setq header |
9459 | (inline (gnus-nov-parse-line | |
9460 | number dependencies force-new))) | |
41487370 LMI |
9461 | (setq headers (cons header headers))))) |
9462 | (forward-line 1)) | |
9463 | (setq headers (nreverse headers))) | |
9464 | headers)) | |
9465 | ||
9466 | ;; This function has to be called with point after the article number | |
9467 | ;; on the beginning of the line. | |
231f989b | 9468 | (defun gnus-nov-parse-line (number dependencies &optional force-new) |
41487370 | 9469 | (let ((none 0) |
231f989b | 9470 | (eol (gnus-point-at-eol)) |
41487370 | 9471 | (buffer (current-buffer)) |
231f989b | 9472 | header ref id id-dep ref-dep) |
41487370 LMI |
9473 | |
9474 | ;; overview: [num subject from date id refs chars lines misc] | |
9475 | (narrow-to-region (point) eol) | |
9476 | (or (eobp) (forward-char)) | |
9477 | ||
9478 | (condition-case nil | |
9479 | (setq header | |
231f989b | 9480 | (vector |
41487370 | 9481 | number ; number |
231f989b LMI |
9482 | (gnus-nov-field) ; subject |
9483 | (gnus-nov-field) ; from | |
41487370 LMI |
9484 | (gnus-nov-field) ; date |
9485 | (setq id (or (gnus-nov-field) | |
9486 | (concat "none+" | |
231f989b | 9487 | (int-to-string |
41487370 LMI |
9488 | (setq none (1+ none)))))) ; id |
9489 | (progn | |
9490 | (save-excursion | |
9491 | (let ((beg (point))) | |
9492 | (search-forward "\t" eol) | |
9493 | (if (search-backward ">" beg t) | |
231f989b LMI |
9494 | (setq ref |
9495 | (buffer-substring | |
9496 | (1+ (point)) | |
9497 | (search-backward "<" beg t))) | |
41487370 LMI |
9498 | (setq ref nil)))) |
9499 | (gnus-nov-field)) ; refs | |
9500 | (gnus-nov-read-integer) ; chars | |
9501 | (gnus-nov-read-integer) ; lines | |
9502 | (if (= (following-char) ?\n) | |
9503 | nil | |
9504 | (gnus-nov-field)) ; misc | |
9505 | )) | |
231f989b LMI |
9506 | (error (progn |
9507 | (gnus-error 4 "Strange nov line") | |
41487370 LMI |
9508 | (setq header nil) |
9509 | (goto-char eol)))) | |
9510 | ||
9511 | (widen) | |
9512 | ||
9513 | ;; We build the thread tree. | |
231f989b LMI |
9514 | (when header |
9515 | (if (boundp (setq id-dep (intern id dependencies))) | |
9516 | (if (and (car (symbol-value id-dep)) | |
9517 | (not force-new)) | |
9518 | ;; An article with this Message-ID has already been seen, | |
9519 | ;; so we ignore this one, except we add any additional | |
9520 | ;; Xrefs (in case the two articles came from different | |
9521 | ;; servers. | |
9522 | (progn | |
9523 | (mail-header-set-xref | |
9524 | (car (symbol-value id-dep)) | |
9525 | (concat (or (mail-header-xref | |
9526 | (car (symbol-value id-dep))) "") | |
9527 | (or (mail-header-xref header) ""))) | |
9528 | (setq header nil)) | |
9529 | (setcar (symbol-value id-dep) header)) | |
9530 | (set id-dep (list header)))) | |
9531 | (when header | |
9532 | (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) | |
9533 | (setcdr (symbol-value ref-dep) | |
9534 | (nconc (cdr (symbol-value ref-dep)) | |
9535 | (list (symbol-value id-dep)))) | |
9536 | (set ref-dep (list nil (symbol-value id-dep))))) | |
41487370 LMI |
9537 | header)) |
9538 | ||
9539 | (defun gnus-article-get-xrefs () | |
9540 | "Fill in the Xref value in `gnus-current-headers', if necessary. | |
9541 | This is meant to be called in `gnus-article-internal-prepare-hook'." | |
9542 | (let ((headers (save-excursion (set-buffer gnus-summary-buffer) | |
9543 | gnus-current-headers))) | |
9544 | (or (not gnus-use-cross-reference) | |
9545 | (not headers) | |
9546 | (and (mail-header-xref headers) | |
9547 | (not (string= (mail-header-xref headers) ""))) | |
9548 | (let ((case-fold-search t) | |
9549 | xref) | |
9550 | (save-restriction | |
231f989b | 9551 | (nnheader-narrow-to-headers) |
41487370 LMI |
9552 | (goto-char (point-min)) |
9553 | (if (or (and (eq (downcase (following-char)) ?x) | |
9554 | (looking-at "Xref:")) | |
9555 | (search-forward "\nXref:" nil t)) | |
9556 | (progn | |
9557 | (goto-char (1+ (match-end 0))) | |
231f989b | 9558 | (setq xref (buffer-substring (point) |
41487370 LMI |
9559 | (progn (end-of-line) (point)))) |
9560 | (mail-header-set-xref headers xref)))))))) | |
9561 | ||
231f989b LMI |
9562 | (defun gnus-summary-insert-subject (id &optional old-header use-old-header) |
9563 | "Find article ID and insert the summary line for that article." | |
9564 | (let ((header (if (and old-header use-old-header) | |
9565 | old-header (gnus-read-header id))) | |
9566 | (number (and (numberp id) id)) | |
9567 | pos) | |
9568 | (when header | |
9569 | ;; Rebuild the thread that this article is part of and go to the | |
9570 | ;; article we have fetched. | |
9571 | (when (and (not gnus-show-threads) | |
9572 | old-header) | |
9573 | (when (setq pos (text-property-any | |
9574 | (point-min) (point-max) 'gnus-number | |
9575 | (mail-header-number old-header))) | |
9576 | (goto-char pos) | |
9577 | (gnus-delete-line) | |
9578 | (gnus-data-remove (mail-header-number old-header)))) | |
9579 | (when old-header | |
9580 | (mail-header-set-number header (mail-header-number old-header))) | |
9581 | (setq gnus-newsgroup-sparse | |
9582 | (delq (setq number (mail-header-number header)) | |
9583 | gnus-newsgroup-sparse)) | |
9584 | (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) | |
9585 | (gnus-rebuild-thread (mail-header-id header)) | |
9586 | (gnus-summary-goto-subject number nil t)) | |
9587 | (when (and (numberp number) | |
9588 | (> number 0)) | |
9589 | ;; We have to update the boundaries even if we can't fetch the | |
9590 | ;; article if ID is a number -- so that the next `P' or `N' | |
9591 | ;; command will fetch the previous (or next) article even | |
9592 | ;; if the one we tried to fetch this time has been canceled. | |
9593 | (and (> number gnus-newsgroup-end) | |
9594 | (setq gnus-newsgroup-end number)) | |
9595 | (and (< number gnus-newsgroup-begin) | |
9596 | (setq gnus-newsgroup-begin number)) | |
9597 | (setq gnus-newsgroup-unselected | |
9598 | (delq number gnus-newsgroup-unselected))) | |
9599 | ;; Report back a success? | |
9600 | (and header (mail-header-number header)))) | |
41487370 LMI |
9601 | |
9602 | (defun gnus-summary-work-articles (n) | |
231f989b | 9603 | "Return a list of articles to be worked upon. The prefix argument, |
41487370 LMI |
9604 | the list of process marked articles, and the current article will be |
9605 | taken into consideration." | |
231f989b LMI |
9606 | (cond |
9607 | (n | |
9608 | ;; A numerical prefix has been given. | |
9609 | (let ((backward (< n 0)) | |
9610 | (n (abs (prefix-numeric-value n))) | |
9611 | articles article) | |
9612 | (save-excursion | |
9613 | (while | |
9614 | (and (> n 0) | |
9615 | (push (setq article (gnus-summary-article-number)) | |
9616 | articles) | |
9617 | (if backward | |
9618 | (gnus-summary-find-prev nil article) | |
9619 | (gnus-summary-find-next nil article))) | |
9620 | (decf n))) | |
9621 | (nreverse articles))) | |
9622 | ((and (boundp 'transient-mark-mode) | |
9623 | transient-mark-mode | |
9624 | mark-active) | |
9625 | ;; Work on the region between point and mark. | |
9626 | (let ((max (max (point) (mark))) | |
9627 | articles article) | |
9628 | (save-excursion | |
9629 | (goto-char (min (point) (mark))) | |
9630 | (while | |
9631 | (and | |
9632 | (push (setq article (gnus-summary-article-number)) articles) | |
9633 | (gnus-summary-find-next nil article) | |
9634 | (< (point) max))) | |
9635 | (nreverse articles)))) | |
9636 | (gnus-newsgroup-processable | |
9637 | ;; There are process-marked articles present. | |
9638 | (reverse gnus-newsgroup-processable)) | |
9639 | (t | |
9640 | ;; Just return the current article. | |
9641 | (list (gnus-summary-article-number))))) | |
41487370 LMI |
9642 | |
9643 | (defun gnus-summary-search-group (&optional backward use-level) | |
9644 | "Search for next unread newsgroup. | |
9645 | If optional argument BACKWARD is non-nil, search backward instead." | |
9646 | (save-excursion | |
9647 | (set-buffer gnus-group-buffer) | |
231f989b | 9648 | (if (gnus-group-search-forward |
41487370 LMI |
9649 | backward nil (if use-level (gnus-group-group-level) nil)) |
9650 | (gnus-group-group-name)))) | |
9651 | ||
9652 | (defun gnus-summary-best-group (&optional exclude-group) | |
9653 | "Find the name of the best unread group. | |
9654 | If EXCLUDE-GROUP, do not go to this group." | |
9655 | (save-excursion | |
9656 | (set-buffer gnus-group-buffer) | |
9657 | (save-excursion | |
9658 | (gnus-group-best-unread-group exclude-group)))) | |
9659 | ||
231f989b LMI |
9660 | (defun gnus-summary-find-next (&optional unread article backward) |
9661 | (if backward (gnus-summary-find-prev) | |
9662 | (let* ((dummy (gnus-summary-article-intangible-p)) | |
9663 | (article (or article (gnus-summary-article-number))) | |
9664 | (arts (gnus-data-find-list article)) | |
9665 | result) | |
9666 | (when (and (not dummy) | |
9667 | (or (not gnus-summary-check-current) | |
9668 | (not unread) | |
9669 | (not (gnus-data-unread-p (car arts))))) | |
9670 | (setq arts (cdr arts))) | |
9671 | (when (setq result | |
9672 | (if unread | |
9673 | (progn | |
9674 | (while arts | |
9675 | (when (gnus-data-unread-p (car arts)) | |
9676 | (setq result (car arts) | |
9677 | arts nil)) | |
9678 | (setq arts (cdr arts))) | |
9679 | result) | |
9680 | (car arts))) | |
9681 | (goto-char (gnus-data-pos result)) | |
9682 | (gnus-data-number result))))) | |
9683 | ||
9684 | (defun gnus-summary-find-prev (&optional unread article) | |
9685 | (let* ((eobp (eobp)) | |
9686 | (article (or article (gnus-summary-article-number))) | |
9687 | (arts (gnus-data-find-list article (gnus-data-list 'rev))) | |
9688 | result) | |
9689 | (when (and (not eobp) | |
9690 | (or (not gnus-summary-check-current) | |
9691 | (not unread) | |
9692 | (not (gnus-data-unread-p (car arts))))) | |
9693 | (setq arts (cdr arts))) | |
9694 | (if (setq result | |
9695 | (if unread | |
9696 | (progn | |
9697 | (while arts | |
9698 | (and (gnus-data-unread-p (car arts)) | |
9699 | (setq result (car arts) | |
9700 | arts nil)) | |
9701 | (setq arts (cdr arts))) | |
9702 | result) | |
9703 | (car arts))) | |
9704 | (progn | |
9705 | (goto-char (gnus-data-pos result)) | |
9706 | (gnus-data-number result))))) | |
9707 | ||
9708 | (defun gnus-summary-find-subject (subject &optional unread backward article) | |
9709 | (let* ((simp-subject (gnus-simplify-subject-fully subject)) | |
9710 | (article (or article (gnus-summary-article-number))) | |
9711 | (articles (gnus-data-list backward)) | |
9712 | (arts (gnus-data-find-list article articles)) | |
9713 | result) | |
9714 | (when (or (not gnus-summary-check-current) | |
9715 | (not unread) | |
9716 | (not (gnus-data-unread-p (car arts)))) | |
9717 | (setq arts (cdr arts))) | |
9718 | (while arts | |
9719 | (and (or (not unread) | |
9720 | (gnus-data-unread-p (car arts))) | |
9721 | (vectorp (gnus-data-header (car arts))) | |
9722 | (gnus-subject-equal | |
9723 | simp-subject (mail-header-subject (gnus-data-header (car arts))) t) | |
9724 | (setq result (car arts) | |
9725 | arts nil)) | |
9726 | (setq arts (cdr arts))) | |
9727 | (and result | |
9728 | (goto-char (gnus-data-pos result)) | |
9729 | (gnus-data-number result)))) | |
9730 | ||
9731 | (defun gnus-summary-search-forward (&optional unread subject backward) | |
9732 | "Search forward for an article. | |
9733 | If UNREAD, look for unread articles. If SUBJECT, look for | |
9734 | articles with that subject. If BACKWARD, search backward instead." | |
9735 | (cond (subject (gnus-summary-find-subject subject unread backward)) | |
9736 | (backward (gnus-summary-find-prev unread)) | |
9737 | (t (gnus-summary-find-next unread)))) | |
9738 | ||
9739 | (defun gnus-recenter (&optional n) | |
9740 | "Center point in window and redisplay frame. | |
9741 | Also do horizontal recentering." | |
9742 | (interactive "P") | |
9743 | (when (and gnus-auto-center-summary | |
9744 | (not (eq gnus-auto-center-summary 'vertical))) | |
9745 | (gnus-horizontal-recenter)) | |
9746 | (recenter n)) | |
41487370 LMI |
9747 | |
9748 | (defun gnus-summary-recenter () | |
9749 | "Center point in the summary window. | |
9750 | If `gnus-auto-center-summary' is nil, or the article buffer isn't | |
231f989b | 9751 | displayed, no centering will be performed." |
41487370 | 9752 | ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). |
231f989b | 9753 | ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. |
41487370 LMI |
9754 | (let* ((top (cond ((< (window-height) 4) 0) |
9755 | ((< (window-height) 7) 1) | |
9756 | (t 2))) | |
9757 | (height (1- (window-height))) | |
9758 | (bottom (save-excursion (goto-char (point-max)) | |
9759 | (forward-line (- height)) | |
9760 | (point))) | |
9761 | (window (get-buffer-window (current-buffer)))) | |
231f989b LMI |
9762 | ;; The user has to want it. |
9763 | (when gnus-auto-center-summary | |
9764 | (when (get-buffer-window gnus-article-buffer) | |
9765 | ;; Only do recentering when the article buffer is displayed, | |
9766 | ;; Set the window start to either `bottom', which is the biggest | |
9767 | ;; possible valid number, or the second line from the top, | |
9768 | ;; whichever is the least. | |
9769 | (set-window-start | |
9770 | window (min bottom (save-excursion | |
9771 | (forward-line (- top)) (point))))) | |
9772 | ;; Do horizontal recentering while we're at it. | |
9773 | (when (and (get-buffer-window (current-buffer) t) | |
9774 | (not (eq gnus-auto-center-summary 'vertical))) | |
9775 | (let ((selected (selected-window))) | |
9776 | (select-window (get-buffer-window (current-buffer) t)) | |
9777 | (gnus-summary-position-point) | |
9778 | (gnus-horizontal-recenter) | |
9779 | (select-window selected)))))) | |
9780 | ||
9781 | (defun gnus-horizontal-recenter () | |
9782 | "Recenter the current buffer horizontally." | |
9783 | (if (< (current-column) (/ (window-width) 2)) | |
9784 | (set-window-hscroll (get-buffer-window (current-buffer) t) 0) | |
9785 | (let* ((orig (point)) | |
9786 | (end (window-end (get-buffer-window (current-buffer) t))) | |
9787 | (max 0)) | |
9788 | ;; Find the longest line currently displayed in the window. | |
9789 | (goto-char (window-start)) | |
9790 | (while (and (not (eobp)) | |
9791 | (< (point) end)) | |
9792 | (end-of-line) | |
9793 | (setq max (max max (current-column))) | |
9794 | (forward-line 1)) | |
9795 | (goto-char orig) | |
9796 | ;; Scroll horizontally to center (sort of) the point. | |
9797 | (if (> max (window-width)) | |
9798 | (set-window-hscroll | |
9799 | (get-buffer-window (current-buffer) t) | |
9800 | (min (- (current-column) (/ (window-width) 3)) | |
9801 | (+ 2 (- max (window-width))))) | |
9802 | (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) | |
9803 | max))) | |
41487370 LMI |
9804 | |
9805 | ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>. | |
9806 | (defun gnus-short-group-name (group &optional levels) | |
9807 | "Collapse GROUP name LEVELS." | |
231f989b LMI |
9808 | (let* ((name "") |
9809 | (foreign "") | |
9810 | (depth 0) | |
9811 | (skip 1) | |
41487370 LMI |
9812 | (levels (or levels |
9813 | (progn | |
9814 | (while (string-match "\\." group skip) | |
9815 | (setq skip (match-end 0) | |
9816 | depth (+ depth 1))) | |
9817 | depth)))) | |
9818 | (if (string-match ":" group) | |
9819 | (setq foreign (substring group 0 (match-end 0)) | |
9820 | group (substring group (match-end 0)))) | |
9821 | (while group | |
231f989b LMI |
9822 | (if (and (string-match "\\." group) |
9823 | (> levels (- gnus-group-uncollapsed-levels 1))) | |
41487370 LMI |
9824 | (setq name (concat name (substring group 0 1)) |
9825 | group (substring group (match-end 0)) | |
9826 | levels (- levels 1) | |
9827 | name (concat name ".")) | |
9828 | (setq name (concat foreign name group) | |
9829 | group nil))) | |
9830 | name)) | |
9831 | ||
9832 | (defun gnus-summary-jump-to-group (newsgroup) | |
9833 | "Move point to NEWSGROUP in group mode buffer." | |
9834 | ;; Keep update point of group mode buffer if visible. | |
9835 | (if (eq (current-buffer) (get-buffer gnus-group-buffer)) | |
9836 | (save-window-excursion | |
9837 | ;; Take care of tree window mode. | |
9838 | (if (get-buffer-window gnus-group-buffer) | |
9839 | (pop-to-buffer gnus-group-buffer)) | |
9840 | (gnus-group-jump-to-group newsgroup)) | |
9841 | (save-excursion | |
9842 | ;; Take care of tree window mode. | |
9843 | (if (get-buffer-window gnus-group-buffer) | |
9844 | (pop-to-buffer gnus-group-buffer) | |
9845 | (set-buffer gnus-group-buffer)) | |
9846 | (gnus-group-jump-to-group newsgroup)))) | |
9847 | ||
9848 | ;; This function returns a list of article numbers based on the | |
9849 | ;; difference between the ranges of read articles in this group and | |
9850 | ;; the range of active articles. | |
9851 | (defun gnus-list-of-unread-articles (group) | |
231f989b LMI |
9852 | (let* ((read (gnus-info-read (gnus-get-info group))) |
9853 | (active (gnus-active group)) | |
41487370 LMI |
9854 | (last (cdr active)) |
9855 | first nlast unread) | |
231f989b | 9856 | ;; If none are read, then all are unread. |
41487370 LMI |
9857 | (if (not read) |
9858 | (setq first (car active)) | |
9859 | ;; If the range of read articles is a single range, then the | |
9860 | ;; first unread article is the article after the last read | |
231f989b | 9861 | ;; article. Sounds logical, doesn't it? |
41487370 LMI |
9862 | (if (not (listp (cdr read))) |
9863 | (setq first (1+ (cdr read))) | |
9864 | ;; `read' is a list of ranges. | |
231f989b LMI |
9865 | (if (/= (setq nlast (or (and (numberp (car read)) (car read)) |
9866 | (caar read))) 1) | |
41487370 LMI |
9867 | (setq first 1)) |
9868 | (while read | |
231f989b | 9869 | (if first |
41487370 LMI |
9870 | (while (< first nlast) |
9871 | (setq unread (cons first unread)) | |
9872 | (setq first (1+ first)))) | |
231f989b LMI |
9873 | (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) |
9874 | (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) | |
41487370 LMI |
9875 | (setq read (cdr read))))) |
9876 | ;; And add the last unread articles. | |
9877 | (while (<= first last) | |
9878 | (setq unread (cons first unread)) | |
9879 | (setq first (1+ first))) | |
9880 | ;; Return the list of unread articles. | |
9881 | (nreverse unread))) | |
9882 | ||
9883 | (defun gnus-list-of-read-articles (group) | |
231f989b LMI |
9884 | "Return a list of unread, unticked and non-dormant articles." |
9885 | (let* ((info (gnus-get-info group)) | |
9886 | (marked (gnus-info-marks info)) | |
9887 | (active (gnus-active group))) | |
41487370 | 9888 | (and info active |
231f989b LMI |
9889 | (gnus-set-difference |
9890 | (gnus-sorted-complement | |
9891 | (gnus-uncompress-range active) | |
9892 | (gnus-list-of-unread-articles group)) | |
9893 | (append | |
9894 | (gnus-uncompress-range (cdr (assq 'dormant marked))) | |
9895 | (gnus-uncompress-range (cdr (assq 'tick marked)))))))) | |
41487370 LMI |
9896 | |
9897 | ;; Various summary commands | |
9898 | ||
231f989b LMI |
9899 | (defun gnus-summary-universal-argument (arg) |
9900 | "Perform any operation on all articles that are process/prefixed." | |
9901 | (interactive "P") | |
41487370 | 9902 | (gnus-set-global-variables) |
231f989b LMI |
9903 | (let ((articles (gnus-summary-work-articles arg)) |
9904 | func article) | |
9905 | (if (eq | |
9906 | (setq | |
9907 | func | |
9908 | (key-binding | |
9909 | (read-key-sequence | |
9910 | (substitute-command-keys | |
9911 | "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]" | |
9912 | )))) | |
9913 | 'undefined) | |
9914 | (gnus-error 1 "Undefined key") | |
9915 | (save-excursion | |
9916 | (while articles | |
9917 | (gnus-summary-goto-subject (setq article (pop articles))) | |
9918 | (command-execute func) | |
9919 | (gnus-summary-remove-process-mark article))))) | |
9920 | (gnus-summary-position-point)) | |
41487370 LMI |
9921 | |
9922 | (defun gnus-summary-toggle-truncation (&optional arg) | |
9923 | "Toggle truncation of summary lines. | |
9924 | With arg, turn line truncation on iff arg is positive." | |
9925 | (interactive "P") | |
9926 | (setq truncate-lines | |
9927 | (if (null arg) (not truncate-lines) | |
9928 | (> (prefix-numeric-value arg) 0))) | |
9929 | (redraw-display)) | |
9930 | ||
231f989b LMI |
9931 | (defun gnus-summary-reselect-current-group (&optional all rescan) |
9932 | "Exit and then reselect the current newsgroup. | |
41487370 LMI |
9933 | The prefix argument ALL means to select all articles." |
9934 | (interactive "P") | |
9935 | (gnus-set-global-variables) | |
231f989b LMI |
9936 | (when (gnus-ephemeral-group-p gnus-newsgroup-name) |
9937 | (error "Ephemeral groups can't be reselected")) | |
41487370 LMI |
9938 | (let ((current-subject (gnus-summary-article-number)) |
9939 | (group gnus-newsgroup-name)) | |
9940 | (setq gnus-newsgroup-begin nil) | |
231f989b | 9941 | (gnus-summary-exit) |
41487370 LMI |
9942 | ;; We have to adjust the point of group mode buffer because the |
9943 | ;; current point was moved to the next unread newsgroup by | |
9944 | ;; exiting. | |
9945 | (gnus-summary-jump-to-group group) | |
231f989b LMI |
9946 | (when rescan |
9947 | (save-excursion | |
9948 | (gnus-group-get-new-news-this-group 1))) | |
41487370 | 9949 | (gnus-group-read-group all t) |
231f989b | 9950 | (gnus-summary-goto-subject current-subject nil t))) |
41487370 LMI |
9951 | |
9952 | (defun gnus-summary-rescan-group (&optional all) | |
9953 | "Exit the newsgroup, ask for new articles, and select the newsgroup." | |
9954 | (interactive "P") | |
231f989b | 9955 | (gnus-summary-reselect-current-group all t)) |
41487370 LMI |
9956 | |
9957 | (defun gnus-summary-update-info () | |
9958 | (let* ((group gnus-newsgroup-name)) | |
231f989b LMI |
9959 | (when gnus-newsgroup-kill-headers |
9960 | (setq gnus-newsgroup-killed | |
9961 | (gnus-compress-sequence | |
9962 | (nconc | |
9963 | (gnus-set-sorted-intersection | |
9964 | (gnus-uncompress-range gnus-newsgroup-killed) | |
9965 | (setq gnus-newsgroup-unselected | |
9966 | (sort gnus-newsgroup-unselected '<))) | |
9967 | (setq gnus-newsgroup-unreads | |
9968 | (sort gnus-newsgroup-unreads '<))) t))) | |
9969 | (unless (listp (cdr gnus-newsgroup-killed)) | |
9970 | (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) | |
41487370 | 9971 | (let ((headers gnus-newsgroup-headers)) |
41487370 | 9972 | (run-hooks 'gnus-exit-group-hook) |
231f989b LMI |
9973 | (unless gnus-save-score |
9974 | (setq gnus-newsgroup-scored nil)) | |
9975 | ;; Set the new ranges of read articles. | |
9976 | (gnus-update-read-articles | |
9977 | group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) | |
9978 | ;; Set the current article marks. | |
9979 | (gnus-update-marks) | |
9980 | ;; Do the cross-ref thing. | |
9981 | (when gnus-use-cross-reference | |
9982 | (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) | |
41487370 | 9983 | ;; Do adaptive scoring, and possibly save score files. |
231f989b LMI |
9984 | (when gnus-newsgroup-adaptive |
9985 | (gnus-score-adaptive)) | |
9986 | (when gnus-use-scoring | |
9987 | (gnus-score-save)) | |
41487370 LMI |
9988 | ;; Do not switch windows but change the buffer to work. |
9989 | (set-buffer gnus-group-buffer) | |
9990 | (or (gnus-ephemeral-group-p gnus-newsgroup-name) | |
9991 | (gnus-group-update-group group))))) | |
231f989b | 9992 | |
41487370 LMI |
9993 | (defun gnus-summary-exit (&optional temporary) |
9994 | "Exit reading current newsgroup, and then return to group selection mode. | |
9995 | gnus-exit-group-hook is called with no arguments if that value is non-nil." | |
9996 | (interactive) | |
9997 | (gnus-set-global-variables) | |
9998 | (gnus-kill-save-kill-buffer) | |
9999 | (let* ((group gnus-newsgroup-name) | |
10000 | (quit-config (gnus-group-quit-config gnus-newsgroup-name)) | |
10001 | (mode major-mode) | |
10002 | (buf (current-buffer))) | |
10003 | (run-hooks 'gnus-summary-prepare-exit-hook) | |
231f989b LMI |
10004 | ;; If we have several article buffers, we kill them at exit. |
10005 | (unless gnus-single-article-buffer | |
10006 | (gnus-kill-buffer gnus-original-article-buffer) | |
10007 | (setq gnus-article-current nil)) | |
10008 | (when gnus-use-cache | |
10009 | (gnus-cache-possibly-remove-articles) | |
10010 | (gnus-cache-save-buffers)) | |
10011 | (when gnus-use-trees | |
10012 | (gnus-tree-close group)) | |
41487370 | 10013 | ;; Make all changes in this group permanent. |
231f989b LMI |
10014 | (unless quit-config |
10015 | (gnus-summary-update-info)) | |
10016 | (gnus-close-group group) | |
41487370 LMI |
10017 | ;; Make sure where I was, and go to next newsgroup. |
10018 | (set-buffer gnus-group-buffer) | |
231f989b LMI |
10019 | (unless quit-config |
10020 | (gnus-group-jump-to-group group)) | |
10021 | (run-hooks 'gnus-summary-exit-hook) | |
10022 | (unless quit-config | |
10023 | (gnus-group-next-unread-group 1)) | |
41487370 LMI |
10024 | (if temporary |
10025 | nil ;Nothing to do. | |
231f989b LMI |
10026 | ;; If we have several article buffers, we kill them at exit. |
10027 | (unless gnus-single-article-buffer | |
10028 | (gnus-kill-buffer gnus-article-buffer) | |
10029 | (gnus-kill-buffer gnus-original-article-buffer) | |
10030 | (setq gnus-article-current nil)) | |
41487370 | 10031 | (set-buffer buf) |
231f989b LMI |
10032 | (if (not gnus-kill-summary-on-exit) |
10033 | (gnus-deaden-summary) | |
10034 | ;; We set all buffer-local variables to nil. It is unclear why | |
10035 | ;; this is needed, but if we don't, buffer-local variables are | |
10036 | ;; not garbage-collected, it seems. This would the lead to en | |
10037 | ;; ever-growing Emacs. | |
10038 | (gnus-summary-clear-local-variables) | |
10039 | (when (get-buffer gnus-article-buffer) | |
41487370 | 10040 | (bury-buffer gnus-article-buffer)) |
231f989b LMI |
10041 | ;; We clear the global counterparts of the buffer-local |
10042 | ;; variables as well, just to be on the safe side. | |
10043 | (gnus-configure-windows 'group 'force) | |
10044 | (gnus-summary-clear-local-variables) | |
10045 | ;; Return to group mode buffer. | |
10046 | (if (eq mode 'gnus-summary-mode) | |
10047 | (gnus-kill-buffer buf))) | |
41487370 LMI |
10048 | (setq gnus-current-select-method gnus-select-method) |
10049 | (pop-to-buffer gnus-group-buffer) | |
231f989b | 10050 | ;; Clear the current group name. |
41487370 LMI |
10051 | (if (not quit-config) |
10052 | (progn | |
10053 | (gnus-group-jump-to-group group) | |
231f989b LMI |
10054 | (gnus-group-next-unread-group 1) |
10055 | (gnus-configure-windows 'group 'force)) | |
41487370 LMI |
10056 | (if (not (buffer-name (car quit-config))) |
10057 | (gnus-configure-windows 'group 'force) | |
10058 | (set-buffer (car quit-config)) | |
10059 | (and (eq major-mode 'gnus-summary-mode) | |
10060 | (gnus-set-global-variables)) | |
10061 | (gnus-configure-windows (cdr quit-config)))) | |
231f989b LMI |
10062 | (unless quit-config |
10063 | (setq gnus-newsgroup-name nil))))) | |
41487370 LMI |
10064 | |
10065 | (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) | |
10066 | (defun gnus-summary-exit-no-update (&optional no-questions) | |
10067 | "Quit reading current newsgroup without updating read article info." | |
10068 | (interactive) | |
10069 | (gnus-set-global-variables) | |
10070 | (let* ((group gnus-newsgroup-name) | |
10071 | (quit-config (gnus-group-quit-config group))) | |
231f989b LMI |
10072 | (when (or no-questions |
10073 | gnus-expert-user | |
10074 | (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) | |
10075 | ;; If we have several article buffers, we kill them at exit. | |
10076 | (unless gnus-single-article-buffer | |
10077 | (gnus-kill-buffer gnus-article-buffer) | |
10078 | (gnus-kill-buffer gnus-original-article-buffer) | |
10079 | (setq gnus-article-current nil)) | |
10080 | (if (not gnus-kill-summary-on-exit) | |
10081 | (gnus-deaden-summary) | |
10082 | (gnus-close-group group) | |
10083 | (gnus-summary-clear-local-variables) | |
10084 | (set-buffer gnus-group-buffer) | |
10085 | (gnus-summary-clear-local-variables) | |
10086 | (when (get-buffer gnus-summary-buffer) | |
10087 | (kill-buffer gnus-summary-buffer))) | |
10088 | (unless gnus-single-article-buffer | |
10089 | (setq gnus-article-current nil)) | |
10090 | (when gnus-use-trees | |
10091 | (gnus-tree-close group)) | |
10092 | (when (get-buffer gnus-article-buffer) | |
10093 | (bury-buffer gnus-article-buffer)) | |
10094 | ;; Return to the group buffer. | |
10095 | (gnus-configure-windows 'group 'force) | |
10096 | ;; Clear the current group name. | |
10097 | (setq gnus-newsgroup-name nil) | |
10098 | (when (equal (gnus-group-group-name) group) | |
10099 | (gnus-group-next-unread-group 1)) | |
10100 | (when quit-config | |
10101 | (if (not (buffer-name (car quit-config))) | |
10102 | (gnus-configure-windows 'group 'force) | |
10103 | (set-buffer (car quit-config)) | |
10104 | (when (eq major-mode 'gnus-summary-mode) | |
10105 | (gnus-set-global-variables)) | |
10106 | (gnus-configure-windows (cdr quit-config))))))) | |
10107 | ||
10108 | ;;; Dead summaries. | |
10109 | ||
10110 | (defvar gnus-dead-summary-mode-map nil) | |
10111 | ||
10112 | (if gnus-dead-summary-mode-map | |
10113 | nil | |
10114 | (setq gnus-dead-summary-mode-map (make-keymap)) | |
10115 | (suppress-keymap gnus-dead-summary-mode-map) | |
10116 | (substitute-key-definition | |
10117 | 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) | |
10118 | (let ((keys '("\C-d" "\r" "\177"))) | |
10119 | (while keys | |
10120 | (define-key gnus-dead-summary-mode-map | |
10121 | (pop keys) 'gnus-summary-wake-up-the-dead)))) | |
10122 | ||
10123 | (defvar gnus-dead-summary-mode nil | |
10124 | "Minor mode for Gnus summary buffers.") | |
10125 | ||
10126 | (defun gnus-dead-summary-mode (&optional arg) | |
10127 | "Minor mode for Gnus summary buffers." | |
10128 | (interactive "P") | |
10129 | (when (eq major-mode 'gnus-summary-mode) | |
10130 | (make-local-variable 'gnus-dead-summary-mode) | |
10131 | (setq gnus-dead-summary-mode | |
10132 | (if (null arg) (not gnus-dead-summary-mode) | |
10133 | (> (prefix-numeric-value arg) 0))) | |
10134 | (when gnus-dead-summary-mode | |
10135 | (unless (assq 'gnus-dead-summary-mode minor-mode-alist) | |
10136 | (push '(gnus-dead-summary-mode " Dead") minor-mode-alist)) | |
10137 | (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist) | |
10138 | (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map) | |
10139 | minor-mode-map-alist))))) | |
10140 | ||
10141 | (defun gnus-deaden-summary () | |
10142 | "Make the current summary buffer into a dead summary buffer." | |
10143 | ;; Kill any previous dead summary buffer. | |
10144 | (when (and gnus-dead-summary | |
10145 | (buffer-name gnus-dead-summary)) | |
10146 | (save-excursion | |
10147 | (set-buffer gnus-dead-summary) | |
10148 | (when gnus-dead-summary-mode | |
10149 | (kill-buffer (current-buffer))))) | |
10150 | ;; Make this the current dead summary. | |
10151 | (setq gnus-dead-summary (current-buffer)) | |
10152 | (gnus-dead-summary-mode 1) | |
10153 | (let ((name (buffer-name))) | |
10154 | (when (string-match "Summary" name) | |
10155 | (rename-buffer | |
10156 | (concat (substring name 0 (match-beginning 0)) "Dead " | |
10157 | (substring name (match-beginning 0))) t)))) | |
10158 | ||
10159 | (defun gnus-kill-or-deaden-summary (buffer) | |
10160 | "Kill or deaden the summary BUFFER." | |
10161 | (when (and (buffer-name buffer) | |
10162 | (not gnus-single-article-buffer)) | |
10163 | (save-excursion | |
10164 | (set-buffer buffer) | |
10165 | (gnus-kill-buffer gnus-article-buffer) | |
10166 | (gnus-kill-buffer gnus-original-article-buffer))) | |
10167 | (cond (gnus-kill-summary-on-exit | |
10168 | (when (and gnus-use-trees | |
10169 | (and (get-buffer buffer) | |
10170 | (buffer-name (get-buffer buffer)))) | |
10171 | (save-excursion | |
10172 | (set-buffer (get-buffer buffer)) | |
10173 | (gnus-tree-close gnus-newsgroup-name))) | |
10174 | (gnus-kill-buffer buffer)) | |
10175 | ((and (get-buffer buffer) | |
10176 | (buffer-name (get-buffer buffer))) | |
10177 | (save-excursion | |
10178 | (set-buffer buffer) | |
10179 | (gnus-deaden-summary))))) | |
10180 | ||
10181 | (defun gnus-summary-wake-up-the-dead (&rest args) | |
10182 | "Wake up the dead summary buffer." | |
10183 | (interactive) | |
10184 | (gnus-dead-summary-mode -1) | |
10185 | (let ((name (buffer-name))) | |
10186 | (when (string-match "Dead " name) | |
10187 | (rename-buffer | |
10188 | (concat (substring name 0 (match-beginning 0)) | |
10189 | (substring name (match-end 0))) t))) | |
10190 | (gnus-message 3 "This dead summary is now alive again")) | |
41487370 LMI |
10191 | |
10192 | ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>. | |
231f989b LMI |
10193 | (defun gnus-summary-fetch-faq (&optional faq-dir) |
10194 | "Fetch the FAQ for the current group. | |
10195 | If FAQ-DIR (the prefix), prompt for a directory to search for the faq | |
10196 | in." | |
10197 | (interactive | |
10198 | (list | |
10199 | (if current-prefix-arg | |
10200 | (completing-read | |
10201 | "Faq dir: " (and (listp gnus-group-faq-directory) | |
10202 | gnus-group-faq-directory))))) | |
41487370 | 10203 | (let (gnus-faq-buffer) |
231f989b LMI |
10204 | (and (setq gnus-faq-buffer |
10205 | (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) | |
41487370 LMI |
10206 | (gnus-configure-windows 'summary-faq)))) |
10207 | ||
10208 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. | |
10209 | (defun gnus-summary-describe-group (&optional force) | |
10210 | "Describe the current newsgroup." | |
10211 | (interactive "P") | |
10212 | (gnus-group-describe-group force gnus-newsgroup-name)) | |
10213 | ||
10214 | (defun gnus-summary-describe-briefly () | |
10215 | "Describe summary mode commands briefly." | |
10216 | (interactive) | |
10217 | (gnus-message 6 | |
231f989b | 10218 | (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 |
10219 | |
10220 | ;; Walking around group mode buffer from summary mode. | |
10221 | ||
10222 | (defun gnus-summary-next-group (&optional no-article target-group backward) | |
10223 | "Exit current newsgroup and then select next unread newsgroup. | |
10224 | If prefix argument NO-ARTICLE is non-nil, no article is selected | |
231f989b | 10225 | initially. If NEXT-GROUP, go to this group. If BACKWARD, go to |
41487370 LMI |
10226 | previous group instead." |
10227 | (interactive "P") | |
10228 | (gnus-set-global-variables) | |
10229 | (let ((current-group gnus-newsgroup-name) | |
10230 | (current-buffer (current-buffer)) | |
10231 | entered) | |
10232 | ;; First we semi-exit this group to update Xrefs and all variables. | |
10233 | ;; We can't do a real exit, because the window conf must remain | |
10234 | ;; the same in case the user is prompted for info, and we don't | |
10235 | ;; want the window conf to change before that... | |
10236 | (gnus-summary-exit t) | |
10237 | (while (not entered) | |
10238 | ;; Then we find what group we are supposed to enter. | |
10239 | (set-buffer gnus-group-buffer) | |
10240 | (gnus-group-jump-to-group current-group) | |
231f989b LMI |
10241 | (setq target-group |
10242 | (or target-group | |
10243 | (if (eq gnus-keep-same-level 'best) | |
41487370 LMI |
10244 | (gnus-summary-best-group gnus-newsgroup-name) |
10245 | (gnus-summary-search-group backward gnus-keep-same-level)))) | |
10246 | (if (not target-group) | |
10247 | ;; There are no further groups, so we return to the group | |
10248 | ;; buffer. | |
10249 | (progn | |
10250 | (gnus-message 5 "Returning to the group buffer") | |
10251 | (setq entered t) | |
10252 | (set-buffer current-buffer) | |
10253 | (gnus-summary-exit)) | |
10254 | ;; We try to enter the target group. | |
10255 | (gnus-group-jump-to-group target-group) | |
10256 | (let ((unreads (gnus-group-group-unread))) | |
10257 | (if (and (or (eq t unreads) | |
10258 | (and unreads (not (zerop unreads)))) | |
10259 | (gnus-summary-read-group | |
10260 | target-group nil no-article current-buffer)) | |
10261 | (setq entered t) | |
10262 | (setq current-group target-group | |
10263 | target-group nil))))))) | |
10264 | ||
41487370 LMI |
10265 | (defun gnus-summary-prev-group (&optional no-article) |
10266 | "Exit current newsgroup and then select previous unread newsgroup. | |
10267 | If prefix argument NO-ARTICLE is non-nil, no article is selected initially." | |
10268 | (interactive "P") | |
10269 | (gnus-summary-next-group no-article nil t)) | |
10270 | ||
10271 | ;; Walking around summary lines. | |
10272 | ||
10273 | (defun gnus-summary-first-subject (&optional unread) | |
10274 | "Go to the first unread subject. | |
10275 | If UNREAD is non-nil, go to the first unread article. | |
231f989b | 10276 | Returns the article selected or nil if there are no unread articles." |
41487370 LMI |
10277 | (interactive "P") |
10278 | (prog1 | |
231f989b LMI |
10279 | (cond |
10280 | ;; Empty summary. | |
10281 | ((null gnus-newsgroup-data) | |
10282 | (gnus-message 3 "No articles in the group") | |
10283 | nil) | |
10284 | ;; Pick the first article. | |
10285 | ((not unread) | |
10286 | (goto-char (gnus-data-pos (car gnus-newsgroup-data))) | |
10287 | (gnus-data-number (car gnus-newsgroup-data))) | |
10288 | ;; No unread articles. | |
10289 | ((null gnus-newsgroup-unreads) | |
10290 | (gnus-message 3 "No more unread articles") | |
10291 | nil) | |
10292 | ;; Find the first unread article. | |
10293 | (t | |
10294 | (let ((data gnus-newsgroup-data)) | |
10295 | (while (and data | |
10296 | (not (gnus-data-unread-p (car data)))) | |
10297 | (setq data (cdr data))) | |
10298 | (if data | |
10299 | (progn | |
10300 | (goto-char (gnus-data-pos (car data))) | |
10301 | (gnus-data-number (car data))))))) | |
10302 | (gnus-summary-position-point))) | |
41487370 LMI |
10303 | |
10304 | (defun gnus-summary-next-subject (n &optional unread dont-display) | |
10305 | "Go to next N'th summary line. | |
10306 | If N is negative, go to the previous N'th subject line. | |
10307 | If UNREAD is non-nil, only unread articles are selected. | |
10308 | The difference between N and the actual number of steps taken is | |
10309 | returned." | |
745bc783 | 10310 | (interactive "p") |
41487370 LMI |
10311 | (let ((backward (< n 0)) |
10312 | (n (abs n))) | |
10313 | (while (and (> n 0) | |
231f989b LMI |
10314 | (if backward |
10315 | (gnus-summary-find-prev unread) | |
10316 | (gnus-summary-find-next unread))) | |
41487370 LMI |
10317 | (setq n (1- n))) |
10318 | (if (/= 0 n) (gnus-message 7 "No more%s articles" | |
10319 | (if unread " unread" ""))) | |
231f989b LMI |
10320 | (unless dont-display |
10321 | (gnus-summary-recenter) | |
10322 | (gnus-summary-position-point)) | |
41487370 | 10323 | n)) |
745bc783 | 10324 | |
b027f415 | 10325 | (defun gnus-summary-next-unread-subject (n) |
41487370 | 10326 | "Go to next N'th unread summary line." |
745bc783 | 10327 | (interactive "p") |
b027f415 | 10328 | (gnus-summary-next-subject n t)) |
745bc783 | 10329 | |
b027f415 | 10330 | (defun gnus-summary-prev-subject (n &optional unread) |
41487370 | 10331 | "Go to previous N'th summary line. |
745bc783 JB |
10332 | If optional argument UNREAD is non-nil, only unread article is selected." |
10333 | (interactive "p") | |
41487370 | 10334 | (gnus-summary-next-subject (- n) unread)) |
745bc783 | 10335 | |
b027f415 | 10336 | (defun gnus-summary-prev-unread-subject (n) |
41487370 | 10337 | "Go to previous N'th unread summary line." |
745bc783 | 10338 | (interactive "p") |
41487370 LMI |
10339 | (gnus-summary-next-subject (- n) t)) |
10340 | ||
231f989b LMI |
10341 | (defun gnus-summary-goto-subject (article &optional force silent) |
10342 | "Go the subject line of ARTICLE. | |
10343 | If FORCE, also allow jumping to articles not currently shown." | |
10344 | (let ((b (point)) | |
10345 | (data (gnus-data-find article))) | |
10346 | ;; We read in the article if we have to. | |
10347 | (and (not data) | |
10348 | force | |
10349 | (gnus-summary-insert-subject article (and (vectorp force) force) t) | |
10350 | (setq data (gnus-data-find article))) | |
10351 | (goto-char b) | |
10352 | (if (not data) | |
10353 | (progn | |
10354 | (unless silent | |
10355 | (gnus-message 3 "Can't find article %d" article)) | |
10356 | nil) | |
10357 | (goto-char (gnus-data-pos data)) | |
10358 | article))) | |
745bc783 | 10359 | |
b027f415 | 10360 | ;; Walking around summary lines with displaying articles. |
745bc783 | 10361 | |
41487370 LMI |
10362 | (defun gnus-summary-expand-window (&optional arg) |
10363 | "Make the summary buffer take up the entire Emacs frame. | |
10364 | Given a prefix, will force an `article' buffer configuration." | |
10365 | (interactive "P") | |
10366 | (gnus-set-global-variables) | |
10367 | (if arg | |
10368 | (gnus-configure-windows 'article 'force) | |
10369 | (gnus-configure-windows 'summary 'force))) | |
745bc783 | 10370 | |
b027f415 | 10371 | (defun gnus-summary-display-article (article &optional all-header) |
41487370 LMI |
10372 | "Display ARTICLE in article buffer." |
10373 | (gnus-set-global-variables) | |
745bc783 JB |
10374 | (if (null article) |
10375 | nil | |
41487370 | 10376 | (prog1 |
231f989b LMI |
10377 | (if gnus-summary-display-article-function |
10378 | (funcall gnus-summary-display-article-function article all-header) | |
10379 | (gnus-article-prepare article all-header)) | |
41487370 | 10380 | (run-hooks 'gnus-select-article-hook) |
231f989b LMI |
10381 | (unless (zerop gnus-current-article) |
10382 | (gnus-summary-goto-subject gnus-current-article)) | |
41487370 | 10383 | (gnus-summary-recenter) |
231f989b LMI |
10384 | (when gnus-use-trees |
10385 | (gnus-possibly-generate-tree article) | |
10386 | (gnus-highlight-selected-tree article)) | |
41487370 | 10387 | ;; Successfully display article. |
231f989b LMI |
10388 | (gnus-article-set-window-start |
10389 | (cdr (assq article gnus-newsgroup-bookmarks)))))) | |
41487370 LMI |
10390 | |
10391 | (defun gnus-summary-select-article (&optional all-headers force pseudo article) | |
745bc783 | 10392 | "Select the current article. |
41487370 LMI |
10393 | If ALL-HEADERS is non-nil, show all header fields. If FORCE is |
10394 | non-nil, the article will be re-fetched even if it already present in | |
10395 | the article buffer. If PSEUDO is non-nil, pseudo-articles will also | |
10396 | be displayed." | |
231f989b LMI |
10397 | ;; Make sure we are in the summary buffer to work around bbdb bug. |
10398 | (unless (eq major-mode 'gnus-summary-mode) | |
10399 | (set-buffer gnus-summary-buffer)) | |
41487370 LMI |
10400 | (let ((article (or article (gnus-summary-article-number))) |
10401 | (all-headers (not (not all-headers))) ;Must be T or NIL. | |
231f989b LMI |
10402 | gnus-summary-display-article-function |
10403 | did) | |
10404 | (and (not pseudo) | |
10405 | (gnus-summary-article-pseudo-p article) | |
10406 | (error "This is a pseudo-article.")) | |
41487370 LMI |
10407 | (prog1 |
10408 | (save-excursion | |
10409 | (set-buffer gnus-summary-buffer) | |
231f989b LMI |
10410 | (if (or (and gnus-single-article-buffer |
10411 | (or (null gnus-current-article) | |
10412 | (null gnus-article-current) | |
10413 | (null (get-buffer gnus-article-buffer)) | |
10414 | (not (eq article (cdr gnus-article-current))) | |
10415 | (not (equal (car gnus-article-current) | |
10416 | gnus-newsgroup-name)))) | |
10417 | (and (not gnus-single-article-buffer) | |
10418 | (or (null gnus-current-article) | |
10419 | (not (eq gnus-current-article article)))) | |
41487370 LMI |
10420 | force) |
10421 | ;; The requested article is different from the current article. | |
231f989b LMI |
10422 | (prog1 |
10423 | (gnus-summary-display-article article all-headers) | |
41487370 | 10424 | (setq did article)) |
231f989b | 10425 | (if (or all-headers gnus-show-all-headers) |
41487370 | 10426 | (gnus-article-show-all-headers)) |
231f989b LMI |
10427 | 'old)) |
10428 | (if did | |
10429 | (gnus-article-set-window-start | |
41487370 | 10430 | (cdr (assq article gnus-newsgroup-bookmarks))))))) |
745bc783 | 10431 | |
b027f415 | 10432 | (defun gnus-summary-set-current-mark (&optional current-mark) |
41487370 LMI |
10433 | "Obsolete function." |
10434 | nil) | |
10435 | ||
231f989b | 10436 | (defun gnus-summary-next-article (&optional unread subject backward push) |
41487370 LMI |
10437 | "Select the next article. |
10438 | If UNREAD, only unread articles are selected. | |
10439 | If SUBJECT, only articles with SUBJECT are selected. | |
10440 | If BACKWARD, the previous article is selected instead of the next." | |
745bc783 | 10441 | (interactive "P") |
41487370 | 10442 | (gnus-set-global-variables) |
231f989b LMI |
10443 | (cond |
10444 | ;; Is there such an article? | |
10445 | ((and (gnus-summary-search-forward unread subject backward) | |
10446 | (or (gnus-summary-display-article (gnus-summary-article-number)) | |
10447 | (eq (gnus-summary-article-mark) gnus-canceled-mark))) | |
10448 | (gnus-summary-position-point)) | |
10449 | ;; If not, we try the first unread, if that is wanted. | |
10450 | ((and subject | |
10451 | gnus-auto-select-same | |
564b670b | 10452 | (gnus-summary-first-unread-article)) |
231f989b LMI |
10453 | (gnus-summary-position-point) |
10454 | (gnus-message 6 "Wrapped")) | |
10455 | ;; Try to get next/previous article not displayed in this group. | |
10456 | ((and gnus-auto-extend-newsgroup | |
10457 | (not unread) (not subject)) | |
10458 | (gnus-summary-goto-article | |
10459 | (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) | |
10460 | nil t)) | |
10461 | ;; Go to next/previous group. | |
10462 | (t | |
10463 | (or (gnus-ephemeral-group-p gnus-newsgroup-name) | |
10464 | (gnus-summary-jump-to-group gnus-newsgroup-name)) | |
10465 | (let ((cmd last-command-char) | |
10466 | (group | |
10467 | (if (eq gnus-keep-same-level 'best) | |
10468 | (gnus-summary-best-group gnus-newsgroup-name) | |
10469 | (gnus-summary-search-group backward gnus-keep-same-level)))) | |
10470 | ;; For some reason, the group window gets selected. We change | |
10471 | ;; it back. | |
10472 | (select-window (get-buffer-window (current-buffer))) | |
10473 | ;; Select next unread newsgroup automagically. | |
10474 | (cond | |
10475 | ((or (not gnus-auto-select-next) | |
10476 | (not cmd)) | |
10477 | (gnus-message 7 "No more%s articles" (if unread " unread" ""))) | |
10478 | ((or (eq gnus-auto-select-next 'quietly) | |
10479 | (and (eq gnus-auto-select-next 'slightly-quietly) | |
10480 | push) | |
10481 | (and (eq gnus-auto-select-next 'almost-quietly) | |
10482 | (gnus-summary-last-article-p))) | |
10483 | ;; Select quietly. | |
10484 | (if (gnus-ephemeral-group-p gnus-newsgroup-name) | |
10485 | (gnus-summary-exit) | |
10486 | (gnus-message 7 "No more%s articles (%s)..." | |
10487 | (if unread " unread" "") | |
10488 | (if group (concat "selecting " group) | |
10489 | "exiting")) | |
10490 | (gnus-summary-next-group nil group backward))) | |
10491 | (t | |
10492 | (gnus-summary-walk-group-buffer | |
10493 | gnus-newsgroup-name cmd unread backward))))))) | |
10494 | ||
10495 | (defun gnus-summary-walk-group-buffer (from-group cmd unread backward) | |
10496 | (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) | |
10497 | (?\C-p (gnus-group-prev-unread-group 1)))) | |
10498 | keve key group ended) | |
10499 | (save-excursion | |
10500 | (set-buffer gnus-group-buffer) | |
10501 | (gnus-summary-jump-to-group from-group) | |
10502 | (setq group | |
10503 | (if (eq gnus-keep-same-level 'best) | |
10504 | (gnus-summary-best-group gnus-newsgroup-name) | |
10505 | (gnus-summary-search-group backward gnus-keep-same-level)))) | |
10506 | (while (not ended) | |
10507 | (gnus-message | |
10508 | 5 "No more%s articles%s" (if unread " unread" "") | |
10509 | (if (and group | |
10510 | (not (gnus-ephemeral-group-p gnus-newsgroup-name))) | |
10511 | (format " (Type %s for %s [%s])" | |
10512 | (single-key-description cmd) group | |
10513 | (car (gnus-gethash group gnus-newsrc-hashtb))) | |
10514 | (format " (Type %s to exit %s)" | |
10515 | (single-key-description cmd) | |
10516 | gnus-newsgroup-name))) | |
10517 | ;; Confirm auto selection. | |
10518 | (setq key (car (setq keve (gnus-read-event-char)))) | |
10519 | (setq ended t) | |
10520 | (cond | |
10521 | ((assq key keystrokes) | |
10522 | (let ((obuf (current-buffer))) | |
10523 | (switch-to-buffer gnus-group-buffer) | |
10524 | (and group | |
10525 | (gnus-group-jump-to-group group)) | |
10526 | (eval (cadr (assq key keystrokes))) | |
10527 | (setq group (gnus-group-group-name)) | |
10528 | (switch-to-buffer obuf)) | |
10529 | (setq ended nil)) | |
10530 | ((equal key cmd) | |
10531 | (if (or (not group) | |
10532 | (gnus-ephemeral-group-p gnus-newsgroup-name)) | |
10533 | (gnus-summary-exit) | |
10534 | (gnus-summary-next-group nil group backward))) | |
10535 | (t | |
10536 | (push (cdr keve) unread-command-events)))))) | |
10537 | ||
10538 | (defun gnus-read-event-char () | |
10539 | "Get the next event." | |
10540 | (let ((event (read-event))) | |
10541 | (cons (and (numberp event) event) event))) | |
745bc783 | 10542 | |
b027f415 | 10543 | (defun gnus-summary-next-unread-article () |
745bc783 JB |
10544 | "Select unread article after current one." |
10545 | (interactive) | |
b027f415 | 10546 | (gnus-summary-next-article t (and gnus-auto-select-same |
231f989b | 10547 | (gnus-summary-article-subject)))) |
745bc783 | 10548 | |
41487370 LMI |
10549 | (defun gnus-summary-prev-article (&optional unread subject) |
10550 | "Select the article after the current one. | |
10551 | If UNREAD is non-nil, only unread articles are selected." | |
745bc783 | 10552 | (interactive "P") |
41487370 | 10553 | (gnus-summary-next-article unread subject t)) |
745bc783 | 10554 | |
b027f415 | 10555 | (defun gnus-summary-prev-unread-article () |
41487370 | 10556 | "Select unred article before current one." |
745bc783 | 10557 | (interactive) |
b027f415 | 10558 | (gnus-summary-prev-article t (and gnus-auto-select-same |
231f989b | 10559 | (gnus-summary-article-subject)))) |
745bc783 | 10560 | |
41487370 | 10561 | (defun gnus-summary-next-page (&optional lines circular) |
231f989b LMI |
10562 | "Show next page of the selected article. |
10563 | If at the end of the current article, select the next article. | |
10564 | LINES says how many lines should be scrolled up. | |
10565 | ||
10566 | If CIRCULAR is non-nil, go to the start of the article instead of | |
10567 | selecting the next article when reaching the end of the current | |
10568 | article." | |
745bc783 | 10569 | (interactive "P") |
41487370 LMI |
10570 | (setq gnus-summary-buffer (current-buffer)) |
10571 | (gnus-set-global-variables) | |
b027f415 | 10572 | (let ((article (gnus-summary-article-number)) |
745bc783 | 10573 | (endp nil)) |
41487370 | 10574 | (gnus-configure-windows 'article) |
231f989b LMI |
10575 | (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) |
10576 | (if (and (eq gnus-summary-goto-unread 'never) | |
10577 | (not (gnus-summary-last-article-p article))) | |
10578 | (gnus-summary-next-article) | |
10579 | (gnus-summary-next-unread-article)) | |
10580 | (if (or (null gnus-current-article) | |
10581 | (null gnus-article-current) | |
10582 | (/= article (cdr gnus-article-current)) | |
10583 | (not (equal (car gnus-article-current) gnus-newsgroup-name))) | |
10584 | ;; Selected subject is different from current article's. | |
10585 | (gnus-summary-display-article article) | |
10586 | (gnus-eval-in-buffer-window gnus-article-buffer | |
10587 | (setq endp (gnus-article-next-page lines))) | |
10588 | (if endp | |
10589 | (cond (circular | |
10590 | (gnus-summary-beginning-of-article)) | |
10591 | (lines | |
10592 | (gnus-message 3 "End of message")) | |
10593 | ((null lines) | |
10594 | (if (and (eq gnus-summary-goto-unread 'never) | |
10595 | (not (gnus-summary-last-article-p article))) | |
10596 | (gnus-summary-next-article) | |
10597 | (gnus-summary-next-unread-article))))))) | |
41487370 | 10598 | (gnus-summary-recenter) |
231f989b | 10599 | (gnus-summary-position-point))) |
41487370 LMI |
10600 | |
10601 | (defun gnus-summary-prev-page (&optional lines) | |
745bc783 JB |
10602 | "Show previous page of selected article. |
10603 | Argument LINES specifies lines to be scrolled down." | |
10604 | (interactive "P") | |
41487370 | 10605 | (gnus-set-global-variables) |
b027f415 | 10606 | (let ((article (gnus-summary-article-number))) |
41487370 | 10607 | (gnus-configure-windows 'article) |
745bc783 | 10608 | (if (or (null gnus-current-article) |
41487370 LMI |
10609 | (null gnus-article-current) |
10610 | (/= article (cdr gnus-article-current)) | |
10611 | (not (equal (car gnus-article-current) gnus-newsgroup-name))) | |
745bc783 | 10612 | ;; Selected subject is different from current article's. |
b027f415 | 10613 | (gnus-summary-display-article article) |
41487370 | 10614 | (gnus-summary-recenter) |
b027f415 | 10615 | (gnus-eval-in-buffer-window gnus-article-buffer |
231f989b LMI |
10616 | (gnus-article-prev-page lines)))) |
10617 | (gnus-summary-position-point)) | |
745bc783 | 10618 | |
b027f415 | 10619 | (defun gnus-summary-scroll-up (lines) |
745bc783 JB |
10620 | "Scroll up (or down) one line current article. |
10621 | Argument LINES specifies lines to be scrolled up (or down if negative)." | |
10622 | (interactive "p") | |
41487370 LMI |
10623 | (gnus-set-global-variables) |
10624 | (gnus-configure-windows 'article) | |
231f989b LMI |
10625 | (gnus-summary-show-thread) |
10626 | (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) | |
10627 | (gnus-eval-in-buffer-window gnus-article-buffer | |
10628 | (cond ((> lines 0) | |
10629 | (if (gnus-article-next-page lines) | |
10630 | (gnus-message 3 "End of message"))) | |
10631 | ((< lines 0) | |
10632 | (gnus-article-prev-page (- lines)))))) | |
41487370 | 10633 | (gnus-summary-recenter) |
231f989b | 10634 | (gnus-summary-position-point)) |
745bc783 | 10635 | |
b027f415 | 10636 | (defun gnus-summary-next-same-subject () |
745bc783 JB |
10637 | "Select next article which has the same subject as current one." |
10638 | (interactive) | |
41487370 | 10639 | (gnus-set-global-variables) |
231f989b | 10640 | (gnus-summary-next-article nil (gnus-summary-article-subject))) |
745bc783 | 10641 | |
b027f415 | 10642 | (defun gnus-summary-prev-same-subject () |
745bc783 JB |
10643 | "Select previous article which has the same subject as current one." |
10644 | (interactive) | |
41487370 | 10645 | (gnus-set-global-variables) |
231f989b | 10646 | (gnus-summary-prev-article nil (gnus-summary-article-subject))) |
745bc783 | 10647 | |
b027f415 | 10648 | (defun gnus-summary-next-unread-same-subject () |
745bc783 JB |
10649 | "Select next unread article which has the same subject as current one." |
10650 | (interactive) | |
41487370 | 10651 | (gnus-set-global-variables) |
231f989b | 10652 | (gnus-summary-next-article t (gnus-summary-article-subject))) |
745bc783 | 10653 | |
b027f415 | 10654 | (defun gnus-summary-prev-unread-same-subject () |
745bc783 JB |
10655 | "Select previous unread article which has the same subject as current one." |
10656 | (interactive) | |
41487370 | 10657 | (gnus-set-global-variables) |
231f989b | 10658 | (gnus-summary-prev-article t (gnus-summary-article-subject))) |
745bc783 | 10659 | |
41487370 | 10660 | (defun gnus-summary-first-unread-article () |
231f989b | 10661 | "Select the first unread article. |
41487370 LMI |
10662 | Return nil if there are no unread articles." |
10663 | (interactive) | |
10664 | (gnus-set-global-variables) | |
10665 | (prog1 | |
10666 | (if (gnus-summary-first-subject t) | |
10667 | (progn | |
10668 | (gnus-summary-show-thread) | |
10669 | (gnus-summary-first-subject t) | |
10670 | (gnus-summary-display-article (gnus-summary-article-number)))) | |
231f989b | 10671 | (gnus-summary-position-point))) |
745bc783 | 10672 | |
41487370 LMI |
10673 | (defun gnus-summary-best-unread-article () |
10674 | "Select the unread article with the highest score." | |
10675 | (interactive) | |
10676 | (gnus-set-global-variables) | |
10677 | (let ((best -1000000) | |
231f989b | 10678 | (data gnus-newsgroup-data) |
41487370 | 10679 | article score) |
231f989b LMI |
10680 | (while data |
10681 | (and (gnus-data-unread-p (car data)) | |
10682 | (> (setq score | |
10683 | (gnus-summary-article-score (gnus-data-number (car data)))) | |
10684 | best) | |
10685 | (setq best score | |
10686 | article (gnus-data-number (car data)))) | |
10687 | (setq data (cdr data))) | |
10688 | (prog1 | |
10689 | (if article | |
10690 | (gnus-summary-goto-article article) | |
41487370 | 10691 | (error "No unread articles")) |
231f989b | 10692 | (gnus-summary-position-point)))) |
745bc783 | 10693 | |
231f989b LMI |
10694 | (defun gnus-summary-last-subject () |
10695 | "Go to the last displayed subject line in the group." | |
10696 | (let ((article (gnus-data-number (car (gnus-data-list t))))) | |
10697 | (when article | |
10698 | (gnus-summary-goto-subject article)))) | |
10699 | ||
10700 | (defun gnus-summary-goto-article (article &optional all-headers force) | |
41487370 LMI |
10701 | "Fetch ARTICLE and display it if it exists. |
10702 | If ALL-HEADERS is non-nil, no header lines are hidden." | |
10703 | (interactive | |
10704 | (list | |
10705 | (string-to-int | |
231f989b | 10706 | (completing-read |
41487370 | 10707 | "Article number: " |
231f989b LMI |
10708 | (mapcar (lambda (number) (list (int-to-string number))) |
10709 | gnus-newsgroup-limit))) | |
10710 | current-prefix-arg | |
10711 | t)) | |
41487370 | 10712 | (prog1 |
231f989b LMI |
10713 | (if (gnus-summary-goto-subject article force) |
10714 | (gnus-summary-display-article article all-headers) | |
10715 | (gnus-message 4 "Couldn't go to article %s" article) nil) | |
10716 | (gnus-summary-position-point))) | |
745bc783 | 10717 | |
41487370 LMI |
10718 | (defun gnus-summary-goto-last-article () |
10719 | "Go to the previously read article." | |
10720 | (interactive) | |
10721 | (prog1 | |
10722 | (and gnus-last-article | |
10723 | (gnus-summary-goto-article gnus-last-article)) | |
231f989b | 10724 | (gnus-summary-position-point))) |
41487370 LMI |
10725 | |
10726 | (defun gnus-summary-pop-article (number) | |
10727 | "Pop one article off the history and go to the previous. | |
10728 | NUMBER articles will be popped off." | |
745bc783 | 10729 | (interactive "p") |
41487370 LMI |
10730 | (let (to) |
10731 | (setq gnus-newsgroup-history | |
10732 | (cdr (setq to (nthcdr number gnus-newsgroup-history)))) | |
10733 | (if to | |
10734 | (gnus-summary-goto-article (car to)) | |
10735 | (error "Article history empty"))) | |
231f989b LMI |
10736 | (gnus-summary-position-point)) |
10737 | ||
10738 | ;; Summary commands and functions for limiting the summary buffer. | |
10739 | ||
10740 | (defun gnus-summary-limit-to-articles (n) | |
10741 | "Limit the summary buffer to the next N articles. | |
10742 | If not given a prefix, use the process marked articles instead." | |
10743 | (interactive "P") | |
10744 | (gnus-set-global-variables) | |
10745 | (prog1 | |
10746 | (let ((articles (gnus-summary-work-articles n))) | |
10747 | (setq gnus-newsgroup-processable nil) | |
10748 | (gnus-summary-limit articles)) | |
10749 | (gnus-summary-position-point))) | |
10750 | ||
10751 | (defun gnus-summary-pop-limit (&optional total) | |
10752 | "Restore the previous limit. | |
10753 | If given a prefix, remove all limits." | |
10754 | (interactive "P") | |
10755 | (gnus-set-global-variables) | |
10756 | (when total | |
10757 | (setq gnus-newsgroup-limits | |
10758 | (list (mapcar (lambda (h) (mail-header-number h)) | |
10759 | gnus-newsgroup-headers)))) | |
10760 | (unless gnus-newsgroup-limits | |
10761 | (error "No limit to pop")) | |
10762 | (prog1 | |
10763 | (gnus-summary-limit nil 'pop) | |
10764 | (gnus-summary-position-point))) | |
10765 | ||
10766 | (defun gnus-summary-limit-to-subject (subject &optional header) | |
10767 | "Limit the summary buffer to articles that have subjects that match a regexp." | |
10768 | (interactive "sRegexp: ") | |
10769 | (unless header | |
10770 | (setq header "subject")) | |
10771 | (when (not (equal "" subject)) | |
10772 | (prog1 | |
10773 | (let ((articles (gnus-summary-find-matching | |
10774 | (or header "subject") subject 'all))) | |
10775 | (or articles (error "Found no matches for \"%s\"" subject)) | |
10776 | (gnus-summary-limit articles)) | |
10777 | (gnus-summary-position-point)))) | |
10778 | ||
10779 | (defun gnus-summary-limit-to-author (from) | |
10780 | "Limit the summary buffer to articles that have authors that match a regexp." | |
10781 | (interactive "sRegexp: ") | |
10782 | (gnus-summary-limit-to-subject from "from")) | |
10783 | ||
10784 | (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) | |
10785 | (make-obsolete | |
10786 | 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) | |
10787 | ||
10788 | (defun gnus-summary-limit-to-unread (&optional all) | |
10789 | "Limit the summary buffer to articles that are not marked as read. | |
10790 | If ALL is non-nil, limit strictly to unread articles." | |
10791 | (interactive "P") | |
10792 | (if all | |
10793 | (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) | |
10794 | (gnus-summary-limit-to-marks | |
10795 | ;; Concat all the marks that say that an article is read and have | |
10796 | ;; those removed. | |
10797 | (list gnus-del-mark gnus-read-mark gnus-ancient-mark | |
10798 | gnus-killed-mark gnus-kill-file-mark | |
10799 | gnus-low-score-mark gnus-expirable-mark | |
10800 | gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark) | |
10801 | 'reverse))) | |
10802 | ||
10803 | (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) | |
10804 | (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) | |
10805 | ||
10806 | (defun gnus-summary-limit-to-marks (marks &optional reverse) | |
10807 | "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). | |
10808 | If REVERSE, limit the summary buffer to articles that are not marked | |
10809 | with MARKS. MARKS can either be a string of marks or a list of marks. | |
10810 | Returns how many articles were removed." | |
10811 | (interactive "sMarks: ") | |
10812 | (gnus-set-global-variables) | |
10813 | (prog1 | |
10814 | (let ((data gnus-newsgroup-data) | |
10815 | (marks (if (listp marks) marks | |
10816 | (append marks nil))) ; Transform to list. | |
10817 | articles) | |
10818 | (while data | |
10819 | (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) | |
10820 | (memq (gnus-data-mark (car data)) marks)) | |
10821 | (setq articles (cons (gnus-data-number (car data)) articles))) | |
10822 | (setq data (cdr data))) | |
10823 | (gnus-summary-limit articles)) | |
10824 | (gnus-summary-position-point))) | |
10825 | ||
10826 | (defun gnus-summary-limit-to-score (&optional score) | |
10827 | "Limit to articles with score at or above SCORE." | |
10828 | (interactive "P") | |
10829 | (gnus-set-global-variables) | |
10830 | (setq score (if score | |
10831 | (prefix-numeric-value score) | |
10832 | (or gnus-summary-default-score 0))) | |
10833 | (let ((data gnus-newsgroup-data) | |
10834 | articles) | |
10835 | (while data | |
10836 | (when (>= (gnus-summary-article-score (gnus-data-number (car data))) | |
10837 | score) | |
10838 | (push (gnus-data-number (car data)) articles)) | |
10839 | (setq data (cdr data))) | |
10840 | (prog1 | |
10841 | (gnus-summary-limit articles) | |
10842 | (gnus-summary-position-point)))) | |
10843 | ||
10844 | (defun gnus-summary-limit-include-dormant () | |
10845 | "Display all the hidden articles that are marked as dormant." | |
10846 | (interactive) | |
10847 | (gnus-set-global-variables) | |
10848 | (or gnus-newsgroup-dormant | |
10849 | (error "There are no dormant articles in this group")) | |
10850 | (prog1 | |
10851 | (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) | |
10852 | (gnus-summary-position-point))) | |
10853 | ||
10854 | (defun gnus-summary-limit-exclude-dormant () | |
10855 | "Hide all dormant articles." | |
10856 | (interactive) | |
10857 | (gnus-set-global-variables) | |
10858 | (prog1 | |
10859 | (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) | |
10860 | (gnus-summary-position-point))) | |
10861 | ||
10862 | (defun gnus-summary-limit-exclude-childless-dormant () | |
10863 | "Hide all dormant articles that have no children." | |
10864 | (interactive) | |
10865 | (gnus-set-global-variables) | |
10866 | (let ((data (gnus-data-list t)) | |
10867 | articles d children) | |
10868 | ;; Find all articles that are either not dormant or have | |
10869 | ;; children. | |
10870 | (while (setq d (pop data)) | |
10871 | (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) | |
10872 | (and (setq children | |
10873 | (gnus-article-children (gnus-data-number d))) | |
10874 | (let (found) | |
10875 | (while children | |
10876 | (when (memq (car children) articles) | |
10877 | (setq children nil | |
10878 | found t)) | |
10879 | (pop children)) | |
10880 | found))) | |
10881 | (push (gnus-data-number d) articles))) | |
10882 | ;; Do the limiting. | |
10883 | (prog1 | |
10884 | (gnus-summary-limit articles) | |
10885 | (gnus-summary-position-point)))) | |
10886 | ||
10887 | (defun gnus-summary-limit-mark-excluded-as-read (&optional all) | |
10888 | "Mark all unread excluded articles as read. | |
10889 | If ALL, mark even excluded ticked and dormants as read." | |
10890 | (interactive "P") | |
10891 | (let ((articles (gnus-sorted-complement | |
10892 | (sort | |
10893 | (mapcar (lambda (h) (mail-header-number h)) | |
10894 | gnus-newsgroup-headers) | |
10895 | '<) | |
10896 | (sort gnus-newsgroup-limit '<))) | |
10897 | article) | |
10898 | (setq gnus-newsgroup-unreads nil) | |
10899 | (if all | |
10900 | (setq gnus-newsgroup-dormant nil | |
10901 | gnus-newsgroup-marked nil | |
10902 | gnus-newsgroup-reads | |
10903 | (nconc | |
10904 | (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) | |
10905 | gnus-newsgroup-reads)) | |
10906 | (while (setq article (pop articles)) | |
10907 | (unless (or (memq article gnus-newsgroup-dormant) | |
10908 | (memq article gnus-newsgroup-marked)) | |
10909 | (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) | |
10910 | ||
10911 | (defun gnus-summary-limit (articles &optional pop) | |
10912 | (if pop | |
10913 | ;; We pop the previous limit off the stack and use that. | |
10914 | (setq articles (car gnus-newsgroup-limits) | |
10915 | gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) | |
10916 | ;; We use the new limit, so we push the old limit on the stack. | |
10917 | (setq gnus-newsgroup-limits | |
10918 | (cons gnus-newsgroup-limit gnus-newsgroup-limits))) | |
10919 | ;; Set the limit. | |
10920 | (setq gnus-newsgroup-limit articles) | |
10921 | (let ((total (length gnus-newsgroup-data)) | |
10922 | (data (gnus-data-find-list (gnus-summary-article-number))) | |
564b670b | 10923 | (gnus-summary-mark-below nil) ; Inhibit this. |
231f989b LMI |
10924 | found) |
10925 | ;; This will do all the work of generating the new summary buffer | |
10926 | ;; according to the new limit. | |
10927 | (gnus-summary-prepare) | |
10928 | ;; Hide any threads, possibly. | |
10929 | (and gnus-show-threads | |
10930 | gnus-thread-hide-subtree | |
10931 | (gnus-summary-hide-all-threads)) | |
10932 | ;; Try to return to the article you were at, or one in the | |
10933 | ;; neighborhood. | |
10934 | (if data | |
10935 | ;; We try to find some article after the current one. | |
10936 | (while data | |
10937 | (and (gnus-summary-goto-subject | |
10938 | (gnus-data-number (car data)) nil t) | |
10939 | (setq data nil | |
10940 | found t)) | |
10941 | (setq data (cdr data)))) | |
10942 | (or found | |
10943 | ;; If there is no data, that means that we were after the last | |
10944 | ;; article. The same goes when we can't find any articles | |
10945 | ;; after the current one. | |
10946 | (progn | |
10947 | (goto-char (point-max)) | |
10948 | (gnus-summary-find-prev))) | |
10949 | ;; We return how many articles were removed from the summary | |
10950 | ;; buffer as a result of the new limit. | |
10951 | (- total (length gnus-newsgroup-data)))) | |
10952 | ||
10953 | (defsubst gnus-invisible-cut-children (threads) | |
10954 | (let ((num 0)) | |
10955 | (while threads | |
10956 | (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) | |
10957 | (incf num)) | |
10958 | (pop threads)) | |
10959 | (< num 2))) | |
10960 | ||
10961 | (defsubst gnus-cut-thread (thread) | |
10962 | "Go forwards in the thread until we find an article that we want to display." | |
10963 | (when (or (eq gnus-fetch-old-headers 'some) | |
10964 | (eq gnus-build-sparse-threads 'some) | |
10965 | (eq gnus-build-sparse-threads 'more)) | |
10966 | ;; Deal with old-fetched headers and sparse threads. | |
10967 | (while (and | |
10968 | thread | |
10969 | (or | |
10970 | (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) | |
10971 | (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)) | |
10972 | (or (<= (length (cdr thread)) 1) | |
10973 | (gnus-invisible-cut-children (cdr thread)))) | |
10974 | (setq thread (cadr thread)))) | |
10975 | thread) | |
10976 | ||
10977 | (defun gnus-cut-threads (threads) | |
10978 | "Cut off all uninteresting articles from the beginning of threads." | |
10979 | (when (or (eq gnus-fetch-old-headers 'some) | |
10980 | (eq gnus-build-sparse-threads 'some) | |
10981 | (eq gnus-build-sparse-threads 'more)) | |
10982 | (let ((th threads)) | |
10983 | (while th | |
10984 | (setcar th (gnus-cut-thread (car th))) | |
10985 | (setq th (cdr th))))) | |
10986 | ;; Remove nixed out threads. | |
10987 | (delq nil threads)) | |
10988 | ||
10989 | (defun gnus-summary-initial-limit (&optional show-if-empty) | |
10990 | "Figure out what the initial limit is supposed to be on group entry. | |
10991 | This entails weeding out unwanted dormants, low-scored articles, | |
10992 | fetch-old-headers verbiage, and so on." | |
10993 | ;; Most groups have nothing to remove. | |
10994 | (if (or gnus-inhibit-limiting | |
10995 | (and (null gnus-newsgroup-dormant) | |
10996 | (not (eq gnus-fetch-old-headers 'some)) | |
10997 | (null gnus-summary-expunge-below) | |
10998 | (not (eq gnus-build-sparse-threads 'some)) | |
10999 | (not (eq gnus-build-sparse-threads 'more)) | |
11000 | (null gnus-thread-expunge-below) | |
11001 | (not gnus-use-nocem))) | |
11002 | () ; Do nothing. | |
11003 | (push gnus-newsgroup-limit gnus-newsgroup-limits) | |
11004 | (setq gnus-newsgroup-limit nil) | |
11005 | (mapatoms | |
11006 | (lambda (node) | |
11007 | (unless (car (symbol-value node)) | |
11008 | ;; These threads have no parents -- they are roots. | |
11009 | (let ((nodes (cdr (symbol-value node))) | |
11010 | thread) | |
11011 | (while nodes | |
11012 | (if (and gnus-thread-expunge-below | |
11013 | (< (gnus-thread-total-score (car nodes)) | |
11014 | gnus-thread-expunge-below)) | |
11015 | (gnus-expunge-thread (pop nodes)) | |
11016 | (setq thread (pop nodes)) | |
11017 | (gnus-summary-limit-children thread)))))) | |
11018 | gnus-newsgroup-dependencies) | |
11019 | ;; If this limitation resulted in an empty group, we might | |
11020 | ;; pop the previous limit and use it instead. | |
11021 | (when (and (not gnus-newsgroup-limit) | |
11022 | show-if-empty) | |
11023 | (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) | |
11024 | gnus-newsgroup-limit)) | |
11025 | ||
11026 | (defun gnus-summary-limit-children (thread) | |
11027 | "Return 1 if this subthread is visible and 0 if it is not." | |
11028 | ;; First we get the number of visible children to this thread. This | |
11029 | ;; is done by recursing down the thread using this function, so this | |
11030 | ;; will really go down to a leaf article first, before slowly | |
11031 | ;; working its way up towards the root. | |
11032 | (when thread | |
11033 | (let ((children | |
11034 | (if (cdr thread) | |
11035 | (apply '+ (mapcar 'gnus-summary-limit-children | |
11036 | (cdr thread))) | |
11037 | 0)) | |
11038 | (number (mail-header-number (car thread))) | |
11039 | score) | |
11040 | (if (or | |
11041 | ;; If this article is dormant and has absolutely no visible | |
11042 | ;; children, then this article isn't visible. | |
11043 | (and (memq number gnus-newsgroup-dormant) | |
11044 | (= children 0)) | |
11045 | ;; If this is "fetch-old-headered" and there is only one | |
11046 | ;; visible child (or less), then we don't want this article. | |
11047 | (and (eq gnus-fetch-old-headers 'some) | |
11048 | (memq number gnus-newsgroup-ancient) | |
11049 | (zerop children)) | |
11050 | ;; If this is a sparsely inserted article with no children, | |
11051 | ;; we don't want it. | |
11052 | (and (eq gnus-build-sparse-threads 'some) | |
11053 | (memq number gnus-newsgroup-sparse) | |
11054 | (zerop children)) | |
11055 | ;; If we use expunging, and this article is really | |
11056 | ;; low-scored, then we don't want this article. | |
11057 | (when (and gnus-summary-expunge-below | |
11058 | (< (setq score | |
11059 | (or (cdr (assq number gnus-newsgroup-scored)) | |
11060 | gnus-summary-default-score)) | |
11061 | gnus-summary-expunge-below)) | |
11062 | ;; We increase the expunge-tally here, but that has | |
11063 | ;; nothing to do with the limits, really. | |
11064 | (incf gnus-newsgroup-expunged-tally) | |
11065 | ;; We also mark as read here, if that's wanted. | |
11066 | (when (and gnus-summary-mark-below | |
11067 | (< score gnus-summary-mark-below)) | |
11068 | (setq gnus-newsgroup-unreads | |
11069 | (delq number gnus-newsgroup-unreads)) | |
11070 | (if gnus-newsgroup-auto-expire | |
11071 | (push number gnus-newsgroup-expirable) | |
11072 | (push (cons number gnus-low-score-mark) | |
11073 | gnus-newsgroup-reads))) | |
11074 | t) | |
11075 | (and gnus-use-nocem | |
11076 | (gnus-nocem-unwanted-article-p (mail-header-id (car thread))))) | |
11077 | ;; Nope, invisible article. | |
11078 | 0 | |
11079 | ;; Ok, this article is to be visible, so we add it to the limit | |
11080 | ;; and return 1. | |
11081 | (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit)) | |
11082 | 1)))) | |
11083 | ||
11084 | (defun gnus-expunge-thread (thread) | |
11085 | "Mark all articles in THREAD as read." | |
11086 | (let* ((number (mail-header-number (car thread)))) | |
11087 | (incf gnus-newsgroup-expunged-tally) | |
11088 | ;; We also mark as read here, if that's wanted. | |
11089 | (setq gnus-newsgroup-unreads | |
11090 | (delq number gnus-newsgroup-unreads)) | |
11091 | (if gnus-newsgroup-auto-expire | |
11092 | (push number gnus-newsgroup-expirable) | |
11093 | (push (cons number gnus-low-score-mark) | |
11094 | gnus-newsgroup-reads))) | |
11095 | ;; Go recursively through all subthreads. | |
11096 | (mapcar 'gnus-expunge-thread (cdr thread))) | |
41487370 LMI |
11097 | |
11098 | ;; Summary article oriented commands | |
11099 | ||
11100 | (defun gnus-summary-refer-parent-article (n) | |
11101 | "Refer parent article N times. | |
11102 | The difference between N and the number of articles fetched is returned." | |
11103 | (interactive "p") | |
11104 | (gnus-set-global-variables) | |
231f989b LMI |
11105 | (while |
11106 | (and | |
41487370 | 11107 | (> n 0) |
231f989b LMI |
11108 | (let* ((header (gnus-summary-article-header)) |
11109 | (ref | |
11110 | ;; If we try to find the parent of the currently | |
11111 | ;; displayed article, then we take a look at the actual | |
11112 | ;; References header, since this is slightly more | |
11113 | ;; reliable than the References field we got from the | |
11114 | ;; server. | |
11115 | (if (and (eq (mail-header-number header) | |
11116 | (cdr gnus-article-current)) | |
11117 | (equal gnus-newsgroup-name | |
11118 | (car gnus-article-current))) | |
11119 | (save-excursion | |
11120 | (set-buffer gnus-original-article-buffer) | |
11121 | (nnheader-narrow-to-headers) | |
11122 | (prog1 | |
11123 | (message-fetch-field "references") | |
11124 | (widen))) | |
11125 | ;; It's not the current article, so we take a bet on | |
11126 | ;; the value we got from the server. | |
11127 | (mail-header-references header)))) | |
11128 | (if (setq ref (or ref (mail-header-references header))) | |
11129 | (or (gnus-summary-refer-article (gnus-parent-id ref)) | |
11130 | (gnus-message 1 "Couldn't find parent")) | |
41487370 LMI |
11131 | (gnus-message 1 "No references in article %d" |
11132 | (gnus-summary-article-number)) | |
11133 | nil))) | |
11134 | (setq n (1- n))) | |
231f989b | 11135 | (gnus-summary-position-point) |
41487370 | 11136 | n) |
231f989b LMI |
11137 | |
11138 | (defun gnus-summary-refer-references () | |
11139 | "Fetch all articles mentioned in the References header. | |
11140 | Return how many articles were fetched." | |
11141 | (interactive) | |
11142 | (gnus-set-global-variables) | |
11143 | (let ((ref (mail-header-references (gnus-summary-article-header))) | |
11144 | (current (gnus-summary-article-number)) | |
11145 | (n 0)) | |
11146 | ;; For each Message-ID in the References header... | |
11147 | (while (string-match "<[^>]*>" ref) | |
11148 | (incf n) | |
11149 | ;; ... fetch that article. | |
11150 | (gnus-summary-refer-article | |
11151 | (prog1 (match-string 0 ref) | |
11152 | (setq ref (substring ref (match-end 0)))))) | |
11153 | (gnus-summary-goto-subject current) | |
11154 | (gnus-summary-position-point) | |
11155 | n)) | |
11156 | ||
41487370 | 11157 | (defun gnus-summary-refer-article (message-id) |
231f989b | 11158 | "Fetch an article specified by MESSAGE-ID." |
41487370 | 11159 | (interactive "sMessage-ID: ") |
231f989b LMI |
11160 | (when (and (stringp message-id) |
11161 | (not (zerop (length message-id)))) | |
41487370 LMI |
11162 | ;; Construct the correct Message-ID if necessary. |
11163 | ;; Suggested by tale@pawl.rpi.edu. | |
231f989b LMI |
11164 | (unless (string-match "^<" message-id) |
11165 | (setq message-id (concat "<" message-id))) | |
11166 | (unless (string-match ">$" message-id) | |
11167 | (setq message-id (concat message-id ">"))) | |
11168 | (let* ((header (gnus-id-to-header message-id)) | |
11169 | (sparse (and header | |
11170 | (memq (mail-header-number header) | |
11171 | gnus-newsgroup-sparse)))) | |
41487370 | 11172 | (if header |
41487370 | 11173 | (prog1 |
231f989b LMI |
11174 | ;; The article is present in the buffer, to we just go to it. |
11175 | (gnus-summary-goto-article | |
11176 | (mail-header-number header) nil header) | |
11177 | (when sparse | |
11178 | (gnus-summary-update-article (mail-header-number header)))) | |
11179 | ;; We fetch the article | |
11180 | (let ((gnus-override-method | |
11181 | (and (gnus-news-group-p gnus-newsgroup-name) | |
11182 | gnus-refer-article-method)) | |
11183 | number) | |
11184 | ;; Start the special refer-article method, if necessary. | |
11185 | (when (and gnus-refer-article-method | |
11186 | (gnus-news-group-p gnus-newsgroup-name)) | |
11187 | (gnus-check-server gnus-refer-article-method)) | |
11188 | ;; Fetch the header, and display the article. | |
11189 | (if (setq number (gnus-summary-insert-subject message-id)) | |
11190 | (gnus-summary-select-article nil nil nil number) | |
11191 | (gnus-message 3 "Couldn't fetch article %s" message-id))))))) | |
11192 | ||
11193 | (defun gnus-summary-enter-digest-group (&optional force) | |
41487370 | 11194 | "Enter a digest group based on the current article." |
231f989b | 11195 | (interactive "P") |
41487370 LMI |
11196 | (gnus-set-global-variables) |
11197 | (gnus-summary-select-article) | |
231f989b LMI |
11198 | (let ((name (format "%s-%d" |
11199 | (gnus-group-prefixed-name | |
11200 | gnus-newsgroup-name (list 'nndoc "")) | |
41487370 LMI |
11201 | gnus-current-article)) |
11202 | (ogroup gnus-newsgroup-name) | |
231f989b LMI |
11203 | (case-fold-search t) |
11204 | (buf (current-buffer)) | |
11205 | dig) | |
11206 | (save-excursion | |
11207 | (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) | |
11208 | (insert-buffer-substring gnus-original-article-buffer) | |
11209 | (narrow-to-region | |
11210 | (goto-char (point-min)) | |
11211 | (or (search-forward "\n\n" nil t) (point))) | |
11212 | (goto-char (point-min)) | |
11213 | (delete-matching-lines "^\\(Path\\):\\|^From ") | |
11214 | (widen)) | |
11215 | (unwind-protect | |
11216 | (if (gnus-group-read-ephemeral-group | |
11217 | name `(nndoc ,name (nndoc-address | |
11218 | ,(get-buffer dig)) | |
11219 | (nndoc-article-type ,(if force 'digest 'guess))) t) | |
11220 | ;; Make all postings to this group go to the parent group. | |
11221 | (nconc (gnus-info-params (gnus-get-info name)) | |
11222 | (list (cons 'to-group ogroup))) | |
11223 | ;; Couldn't select this doc group. | |
11224 | (switch-to-buffer buf) | |
11225 | (gnus-set-global-variables) | |
11226 | (gnus-configure-windows 'summary) | |
11227 | (gnus-message 3 "Article couldn't be entered?")) | |
11228 | (kill-buffer dig)))) | |
11229 | ||
11230 | (defun gnus-summary-isearch-article (&optional regexp-p) | |
11231 | "Do incremental search forward on the current article. | |
11232 | If REGEXP-P (the prefix) is non-nil, do regexp isearch." | |
11233 | (interactive "P") | |
41487370 | 11234 | (gnus-set-global-variables) |
b027f415 | 11235 | (gnus-summary-select-article) |
231f989b LMI |
11236 | (gnus-configure-windows 'article) |
11237 | (gnus-eval-in-buffer-window gnus-article-buffer | |
11238 | (goto-char (point-min)) | |
11239 | (isearch-forward regexp-p))) | |
745bc783 | 11240 | |
41487370 | 11241 | (defun gnus-summary-search-article-forward (regexp &optional backward) |
745bc783 | 11242 | "Search for an article containing REGEXP forward. |
41487370 | 11243 | If BACKWARD, search backward instead." |
745bc783 JB |
11244 | (interactive |
11245 | (list (read-string | |
41487370 LMI |
11246 | (format "Search article %s (regexp%s): " |
11247 | (if current-prefix-arg "backward" "forward") | |
745bc783 | 11248 | (if gnus-last-search-regexp |
41487370 LMI |
11249 | (concat ", default " gnus-last-search-regexp) |
11250 | ""))) | |
11251 | current-prefix-arg)) | |
11252 | (gnus-set-global-variables) | |
745bc783 JB |
11253 | (if (string-equal regexp "") |
11254 | (setq regexp (or gnus-last-search-regexp "")) | |
11255 | (setq gnus-last-search-regexp regexp)) | |
231f989b | 11256 | (unless (gnus-summary-search-article regexp backward) |
41487370 | 11257 | (error "Search failed: \"%s\"" regexp))) |
745bc783 | 11258 | |
b027f415 | 11259 | (defun gnus-summary-search-article-backward (regexp) |
41487370 | 11260 | "Search for an article containing REGEXP backward." |
745bc783 JB |
11261 | (interactive |
11262 | (list (read-string | |
41487370 | 11263 | (format "Search article backward (regexp%s): " |
745bc783 | 11264 | (if gnus-last-search-regexp |
41487370 LMI |
11265 | (concat ", default " gnus-last-search-regexp) |
11266 | ""))))) | |
11267 | (gnus-summary-search-article-forward regexp 'backward)) | |
745bc783 | 11268 | |
b027f415 | 11269 | (defun gnus-summary-search-article (regexp &optional backward) |
745bc783 JB |
11270 | "Search for an article containing REGEXP. |
11271 | Optional argument BACKWARD means do search for backward. | |
231f989b | 11272 | `gnus-select-article-hook' is not called during the search." |
b027f415 | 11273 | (let ((gnus-select-article-hook nil) ;Disable hook. |
231f989b | 11274 | (gnus-article-display-hook nil) |
b027f415 | 11275 | (gnus-mark-article-hook nil) ;Inhibit marking as read. |
745bc783 JB |
11276 | (re-search |
11277 | (if backward | |
231f989b LMI |
11278 | 're-search-backward 're-search-forward)) |
11279 | (sum (current-buffer)) | |
11280 | (found nil)) | |
11281 | (gnus-save-hidden-threads | |
11282 | (gnus-summary-select-article) | |
11283 | (set-buffer gnus-article-buffer) | |
11284 | (when backward | |
11285 | (forward-line -1)) | |
11286 | (while (not found) | |
11287 | (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) | |
11288 | (if (if backward | |
11289 | (re-search-backward regexp nil t) | |
11290 | (re-search-forward regexp nil t)) | |
11291 | ;; We found the regexp. | |
11292 | (progn | |
11293 | (setq found 'found) | |
11294 | (beginning-of-line) | |
11295 | (set-window-start | |
11296 | (get-buffer-window (current-buffer)) | |
11297 | (point)) | |
11298 | (forward-line 1) | |
11299 | (set-buffer sum)) | |
11300 | ;; We didn't find it, so we go to the next article. | |
11301 | (set-buffer sum) | |
11302 | (if (not (if backward (gnus-summary-find-prev) | |
11303 | (gnus-summary-find-next))) | |
11304 | ;; No more articles. | |
11305 | (setq found t) | |
11306 | ;; Select the next article and adjust point. | |
11307 | (gnus-summary-select-article) | |
11308 | (set-buffer gnus-article-buffer) | |
11309 | (widen) | |
11310 | (goto-char (if backward (point-max) (point-min)))))) | |
11311 | (gnus-message 7 "")) | |
11312 | ;; Return whether we found the regexp. | |
11313 | (when (eq found 'found) | |
11314 | (gnus-summary-show-thread) | |
11315 | (gnus-summary-goto-subject gnus-current-article) | |
11316 | (gnus-summary-position-point) | |
11317 | t))) | |
11318 | ||
11319 | (defun gnus-summary-find-matching (header regexp &optional backward unread | |
11320 | not-case-fold) | |
11321 | "Return a list of all articles that match REGEXP on HEADER. | |
11322 | The search stars on the current article and goes forwards unless | |
11323 | BACKWARD is non-nil. If BACKWARD is `all', do all articles. | |
11324 | If UNREAD is non-nil, only unread articles will | |
11325 | be taken into consideration. If NOT-CASE-FOLD, case won't be folded | |
11326 | in the comparisons." | |
11327 | (let ((data (if (eq backward 'all) gnus-newsgroup-data | |
11328 | (gnus-data-find-list | |
11329 | (gnus-summary-article-number) (gnus-data-list backward)))) | |
11330 | (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) | |
11331 | (case-fold-search (not not-case-fold)) | |
11332 | articles d) | |
11333 | (or (fboundp (intern (concat "mail-header-" header))) | |
11334 | (error "%s is not a valid header" header)) | |
11335 | (while data | |
11336 | (setq d (car data)) | |
11337 | (and (or (not unread) ; We want all articles... | |
11338 | (gnus-data-unread-p d)) ; Or just unreads. | |
11339 | (vectorp (gnus-data-header d)) ; It's not a pseudo. | |
11340 | (string-match regexp (funcall func (gnus-data-header d))) ; Match. | |
11341 | (setq articles (cons (gnus-data-number d) articles))) ; Success! | |
11342 | (setq data (cdr data))) | |
11343 | (nreverse articles))) | |
745bc783 | 11344 | |
41487370 LMI |
11345 | (defun gnus-summary-execute-command (header regexp command &optional backward) |
11346 | "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. | |
11347 | If HEADER is an empty string (or nil), the match is done on the entire | |
231f989b | 11348 | article. If BACKWARD (the prefix) is non-nil, search backward instead." |
745bc783 JB |
11349 | (interactive |
11350 | (list (let ((completion-ignore-case t)) | |
231f989b | 11351 | (completing-read |
41487370 LMI |
11352 | "Header name: " |
11353 | (mapcar (lambda (string) (list string)) | |
11354 | '("Number" "Subject" "From" "Lines" "Date" | |
231f989b | 11355 | "Message-ID" "Xref" "References" "Body")) |
41487370 | 11356 | nil 'require-match)) |
745bc783 JB |
11357 | (read-string "Regexp: ") |
11358 | (read-key-sequence "Command: ") | |
11359 | current-prefix-arg)) | |
231f989b LMI |
11360 | (when (equal header "Body") |
11361 | (setq header "")) | |
41487370 LMI |
11362 | (gnus-set-global-variables) |
11363 | ;; Hidden thread subtrees must be searched as well. | |
b027f415 | 11364 | (gnus-summary-show-all-threads) |
745bc783 JB |
11365 | ;; We don't want to change current point nor window configuration. |
11366 | (save-excursion | |
11367 | (save-window-excursion | |
41487370 | 11368 | (gnus-message 6 "Executing %s..." (key-description command)) |
745bc783 | 11369 | ;; We'd like to execute COMMAND interactively so as to give arguments. |
41487370 | 11370 | (gnus-execute header regexp |
231f989b | 11371 | `(lambda () (call-interactively ',(key-binding command))) |
745bc783 | 11372 | backward) |
41487370 | 11373 | (gnus-message 6 "Executing %s...done" (key-description command))))) |
745bc783 | 11374 | |
b027f415 | 11375 | (defun gnus-summary-beginning-of-article () |
41487370 | 11376 | "Scroll the article back to the beginning." |
745bc783 | 11377 | (interactive) |
41487370 | 11378 | (gnus-set-global-variables) |
b027f415 | 11379 | (gnus-summary-select-article) |
41487370 | 11380 | (gnus-configure-windows 'article) |
231f989b LMI |
11381 | (gnus-eval-in-buffer-window gnus-article-buffer |
11382 | (widen) | |
11383 | (goto-char (point-min)) | |
11384 | (and gnus-break-pages (gnus-narrow-to-page)))) | |
745bc783 | 11385 | |
b027f415 | 11386 | (defun gnus-summary-end-of-article () |
41487370 | 11387 | "Scroll to the end of the article." |
745bc783 | 11388 | (interactive) |
41487370 | 11389 | (gnus-set-global-variables) |
b027f415 | 11390 | (gnus-summary-select-article) |
41487370 | 11391 | (gnus-configure-windows 'article) |
231f989b LMI |
11392 | (gnus-eval-in-buffer-window gnus-article-buffer |
11393 | (widen) | |
11394 | (goto-char (point-max)) | |
11395 | (recenter -3) | |
11396 | (and gnus-break-pages (gnus-narrow-to-page)))) | |
11397 | ||
11398 | (defun gnus-summary-show-article (&optional arg) | |
11399 | "Force re-fetching of the current article. | |
11400 | If ARG (the prefix) is non-nil, show the raw article without any | |
11401 | article massaging functions being run." | |
11402 | (interactive "P") | |
41487370 | 11403 | (gnus-set-global-variables) |
231f989b LMI |
11404 | (if (not arg) |
11405 | ;; Select the article the normal way. | |
11406 | (gnus-summary-select-article nil 'force) | |
11407 | ;; Bind the article treatment functions to nil. | |
11408 | (let ((gnus-have-all-headers t) | |
11409 | gnus-article-display-hook | |
11410 | gnus-article-prepare-hook | |
11411 | gnus-break-pages | |
11412 | gnus-visual) | |
11413 | (gnus-summary-select-article nil 'force))) | |
11414 | (gnus-summary-goto-subject gnus-current-article) | |
11415 | ; (gnus-configure-windows 'article) | |
11416 | (gnus-summary-position-point)) | |
745bc783 | 11417 | |
41487370 LMI |
11418 | (defun gnus-summary-verbose-headers (&optional arg) |
11419 | "Toggle permanent full header display. | |
11420 | If ARG is a positive number, turn header display on. | |
11421 | If ARG is a negative number, turn header display off." | |
11422 | (interactive "P") | |
11423 | (gnus-set-global-variables) | |
11424 | (gnus-summary-toggle-header arg) | |
11425 | (setq gnus-show-all-headers | |
11426 | (cond ((or (not (numberp arg)) | |
11427 | (zerop arg)) | |
11428 | (not gnus-show-all-headers)) | |
11429 | ((natnump arg) | |
11430 | t)))) | |
11431 | ||
11432 | (defun gnus-summary-toggle-header (&optional arg) | |
11433 | "Show the headers if they are hidden, or hide them if they are shown. | |
11434 | If ARG is a positive number, show the entire header. | |
11435 | If ARG is a negative number, hide the unwanted header lines." | |
745bc783 | 11436 | (interactive "P") |
41487370 LMI |
11437 | (gnus-set-global-variables) |
11438 | (save-excursion | |
11439 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
11440 | (let* ((buffer-read-only nil) |
11441 | (inhibit-point-motion-hooks t) | |
11442 | (hidden (text-property-any | |
11443 | (goto-char (point-min)) (search-forward "\n\n") | |
11444 | 'invisible t)) | |
11445 | e) | |
11446 | (goto-char (point-min)) | |
11447 | (when (search-forward "\n\n" nil t) | |
11448 | (delete-region (point-min) (1- (point)))) | |
11449 | (goto-char (point-min)) | |
11450 | (save-excursion | |
11451 | (set-buffer gnus-original-article-buffer) | |
11452 | (goto-char (point-min)) | |
11453 | (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) | |
11454 | (insert-buffer-substring gnus-original-article-buffer 1 e) | |
11455 | (let ((gnus-inhibit-hiding t)) | |
11456 | (run-hooks 'gnus-article-display-hook)) | |
11457 | (if (or (not hidden) (and (numberp arg) (< arg 0))) | |
11458 | (gnus-article-hide-headers))))) | |
745bc783 | 11459 | |
b027f415 | 11460 | (defun gnus-summary-show-all-headers () |
41487370 | 11461 | "Make all header lines visible." |
745bc783 | 11462 | (interactive) |
41487370 LMI |
11463 | (gnus-set-global-variables) |
11464 | (gnus-article-show-all-headers)) | |
b027f415 | 11465 | |
41487370 | 11466 | (defun gnus-summary-toggle-mime (&optional arg) |
b027f415 | 11467 | "Toggle MIME processing. |
41487370 | 11468 | If ARG is a positive number, turn MIME processing on." |
b027f415 | 11469 | (interactive "P") |
41487370 | 11470 | (gnus-set-global-variables) |
b027f415 RS |
11471 | (setq gnus-show-mime |
11472 | (if (null arg) (not gnus-show-mime) | |
11473 | (> (prefix-numeric-value arg) 0))) | |
41487370 LMI |
11474 | (gnus-summary-select-article t 'force)) |
11475 | ||
11476 | (defun gnus-summary-caesar-message (&optional arg) | |
11477 | "Caesar rotate the current article by 13. | |
11478 | The numerical prefix specifies how manu places to rotate each letter | |
11479 | forward." | |
11480 | (interactive "P") | |
11481 | (gnus-set-global-variables) | |
11482 | (gnus-summary-select-article) | |
11483 | (let ((mail-header-separator "")) | |
231f989b LMI |
11484 | (gnus-eval-in-buffer-window gnus-article-buffer |
11485 | (save-restriction | |
11486 | (widen) | |
11487 | (let ((start (window-start)) | |
11488 | buffer-read-only) | |
11489 | (message-caesar-buffer-body arg) | |
11490 | (set-window-start (get-buffer-window (current-buffer)) start)))))) | |
745bc783 | 11491 | |
b027f415 | 11492 | (defun gnus-summary-stop-page-breaking () |
41487370 | 11493 | "Stop page breaking in the current article." |
745bc783 | 11494 | (interactive) |
41487370 | 11495 | (gnus-set-global-variables) |
b027f415 | 11496 | (gnus-summary-select-article) |
231f989b LMI |
11497 | (gnus-eval-in-buffer-window gnus-article-buffer |
11498 | (widen))) | |
41487370 | 11499 | |
231f989b | 11500 | (defun gnus-summary-move-article (&optional n to-newsgroup select-method action) |
41487370 LMI |
11501 | "Move the current article to a different newsgroup. |
11502 | If N is a positive number, move the N next articles. | |
11503 | If N is a negative number, move the N previous articles. | |
11504 | If N is nil and any articles have been marked with the process mark, | |
11505 | move those articles instead. | |
231f989b LMI |
11506 | If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. |
11507 | If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but | |
41487370 | 11508 | re-spool using this method. |
231f989b | 11509 | |
41487370 LMI |
11510 | For this function to work, both the current newsgroup and the |
11511 | newsgroup that you want to move to have to support the `request-move' | |
231f989b | 11512 | and `request-accept' functions." |
41487370 | 11513 | (interactive "P") |
231f989b | 11514 | (unless action (setq action 'move)) |
41487370 | 11515 | (gnus-set-global-variables) |
231f989b LMI |
11516 | ;; Check whether the source group supports the required functions. |
11517 | (cond ((and (eq action 'move) | |
11518 | (not (gnus-check-backend-function | |
11519 | 'request-move-article gnus-newsgroup-name))) | |
11520 | (error "The current group does not support article moving")) | |
11521 | ((and (eq action 'crosspost) | |
11522 | (not (gnus-check-backend-function | |
11523 | 'request-replace-article gnus-newsgroup-name))) | |
11524 | (error "The current group does not support article editing"))) | |
41487370 LMI |
11525 | (let ((articles (gnus-summary-work-articles n)) |
11526 | (prefix (gnus-group-real-prefix gnus-newsgroup-name)) | |
231f989b LMI |
11527 | (names '((move "Move" "Moving") |
11528 | (copy "Copy" "Copying") | |
11529 | (crosspost "Crosspost" "Crossposting"))) | |
11530 | (copy-buf (save-excursion | |
11531 | (nnheader-set-temp-buffer " *copy article*"))) | |
11532 | art-group to-method new-xref article to-groups) | |
11533 | (unless (assq action names) | |
11534 | (error "Unknown action %s" action)) | |
11535 | ;; Read the newsgroup name. | |
11536 | (when (and (not to-newsgroup) | |
11537 | (not select-method)) | |
11538 | (setq to-newsgroup | |
11539 | (gnus-read-move-group-name | |
11540 | (cadr (assq action names)) | |
11541 | (symbol-value (intern (format "gnus-current-%s-group" action))) | |
11542 | articles prefix)) | |
11543 | (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) | |
11544 | (setq to-method (or select-method | |
11545 | (gnus-group-name-to-method to-newsgroup))) | |
11546 | ;; Check the method we are to move this article to... | |
41487370 LMI |
11547 | (or (gnus-check-backend-function 'request-accept-article (car to-method)) |
11548 | (error "%s does not support article copying" (car to-method))) | |
11549 | (or (gnus-check-server to-method) | |
11550 | (error "Can't open server %s" (car to-method))) | |
231f989b LMI |
11551 | (gnus-message 6 "%s to %s: %s..." |
11552 | (caddr (assq action names)) | |
11553 | (or (car select-method) to-newsgroup) articles) | |
41487370 | 11554 | (while articles |
231f989b LMI |
11555 | (setq article (pop articles)) |
11556 | (setq | |
11557 | art-group | |
11558 | (cond | |
11559 | ;; Move the article. | |
11560 | ((eq action 'move) | |
11561 | (gnus-request-move-article | |
11562 | article ; Article to move | |
11563 | gnus-newsgroup-name ; From newsgrouo | |
11564 | (nth 1 (gnus-find-method-for-group | |
11565 | gnus-newsgroup-name)) ; Server | |
11566 | (list 'gnus-request-accept-article | |
11567 | to-newsgroup (list 'quote select-method) | |
11568 | (not articles)) ; Accept form | |
11569 | (not articles))) ; Only save nov last time | |
11570 | ;; Copy the article. | |
11571 | ((eq action 'copy) | |
11572 | (save-excursion | |
11573 | (set-buffer copy-buf) | |
11574 | (gnus-request-article-this-buffer article gnus-newsgroup-name) | |
11575 | (gnus-request-accept-article | |
11576 | to-newsgroup select-method (not articles)))) | |
11577 | ;; Crosspost the article. | |
11578 | ((eq action 'crosspost) | |
11579 | (let ((xref (mail-header-xref (gnus-summary-article-header article)))) | |
11580 | (setq new-xref (concat gnus-newsgroup-name ":" article)) | |
11581 | (if (and xref (not (string= xref ""))) | |
11582 | (progn | |
11583 | (when (string-match "^Xref: " xref) | |
11584 | (setq xref (substring xref (match-end 0)))) | |
11585 | (setq new-xref (concat xref " " new-xref))) | |
11586 | (setq new-xref (concat (system-name) " " new-xref))) | |
11587 | (save-excursion | |
11588 | (set-buffer copy-buf) | |
11589 | (gnus-request-article-this-buffer article gnus-newsgroup-name) | |
11590 | (nnheader-replace-header "xref" new-xref) | |
11591 | (gnus-request-accept-article | |
11592 | to-newsgroup select-method (not articles))))))) | |
11593 | (if (not art-group) | |
11594 | (gnus-message 1 "Couldn't %s article %s" | |
11595 | (cadr (assq action names)) article) | |
11596 | (let* ((entry | |
11597 | (or | |
11598 | (gnus-gethash (car art-group) gnus-newsrc-hashtb) | |
11599 | (gnus-gethash | |
11600 | (gnus-group-prefixed-name | |
11601 | (car art-group) | |
11602 | (or select-method | |
41487370 | 11603 | (gnus-find-method-for-group to-newsgroup))) |
231f989b LMI |
11604 | gnus-newsrc-hashtb))) |
11605 | (info (nth 2 entry)) | |
11606 | (to-group (gnus-info-group info))) | |
11607 | ;; Update the group that has been moved to. | |
11608 | (when (and info | |
11609 | (memq action '(move copy))) | |
11610 | (unless (member to-group to-groups) | |
11611 | (push to-group to-groups)) | |
11612 | ||
11613 | (unless (memq article gnus-newsgroup-unreads) | |
11614 | (gnus-info-set-read | |
11615 | info (gnus-add-to-range (gnus-info-read info) | |
11616 | (list (cdr art-group))))) | |
11617 | ||
11618 | ;; Copy any marks over to the new group. | |
11619 | (let ((marks gnus-article-mark-lists) | |
11620 | (to-article (cdr art-group))) | |
11621 | ||
11622 | ;; See whether the article is to be put in the cache. | |
11623 | (when gnus-use-cache | |
11624 | (gnus-cache-possibly-enter-article | |
11625 | to-group to-article | |
11626 | (let ((header (copy-sequence | |
11627 | (gnus-summary-article-header article)))) | |
11628 | (mail-header-set-number header to-article) | |
11629 | header) | |
11630 | (memq article gnus-newsgroup-marked) | |
11631 | (memq article gnus-newsgroup-dormant) | |
11632 | (memq article gnus-newsgroup-unreads))) | |
11633 | ||
11634 | (while marks | |
11635 | (when (memq article (symbol-value | |
11636 | (intern (format "gnus-newsgroup-%s" | |
11637 | (caar marks))))) | |
11638 | ;; If the other group is the same as this group, | |
11639 | ;; then we have to add the mark to the list. | |
11640 | (when (equal to-group gnus-newsgroup-name) | |
11641 | (set (intern (format "gnus-newsgroup-%s" (caar marks))) | |
11642 | (cons to-article | |
11643 | (symbol-value | |
11644 | (intern (format "gnus-newsgroup-%s" | |
11645 | (caar marks))))))) | |
11646 | ;; Copy mark to other group. | |
11647 | (gnus-add-marked-articles | |
11648 | to-group (cdar marks) (list to-article) info)) | |
11649 | (setq marks (cdr marks))))) | |
11650 | ||
11651 | ;; Update the Xref header in this article to point to | |
11652 | ;; the new crossposted article we have just created. | |
11653 | (when (eq action 'crosspost) | |
11654 | (save-excursion | |
11655 | (set-buffer copy-buf) | |
11656 | (gnus-request-article-this-buffer article gnus-newsgroup-name) | |
11657 | (nnheader-replace-header | |
11658 | "xref" (concat new-xref " " (gnus-group-prefixed-name | |
11659 | (car art-group) to-method) | |
11660 | ":" (cdr art-group))) | |
11661 | (gnus-request-replace-article | |
11662 | article gnus-newsgroup-name (current-buffer))))) | |
11663 | ||
11664 | (gnus-summary-goto-subject article) | |
11665 | (when (eq action 'move) | |
11666 | (gnus-summary-mark-article article gnus-canceled-mark))) | |
11667 | (gnus-summary-remove-process-mark article)) | |
11668 | ;; Re-activate all groups that have been moved to. | |
11669 | (while to-groups | |
11670 | (gnus-activate-group (pop to-groups))) | |
11671 | ||
11672 | (gnus-kill-buffer copy-buf) | |
11673 | (gnus-summary-position-point) | |
41487370 LMI |
11674 | (gnus-set-mode-line 'summary))) |
11675 | ||
231f989b LMI |
11676 | (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) |
11677 | "Move the current article to a different newsgroup. | |
11678 | If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. | |
11679 | If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but | |
11680 | re-spool using this method." | |
11681 | (interactive "P") | |
11682 | (gnus-summary-move-article n nil select-method 'copy)) | |
11683 | ||
11684 | (defun gnus-summary-crosspost-article (&optional n) | |
11685 | "Crosspost the current article to some other group." | |
11686 | (interactive "P") | |
11687 | (gnus-summary-move-article n nil nil 'crosspost)) | |
11688 | ||
11689 | (defvar gnus-summary-respool-default-method nil | |
11690 | "Default method for respooling an article. | |
11691 | If nil, use to the current newsgroup method.") | |
11692 | ||
11693 | (defun gnus-summary-respool-article (&optional n method) | |
41487370 LMI |
11694 | "Respool the current article. |
11695 | The article will be squeezed through the mail spooling process again, | |
11696 | which means that it will be put in some mail newsgroup or other | |
11697 | depending on `nnmail-split-methods'. | |
11698 | If N is a positive number, respool the N next articles. | |
11699 | If N is a negative number, respool the N previous articles. | |
11700 | If N is nil and any articles have been marked with the process mark, | |
11701 | respool those articles instead. | |
11702 | ||
11703 | Respooling can be done both from mail groups and \"real\" newsgroups. | |
11704 | In the former case, the articles in question will be moved from the | |
11705 | current group into whatever groups they are destined to. In the | |
11706 | latter case, they will be copied into the relevant groups." | |
231f989b LMI |
11707 | (interactive |
11708 | (list current-prefix-arg | |
11709 | (let* ((methods (gnus-methods-using 'respool)) | |
11710 | (methname | |
11711 | (symbol-name (or gnus-summary-respool-default-method | |
11712 | (car (gnus-find-method-for-group | |
11713 | gnus-newsgroup-name))))) | |
11714 | (method | |
11715 | (gnus-completing-read | |
11716 | methname "What backend do you want to use when respooling?" | |
11717 | methods nil t nil 'gnus-method-history)) | |
11718 | ms) | |
11719 | (cond | |
11720 | ((zerop (length (setq ms (gnus-servers-using-backend method)))) | |
11721 | (list (intern method) "")) | |
11722 | ((= 1 (length ms)) | |
11723 | (car ms)) | |
11724 | (t | |
11725 | (cdr (completing-read | |
11726 | "Server name: " | |
11727 | (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t))))))) | |
41487370 | 11728 | (gnus-set-global-variables) |
231f989b LMI |
11729 | (unless method |
11730 | (error "No method given for respooling")) | |
11731 | (if (assoc (symbol-name | |
11732 | (car (gnus-find-method-for-group gnus-newsgroup-name))) | |
11733 | (gnus-methods-using 'respool)) | |
11734 | (gnus-summary-move-article n nil method) | |
11735 | (gnus-summary-copy-article n nil method))) | |
41487370 LMI |
11736 | |
11737 | (defun gnus-summary-import-article (file) | |
11738 | "Import a random file into a mail newsgroup." | |
11739 | (interactive "fImport file: ") | |
231f989b | 11740 | (gnus-set-global-variables) |
41487370 | 11741 | (let ((group gnus-newsgroup-name) |
231f989b LMI |
11742 | (now (current-time)) |
11743 | atts lines) | |
41487370 LMI |
11744 | (or (gnus-check-backend-function 'request-accept-article group) |
11745 | (error "%s does not support article importing" group)) | |
11746 | (or (file-readable-p file) | |
11747 | (not (file-regular-p file)) | |
11748 | (error "Can't read %s" file)) | |
11749 | (save-excursion | |
11750 | (set-buffer (get-buffer-create " *import file*")) | |
11751 | (buffer-disable-undo (current-buffer)) | |
11752 | (erase-buffer) | |
11753 | (insert-file-contents file) | |
11754 | (goto-char (point-min)) | |
231f989b LMI |
11755 | (unless (nnheader-article-p) |
11756 | ;; This doesn't look like an article, so we fudge some headers. | |
11757 | (setq atts (file-attributes file) | |
11758 | lines (count-lines (point-min) (point-max))) | |
41487370 LMI |
11759 | (insert "From: " (read-string "From: ") "\n" |
11760 | "Subject: " (read-string "Subject: ") "\n" | |
231f989b LMI |
11761 | "Date: " (timezone-make-date-arpa-standard |
11762 | (current-time-string (nth 5 atts)) | |
11763 | (current-time-zone now) | |
11764 | (current-time-zone now)) "\n" | |
11765 | "Message-ID: " (message-make-message-id) "\n" | |
11766 | "Lines: " (int-to-string lines) "\n" | |
41487370 | 11767 | "Chars: " (int-to-string (nth 7 atts)) "\n\n")) |
231f989b | 11768 | (gnus-request-accept-article group nil t) |
41487370 LMI |
11769 | (kill-buffer (current-buffer))))) |
11770 | ||
231f989b | 11771 | (defun gnus-summary-expire-articles (&optional now) |
41487370 LMI |
11772 | "Expire all articles that are marked as expirable in the current group." |
11773 | (interactive) | |
231f989b LMI |
11774 | (gnus-set-global-variables) |
11775 | (when (gnus-check-backend-function | |
11776 | 'request-expire-articles gnus-newsgroup-name) | |
11777 | ;; This backend supports expiry. | |
11778 | (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) | |
41487370 LMI |
11779 | (expirable (if total |
11780 | (gnus-list-of-read-articles gnus-newsgroup-name) | |
11781 | (setq gnus-newsgroup-expirable | |
11782 | (sort gnus-newsgroup-expirable '<)))) | |
231f989b LMI |
11783 | (expiry-wait (if now 'immediate |
11784 | (gnus-group-get-parameter | |
11785 | gnus-newsgroup-name 'expiry-wait))) | |
41487370 | 11786 | es) |
231f989b LMI |
11787 | (when expirable |
11788 | ;; There are expirable articles in this group, so we run them | |
11789 | ;; through the expiry process. | |
41487370 LMI |
11790 | (gnus-message 6 "Expiring articles...") |
11791 | ;; The list of articles that weren't expired is returned. | |
231f989b LMI |
11792 | (if expiry-wait |
11793 | (let ((nnmail-expiry-wait-function nil) | |
11794 | (nnmail-expiry-wait expiry-wait)) | |
11795 | (setq es (gnus-request-expire-articles | |
11796 | expirable gnus-newsgroup-name))) | |
11797 | (setq es (gnus-request-expire-articles | |
11798 | expirable gnus-newsgroup-name))) | |
41487370 LMI |
11799 | (or total (setq gnus-newsgroup-expirable es)) |
11800 | ;; We go through the old list of expirable, and mark all | |
b94ae5f7 | 11801 | ;; really expired articles as nonexistent. |
231f989b LMI |
11802 | (unless (eq es expirable) ;If nothing was expired, we don't mark. |
11803 | (let ((gnus-use-cache nil)) | |
11804 | (while expirable | |
11805 | (unless (memq (car expirable) es) | |
11806 | (when (gnus-data-find (car expirable)) | |
11807 | (gnus-summary-mark-article | |
11808 | (car expirable) gnus-canceled-mark))) | |
11809 | (setq expirable (cdr expirable))))) | |
41487370 LMI |
11810 | (gnus-message 6 "Expiring articles...done"))))) |
11811 | ||
11812 | (defun gnus-summary-expire-articles-now () | |
11813 | "Expunge all expirable articles in the current group. | |
11814 | This means that *all* articles that are marked as expirable will be | |
11815 | deleted forever, right now." | |
11816 | (interactive) | |
231f989b | 11817 | (gnus-set-global-variables) |
41487370 LMI |
11818 | (or gnus-expert-user |
11819 | (gnus-y-or-n-p | |
231f989b | 11820 | "Are you really, really, really sure you want to delete all these messages? ") |
41487370 | 11821 | (error "Phew!")) |
231f989b | 11822 | (gnus-summary-expire-articles t)) |
41487370 LMI |
11823 | |
11824 | ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. | |
11825 | (defun gnus-summary-delete-article (&optional n) | |
11826 | "Delete the N next (mail) articles. | |
231f989b LMI |
11827 | This command actually deletes articles. This is not a marking |
11828 | command. The article will disappear forever from your life, never to | |
11829 | return. | |
41487370 LMI |
11830 | If N is negative, delete backwards. |
11831 | If N is nil and articles have been marked with the process mark, | |
11832 | delete these instead." | |
11833 | (interactive "P") | |
231f989b LMI |
11834 | (gnus-set-global-variables) |
11835 | (or (gnus-check-backend-function 'request-expire-articles | |
41487370 LMI |
11836 | gnus-newsgroup-name) |
11837 | (error "The current newsgroup does not support article deletion.")) | |
11838 | ;; Compute the list of articles to delete. | |
11839 | (let ((articles (gnus-summary-work-articles n)) | |
11840 | not-deleted) | |
11841 | (if (and gnus-novice-user | |
231f989b | 11842 | (not (gnus-y-or-n-p |
41487370 | 11843 | (format "Do you really want to delete %s forever? " |
231f989b LMI |
11844 | (if (> (length articles) 1) |
11845 | (format "these %s articles" (length articles)) | |
41487370 LMI |
11846 | "this article"))))) |
11847 | () | |
11848 | ;; Delete the articles. | |
231f989b | 11849 | (setq not-deleted (gnus-request-expire-articles |
41487370 LMI |
11850 | articles gnus-newsgroup-name 'force)) |
11851 | (while articles | |
231f989b | 11852 | (gnus-summary-remove-process-mark (car articles)) |
41487370 | 11853 | ;; The backend might not have been able to delete the article |
231f989b | 11854 | ;; after all. |
41487370 LMI |
11855 | (or (memq (car articles) not-deleted) |
11856 | (gnus-summary-mark-article (car articles) gnus-canceled-mark)) | |
11857 | (setq articles (cdr articles)))) | |
231f989b | 11858 | (gnus-summary-position-point) |
41487370 LMI |
11859 | (gnus-set-mode-line 'summary) |
11860 | not-deleted)) | |
11861 | ||
11862 | (defun gnus-summary-edit-article (&optional force) | |
11863 | "Enter into a buffer and edit the current article. | |
11864 | This will have permanent effect only in mail groups. | |
11865 | If FORCE is non-nil, allow editing of articles even in read-only | |
11866 | groups." | |
11867 | (interactive "P") | |
231f989b LMI |
11868 | (save-excursion |
11869 | (set-buffer gnus-summary-buffer) | |
11870 | (gnus-set-global-variables) | |
11871 | (when (and (not force) | |
11872 | (gnus-group-read-only-p)) | |
41487370 | 11873 | (error "The current newsgroup does not support article editing.")) |
231f989b LMI |
11874 | (gnus-summary-select-article t nil t) |
11875 | (gnus-configure-windows 'article) | |
11876 | (select-window (get-buffer-window gnus-article-buffer)) | |
11877 | (gnus-message 6 "C-c C-c to end edits") | |
11878 | (setq buffer-read-only nil) | |
11879 | (text-mode) | |
11880 | (use-local-map (copy-keymap (current-local-map))) | |
11881 | (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) | |
11882 | (buffer-enable-undo) | |
11883 | (widen) | |
11884 | (goto-char (point-min)) | |
11885 | (search-forward "\n\n" nil t))) | |
41487370 LMI |
11886 | |
11887 | (defun gnus-summary-edit-article-done () | |
11888 | "Make edits to the current article permanent." | |
11889 | (interactive) | |
11890 | (if (gnus-group-read-only-p) | |
11891 | (progn | |
564b670b LMI |
11892 | (let ((beep (not (eq major-mode 'text-mode)))) |
11893 | (gnus-summary-edit-article-postpone) | |
11894 | (when beep | |
11895 | (gnus-error | |
11896 | 3 "The current newsgroup does not support article editing.")))) | |
231f989b | 11897 | (let ((buf (format "%s" (buffer-string)))) |
41487370 LMI |
11898 | (erase-buffer) |
11899 | (insert buf) | |
231f989b LMI |
11900 | (if (not (gnus-request-replace-article |
11901 | (cdr gnus-article-current) (car gnus-article-current) | |
41487370 LMI |
11902 | (current-buffer))) |
11903 | (error "Couldn't replace article.") | |
11904 | (gnus-article-mode) | |
11905 | (use-local-map gnus-article-mode-map) | |
11906 | (setq buffer-read-only t) | |
11907 | (buffer-disable-undo (current-buffer)) | |
231f989b LMI |
11908 | (gnus-configure-windows 'summary) |
11909 | (gnus-summary-update-article (cdr gnus-article-current)) | |
11910 | (when gnus-use-cache | |
11911 | (gnus-cache-update-article | |
11912 | (car gnus-article-current) (cdr gnus-article-current))) | |
11913 | (when gnus-keep-backlog | |
11914 | (gnus-backlog-remove-article | |
11915 | (car gnus-article-current) (cdr gnus-article-current)))) | |
11916 | (save-excursion | |
11917 | (when (get-buffer gnus-original-article-buffer) | |
11918 | (set-buffer gnus-original-article-buffer) | |
11919 | (setq gnus-original-article nil))) | |
11920 | (setq gnus-article-current nil | |
11921 | gnus-current-article nil) | |
11922 | (run-hooks 'gnus-article-display-hook) | |
11923 | (and (gnus-visual-p 'summary-highlight 'highlight) | |
11924 | (run-hooks 'gnus-visual-mark-article-hook))))) | |
41487370 LMI |
11925 | |
11926 | (defun gnus-summary-edit-article-postpone () | |
11927 | "Postpone changes to the current article." | |
11928 | (interactive) | |
11929 | (gnus-article-mode) | |
11930 | (use-local-map gnus-article-mode-map) | |
11931 | (setq buffer-read-only t) | |
11932 | (buffer-disable-undo (current-buffer)) | |
11933 | (gnus-configure-windows 'summary) | |
231f989b LMI |
11934 | (and (gnus-visual-p 'summary-highlight 'highlight) |
11935 | (run-hooks 'gnus-visual-mark-article-hook))) | |
41487370 | 11936 | |
231f989b LMI |
11937 | (defun gnus-summary-respool-query () |
11938 | "Query where the respool algorithm would put this article." | |
41487370 | 11939 | (interactive) |
231f989b | 11940 | (gnus-set-global-variables) |
41487370 LMI |
11941 | (gnus-summary-select-article) |
11942 | (save-excursion | |
11943 | (set-buffer gnus-article-buffer) | |
11944 | (save-restriction | |
11945 | (goto-char (point-min)) | |
11946 | (search-forward "\n\n") | |
11947 | (narrow-to-region (point-min) (point)) | |
231f989b LMI |
11948 | (pp-eval-expression |
11949 | (list 'quote (mapcar 'car (nnmail-article-group 'identity))))))) | |
41487370 LMI |
11950 | |
11951 | ;; Summary marking commands. | |
11952 | ||
41487370 LMI |
11953 | (defun gnus-summary-kill-same-subject-and-select (&optional unmark) |
11954 | "Mark articles which has the same subject as read, and then select the next. | |
11955 | If UNMARK is positive, remove any kind of mark. | |
11956 | If UNMARK is negative, tick articles." | |
745bc783 | 11957 | (interactive "P") |
231f989b | 11958 | (gnus-set-global-variables) |
745bc783 JB |
11959 | (if unmark |
11960 | (setq unmark (prefix-numeric-value unmark))) | |
11961 | (let ((count | |
b027f415 | 11962 | (gnus-summary-mark-same-subject |
231f989b LMI |
11963 | (gnus-summary-article-subject) unmark))) |
11964 | ;; Select next unread article. If auto-select-same mode, should | |
745bc783 | 11965 | ;; select the first unread article. |
b027f415 | 11966 | (gnus-summary-next-article t (and gnus-auto-select-same |
231f989b | 11967 | (gnus-summary-article-subject))) |
41487370 LMI |
11968 | (gnus-message 7 "%d article%s marked as %s" |
11969 | count (if (= count 1) " is" "s are") | |
11970 | (if unmark "unread" "read")))) | |
745bc783 | 11971 | |
41487370 | 11972 | (defun gnus-summary-kill-same-subject (&optional unmark) |
231f989b | 11973 | "Mark articles which has the same subject as read. |
41487370 LMI |
11974 | If UNMARK is positive, remove any kind of mark. |
11975 | If UNMARK is negative, tick articles." | |
745bc783 | 11976 | (interactive "P") |
231f989b | 11977 | (gnus-set-global-variables) |
745bc783 JB |
11978 | (if unmark |
11979 | (setq unmark (prefix-numeric-value unmark))) | |
11980 | (let ((count | |
b027f415 | 11981 | (gnus-summary-mark-same-subject |
231f989b | 11982 | (gnus-summary-article-subject) unmark))) |
745bc783 JB |
11983 | ;; If marked as read, go to next unread subject. |
11984 | (if (null unmark) | |
11985 | ;; Go to next unread subject. | |
b027f415 | 11986 | (gnus-summary-next-subject 1 t)) |
41487370 LMI |
11987 | (gnus-message 7 "%d articles are marked as %s" |
11988 | count (if unmark "unread" "read")))) | |
745bc783 | 11989 | |
b027f415 | 11990 | (defun gnus-summary-mark-same-subject (subject &optional unmark) |
745bc783 JB |
11991 | "Mark articles with same SUBJECT as read, and return marked number. |
11992 | If optional argument UNMARK is positive, remove any kinds of marks. | |
11993 | If optional argument UNMARK is negative, mark articles as unread instead." | |
11994 | (let ((count 1)) | |
11995 | (save-excursion | |
231f989b | 11996 | (cond |
41487370 | 11997 | ((null unmark) ; Mark as read. |
231f989b | 11998 | (while (and |
41487370 LMI |
11999 | (progn |
12000 | (gnus-summary-mark-article-as-read gnus-killed-mark) | |
12001 | (gnus-summary-show-thread) t) | |
231f989b | 12002 | (gnus-summary-find-subject subject)) |
41487370 LMI |
12003 | (setq count (1+ count)))) |
12004 | ((> unmark 0) ; Tick. | |
12005 | (while (and | |
12006 | (progn | |
12007 | (gnus-summary-mark-article-as-unread gnus-ticked-mark) | |
12008 | (gnus-summary-show-thread) t) | |
231f989b | 12009 | (gnus-summary-find-subject subject)) |
41487370 LMI |
12010 | (setq count (1+ count)))) |
12011 | (t ; Mark as unread. | |
12012 | (while (and | |
12013 | (progn | |
12014 | (gnus-summary-mark-article-as-unread gnus-unread-mark) | |
12015 | (gnus-summary-show-thread) t) | |
231f989b | 12016 | (gnus-summary-find-subject subject)) |
41487370 LMI |
12017 | (setq count (1+ count))))) |
12018 | (gnus-set-mode-line 'summary) | |
12019 | ;; Return the number of marked articles. | |
12020 | count))) | |
12021 | ||
12022 | (defun gnus-summary-mark-as-processable (n &optional unmark) | |
12023 | "Set the process mark on the next N articles. | |
12024 | If N is negative, mark backward instead. If UNMARK is non-nil, remove | |
12025 | the process mark instead. The difference between N and the actual | |
12026 | number of articles marked is returned." | |
12027 | (interactive "p") | |
231f989b | 12028 | (gnus-set-global-variables) |
41487370 LMI |
12029 | (let ((backward (< n 0)) |
12030 | (n (abs n))) | |
231f989b | 12031 | (while (and |
41487370 LMI |
12032 | (> n 0) |
12033 | (if unmark | |
12034 | (gnus-summary-remove-process-mark | |
12035 | (gnus-summary-article-number)) | |
12036 | (gnus-summary-set-process-mark (gnus-summary-article-number))) | |
12037 | (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) | |
12038 | (setq n (1- n))) | |
12039 | (if (/= 0 n) (gnus-message 7 "No more articles")) | |
12040 | (gnus-summary-recenter) | |
231f989b | 12041 | (gnus-summary-position-point) |
41487370 LMI |
12042 | n)) |
12043 | ||
12044 | (defun gnus-summary-unmark-as-processable (n) | |
12045 | "Remove the process mark from the next N articles. | |
12046 | If N is negative, mark backward instead. The difference between N and | |
12047 | the actual number of articles marked is returned." | |
12048 | (interactive "p") | |
231f989b | 12049 | (gnus-set-global-variables) |
41487370 LMI |
12050 | (gnus-summary-mark-as-processable n t)) |
12051 | ||
12052 | (defun gnus-summary-unmark-all-processable () | |
12053 | "Remove the process mark from all articles." | |
12054 | (interactive) | |
231f989b | 12055 | (gnus-set-global-variables) |
41487370 LMI |
12056 | (save-excursion |
12057 | (while gnus-newsgroup-processable | |
12058 | (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) | |
231f989b | 12059 | (gnus-summary-position-point)) |
41487370 LMI |
12060 | |
12061 | (defun gnus-summary-mark-as-expirable (n) | |
12062 | "Mark N articles forward as expirable. | |
231f989b | 12063 | If N is negative, mark backward instead. The difference between N and |
41487370 | 12064 | the actual number of articles marked is returned." |
745bc783 | 12065 | (interactive "p") |
231f989b | 12066 | (gnus-set-global-variables) |
41487370 LMI |
12067 | (gnus-summary-mark-forward n gnus-expirable-mark)) |
12068 | ||
12069 | (defun gnus-summary-mark-article-as-replied (article) | |
12070 | "Mark ARTICLE replied and update the summary line." | |
12071 | (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) | |
12072 | (let ((buffer-read-only nil)) | |
231f989b LMI |
12073 | (when (gnus-summary-goto-subject article) |
12074 | (gnus-summary-update-secondary-mark article)))) | |
41487370 LMI |
12075 | |
12076 | (defun gnus-summary-set-bookmark (article) | |
12077 | "Set a bookmark in current article." | |
12078 | (interactive (list (gnus-summary-article-number))) | |
231f989b | 12079 | (gnus-set-global-variables) |
41487370 LMI |
12080 | (if (or (not (get-buffer gnus-article-buffer)) |
12081 | (not gnus-current-article) | |
12082 | (not gnus-article-current) | |
12083 | (not (equal gnus-newsgroup-name (car gnus-article-current)))) | |
12084 | (error "No current article selected")) | |
12085 | ;; Remove old bookmark, if one exists. | |
12086 | (let ((old (assq article gnus-newsgroup-bookmarks))) | |
231f989b | 12087 | (if old (setq gnus-newsgroup-bookmarks |
41487370 | 12088 | (delq old gnus-newsgroup-bookmarks)))) |
231f989b | 12089 | ;; Set the new bookmark, which is on the form |
41487370 | 12090 | ;; (article-number . line-number-in-body). |
231f989b LMI |
12091 | (setq gnus-newsgroup-bookmarks |
12092 | (cons | |
12093 | (cons article | |
41487370 LMI |
12094 | (save-excursion |
12095 | (set-buffer gnus-article-buffer) | |
12096 | (count-lines | |
12097 | (min (point) | |
12098 | (save-excursion | |
12099 | (goto-char (point-min)) | |
12100 | (search-forward "\n\n" nil t) | |
12101 | (point))) | |
12102 | (point)))) | |
12103 | gnus-newsgroup-bookmarks)) | |
12104 | (gnus-message 6 "A bookmark has been added to the current article.")) | |
12105 | ||
12106 | (defun gnus-summary-remove-bookmark (article) | |
12107 | "Remove the bookmark from the current article." | |
12108 | (interactive (list (gnus-summary-article-number))) | |
231f989b | 12109 | (gnus-set-global-variables) |
41487370 LMI |
12110 | ;; Remove old bookmark, if one exists. |
12111 | (let ((old (assq article gnus-newsgroup-bookmarks))) | |
231f989b | 12112 | (if old |
41487370 | 12113 | (progn |
231f989b | 12114 | (setq gnus-newsgroup-bookmarks |
41487370 LMI |
12115 | (delq old gnus-newsgroup-bookmarks)) |
12116 | (gnus-message 6 "Removed bookmark.")) | |
12117 | (gnus-message 6 "No bookmark in current article.")))) | |
12118 | ||
12119 | ;; Suggested by Daniel Quinlan <quinlan@best.com>. | |
12120 | (defun gnus-summary-mark-as-dormant (n) | |
12121 | "Mark N articles forward as dormant. | |
12122 | If N is negative, mark backward instead. The difference between N and | |
12123 | the actual number of articles marked is returned." | |
12124 | (interactive "p") | |
231f989b | 12125 | (gnus-set-global-variables) |
41487370 LMI |
12126 | (gnus-summary-mark-forward n gnus-dormant-mark)) |
12127 | ||
12128 | (defun gnus-summary-set-process-mark (article) | |
12129 | "Set the process mark on ARTICLE and update the summary line." | |
231f989b LMI |
12130 | (setq gnus-newsgroup-processable |
12131 | (cons article | |
7e988fb6 | 12132 | (delq article gnus-newsgroup-processable))) |
231f989b LMI |
12133 | (when (gnus-summary-goto-subject article) |
12134 | (gnus-summary-show-thread) | |
12135 | (gnus-summary-update-secondary-mark article))) | |
41487370 LMI |
12136 | |
12137 | (defun gnus-summary-remove-process-mark (article) | |
12138 | "Remove the process mark from ARTICLE and update the summary line." | |
12139 | (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) | |
231f989b LMI |
12140 | (when (gnus-summary-goto-subject article) |
12141 | (gnus-summary-show-thread) | |
12142 | (gnus-summary-update-secondary-mark article))) | |
12143 | ||
12144 | (defun gnus-summary-set-saved-mark (article) | |
12145 | "Set the process mark on ARTICLE and update the summary line." | |
12146 | (push article gnus-newsgroup-saved) | |
12147 | (when (gnus-summary-goto-subject article) | |
12148 | (gnus-summary-update-secondary-mark article))) | |
41487370 LMI |
12149 | |
12150 | (defun gnus-summary-mark-forward (n &optional mark no-expire) | |
12151 | "Mark N articles as read forwards. | |
231f989b | 12152 | If N is negative, mark backwards instead. Mark with MARK, ?r by default. |
41487370 LMI |
12153 | The difference between N and the actual number of articles marked is |
12154 | returned." | |
12155 | (interactive "p") | |
12156 | (gnus-set-global-variables) | |
12157 | (let ((backward (< n 0)) | |
12158 | (gnus-summary-goto-unread | |
12159 | (and gnus-summary-goto-unread | |
231f989b | 12160 | (not (eq gnus-summary-goto-unread 'never)) |
41487370 LMI |
12161 | (not (memq mark (list gnus-unread-mark |
12162 | gnus-ticked-mark gnus-dormant-mark))))) | |
12163 | (n (abs n)) | |
12164 | (mark (or mark gnus-del-mark))) | |
12165 | (while (and (> n 0) | |
12166 | (gnus-summary-mark-article nil mark no-expire) | |
231f989b LMI |
12167 | (zerop (gnus-summary-next-subject |
12168 | (if backward -1 1) | |
12169 | (and gnus-summary-goto-unread | |
12170 | (not (eq gnus-summary-goto-unread 'never))) | |
12171 | t))) | |
41487370 LMI |
12172 | (setq n (1- n))) |
12173 | (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) | |
12174 | (gnus-summary-recenter) | |
231f989b | 12175 | (gnus-summary-position-point) |
41487370 LMI |
12176 | (gnus-set-mode-line 'summary) |
12177 | n)) | |
12178 | ||
12179 | (defun gnus-summary-mark-article-as-read (mark) | |
12180 | "Mark the current article quickly as read with MARK." | |
12181 | (let ((article (gnus-summary-article-number))) | |
12182 | (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) | |
12183 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) | |
12184 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
12185 | (setq gnus-newsgroup-reads | |
12186 | (cons (cons article mark) gnus-newsgroup-reads)) | |
231f989b | 12187 | ;; Possibly remove from cache, if that is used. |
41487370 | 12188 | (and gnus-use-cache (gnus-cache-enter-remove-article article)) |
231f989b LMI |
12189 | ;; Allow the backend to change the mark. |
12190 | (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) | |
12191 | ;; Check for auto-expiry. | |
12192 | (when (and gnus-newsgroup-auto-expire | |
12193 | (or (= mark gnus-killed-mark) (= mark gnus-del-mark) | |
12194 | (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) | |
12195 | (= mark gnus-ancient-mark) | |
12196 | (= mark gnus-read-mark) (= mark gnus-souped-mark))) | |
12197 | (setq mark gnus-expirable-mark) | |
12198 | (push article gnus-newsgroup-expirable)) | |
12199 | ;; Set the mark in the buffer. | |
41487370 LMI |
12200 | (gnus-summary-update-mark mark 'unread) |
12201 | t)) | |
12202 | ||
12203 | (defun gnus-summary-mark-article-as-unread (mark) | |
12204 | "Mark the current article quickly as unread with MARK." | |
12205 | (let ((article (gnus-summary-article-number))) | |
231f989b LMI |
12206 | (if (< article 0) |
12207 | (gnus-error 1 "Unmarkable article") | |
12208 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) | |
12209 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
12210 | (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) | |
12211 | (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) | |
12212 | (cond ((= mark gnus-ticked-mark) | |
12213 | (push article gnus-newsgroup-marked)) | |
12214 | ((= mark gnus-dormant-mark) | |
12215 | (push article gnus-newsgroup-dormant)) | |
12216 | (t | |
12217 | (push article gnus-newsgroup-unreads))) | |
12218 | (setq gnus-newsgroup-reads | |
12219 | (delq (assq article gnus-newsgroup-reads) | |
12220 | gnus-newsgroup-reads)) | |
12221 | ||
12222 | ;; See whether the article is to be put in the cache. | |
12223 | (and gnus-use-cache | |
12224 | (vectorp (gnus-summary-article-header article)) | |
12225 | (save-excursion | |
12226 | (gnus-cache-possibly-enter-article | |
12227 | gnus-newsgroup-name article | |
12228 | (gnus-summary-article-header article) | |
12229 | (= mark gnus-ticked-mark) | |
12230 | (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) | |
12231 | ||
12232 | ;; Fix the mark. | |
12233 | (gnus-summary-update-mark mark 'unread)) | |
41487370 LMI |
12234 | t)) |
12235 | ||
12236 | (defun gnus-summary-mark-article (&optional article mark no-expire) | |
12237 | "Mark ARTICLE with MARK. MARK can be any character. | |
231f989b LMI |
12238 | Four MARK strings are reserved: `? ' (unread), `?!' (ticked), |
12239 | `??' (dormant) and `?E' (expirable). | |
41487370 LMI |
12240 | If MARK is nil, then the default character `?D' is used. |
12241 | If ARTICLE is nil, then the article on the current line will be | |
231f989b LMI |
12242 | marked." |
12243 | ;; The mark might be a string. | |
41487370 LMI |
12244 | (and (stringp mark) |
12245 | (setq mark (aref mark 0))) | |
12246 | ;; If no mark is given, then we check auto-expiring. | |
12247 | (and (not no-expire) | |
231f989b | 12248 | gnus-newsgroup-auto-expire |
41487370 | 12249 | (or (not mark) |
231f989b | 12250 | (and (numberp mark) |
41487370 LMI |
12251 | (or (= mark gnus-killed-mark) (= mark gnus-del-mark) |
12252 | (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) | |
231f989b | 12253 | (= mark gnus-read-mark) (= mark gnus-souped-mark)))) |
41487370 LMI |
12254 | (setq mark gnus-expirable-mark)) |
12255 | (let* ((mark (or mark gnus-del-mark)) | |
12256 | (article (or article (gnus-summary-article-number)))) | |
12257 | (or article (error "No article on current line")) | |
231f989b LMI |
12258 | (if (or (= mark gnus-unread-mark) |
12259 | (= mark gnus-ticked-mark) | |
41487370 LMI |
12260 | (= mark gnus-dormant-mark)) |
12261 | (gnus-mark-article-as-unread article mark) | |
12262 | (gnus-mark-article-as-read article mark)) | |
12263 | ||
12264 | ;; See whether the article is to be put in the cache. | |
12265 | (and gnus-use-cache | |
12266 | (not (= mark gnus-canceled-mark)) | |
231f989b | 12267 | (vectorp (gnus-summary-article-header article)) |
41487370 | 12268 | (save-excursion |
231f989b LMI |
12269 | (gnus-cache-possibly-enter-article |
12270 | gnus-newsgroup-name article | |
12271 | (gnus-summary-article-header article) | |
41487370 LMI |
12272 | (= mark gnus-ticked-mark) |
12273 | (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) | |
12274 | ||
231f989b | 12275 | (if (gnus-summary-goto-subject article nil t) |
41487370 LMI |
12276 | (let ((buffer-read-only nil)) |
12277 | (gnus-summary-show-thread) | |
41487370 LMI |
12278 | ;; Fix the mark. |
12279 | (gnus-summary-update-mark mark 'unread) | |
12280 | t)))) | |
12281 | ||
231f989b LMI |
12282 | (defun gnus-summary-update-secondary-mark (article) |
12283 | "Update the secondary (read, process, cache) mark." | |
12284 | (gnus-summary-update-mark | |
12285 | (cond ((memq article gnus-newsgroup-processable) | |
12286 | gnus-process-mark) | |
12287 | ((memq article gnus-newsgroup-cached) | |
12288 | gnus-cached-mark) | |
12289 | ((memq article gnus-newsgroup-replied) | |
12290 | gnus-replied-mark) | |
12291 | ((memq article gnus-newsgroup-saved) | |
12292 | gnus-saved-mark) | |
12293 | (t gnus-unread-mark)) | |
12294 | 'replied) | |
12295 | (when (gnus-visual-p 'summary-highlight 'highlight) | |
12296 | (run-hooks 'gnus-summary-update-hook)) | |
12297 | t) | |
12298 | ||
41487370 LMI |
12299 | (defun gnus-summary-update-mark (mark type) |
12300 | (beginning-of-line) | |
12301 | (let ((forward (cdr (assq type gnus-summary-mark-positions))) | |
231f989b LMI |
12302 | (buffer-read-only nil)) |
12303 | (when (and forward | |
12304 | (<= (+ forward (point)) (point-max))) | |
12305 | ;; Go to the right position on the line. | |
12306 | (goto-char (+ forward (point))) | |
12307 | ;; Replace the old mark with the new mark. | |
12308 | (subst-char-in-region (point) (1+ (point)) (following-char) mark) | |
12309 | ;; Optionally update the marks by some user rule. | |
12310 | (when (eq type 'unread) | |
12311 | (gnus-data-set-mark | |
12312 | (gnus-data-find (gnus-summary-article-number)) mark) | |
12313 | (gnus-summary-update-line (eq mark gnus-unread-mark)))))) | |
12314 | ||
41487370 LMI |
12315 | (defun gnus-mark-article-as-read (article &optional mark) |
12316 | "Enter ARTICLE in the pertinent lists and remove it from others." | |
12317 | ;; Make the article expirable. | |
12318 | (let ((mark (or mark gnus-del-mark))) | |
12319 | (if (= mark gnus-expirable-mark) | |
12320 | (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) | |
12321 | (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) | |
12322 | ;; Remove from unread and marked lists. | |
12323 | (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) | |
12324 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) | |
12325 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
231f989b LMI |
12326 | (push (cons article mark) gnus-newsgroup-reads) |
12327 | ;; Possibly remove from cache, if that is used. | |
12328 | (when gnus-use-cache | |
12329 | (gnus-cache-enter-remove-article article)))) | |
41487370 LMI |
12330 | |
12331 | (defun gnus-mark-article-as-unread (article &optional mark) | |
12332 | "Enter ARTICLE in the pertinent lists and remove it from others." | |
12333 | (let ((mark (or mark gnus-ticked-mark))) | |
41487370 LMI |
12334 | (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) |
12335 | (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) | |
12336 | (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) | |
231f989b LMI |
12337 | (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) |
12338 | (cond ((= mark gnus-ticked-mark) | |
12339 | (push article gnus-newsgroup-marked)) | |
12340 | ((= mark gnus-dormant-mark) | |
12341 | (push article gnus-newsgroup-dormant)) | |
12342 | (t | |
12343 | (push article gnus-newsgroup-unreads))) | |
41487370 LMI |
12344 | (setq gnus-newsgroup-reads |
12345 | (delq (assq article gnus-newsgroup-reads) | |
231f989b | 12346 | gnus-newsgroup-reads)))) |
41487370 | 12347 | |
231f989b | 12348 | (defalias 'gnus-summary-mark-as-unread-forward |
41487370 | 12349 | 'gnus-summary-tick-article-forward) |
231f989b | 12350 | (make-obsolete 'gnus-summary-mark-as-unread-forward |
41487370 LMI |
12351 | 'gnus-summary-tick-article-forward) |
12352 | (defun gnus-summary-tick-article-forward (n) | |
12353 | "Tick N articles forwards. | |
12354 | If N is negative, tick backwards instead. | |
12355 | The difference between N and the number of articles ticked is returned." | |
745bc783 | 12356 | (interactive "p") |
41487370 LMI |
12357 | (gnus-summary-mark-forward n gnus-ticked-mark)) |
12358 | ||
231f989b | 12359 | (defalias 'gnus-summary-mark-as-unread-backward |
41487370 | 12360 | 'gnus-summary-tick-article-backward) |
231f989b | 12361 | (make-obsolete 'gnus-summary-mark-as-unread-backward |
41487370 LMI |
12362 | 'gnus-summary-tick-article-backward) |
12363 | (defun gnus-summary-tick-article-backward (n) | |
12364 | "Tick N articles backwards. | |
12365 | The difference between N and the number of articles ticked is returned." | |
12366 | (interactive "p") | |
12367 | (gnus-summary-mark-forward (- n) gnus-ticked-mark)) | |
745bc783 | 12368 | |
41487370 LMI |
12369 | (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) |
12370 | (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) | |
12371 | (defun gnus-summary-tick-article (&optional article clear-mark) | |
745bc783 | 12372 | "Mark current article as unread. |
b027f415 RS |
12373 | Optional 1st argument ARTICLE specifies article number to be marked as unread. |
12374 | Optional 2nd argument CLEAR-MARK remove any kinds of mark." | |
231f989b | 12375 | (interactive) |
41487370 LMI |
12376 | (gnus-summary-mark-article article (if clear-mark gnus-unread-mark |
12377 | gnus-ticked-mark))) | |
12378 | ||
12379 | (defun gnus-summary-mark-as-read-forward (n) | |
12380 | "Mark N articles as read forwards. | |
12381 | If N is negative, mark backwards instead. | |
12382 | The difference between N and the actual number of articles marked is | |
12383 | returned." | |
745bc783 | 12384 | (interactive "p") |
41487370 LMI |
12385 | (gnus-summary-mark-forward n gnus-del-mark t)) |
12386 | ||
12387 | (defun gnus-summary-mark-as-read-backward (n) | |
12388 | "Mark the N articles as read backwards. | |
12389 | The difference between N and the actual number of articles marked is | |
12390 | returned." | |
745bc783 | 12391 | (interactive "p") |
41487370 | 12392 | (gnus-summary-mark-forward (- n) gnus-del-mark t)) |
745bc783 | 12393 | |
b027f415 | 12394 | (defun gnus-summary-mark-as-read (&optional article mark) |
745bc783 | 12395 | "Mark current article as read. |
41487370 LMI |
12396 | ARTICLE specifies the article to be marked as read. |
12397 | MARK specifies a string to be inserted at the beginning of the line." | |
12398 | (gnus-summary-mark-article article mark)) | |
12399 | ||
12400 | (defun gnus-summary-clear-mark-forward (n) | |
12401 | "Clear marks from N articles forward. | |
12402 | If N is negative, clear backward instead. | |
12403 | The difference between N and the number of marks cleared is returned." | |
745bc783 | 12404 | (interactive "p") |
41487370 | 12405 | (gnus-summary-mark-forward n gnus-unread-mark)) |
745bc783 | 12406 | |
41487370 LMI |
12407 | (defun gnus-summary-clear-mark-backward (n) |
12408 | "Clear marks from N articles backward. | |
12409 | The difference between N and the number of marks cleared is returned." | |
12410 | (interactive "p") | |
12411 | (gnus-summary-mark-forward (- n) gnus-unread-mark)) | |
12412 | ||
12413 | (defun gnus-summary-mark-unread-as-read () | |
12414 | "Intended to be used by `gnus-summary-mark-article-hook'." | |
231f989b LMI |
12415 | (when (memq gnus-current-article gnus-newsgroup-unreads) |
12416 | (gnus-summary-mark-article gnus-current-article gnus-read-mark))) | |
12417 | ||
12418 | (defun gnus-summary-mark-read-and-unread-as-read () | |
12419 | "Intended to be used by `gnus-summary-mark-article-hook'." | |
12420 | (let ((mark (gnus-summary-article-mark))) | |
12421 | (when (or (gnus-unread-mark-p mark) | |
12422 | (gnus-read-mark-p mark)) | |
12423 | (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) | |
41487370 LMI |
12424 | |
12425 | (defun gnus-summary-mark-region-as-read (point mark all) | |
12426 | "Mark all unread articles between point and mark as read. | |
12427 | If given a prefix, mark all articles between point and mark as read, | |
12428 | even ticked and dormant ones." | |
12429 | (interactive "r\nP") | |
12430 | (save-excursion | |
231f989b LMI |
12431 | (let (article) |
12432 | (goto-char point) | |
12433 | (beginning-of-line) | |
12434 | (while (and | |
12435 | (< (point) mark) | |
12436 | (progn | |
12437 | (when (or all | |
12438 | (memq (setq article (gnus-summary-article-number)) | |
12439 | gnus-newsgroup-unreads)) | |
12440 | (gnus-summary-mark-article article gnus-del-mark)) | |
12441 | t) | |
12442 | (gnus-summary-find-next)))))) | |
41487370 LMI |
12443 | |
12444 | (defun gnus-summary-mark-below (score mark) | |
12445 | "Mark articles with score less than SCORE with MARK." | |
12446 | (interactive "P\ncMark: ") | |
12447 | (gnus-set-global-variables) | |
12448 | (setq score (if score | |
12449 | (prefix-numeric-value score) | |
12450 | (or gnus-summary-default-score 0))) | |
12451 | (save-excursion | |
12452 | (set-buffer gnus-summary-buffer) | |
12453 | (goto-char (point-min)) | |
231f989b LMI |
12454 | (while |
12455 | (progn | |
12456 | (and (< (gnus-summary-article-score) score) | |
12457 | (gnus-summary-mark-article nil mark)) | |
12458 | (gnus-summary-find-next))))) | |
41487370 LMI |
12459 | |
12460 | (defun gnus-summary-kill-below (&optional score) | |
12461 | "Mark articles with score below SCORE as read." | |
12462 | (interactive "P") | |
12463 | (gnus-set-global-variables) | |
12464 | (gnus-summary-mark-below score gnus-killed-mark)) | |
12465 | ||
12466 | (defun gnus-summary-clear-above (&optional score) | |
12467 | "Clear all marks from articles with score above SCORE." | |
12468 | (interactive "P") | |
12469 | (gnus-set-global-variables) | |
12470 | (gnus-summary-mark-above score gnus-unread-mark)) | |
12471 | ||
12472 | (defun gnus-summary-tick-above (&optional score) | |
12473 | "Tick all articles with score above SCORE." | |
12474 | (interactive "P") | |
12475 | (gnus-set-global-variables) | |
12476 | (gnus-summary-mark-above score gnus-ticked-mark)) | |
12477 | ||
12478 | (defun gnus-summary-mark-above (score mark) | |
12479 | "Mark articles with score over SCORE with MARK." | |
12480 | (interactive "P\ncMark: ") | |
12481 | (gnus-set-global-variables) | |
12482 | (setq score (if score | |
12483 | (prefix-numeric-value score) | |
12484 | (or gnus-summary-default-score 0))) | |
12485 | (save-excursion | |
12486 | (set-buffer gnus-summary-buffer) | |
12487 | (goto-char (point-min)) | |
231f989b LMI |
12488 | (while (and (progn |
12489 | (if (> (gnus-summary-article-score) score) | |
12490 | (gnus-summary-mark-article nil mark)) | |
12491 | t) | |
12492 | (gnus-summary-find-next))))) | |
41487370 | 12493 | |
231f989b LMI |
12494 | ;; Suggested by Daniel Quinlan <quinlan@best.com>. |
12495 | (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) | |
12496 | (defun gnus-summary-limit-include-expunged () | |
41487370 LMI |
12497 | "Display all the hidden articles that were expunged for low scores." |
12498 | (interactive) | |
12499 | (gnus-set-global-variables) | |
12500 | (let ((buffer-read-only nil)) | |
12501 | (let ((scored gnus-newsgroup-scored) | |
12502 | headers h) | |
12503 | (while scored | |
231f989b LMI |
12504 | (or (gnus-summary-goto-subject (caar scored)) |
12505 | (and (setq h (gnus-summary-article-header (caar scored))) | |
12506 | (< (cdar scored) gnus-summary-expunge-below) | |
41487370 LMI |
12507 | (setq headers (cons h headers)))) |
12508 | (setq scored (cdr scored))) | |
12509 | (or headers (error "No expunged articles hidden.")) | |
12510 | (goto-char (point-min)) | |
231f989b | 12511 | (gnus-summary-prepare-unthreaded (nreverse headers))) |
41487370 | 12512 | (goto-char (point-min)) |
231f989b | 12513 | (gnus-summary-position-point))) |
41487370 LMI |
12514 | |
12515 | (defun gnus-summary-catchup (&optional all quietly to-here not-mark) | |
12516 | "Mark all articles not marked as unread in this newsgroup as read. | |
12517 | If prefix argument ALL is non-nil, all articles are marked as read. | |
12518 | If QUIETLY is non-nil, no questions will be asked. | |
231f989b | 12519 | If TO-HERE is non-nil, it should be a point in the buffer. All |
41487370 LMI |
12520 | articles before this point will be marked as read. |
12521 | The number of articles marked as read is returned." | |
12522 | (interactive "P") | |
12523 | (gnus-set-global-variables) | |
12524 | (prog1 | |
12525 | (if (or quietly | |
12526 | (not gnus-interactive-catchup) ;Without confirmation? | |
12527 | gnus-expert-user | |
12528 | (gnus-y-or-n-p | |
12529 | (if all | |
12530 | "Mark absolutely all articles as read? " | |
12531 | "Mark all unread articles as read? "))) | |
231f989b | 12532 | (if (and not-mark |
41487370 LMI |
12533 | (not gnus-newsgroup-adaptive) |
12534 | (not gnus-newsgroup-auto-expire)) | |
12535 | (progn | |
231f989b LMI |
12536 | (when all |
12537 | (setq gnus-newsgroup-marked nil | |
12538 | gnus-newsgroup-dormant nil)) | |
12539 | (setq gnus-newsgroup-unreads nil)) | |
41487370 | 12540 | ;; We actually mark all articles as canceled, which we |
231f989b | 12541 | ;; have to do when using auto-expiry or adaptive scoring. |
41487370 LMI |
12542 | (gnus-summary-show-all-threads) |
12543 | (if (gnus-summary-first-subject (not all)) | |
231f989b | 12544 | (while (and |
41487370 LMI |
12545 | (if to-here (< (point) to-here) t) |
12546 | (gnus-summary-mark-article-as-read gnus-catchup-mark) | |
231f989b LMI |
12547 | (gnus-summary-find-next (not all))))) |
12548 | (unless to-here | |
12549 | (setq gnus-newsgroup-unreads nil)) | |
12550 | (gnus-set-mode-line 'summary))) | |
41487370 LMI |
12551 | (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) |
12552 | (if (and (not to-here) (eq 'nnvirtual (car method))) | |
12553 | (nnvirtual-catchup-group | |
12554 | (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) | |
231f989b | 12555 | (gnus-summary-position-point))) |
41487370 LMI |
12556 | |
12557 | (defun gnus-summary-catchup-to-here (&optional all) | |
12558 | "Mark all unticked articles before the current one as read. | |
12559 | If ALL is non-nil, also mark ticked and dormant articles as read." | |
12560 | (interactive "P") | |
12561 | (gnus-set-global-variables) | |
12562 | (save-excursion | |
231f989b LMI |
12563 | (gnus-save-hidden-threads |
12564 | (let ((beg (point))) | |
12565 | ;; We check that there are unread articles. | |
12566 | (when (or all (gnus-summary-find-prev)) | |
12567 | (gnus-summary-catchup all t beg))))) | |
12568 | (gnus-summary-position-point)) | |
41487370 LMI |
12569 | |
12570 | (defun gnus-summary-catchup-all (&optional quietly) | |
12571 | "Mark all articles in this newsgroup as read." | |
12572 | (interactive "P") | |
12573 | (gnus-set-global-variables) | |
12574 | (gnus-summary-catchup t quietly)) | |
12575 | ||
12576 | (defun gnus-summary-catchup-and-exit (&optional all quietly) | |
12577 | "Mark all articles not marked as unread in this newsgroup as read, then exit. | |
12578 | If prefix argument ALL is non-nil, all articles are marked as read." | |
12579 | (interactive "P") | |
12580 | (gnus-set-global-variables) | |
12581 | (gnus-summary-catchup all quietly nil 'fast) | |
12582 | ;; Select next newsgroup or exit. | |
231f989b | 12583 | (if (eq gnus-auto-select-next 'quietly) |
41487370 LMI |
12584 | (gnus-summary-next-group nil) |
12585 | (gnus-summary-exit))) | |
12586 | ||
12587 | (defun gnus-summary-catchup-all-and-exit (&optional quietly) | |
12588 | "Mark all articles in this newsgroup as read, and then exit." | |
12589 | (interactive "P") | |
12590 | (gnus-set-global-variables) | |
12591 | (gnus-summary-catchup-and-exit t quietly)) | |
12592 | ||
12593 | ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>. | |
12594 | (defun gnus-summary-catchup-and-goto-next-group (&optional all) | |
12595 | "Mark all articles in this group as read and select the next group. | |
12596 | If given a prefix, mark all articles, unread as well as ticked, as | |
231f989b | 12597 | read." |
41487370 LMI |
12598 | (interactive "P") |
12599 | (gnus-set-global-variables) | |
231f989b LMI |
12600 | (save-excursion |
12601 | (gnus-summary-catchup all)) | |
12602 | (gnus-summary-next-article t nil nil t)) | |
745bc783 JB |
12603 | |
12604 | ;; Thread-based commands. | |
12605 | ||
231f989b LMI |
12606 | (defun gnus-summary-articles-in-thread (&optional article) |
12607 | "Return a list of all articles in the current thread. | |
12608 | If ARTICLE is non-nil, return all articles in the thread that starts | |
12609 | with that article." | |
12610 | (let* ((article (or article (gnus-summary-article-number))) | |
12611 | (data (gnus-data-find-list article)) | |
12612 | (top-level (gnus-data-level (car data))) | |
12613 | (top-subject | |
12614 | (cond ((null gnus-thread-operation-ignore-subject) | |
12615 | (gnus-simplify-subject-re | |
12616 | (mail-header-subject (gnus-data-header (car data))))) | |
12617 | ((eq gnus-thread-operation-ignore-subject 'fuzzy) | |
12618 | (gnus-simplify-subject-fuzzy | |
12619 | (mail-header-subject (gnus-data-header (car data))))) | |
12620 | (t nil))) | |
12621 | (end-point (save-excursion | |
12622 | (if (gnus-summary-go-to-next-thread) | |
12623 | (point) (point-max)))) | |
12624 | articles) | |
12625 | (while (and data | |
12626 | (< (gnus-data-pos (car data)) end-point)) | |
12627 | (when (or (not top-subject) | |
12628 | (string= top-subject | |
12629 | (if (eq gnus-thread-operation-ignore-subject 'fuzzy) | |
12630 | (gnus-simplify-subject-fuzzy | |
12631 | (mail-header-subject | |
12632 | (gnus-data-header (car data)))) | |
12633 | (gnus-simplify-subject-re | |
12634 | (mail-header-subject | |
12635 | (gnus-data-header (car data))))))) | |
12636 | (push (gnus-data-number (car data)) articles)) | |
12637 | (unless (and (setq data (cdr data)) | |
12638 | (> (gnus-data-level (car data)) top-level)) | |
12639 | (setq data nil))) | |
12640 | ;; Return the list of articles. | |
12641 | (nreverse articles))) | |
12642 | ||
12643 | (defun gnus-summary-rethread-current () | |
12644 | "Rethread the thread the current article is part of." | |
12645 | (interactive) | |
12646 | (gnus-set-global-variables) | |
12647 | (let* ((gnus-show-threads t) | |
12648 | (article (gnus-summary-article-number)) | |
12649 | (id (mail-header-id (gnus-summary-article-header))) | |
12650 | (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) | |
12651 | (unless id | |
12652 | (error "No article on the current line")) | |
12653 | (gnus-rebuild-thread id) | |
12654 | (gnus-summary-goto-subject article))) | |
12655 | ||
12656 | (defun gnus-summary-reparent-thread () | |
12657 | "Make current article child of the marked (or previous) article. | |
12658 | ||
12659 | Note that the re-threading will only work if `gnus-thread-ignore-subject' | |
12660 | is non-nil or the Subject: of both articles are the same." | |
12661 | (interactive) | |
12662 | (or (not (gnus-group-read-only-p)) | |
12663 | (error "The current newsgroup does not support article editing.")) | |
12664 | (or (<= (length gnus-newsgroup-processable) 1) | |
12665 | (error "No more than one article may be marked.")) | |
12666 | (save-window-excursion | |
12667 | (let ((gnus-article-buffer " *reparent*") | |
12668 | (current-article (gnus-summary-article-number)) | |
12669 | ; first grab the marked article, otherwise one line up. | |
12670 | (parent-article (if (not (null gnus-newsgroup-processable)) | |
12671 | (car gnus-newsgroup-processable) | |
12672 | (save-excursion | |
12673 | (if (eq (forward-line -1) 0) | |
12674 | (gnus-summary-article-number) | |
12675 | (error "Beginning of summary buffer.")))))) | |
12676 | (or (not (eq current-article parent-article)) | |
12677 | (error "An article may not be self-referential.")) | |
12678 | (let ((message-id (mail-header-id | |
12679 | (gnus-summary-article-header parent-article)))) | |
12680 | (or (and message-id (not (equal message-id ""))) | |
12681 | (error "No message-id in desired parent.")) | |
12682 | (gnus-summary-select-article t t nil current-article) | |
12683 | (set-buffer gnus-article-buffer) | |
12684 | (setq buffer-read-only nil) | |
12685 | (let ((buf (format "%s" (buffer-string)))) | |
12686 | (erase-buffer) | |
12687 | (insert buf)) | |
12688 | (goto-char (point-min)) | |
12689 | (if (search-forward-regexp "^References: " nil t) | |
12690 | (insert message-id " " ) | |
12691 | (insert "References: " message-id "\n")) | |
12692 | (or (gnus-request-replace-article current-article | |
12693 | (car gnus-article-current) | |
12694 | gnus-article-buffer) | |
12695 | (error "Couldn't replace article.")) | |
12696 | (set-buffer gnus-summary-buffer) | |
12697 | (gnus-summary-unmark-all-processable) | |
12698 | (gnus-summary-rethread-current) | |
12699 | (gnus-message 3 "Article %d is now the child of article %d." | |
12700 | current-article parent-article))))) | |
12701 | ||
41487370 | 12702 | (defun gnus-summary-toggle-threads (&optional arg) |
745bc783 | 12703 | "Toggle showing conversation threads. |
41487370 | 12704 | If ARG is positive number, turn showing conversation threads on." |
745bc783 | 12705 | (interactive "P") |
41487370 LMI |
12706 | (gnus-set-global-variables) |
12707 | (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) | |
745bc783 JB |
12708 | (setq gnus-show-threads |
12709 | (if (null arg) (not gnus-show-threads) | |
12710 | (> (prefix-numeric-value arg) 0))) | |
b027f415 RS |
12711 | (gnus-summary-prepare) |
12712 | (gnus-summary-goto-subject current) | |
231f989b | 12713 | (gnus-summary-position-point))) |
745bc783 | 12714 | |
b027f415 | 12715 | (defun gnus-summary-show-all-threads () |
41487370 | 12716 | "Show all threads." |
745bc783 | 12717 | (interactive) |
41487370 LMI |
12718 | (gnus-set-global-variables) |
12719 | (save-excursion | |
12720 | (let ((buffer-read-only nil)) | |
12721 | (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) | |
231f989b | 12722 | (gnus-summary-position-point)) |
745bc783 | 12723 | |
b027f415 | 12724 | (defun gnus-summary-show-thread () |
41487370 LMI |
12725 | "Show thread subtrees. |
12726 | Returns nil if no thread was there to be shown." | |
745bc783 | 12727 | (interactive) |
41487370 LMI |
12728 | (gnus-set-global-variables) |
12729 | (let ((buffer-read-only nil) | |
231f989b | 12730 | (orig (point)) |
41487370 LMI |
12731 | ;; first goto end then to beg, to have point at beg after let |
12732 | (end (progn (end-of-line) (point))) | |
12733 | (beg (progn (beginning-of-line) (point)))) | |
12734 | (prog1 | |
12735 | ;; Any hidden lines here? | |
12736 | (search-forward "\r" end t) | |
12737 | (subst-char-in-region beg end ?\^M ?\n t) | |
12738 | (goto-char orig) | |
231f989b | 12739 | (gnus-summary-position-point)))) |
745bc783 | 12740 | |
b027f415 | 12741 | (defun gnus-summary-hide-all-threads () |
745bc783 JB |
12742 | "Hide all thread subtrees." |
12743 | (interactive) | |
41487370 LMI |
12744 | (gnus-set-global-variables) |
12745 | (save-excursion | |
12746 | (goto-char (point-min)) | |
12747 | (gnus-summary-hide-thread) | |
231f989b | 12748 | (while (zerop (gnus-summary-next-thread 1 t)) |
41487370 | 12749 | (gnus-summary-hide-thread))) |
231f989b | 12750 | (gnus-summary-position-point)) |
745bc783 | 12751 | |
b027f415 | 12752 | (defun gnus-summary-hide-thread () |
41487370 LMI |
12753 | "Hide thread subtrees. |
12754 | Returns nil if no threads were there to be hidden." | |
745bc783 | 12755 | (interactive) |
41487370 LMI |
12756 | (gnus-set-global-variables) |
12757 | (let ((buffer-read-only nil) | |
12758 | (start (point)) | |
231f989b LMI |
12759 | (article (gnus-summary-article-number))) |
12760 | (goto-char start) | |
41487370 | 12761 | ;; Go forward until either the buffer ends or the subthread |
231f989b LMI |
12762 | ;; ends. |
12763 | (when (and (not (eobp)) | |
12764 | (or (zerop (gnus-summary-next-thread 1 t)) | |
12765 | (goto-char (point-max)))) | |
41487370 | 12766 | (prog1 |
231f989b LMI |
12767 | (if (and (> (point) start) |
12768 | (search-backward "\n" start t)) | |
12769 | (progn | |
12770 | (subst-char-in-region start (point) ?\n ?\^M) | |
12771 | (gnus-summary-goto-subject article)) | |
12772 | (goto-char start) | |
12773 | nil) | |
12774 | ;;(gnus-summary-position-point) | |
12775 | )))) | |
41487370 LMI |
12776 | |
12777 | (defun gnus-summary-go-to-next-thread (&optional previous) | |
12778 | "Go to the same level (or less) next thread. | |
12779 | If PREVIOUS is non-nil, go to previous thread instead. | |
12780 | Return the article number moved to, or nil if moving was impossible." | |
12781 | (let ((level (gnus-summary-thread-level)) | |
231f989b LMI |
12782 | (way (if previous -1 1)) |
12783 | (beg (point))) | |
12784 | (forward-line way) | |
12785 | (while (and (not (eobp)) | |
12786 | (< level (gnus-summary-thread-level))) | |
12787 | (forward-line way)) | |
12788 | (if (eobp) | |
12789 | (progn | |
12790 | (goto-char beg) | |
12791 | nil) | |
12792 | (setq beg (point)) | |
12793 | (prog1 | |
12794 | (gnus-summary-article-number) | |
12795 | (goto-char beg))))) | |
745bc783 | 12796 | |
231f989b LMI |
12797 | (defun gnus-summary-go-to-next-thread-old (&optional previous) |
12798 | "Go to the same level (or less) next thread. | |
12799 | If PREVIOUS is non-nil, go to previous thread instead. | |
12800 | Return the article number moved to, or nil if moving was impossible." | |
12801 | (if (and (eq gnus-summary-make-false-root 'dummy) | |
12802 | (gnus-summary-article-intangible-p)) | |
12803 | (let ((beg (point))) | |
12804 | (while (and (zerop (forward-line 1)) | |
12805 | (not (gnus-summary-article-intangible-p)) | |
12806 | (not (zerop (save-excursion | |
12807 | (gnus-summary-thread-level)))))) | |
12808 | (if (eobp) | |
12809 | (progn | |
12810 | (goto-char beg) | |
12811 | nil) | |
12812 | (point))) | |
12813 | (let* ((level (gnus-summary-thread-level)) | |
12814 | (article (gnus-summary-article-number)) | |
12815 | (data (cdr (gnus-data-find-list article (gnus-data-list previous)))) | |
12816 | oart) | |
12817 | (while data | |
12818 | (if (<= (gnus-data-level (car data)) level) | |
12819 | (setq oart (gnus-data-number (car data)) | |
12820 | data nil) | |
12821 | (setq data (cdr data)))) | |
12822 | (and oart | |
12823 | (gnus-summary-goto-subject oart))))) | |
12824 | ||
12825 | (defun gnus-summary-next-thread (n &optional silent) | |
41487370 LMI |
12826 | "Go to the same level next N'th thread. |
12827 | If N is negative, search backward instead. | |
12828 | Returns the difference between N and the number of skips actually | |
231f989b LMI |
12829 | done. |
12830 | ||
12831 | If SILENT, don't output messages." | |
745bc783 | 12832 | (interactive "p") |
41487370 LMI |
12833 | (gnus-set-global-variables) |
12834 | (let ((backward (< n 0)) | |
231f989b LMI |
12835 | (n (abs n)) |
12836 | old dum int) | |
745bc783 | 12837 | (while (and (> n 0) |
41487370 | 12838 | (gnus-summary-go-to-next-thread backward)) |
231f989b LMI |
12839 | (decf n)) |
12840 | (unless silent | |
12841 | (gnus-summary-position-point)) | |
12842 | (when (and (not silent) (/= 0 n)) | |
12843 | (gnus-message 7 "No more threads")) | |
41487370 | 12844 | n)) |
745bc783 | 12845 | |
b027f415 | 12846 | (defun gnus-summary-prev-thread (n) |
41487370 LMI |
12847 | "Go to the same level previous N'th thread. |
12848 | Returns the difference between N and the number of skips actually | |
12849 | done." | |
745bc783 | 12850 | (interactive "p") |
41487370 LMI |
12851 | (gnus-set-global-variables) |
12852 | (gnus-summary-next-thread (- n))) | |
12853 | ||
231f989b LMI |
12854 | (defun gnus-summary-go-down-thread () |
12855 | "Go down one level in the current thread." | |
12856 | (let ((children (gnus-summary-article-children))) | |
12857 | (and children | |
12858 | (gnus-summary-goto-subject (car children))))) | |
41487370 LMI |
12859 | |
12860 | (defun gnus-summary-go-up-thread () | |
12861 | "Go up one level in the current thread." | |
231f989b LMI |
12862 | (let ((parent (gnus-summary-article-parent))) |
12863 | (and parent | |
12864 | (gnus-summary-goto-subject parent)))) | |
41487370 LMI |
12865 | |
12866 | (defun gnus-summary-down-thread (n) | |
12867 | "Go down thread N steps. | |
12868 | If N is negative, go up instead. | |
12869 | Returns the difference between N and how many steps down that were | |
12870 | taken." | |
745bc783 | 12871 | (interactive "p") |
41487370 LMI |
12872 | (gnus-set-global-variables) |
12873 | (let ((up (< n 0)) | |
12874 | (n (abs n))) | |
12875 | (while (and (> n 0) | |
12876 | (if up (gnus-summary-go-up-thread) | |
12877 | (gnus-summary-go-down-thread))) | |
12878 | (setq n (1- n))) | |
231f989b | 12879 | (gnus-summary-position-point) |
41487370 LMI |
12880 | (if (/= 0 n) (gnus-message 7 "Can't go further")) |
12881 | n)) | |
12882 | ||
12883 | (defun gnus-summary-up-thread (n) | |
12884 | "Go up thread N steps. | |
12885 | If N is negative, go up instead. | |
12886 | Returns the difference between N and how many steps down that were | |
12887 | taken." | |
745bc783 | 12888 | (interactive "p") |
41487370 LMI |
12889 | (gnus-set-global-variables) |
12890 | (gnus-summary-down-thread (- n))) | |
12891 | ||
231f989b LMI |
12892 | (defun gnus-summary-top-thread () |
12893 | "Go to the top of the thread." | |
12894 | (interactive) | |
12895 | (gnus-set-global-variables) | |
12896 | (while (gnus-summary-go-up-thread)) | |
12897 | (gnus-summary-article-number)) | |
12898 | ||
41487370 | 12899 | (defun gnus-summary-kill-thread (&optional unmark) |
745bc783 | 12900 | "Mark articles under current thread as read. |
41487370 LMI |
12901 | If the prefix argument is positive, remove any kinds of marks. |
12902 | If the prefix argument is negative, tick articles instead." | |
745bc783 | 12903 | (interactive "P") |
41487370 | 12904 | (gnus-set-global-variables) |
231f989b LMI |
12905 | (when unmark |
12906 | (setq unmark (prefix-numeric-value unmark))) | |
12907 | (let ((articles (gnus-summary-articles-in-thread))) | |
41487370 LMI |
12908 | (save-excursion |
12909 | ;; Expand the thread. | |
12910 | (gnus-summary-show-thread) | |
231f989b LMI |
12911 | ;; Mark all the articles. |
12912 | (while articles | |
12913 | (gnus-summary-goto-subject (car articles)) | |
12914 | (cond ((null unmark) | |
12915 | (gnus-summary-mark-article-as-read gnus-killed-mark)) | |
12916 | ((> unmark 0) | |
12917 | (gnus-summary-mark-article-as-unread gnus-unread-mark)) | |
12918 | (t | |
12919 | (gnus-summary-mark-article-as-unread gnus-ticked-mark))) | |
12920 | (setq articles (cdr articles)))) | |
41487370 LMI |
12921 | ;; Hide killed subtrees. |
12922 | (and (null unmark) | |
12923 | gnus-thread-hide-killed | |
12924 | (gnus-summary-hide-thread)) | |
12925 | ;; If marked as read, go to next unread subject. | |
12926 | (if (null unmark) | |
12927 | ;; Go to next unread subject. | |
12928 | (gnus-summary-next-subject 1 t))) | |
12929 | (gnus-set-mode-line 'summary)) | |
745bc783 | 12930 | |
41487370 | 12931 | ;; Summary sorting commands |
745bc783 | 12932 | |
41487370 LMI |
12933 | (defun gnus-summary-sort-by-number (&optional reverse) |
12934 | "Sort summary buffer by article number. | |
745bc783 JB |
12935 | Argument REVERSE means reverse order." |
12936 | (interactive "P") | |
231f989b | 12937 | (gnus-summary-sort 'number reverse)) |
41487370 LMI |
12938 | |
12939 | (defun gnus-summary-sort-by-author (&optional reverse) | |
12940 | "Sort summary buffer by author name alphabetically. | |
745bc783 JB |
12941 | If case-fold-search is non-nil, case of letters is ignored. |
12942 | Argument REVERSE means reverse order." | |
12943 | (interactive "P") | |
231f989b | 12944 | (gnus-summary-sort 'author reverse)) |
41487370 LMI |
12945 | |
12946 | (defun gnus-summary-sort-by-subject (&optional reverse) | |
12947 | "Sort summary buffer by subject alphabetically. `Re:'s are ignored. | |
745bc783 JB |
12948 | If case-fold-search is non-nil, case of letters is ignored. |
12949 | Argument REVERSE means reverse order." | |
12950 | (interactive "P") | |
231f989b | 12951 | (gnus-summary-sort 'subject reverse)) |
41487370 LMI |
12952 | |
12953 | (defun gnus-summary-sort-by-date (&optional reverse) | |
12954 | "Sort summary buffer by date. | |
745bc783 JB |
12955 | Argument REVERSE means reverse order." |
12956 | (interactive "P") | |
231f989b | 12957 | (gnus-summary-sort 'date reverse)) |
41487370 LMI |
12958 | |
12959 | (defun gnus-summary-sort-by-score (&optional reverse) | |
12960 | "Sort summary buffer by score. | |
12961 | Argument REVERSE means reverse order." | |
745bc783 | 12962 | (interactive "P") |
231f989b | 12963 | (gnus-summary-sort 'score reverse)) |
41487370 | 12964 | |
41487370 | 12965 | (defun gnus-summary-sort (predicate reverse) |
231f989b LMI |
12966 | "Sort summary buffer by PREDICATE. REVERSE means reverse order." |
12967 | (gnus-set-global-variables) | |
12968 | (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) | |
12969 | (article (intern (format "gnus-article-sort-by-%s" predicate))) | |
12970 | (gnus-thread-sort-functions | |
12971 | (list | |
12972 | (if (not reverse) | |
12973 | thread | |
12974 | `(lambda (t1 t2) | |
12975 | (,thread t2 t1))))) | |
12976 | (gnus-article-sort-functions | |
12977 | (list | |
12978 | (if (not reverse) | |
12979 | article | |
12980 | `(lambda (t1 t2) | |
12981 | (,article t2 t1))))) | |
12982 | (buffer-read-only) | |
12983 | (gnus-summary-prepare-hook nil)) | |
12984 | ;; We do the sorting by regenerating the threads. | |
12985 | (gnus-summary-prepare) | |
12986 | ;; Hide subthreads if needed. | |
12987 | (when (and gnus-show-threads gnus-thread-hide-subtree) | |
12988 | (gnus-summary-hide-all-threads))) | |
12989 | ;; If in async mode, we send some info to the backend. | |
12990 | (when gnus-newsgroup-async | |
12991 | (gnus-request-asynchronous | |
12992 | gnus-newsgroup-name gnus-newsgroup-data))) | |
41487370 | 12993 | |
41487370 LMI |
12994 | (defun gnus-sortable-date (date) |
12995 | "Make sortable string by string-lessp from DATE. | |
12996 | Timezone package is used." | |
231f989b LMI |
12997 | (condition-case () |
12998 | (progn | |
12999 | (setq date (inline (timezone-fix-time | |
13000 | date nil | |
13001 | (aref (inline (timezone-parse-date date)) 4)))) | |
13002 | (inline | |
13003 | (timezone-make-sortable-date | |
13004 | (aref date 0) (aref date 1) (aref date 2) | |
13005 | (inline | |
13006 | (timezone-make-time-string | |
13007 | (aref date 3) (aref date 4) (aref date 5)))))) | |
13008 | (error ""))) | |
13009 | ||
41487370 LMI |
13010 | ;; Summary saving commands. |
13011 | ||
231f989b | 13012 | (defun gnus-summary-save-article (&optional n not-saved) |
41487370 LMI |
13013 | "Save the current article using the default saver function. |
13014 | If N is a positive number, save the N next articles. | |
13015 | If N is a negative number, save the N previous articles. | |
13016 | If N is nil and any articles have been marked with the process mark, | |
13017 | save those articles instead. | |
b027f415 | 13018 | The variable `gnus-default-article-saver' specifies the saver function." |
41487370 LMI |
13019 | (interactive "P") |
13020 | (gnus-set-global-variables) | |
231f989b LMI |
13021 | (let ((articles (gnus-summary-work-articles n)) |
13022 | (save-buffer (save-excursion | |
13023 | (nnheader-set-temp-buffer " *Gnus Save*"))) | |
13024 | file header article) | |
41487370 | 13025 | (while articles |
231f989b LMI |
13026 | (setq header (gnus-summary-article-header |
13027 | (setq article (pop articles)))) | |
13028 | (if (not (vectorp header)) | |
13029 | ;; This is a pseudo-article. | |
41487370 LMI |
13030 | (if (assq 'name header) |
13031 | (gnus-copy-file (cdr (assq 'name header))) | |
231f989b LMI |
13032 | (gnus-message 1 "Article %d is unsaveable" article)) |
13033 | ;; This is a real article. | |
13034 | (save-window-excursion | |
13035 | (gnus-summary-select-article t nil nil article)) | |
13036 | (save-excursion | |
13037 | (set-buffer save-buffer) | |
13038 | (erase-buffer) | |
13039 | (insert-buffer-substring gnus-original-article-buffer)) | |
13040 | (unless gnus-save-all-headers | |
13041 | ;; Remove headers accoring to `gnus-saved-headers'. | |
13042 | (let ((gnus-visible-headers | |
13043 | (or gnus-saved-headers gnus-visible-headers)) | |
13044 | (gnus-article-buffer save-buffer)) | |
13045 | (gnus-article-hide-headers 1 t))) | |
13046 | (save-window-excursion | |
13047 | (if (not gnus-default-article-saver) | |
13048 | (error "No default saver is defined.") | |
13049 | ;; !!! Magic! The saving functions all save | |
13050 | ;; `gnus-original-article-buffer' (or so they think), | |
13051 | ;; but we bind that variable to our save-buffer. | |
13052 | (set-buffer gnus-article-buffer) | |
13053 | (let ((gnus-original-article-buffer save-buffer)) | |
13054 | (set-buffer gnus-summary-buffer) | |
13055 | (setq file (funcall | |
13056 | gnus-default-article-saver | |
13057 | (cond | |
13058 | ((not gnus-prompt-before-saving) | |
13059 | 'default) | |
13060 | ((eq gnus-prompt-before-saving 'always) | |
13061 | nil) | |
13062 | (t file))))))) | |
13063 | (gnus-summary-remove-process-mark article) | |
13064 | (unless not-saved | |
13065 | (gnus-summary-set-saved-mark article)))) | |
13066 | (gnus-kill-buffer save-buffer) | |
13067 | (gnus-summary-position-point) | |
41487370 LMI |
13068 | n)) |
13069 | ||
13070 | (defun gnus-summary-pipe-output (&optional arg) | |
13071 | "Pipe the current article to a subprocess. | |
13072 | If N is a positive number, pipe the N next articles. | |
13073 | If N is a negative number, pipe the N previous articles. | |
13074 | If N is nil and any articles have been marked with the process mark, | |
13075 | pipe those articles instead." | |
13076 | (interactive "P") | |
13077 | (gnus-set-global-variables) | |
13078 | (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) | |
231f989b | 13079 | (gnus-summary-save-article arg t)) |
bf8aeaf9 | 13080 | (gnus-configure-windows 'pipe)) |
41487370 LMI |
13081 | |
13082 | (defun gnus-summary-save-article-mail (&optional arg) | |
13083 | "Append the current article to an mail file. | |
13084 | If N is a positive number, save the N next articles. | |
13085 | If N is a negative number, save the N previous articles. | |
13086 | If N is nil and any articles have been marked with the process mark, | |
13087 | save those articles instead." | |
13088 | (interactive "P") | |
13089 | (gnus-set-global-variables) | |
13090 | (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) | |
13091 | (gnus-summary-save-article arg))) | |
13092 | ||
13093 | (defun gnus-summary-save-article-rmail (&optional arg) | |
13094 | "Append the current article to an rmail file. | |
13095 | If N is a positive number, save the N next articles. | |
13096 | If N is a negative number, save the N previous articles. | |
13097 | If N is nil and any articles have been marked with the process mark, | |
13098 | save those articles instead." | |
13099 | (interactive "P") | |
13100 | (gnus-set-global-variables) | |
13101 | (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) | |
13102 | (gnus-summary-save-article arg))) | |
13103 | ||
13104 | (defun gnus-summary-save-article-file (&optional arg) | |
13105 | "Append the current article to a file. | |
13106 | If N is a positive number, save the N next articles. | |
13107 | If N is a negative number, save the N previous articles. | |
13108 | If N is nil and any articles have been marked with the process mark, | |
13109 | save those articles instead." | |
13110 | (interactive "P") | |
13111 | (gnus-set-global-variables) | |
13112 | (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) | |
13113 | (gnus-summary-save-article arg))) | |
13114 | ||
231f989b LMI |
13115 | (defun gnus-summary-save-article-body-file (&optional arg) |
13116 | "Append the current article body to a file. | |
13117 | If N is a positive number, save the N next articles. | |
13118 | If N is a negative number, save the N previous articles. | |
13119 | If N is nil and any articles have been marked with the process mark, | |
13120 | save those articles instead." | |
13121 | (interactive "P") | |
13122 | (gnus-set-global-variables) | |
13123 | (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) | |
13124 | (gnus-summary-save-article arg))) | |
13125 | ||
13126 | (defun gnus-get-split-value (methods) | |
13127 | "Return a value based on the split METHODS." | |
13128 | (let (split-name method result match) | |
13129 | (when methods | |
41487370 | 13130 | (save-excursion |
231f989b LMI |
13131 | (set-buffer gnus-original-article-buffer) |
13132 | (save-restriction | |
13133 | (nnheader-narrow-to-headers) | |
13134 | (while methods | |
13135 | (goto-char (point-min)) | |
13136 | (setq method (pop methods)) | |
13137 | (setq match (car method)) | |
13138 | (when (cond | |
13139 | ((stringp match) | |
13140 | ;; Regular expression. | |
13141 | (condition-case () | |
13142 | (re-search-forward match nil t) | |
13143 | (error nil))) | |
13144 | ((gnus-functionp match) | |
13145 | ;; Function. | |
13146 | (save-restriction | |
13147 | (widen) | |
13148 | (setq result (funcall match gnus-newsgroup-name)))) | |
13149 | ((consp match) | |
13150 | ;; Form. | |
13151 | (save-restriction | |
13152 | (widen) | |
13153 | (setq result (eval match))))) | |
13154 | (setq split-name (append (cdr method) split-name)) | |
13155 | (cond ((stringp result) | |
13156 | (push result split-name)) | |
13157 | ((consp result) | |
13158 | (setq split-name (append result split-name))))))))) | |
13159 | split-name)) | |
13160 | ||
13161 | (defun gnus-read-move-group-name (prompt default articles prefix) | |
13162 | "Read a group name." | |
13163 | (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) | |
13164 | (minibuffer-confirm-incomplete nil) ; XEmacs | |
13165 | group-map | |
13166 | (dum (mapatoms | |
13167 | (lambda (g) | |
13168 | (and (boundp g) | |
13169 | (symbol-name g) | |
13170 | (memq 'respool | |
13171 | (assoc (symbol-name | |
13172 | (car (gnus-find-method-for-group | |
13173 | (symbol-name g)))) | |
13174 | gnus-valid-select-methods)) | |
13175 | (push (list (symbol-name g)) group-map))) | |
13176 | gnus-active-hashtb)) | |
13177 | (prom | |
13178 | (format "%s %s to:" | |
13179 | prompt | |
13180 | (if (> (length articles) 1) | |
13181 | (format "these %d articles" (length articles)) | |
13182 | "this article"))) | |
13183 | (to-newsgroup | |
13184 | (cond | |
13185 | ((null split-name) | |
13186 | (gnus-completing-read default prom | |
13187 | group-map nil nil prefix | |
13188 | 'gnus-group-history)) | |
13189 | ((= 1 (length split-name)) | |
13190 | (gnus-completing-read (car split-name) prom group-map | |
13191 | nil nil nil | |
13192 | 'gnus-group-history)) | |
13193 | (t | |
13194 | (gnus-completing-read nil prom | |
13195 | (mapcar (lambda (el) (list el)) | |
13196 | (nreverse split-name)) | |
13197 | nil nil nil | |
13198 | 'gnus-group-history))))) | |
13199 | (when to-newsgroup | |
13200 | (if (or (string= to-newsgroup "") | |
13201 | (string= to-newsgroup prefix)) | |
13202 | (setq to-newsgroup (or default ""))) | |
13203 | (or (gnus-active to-newsgroup) | |
13204 | (gnus-activate-group to-newsgroup) | |
13205 | (if (gnus-y-or-n-p (format "No such group: %s. Create it? " | |
13206 | to-newsgroup)) | |
13207 | (or (and (gnus-request-create-group | |
13208 | to-newsgroup (gnus-group-name-to-method to-newsgroup)) | |
13209 | (gnus-activate-group to-newsgroup nil nil | |
13210 | (gnus-group-name-to-method | |
13211 | to-newsgroup))) | |
13212 | (error "Couldn't create group %s" to-newsgroup))) | |
13213 | (error "No such group: %s" to-newsgroup))) | |
13214 | to-newsgroup)) | |
13215 | ||
13216 | (defun gnus-read-save-file-name (prompt default-name) | |
13217 | (let* ((split-name (gnus-get-split-value gnus-split-methods)) | |
13218 | (file | |
13219 | ;; Let the split methods have their say. | |
13220 | (cond | |
13221 | ;; No split name was found. | |
13222 | ((null split-name) | |
13223 | (read-file-name | |
13224 | (concat prompt " (default " | |
13225 | (file-name-nondirectory default-name) ") ") | |
13226 | (file-name-directory default-name) | |
13227 | default-name)) | |
13228 | ;; A single split name was found | |
13229 | ((= 1 (length split-name)) | |
13230 | (let* ((name (car split-name)) | |
13231 | (dir (cond ((file-directory-p name) | |
13232 | (file-name-as-directory name)) | |
13233 | ((file-exists-p name) name) | |
13234 | (t gnus-article-save-directory)))) | |
13235 | (read-file-name | |
13236 | (concat prompt " (default " name ") ") | |
13237 | dir name))) | |
13238 | ;; A list of splits was found. | |
13239 | (t | |
13240 | (setq split-name (nreverse split-name)) | |
13241 | (let (result) | |
13242 | (let ((file-name-history (nconc split-name file-name-history))) | |
13243 | (setq result | |
13244 | (read-file-name | |
13245 | (concat prompt " (`M-p' for defaults) ") | |
13246 | gnus-article-save-directory | |
13247 | (car split-name)))) | |
13248 | (car (push result file-name-history))))))) | |
13249 | ;; If we have read a directory, we append the default file name. | |
13250 | (when (file-directory-p file) | |
13251 | (setq file (concat (file-name-as-directory file) | |
13252 | (file-name-nondirectory default-name)))) | |
13253 | ;; Possibly translate some charaters. | |
13254 | (nnheader-translate-file-chars file))) | |
13255 | ||
13256 | (defun gnus-article-archive-name (group) | |
13257 | "Return the first instance of an \"Archive-name\" in the current buffer." | |
13258 | (let ((case-fold-search t)) | |
13259 | (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) | |
13260 | (match-string 1)))) | |
745bc783 | 13261 | |
b027f415 | 13262 | (defun gnus-summary-save-in-rmail (&optional filename) |
745bc783 JB |
13263 | "Append this article to Rmail file. |
13264 | Optional argument FILENAME specifies file name. | |
231f989b | 13265 | Directory to save to is default to `gnus-article-save-directory'." |
745bc783 | 13266 | (interactive) |
41487370 LMI |
13267 | (gnus-set-global-variables) |
13268 | (let ((default-name | |
13269 | (funcall gnus-rmail-save-name gnus-newsgroup-name | |
13270 | gnus-current-headers gnus-newsgroup-last-rmail))) | |
231f989b LMI |
13271 | (setq filename |
13272 | (cond ((eq filename 'default) | |
13273 | default-name) | |
13274 | (filename filename) | |
13275 | (t (gnus-read-save-file-name | |
13276 | "Save in rmail file:" default-name)))) | |
41487370 | 13277 | (gnus-make-directory (file-name-directory filename)) |
231f989b LMI |
13278 | (gnus-eval-in-buffer-window gnus-original-article-buffer |
13279 | (save-excursion | |
13280 | (save-restriction | |
13281 | (widen) | |
13282 | (gnus-output-to-rmail filename)))) | |
41487370 LMI |
13283 | ;; Remember the directory name to save articles |
13284 | (setq gnus-newsgroup-last-rmail filename))) | |
745bc783 | 13285 | |
b027f415 | 13286 | (defun gnus-summary-save-in-mail (&optional filename) |
745bc783 JB |
13287 | "Append this article to Unix mail file. |
13288 | Optional argument FILENAME specifies file name. | |
231f989b | 13289 | Directory to save to is default to `gnus-article-save-directory'." |
745bc783 | 13290 | (interactive) |
41487370 LMI |
13291 | (gnus-set-global-variables) |
13292 | (let ((default-name | |
13293 | (funcall gnus-mail-save-name gnus-newsgroup-name | |
13294 | gnus-current-headers gnus-newsgroup-last-mail))) | |
231f989b LMI |
13295 | (setq filename |
13296 | (cond ((eq filename 'default) | |
13297 | default-name) | |
13298 | (filename filename) | |
13299 | (t (gnus-read-save-file-name | |
13300 | "Save in Unix mail file:" default-name)))) | |
41487370 LMI |
13301 | (setq filename |
13302 | (expand-file-name filename | |
13303 | (and default-name | |
13304 | (file-name-directory default-name)))) | |
13305 | (gnus-make-directory (file-name-directory filename)) | |
231f989b LMI |
13306 | (gnus-eval-in-buffer-window gnus-original-article-buffer |
13307 | (save-excursion | |
13308 | (save-restriction | |
13309 | (widen) | |
13310 | (if (and (file-readable-p filename) (mail-file-babyl-p filename)) | |
13311 | (gnus-output-to-rmail filename) | |
13312 | (let ((mail-use-rfc822 t)) | |
13313 | (rmail-output filename 1 t t)))))) | |
41487370 LMI |
13314 | ;; Remember the directory name to save articles. |
13315 | (setq gnus-newsgroup-last-mail filename))) | |
745bc783 | 13316 | |
b027f415 | 13317 | (defun gnus-summary-save-in-file (&optional filename) |
745bc783 JB |
13318 | "Append this article to file. |
13319 | Optional argument FILENAME specifies file name. | |
231f989b LMI |
13320 | Directory to save to is default to `gnus-article-save-directory'." |
13321 | (interactive) | |
13322 | (gnus-set-global-variables) | |
13323 | (let ((default-name | |
13324 | (funcall gnus-file-save-name gnus-newsgroup-name | |
13325 | gnus-current-headers gnus-newsgroup-last-file))) | |
13326 | (setq filename | |
13327 | (cond ((eq filename 'default) | |
13328 | default-name) | |
13329 | (filename filename) | |
13330 | (t (gnus-read-save-file-name | |
13331 | "Save in file:" default-name)))) | |
13332 | (gnus-make-directory (file-name-directory filename)) | |
13333 | (gnus-eval-in-buffer-window gnus-original-article-buffer | |
13334 | (save-excursion | |
13335 | (save-restriction | |
13336 | (widen) | |
13337 | (gnus-output-to-file filename)))) | |
13338 | ;; Remember the directory name to save articles. | |
13339 | (setq gnus-newsgroup-last-file filename))) | |
13340 | ||
13341 | (defun gnus-summary-save-body-in-file (&optional filename) | |
13342 | "Append this article body to a file. | |
13343 | Optional argument FILENAME specifies file name. | |
13344 | The directory to save in defaults to `gnus-article-save-directory'." | |
745bc783 | 13345 | (interactive) |
41487370 LMI |
13346 | (gnus-set-global-variables) |
13347 | (let ((default-name | |
13348 | (funcall gnus-file-save-name gnus-newsgroup-name | |
13349 | gnus-current-headers gnus-newsgroup-last-file))) | |
231f989b LMI |
13350 | (setq filename |
13351 | (cond ((eq filename 'default) | |
13352 | default-name) | |
13353 | (filename filename) | |
13354 | (t (gnus-read-save-file-name | |
13355 | "Save body in file:" default-name)))) | |
41487370 | 13356 | (gnus-make-directory (file-name-directory filename)) |
231f989b LMI |
13357 | (gnus-eval-in-buffer-window gnus-original-article-buffer |
13358 | (save-excursion | |
13359 | (save-restriction | |
13360 | (widen) | |
13361 | (goto-char (point-min)) | |
13362 | (and (search-forward "\n\n" nil t) | |
13363 | (narrow-to-region (point) (point-max))) | |
13364 | (gnus-output-to-file filename)))) | |
41487370 LMI |
13365 | ;; Remember the directory name to save articles. |
13366 | (setq gnus-newsgroup-last-file filename))) | |
13367 | ||
13368 | (defun gnus-summary-save-in-pipe (&optional command) | |
745bc783 JB |
13369 | "Pipe this article to subprocess." |
13370 | (interactive) | |
41487370 | 13371 | (gnus-set-global-variables) |
231f989b LMI |
13372 | (setq command |
13373 | (cond ((eq command 'default) | |
13374 | gnus-last-shell-command) | |
13375 | (command command) | |
13376 | (t (read-string "Shell command on article: " | |
13377 | gnus-last-shell-command)))) | |
13378 | (if (string-equal command "") | |
13379 | (setq command gnus-last-shell-command)) | |
13380 | (gnus-eval-in-buffer-window gnus-article-buffer | |
13381 | (save-restriction | |
13382 | (widen) | |
13383 | (shell-command-on-region (point-min) (point-max) command nil))) | |
13384 | (setq gnus-last-shell-command command)) | |
41487370 LMI |
13385 | |
13386 | ;; Summary extract commands | |
13387 | ||
13388 | (defun gnus-summary-insert-pseudos (pslist &optional not-view) | |
13389 | (let ((buffer-read-only nil) | |
13390 | (article (gnus-summary-article-number)) | |
231f989b | 13391 | after-article b e) |
41487370 LMI |
13392 | (or (gnus-summary-goto-subject article) |
13393 | (error (format "No such article: %d" article))) | |
231f989b | 13394 | (gnus-summary-position-point) |
41487370 | 13395 | ;; If all commands are to be bunched up on one line, we collect |
231f989b | 13396 | ;; them here. |
41487370 LMI |
13397 | (if gnus-view-pseudos-separately |
13398 | () | |
13399 | (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) | |
13400 | files action) | |
13401 | (while ps | |
13402 | (setq action (cdr (assq 'action (car ps)))) | |
13403 | (setq files (list (cdr (assq 'name (car ps))))) | |
13404 | (while (and ps (cdr ps) | |
13405 | (string= (or action "1") | |
231f989b LMI |
13406 | (or (cdr (assq 'action (cadr ps))) "2"))) |
13407 | (setq files (cons (cdr (assq 'name (cadr ps))) files)) | |
13408 | (setcdr ps (cddr ps))) | |
41487370 LMI |
13409 | (if (not files) |
13410 | () | |
13411 | (if (not (string-match "%s" action)) | |
13412 | (setq files (cons " " files))) | |
13413 | (setq files (cons " " files)) | |
13414 | (and (assq 'execute (car ps)) | |
13415 | (setcdr (assq 'execute (car ps)) | |
13416 | (funcall (if (string-match "%s" action) | |
13417 | 'format 'concat) | |
231f989b | 13418 | action |
41487370 LMI |
13419 | (mapconcat (lambda (f) f) files " "))))) |
13420 | (setq ps (cdr ps))))) | |
13421 | (if (and gnus-view-pseudos (not not-view)) | |
13422 | (while pslist | |
13423 | (and (assq 'execute (car pslist)) | |
13424 | (gnus-execute-command (cdr (assq 'execute (car pslist))) | |
13425 | (eq gnus-view-pseudos 'not-confirm))) | |
13426 | (setq pslist (cdr pslist))) | |
13427 | (save-excursion | |
13428 | (while pslist | |
231f989b LMI |
13429 | (setq after-article (or (cdr (assq 'article (car pslist))) |
13430 | (gnus-summary-article-number))) | |
13431 | (gnus-summary-goto-subject after-article) | |
41487370 LMI |
13432 | (forward-line 1) |
13433 | (setq b (point)) | |
231f989b | 13434 | (insert " " (file-name-nondirectory |
41487370 LMI |
13435 | (cdr (assq 'name (car pslist)))) |
13436 | ": " (or (cdr (assq 'execute (car pslist))) "") "\n") | |
231f989b LMI |
13437 | (setq e (point)) |
13438 | (forward-line -1) ; back to `b' | |
13439 | (gnus-add-text-properties | |
13440 | b (1- e) (list 'gnus-number gnus-reffed-article-number | |
13441 | gnus-mouse-face-prop gnus-mouse-face)) | |
13442 | (gnus-data-enter | |
13443 | after-article gnus-reffed-article-number | |
13444 | gnus-unread-mark b (car pslist) 0 (- e b)) | |
13445 | (push gnus-reffed-article-number gnus-newsgroup-unreads) | |
41487370 LMI |
13446 | (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) |
13447 | (setq pslist (cdr pslist))))))) | |
13448 | ||
13449 | (defun gnus-pseudos< (p1 p2) | |
13450 | (let ((c1 (cdr (assq 'action p1))) | |
13451 | (c2 (cdr (assq 'action p2)))) | |
13452 | (and c1 c2 (string< c1 c2)))) | |
13453 | ||
13454 | (defun gnus-request-pseudo-article (props) | |
13455 | (cond ((assq 'execute props) | |
13456 | (gnus-execute-command (cdr (assq 'execute props))))) | |
13457 | (let ((gnus-current-article (gnus-summary-article-number))) | |
13458 | (run-hooks 'gnus-mark-article-hook))) | |
13459 | ||
13460 | (defun gnus-execute-command (command &optional automatic) | |
13461 | (save-excursion | |
13462 | (gnus-article-setup-buffer) | |
13463 | (set-buffer gnus-article-buffer) | |
231f989b | 13464 | (setq buffer-read-only nil) |
41487370 | 13465 | (let ((command (if automatic command (read-string "Command: " command))) |
231f989b LMI |
13466 | ;; Just binding this here doesn't help, because there might |
13467 | ;; be output from the process after exiting the scope of | |
13468 | ;; this `let'. | |
13469 | ;; (buffer-read-only nil) | |
13470 | ) | |
41487370 LMI |
13471 | (erase-buffer) |
13472 | (insert "$ " command "\n\n") | |
13473 | (if gnus-view-pseudo-asynchronously | |
231f989b LMI |
13474 | (start-process "gnus-execute" nil shell-file-name |
13475 | shell-command-switch command) | |
13476 | (call-process shell-file-name nil t nil | |
13477 | shell-command-switch command))))) | |
745bc783 | 13478 | |
41487370 LMI |
13479 | (defun gnus-copy-file (file &optional to) |
13480 | "Copy FILE to TO." | |
13481 | (interactive | |
13482 | (list (read-file-name "Copy file: " default-directory) | |
13483 | (read-file-name "Copy file to: " default-directory))) | |
13484 | (gnus-set-global-variables) | |
13485 | (or to (setq to (read-file-name "Copy file to: " default-directory))) | |
231f989b | 13486 | (and (file-directory-p to) |
41487370 LMI |
13487 | (setq to (concat (file-name-as-directory to) |
13488 | (file-name-nondirectory file)))) | |
13489 | (copy-file file to)) | |
13490 | ||
13491 | ;; Summary kill commands. | |
13492 | ||
13493 | (defun gnus-summary-edit-global-kill (article) | |
13494 | "Edit the \"global\" kill file." | |
13495 | (interactive (list (gnus-summary-article-number))) | |
13496 | (gnus-set-global-variables) | |
13497 | (gnus-group-edit-global-kill article)) | |
745bc783 | 13498 | |
b027f415 | 13499 | (defun gnus-summary-edit-local-kill () |
41487370 | 13500 | "Edit a local kill file applied to the current newsgroup." |
745bc783 | 13501 | (interactive) |
41487370 | 13502 | (gnus-set-global-variables) |
231f989b | 13503 | (setq gnus-current-headers (gnus-summary-article-header)) |
41487370 | 13504 | (gnus-set-global-variables) |
231f989b | 13505 | (gnus-group-edit-local-kill |
41487370 | 13506 | (gnus-summary-article-number) gnus-newsgroup-name)) |
745bc783 JB |
13507 | |
13508 | \f | |
13509 | ;;; | |
41487370 | 13510 | ;;; Gnus article mode |
745bc783 JB |
13511 | ;;; |
13512 | ||
41487370 LMI |
13513 | (put 'gnus-article-mode 'mode-class 'special) |
13514 | ||
b027f415 | 13515 | (if gnus-article-mode-map |
745bc783 | 13516 | nil |
b027f415 RS |
13517 | (setq gnus-article-mode-map (make-keymap)) |
13518 | (suppress-keymap gnus-article-mode-map) | |
41487370 | 13519 | |
231f989b LMI |
13520 | (gnus-define-keys gnus-article-mode-map |
13521 | " " gnus-article-goto-next-page | |
13522 | "\177" gnus-article-goto-prev-page | |
13523 | [delete] gnus-article-goto-prev-page | |
13524 | "\C-c^" gnus-article-refer-article | |
13525 | "h" gnus-article-show-summary | |
13526 | "s" gnus-article-show-summary | |
13527 | "\C-c\C-m" gnus-article-mail | |
13528 | "?" gnus-article-describe-briefly | |
13529 | gnus-mouse-2 gnus-article-push-button | |
13530 | "\r" gnus-article-press-button | |
13531 | "\t" gnus-article-next-button | |
13532 | "\M-\t" gnus-article-prev-button | |
13533 | "<" beginning-of-buffer | |
13534 | ">" end-of-buffer | |
564b670b | 13535 | "\C-c\C-i" gnus-info-find-node |
231f989b LMI |
13536 | "\C-c\C-b" gnus-bug) |
13537 | ||
13538 | (substitute-key-definition | |
13539 | 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) | |
b027f415 RS |
13540 | |
13541 | (defun gnus-article-mode () | |
41487370 LMI |
13542 | "Major mode for displaying an article. |
13543 | ||
13544 | All normal editing commands are switched off. | |
13545 | ||
13546 | The following commands are available: | |
13547 | ||
13548 | \\<gnus-article-mode-map> | |
13549 | \\[gnus-article-next-page]\t Scroll the article one page forwards | |
13550 | \\[gnus-article-prev-page]\t Scroll the article one page backwards | |
13551 | \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point | |
13552 | \\[gnus-article-show-summary]\t Display the summary buffer | |
13553 | \\[gnus-article-mail]\t Send a reply to the address near point | |
13554 | \\[gnus-article-describe-briefly]\t Describe the current mode briefly | |
13555 | \\[gnus-info-find-node]\t Go to the Gnus info node" | |
745bc783 | 13556 | (interactive) |
231f989b LMI |
13557 | (when (and menu-bar-mode |
13558 | (gnus-visual-p 'article-menu 'menu)) | |
13559 | (gnus-article-make-menu-bar)) | |
745bc783 | 13560 | (kill-all-local-variables) |
a828a776 | 13561 | (gnus-simplify-mode-line) |
745bc783 | 13562 | (setq mode-name "Article") |
41487370 | 13563 | (setq major-mode 'gnus-article-mode) |
b027f415 RS |
13564 | (make-local-variable 'minor-mode-alist) |
13565 | (or (assq 'gnus-show-mime minor-mode-alist) | |
13566 | (setq minor-mode-alist | |
13567 | (cons (list 'gnus-show-mime " MIME") minor-mode-alist))) | |
b027f415 | 13568 | (use-local-map gnus-article-mode-map) |
745bc783 JB |
13569 | (make-local-variable 'page-delimiter) |
13570 | (setq page-delimiter gnus-page-delimiter) | |
41487370 | 13571 | (buffer-disable-undo (current-buffer)) |
745bc783 | 13572 | (setq buffer-read-only t) ;Disable modification |
b027f415 | 13573 | (run-hooks 'gnus-article-mode-hook)) |
745bc783 | 13574 | |
b027f415 | 13575 | (defun gnus-article-setup-buffer () |
231f989b LMI |
13576 | "Initialize the article buffer." |
13577 | (let* ((name (if gnus-single-article-buffer "*Article*" | |
13578 | (concat "*Article " gnus-newsgroup-name "*"))) | |
13579 | (original | |
13580 | (progn (string-match "\\*Article" name) | |
13581 | (concat " *Original Article" | |
13582 | (substring name (match-end 0)))))) | |
13583 | (setq gnus-article-buffer name) | |
13584 | (setq gnus-original-article-buffer original) | |
13585 | ;; This might be a variable local to the summary buffer. | |
13586 | (unless gnus-single-article-buffer | |
745bc783 | 13587 | (save-excursion |
231f989b LMI |
13588 | (set-buffer gnus-summary-buffer) |
13589 | (setq gnus-article-buffer name) | |
13590 | (setq gnus-original-article-buffer original) | |
13591 | (gnus-set-global-variables)) | |
13592 | (make-local-variable 'gnus-summary-buffer)) | |
13593 | ;; Init original article buffer. | |
41487370 | 13594 | (save-excursion |
231f989b LMI |
13595 | (set-buffer (get-buffer-create gnus-original-article-buffer)) |
13596 | (buffer-disable-undo (current-buffer)) | |
13597 | (setq major-mode 'gnus-original-article-mode) | |
13598 | (make-local-variable 'gnus-original-article)) | |
13599 | (if (get-buffer name) | |
13600 | (save-excursion | |
13601 | (set-buffer name) | |
13602 | (buffer-disable-undo (current-buffer)) | |
13603 | (setq buffer-read-only t) | |
13604 | (gnus-add-current-to-buffer-list) | |
13605 | (or (eq major-mode 'gnus-article-mode) | |
13606 | (gnus-article-mode)) | |
13607 | (current-buffer)) | |
13608 | (save-excursion | |
13609 | (set-buffer (get-buffer-create name)) | |
13610 | (gnus-add-current-to-buffer-list) | |
13611 | (gnus-article-mode) | |
13612 | (current-buffer))))) | |
41487370 LMI |
13613 | |
13614 | ;; Set article window start at LINE, where LINE is the number of lines | |
13615 | ;; from the head of the article. | |
13616 | (defun gnus-article-set-window-start (&optional line) | |
231f989b LMI |
13617 | (set-window-start |
13618 | (get-buffer-window gnus-article-buffer t) | |
41487370 LMI |
13619 | (save-excursion |
13620 | (set-buffer gnus-article-buffer) | |
13621 | (goto-char (point-min)) | |
13622 | (if (not line) | |
13623 | (point-min) | |
13624 | (gnus-message 6 "Moved to bookmark") | |
13625 | (search-forward "\n\n" nil t) | |
13626 | (forward-line line) | |
13627 | (point))))) | |
13628 | ||
231f989b LMI |
13629 | (defun gnus-kill-all-overlays () |
13630 | "Delete all overlays in the current buffer." | |
13631 | (when (fboundp 'overlay-lists) | |
13632 | (let* ((overlayss (overlay-lists)) | |
13633 | (buffer-read-only nil) | |
13634 | (overlays (nconc (car overlayss) (cdr overlayss)))) | |
13635 | (while overlays | |
13636 | (delete-overlay (pop overlays)))))) | |
13637 | ||
41487370 LMI |
13638 | (defun gnus-request-article-this-buffer (article group) |
13639 | "Get an article and insert it into this buffer." | |
231f989b LMI |
13640 | (let (do-update-line) |
13641 | (prog1 | |
13642 | (save-excursion | |
41487370 | 13643 | (erase-buffer) |
231f989b LMI |
13644 | (gnus-kill-all-overlays) |
13645 | (setq group (or group gnus-newsgroup-name)) | |
13646 | ||
13647 | ;; Open server if it has closed. | |
13648 | (gnus-check-server (gnus-find-method-for-group group)) | |
13649 | ||
13650 | ;; Using `gnus-request-article' directly will insert the article into | |
13651 | ;; `nntp-server-buffer' - so we'll save some time by not having to | |
13652 | ;; copy it from the server buffer into the article buffer. | |
13653 | ||
13654 | ;; We only request an article by message-id when we do not have the | |
13655 | ;; headers for it, so we'll have to get those. | |
13656 | (when (stringp article) | |
13657 | (let ((gnus-override-method gnus-refer-article-method)) | |
13658 | (gnus-read-header article))) | |
13659 | ||
13660 | ;; If the article number is negative, that means that this article | |
13661 | ;; doesn't belong in this newsgroup (possibly), so we find its | |
13662 | ;; message-id and request it by id instead of number. | |
13663 | (when (and (numberp article) | |
13664 | gnus-summary-buffer | |
13665 | (get-buffer gnus-summary-buffer) | |
13666 | (buffer-name (get-buffer gnus-summary-buffer))) | |
13667 | (save-excursion | |
13668 | (set-buffer gnus-summary-buffer) | |
13669 | (let ((header (gnus-summary-article-header article))) | |
13670 | (if (< article 0) | |
13671 | (cond | |
13672 | ((memq article gnus-newsgroup-sparse) | |
13673 | ;; This is a sparse gap article. | |
13674 | (setq do-update-line article) | |
13675 | (setq article (mail-header-id header)) | |
13676 | (let ((gnus-override-method gnus-refer-article-method)) | |
13677 | (gnus-read-header article)) | |
13678 | (setq gnus-newsgroup-sparse | |
13679 | (delq article gnus-newsgroup-sparse))) | |
13680 | ((vectorp header) | |
13681 | ;; It's a real article. | |
13682 | (setq article (mail-header-id header))) | |
13683 | (t | |
13684 | ;; It is an extracted pseudo-article. | |
13685 | (setq article 'pseudo) | |
13686 | (gnus-request-pseudo-article header)))) | |
13687 | ||
13688 | (let ((method (gnus-find-method-for-group | |
13689 | gnus-newsgroup-name))) | |
13690 | (if (not (eq (car method) 'nneething)) | |
13691 | () | |
13692 | (let ((dir (concat (file-name-as-directory (nth 1 method)) | |
13693 | (mail-header-subject header)))) | |
13694 | (if (file-directory-p dir) | |
13695 | (progn | |
13696 | (setq article 'nneething) | |
13697 | (gnus-group-enter-directory dir))))))))) | |
13698 | ||
13699 | (cond | |
13700 | ;; Refuse to select canceled articles. | |
13701 | ((and (numberp article) | |
13702 | gnus-summary-buffer | |
13703 | (get-buffer gnus-summary-buffer) | |
13704 | (buffer-name (get-buffer gnus-summary-buffer)) | |
13705 | (eq (cdr (save-excursion | |
13706 | (set-buffer gnus-summary-buffer) | |
13707 | (assq article gnus-newsgroup-reads))) | |
13708 | gnus-canceled-mark)) | |
13709 | nil) | |
13710 | ;; We first check `gnus-original-article-buffer'. | |
13711 | ((and (get-buffer gnus-original-article-buffer) | |
13712 | (numberp article) | |
13713 | (save-excursion | |
13714 | (set-buffer gnus-original-article-buffer) | |
13715 | (and (equal (car gnus-original-article) group) | |
13716 | (eq (cdr gnus-original-article) article)))) | |
13717 | (insert-buffer-substring gnus-original-article-buffer) | |
13718 | 'article) | |
13719 | ;; Check the backlog. | |
13720 | ((and gnus-keep-backlog | |
13721 | (gnus-backlog-request-article group article (current-buffer))) | |
13722 | 'article) | |
13723 | ;; Check the cache. | |
13724 | ((and gnus-use-cache | |
13725 | (numberp article) | |
13726 | (gnus-cache-request-article article group)) | |
13727 | 'article) | |
13728 | ;; Get the article and put into the article buffer. | |
13729 | ((or (stringp article) (numberp article)) | |
13730 | (let ((gnus-override-method | |
13731 | (and (stringp article) gnus-refer-article-method)) | |
13732 | (buffer-read-only nil)) | |
13733 | (erase-buffer) | |
13734 | (gnus-kill-all-overlays) | |
13735 | (if (gnus-request-article article group (current-buffer)) | |
13736 | (progn | |
13737 | (and gnus-keep-backlog | |
13738 | (numberp article) | |
13739 | (gnus-backlog-enter-article | |
13740 | group article (current-buffer))) | |
13741 | 'article)))) | |
13742 | ;; It was a pseudo. | |
13743 | (t article))) | |
13744 | ||
13745 | ;; Take the article from the original article buffer | |
13746 | ;; and place it in the buffer it's supposed to be in. | |
13747 | (when (and (get-buffer gnus-article-buffer) | |
13748 | ;;(numberp article) | |
13749 | (equal (buffer-name (current-buffer)) | |
13750 | (buffer-name (get-buffer gnus-article-buffer)))) | |
13751 | (save-excursion | |
13752 | (if (get-buffer gnus-original-article-buffer) | |
13753 | (set-buffer (get-buffer gnus-original-article-buffer)) | |
13754 | (set-buffer (get-buffer-create gnus-original-article-buffer)) | |
13755 | (buffer-disable-undo (current-buffer)) | |
13756 | (setq major-mode 'gnus-original-article-mode) | |
13757 | (setq buffer-read-only t) | |
13758 | (gnus-add-current-to-buffer-list)) | |
13759 | (let (buffer-read-only) | |
13760 | (erase-buffer) | |
13761 | (insert-buffer-substring gnus-article-buffer)) | |
13762 | (setq gnus-original-article (cons group article)))) | |
13763 | ||
13764 | ;; Update sparse articles. | |
13765 | (when (and do-update-line | |
13766 | (or (numberp article) | |
13767 | (stringp article))) | |
13768 | (let ((buf (current-buffer))) | |
13769 | (set-buffer gnus-summary-buffer) | |
13770 | (gnus-summary-update-article do-update-line) | |
13771 | (gnus-summary-goto-subject do-update-line nil t) | |
13772 | (set-window-point (get-buffer-window (current-buffer) t) | |
13773 | (point)) | |
13774 | (set-buffer buf)))))) | |
41487370 | 13775 | |
231f989b | 13776 | (defun gnus-read-header (id &optional header) |
41487370 | 13777 | "Read the headers of article ID and enter them into the Gnus system." |
231f989b LMI |
13778 | (let ((group gnus-newsgroup-name) |
13779 | (gnus-override-method | |
13780 | (and (gnus-news-group-p gnus-newsgroup-name) | |
13781 | gnus-refer-article-method)) | |
13782 | where) | |
13783 | ;; First we check to see whether the header in question is already | |
13784 | ;; fetched. | |
13785 | (if (stringp id) | |
13786 | ;; This is a Message-ID. | |
13787 | (setq header (or header (gnus-id-to-header id))) | |
13788 | ;; This is an article number. | |
13789 | (setq header (or header (gnus-summary-article-header id)))) | |
13790 | (if (and header | |
13791 | (not (memq (mail-header-number header) gnus-newsgroup-sparse))) | |
13792 | ;; We have found the header. | |
13793 | header | |
13794 | ;; We have to really fetch the header to this article. | |
13795 | (when (setq where (gnus-request-head id group)) | |
13796 | (save-excursion | |
13797 | (set-buffer nntp-server-buffer) | |
13798 | (goto-char (point-max)) | |
13799 | (insert ".\n") | |
13800 | (goto-char (point-min)) | |
13801 | (insert "211 ") | |
13802 | (princ (cond | |
13803 | ((numberp id) id) | |
13804 | ((cdr where) (cdr where)) | |
13805 | (header (mail-header-number header)) | |
13806 | (t gnus-reffed-article-number)) | |
13807 | (current-buffer)) | |
13808 | (insert " Article retrieved.\n")) | |
13809 | ;(when (and header | |
13810 | ; (memq (mail-header-number header) gnus-newsgroup-sparse)) | |
13811 | ; (setcar (gnus-id-to-thread id) nil)) | |
13812 | (if (not (setq header (car (gnus-get-newsgroup-headers)))) | |
13813 | () ; Malformed head. | |
13814 | (unless (memq (mail-header-number header) gnus-newsgroup-sparse) | |
13815 | (if (and (stringp id) | |
13816 | (not (string= (gnus-group-real-name group) | |
13817 | (car where)))) | |
13818 | ;; If we fetched by Message-ID and the article came | |
13819 | ;; from a different group, we fudge some bogus article | |
13820 | ;; numbers for this article. | |
13821 | (mail-header-set-number header gnus-reffed-article-number)) | |
13822 | (decf gnus-reffed-article-number) | |
13823 | (gnus-remove-header (mail-header-number header)) | |
13824 | (push header gnus-newsgroup-headers) | |
13825 | (setq gnus-current-headers header) | |
13826 | (push (mail-header-number header) gnus-newsgroup-limit)) | |
13827 | header))))) | |
13828 | ||
13829 | (defun gnus-remove-header (number) | |
13830 | "Remove header NUMBER from `gnus-newsgroup-headers'." | |
13831 | (if (and gnus-newsgroup-headers | |
13832 | (= number (mail-header-number (car gnus-newsgroup-headers)))) | |
13833 | (pop gnus-newsgroup-headers) | |
13834 | (let ((headers gnus-newsgroup-headers)) | |
13835 | (while (and (cdr headers) | |
13836 | (not (= number (mail-header-number (cadr headers))))) | |
13837 | (pop headers)) | |
13838 | (when (cdr headers) | |
13839 | (setcdr headers (cddr headers)))))) | |
41487370 LMI |
13840 | |
13841 | (defun gnus-article-prepare (article &optional all-headers header) | |
13842 | "Prepare ARTICLE in article mode buffer. | |
13843 | ARTICLE should either be an article number or a Message-ID. | |
13844 | If ARTICLE is an id, HEADER should be the article headers. | |
13845 | If ALL-HEADERS is non-nil, no headers are hidden." | |
745bc783 | 13846 | (save-excursion |
41487370 | 13847 | ;; Make sure we start in a summary buffer. |
231f989b LMI |
13848 | (unless (eq major-mode 'gnus-summary-mode) |
13849 | (set-buffer gnus-summary-buffer)) | |
41487370 LMI |
13850 | (setq gnus-summary-buffer (current-buffer)) |
13851 | ;; Make sure the connection to the server is alive. | |
231f989b LMI |
13852 | (unless (gnus-server-opened |
13853 | (gnus-find-method-for-group gnus-newsgroup-name)) | |
13854 | (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) | |
13855 | (gnus-request-group gnus-newsgroup-name t)) | |
41487370 LMI |
13856 | (let* ((article (if header (mail-header-number header) article)) |
13857 | (summary-buffer (current-buffer)) | |
13858 | (internal-hook gnus-article-internal-prepare-hook) | |
13859 | (group gnus-newsgroup-name) | |
13860 | result) | |
13861 | (save-excursion | |
13862 | (gnus-article-setup-buffer) | |
13863 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
13864 | ;; Deactivate active regions. |
13865 | (when (and (boundp 'transient-mark-mode) | |
13866 | transient-mark-mode) | |
13867 | (setq mark-active nil)) | |
41487370 | 13868 | (if (not (setq result (let ((buffer-read-only nil)) |
231f989b | 13869 | (gnus-request-article-this-buffer |
41487370 LMI |
13870 | article group)))) |
13871 | ;; There is no such article. | |
13872 | (save-excursion | |
231f989b LMI |
13873 | (when (and (numberp article) |
13874 | (not (memq article gnus-newsgroup-sparse))) | |
13875 | (setq gnus-article-current | |
41487370 LMI |
13876 | (cons gnus-newsgroup-name article)) |
13877 | (set-buffer gnus-summary-buffer) | |
13878 | (setq gnus-current-article article) | |
13879 | (gnus-summary-mark-article article gnus-canceled-mark)) | |
231f989b LMI |
13880 | (unless (memq article gnus-newsgroup-sparse) |
13881 | (gnus-error | |
13882 | 1 "No such article (may have expired or been canceled)"))) | |
41487370 LMI |
13883 | (if (or (eq result 'pseudo) (eq result 'nneething)) |
13884 | (progn | |
13885 | (save-excursion | |
13886 | (set-buffer summary-buffer) | |
13887 | (setq gnus-last-article gnus-current-article | |
13888 | gnus-newsgroup-history (cons gnus-current-article | |
13889 | gnus-newsgroup-history) | |
13890 | gnus-current-article 0 | |
13891 | gnus-current-headers nil | |
13892 | gnus-article-current nil) | |
13893 | (if (eq result 'nneething) | |
13894 | (gnus-configure-windows 'summary) | |
13895 | (gnus-configure-windows 'article)) | |
13896 | (gnus-set-global-variables)) | |
13897 | (gnus-set-mode-line 'article)) | |
13898 | ;; The result from the `request' was an actual article - | |
13899 | ;; or at least some text that is now displayed in the | |
13900 | ;; article buffer. | |
745bc783 JB |
13901 | (if (and (numberp article) |
13902 | (not (eq article gnus-current-article))) | |
41487370 LMI |
13903 | ;; Seems like a new article has been selected. |
13904 | ;; `gnus-current-article' must be an article number. | |
13905 | (save-excursion | |
13906 | (set-buffer summary-buffer) | |
13907 | (setq gnus-last-article gnus-current-article | |
13908 | gnus-newsgroup-history (cons gnus-current-article | |
13909 | gnus-newsgroup-history) | |
13910 | gnus-current-article article | |
231f989b LMI |
13911 | gnus-current-headers |
13912 | (gnus-summary-article-header gnus-current-article) | |
13913 | gnus-article-current | |
41487370 | 13914 | (cons gnus-newsgroup-name gnus-current-article)) |
231f989b LMI |
13915 | (unless (vectorp gnus-current-headers) |
13916 | (setq gnus-current-headers nil)) | |
41487370 | 13917 | (gnus-summary-show-thread) |
b027f415 | 13918 | (run-hooks 'gnus-mark-article-hook) |
41487370 | 13919 | (gnus-set-mode-line 'summary) |
231f989b | 13920 | (and (gnus-visual-p 'article-highlight 'highlight) |
41487370 LMI |
13921 | (run-hooks 'gnus-visual-mark-article-hook)) |
13922 | ;; Set the global newsgroup variables here. | |
13923 | ;; Suggested by Jim Sisolak | |
13924 | ;; <sisolak@trans4.neep.wisc.edu>. | |
13925 | (gnus-set-global-variables) | |
231f989b | 13926 | (setq gnus-have-all-headers |
41487370 | 13927 | (or all-headers gnus-show-all-headers)) |
231f989b LMI |
13928 | (and gnus-use-cache |
13929 | (vectorp (gnus-summary-article-header article)) | |
41487370 LMI |
13930 | (gnus-cache-possibly-enter-article |
13931 | group article | |
231f989b | 13932 | (gnus-summary-article-header article) |
41487370 LMI |
13933 | (memq article gnus-newsgroup-marked) |
13934 | (memq article gnus-newsgroup-dormant) | |
13935 | (memq article gnus-newsgroup-unreads))))) | |
231f989b LMI |
13936 | (when (or (numberp article) |
13937 | (stringp article)) | |
13938 | ;; Hooks for getting information from the article. | |
13939 | ;; This hook must be called before being narrowed. | |
13940 | (let (buffer-read-only) | |
13941 | (run-hooks 'internal-hook) | |
13942 | (run-hooks 'gnus-article-prepare-hook) | |
13943 | ;; Decode MIME message. | |
13944 | (if gnus-show-mime | |
13945 | (if (or (not gnus-strict-mime) | |
13946 | (gnus-fetch-field "Mime-Version")) | |
13947 | (funcall gnus-show-mime-method) | |
13948 | (funcall gnus-decode-encoded-word-method))) | |
13949 | ;; Perform the article display hooks. | |
13950 | (run-hooks 'gnus-article-display-hook)) | |
13951 | ;; Do page break. | |
13952 | (goto-char (point-min)) | |
13953 | (and gnus-break-pages (gnus-narrow-to-page))) | |
41487370 LMI |
13954 | (gnus-set-mode-line 'article) |
13955 | (gnus-configure-windows 'article) | |
13956 | (goto-char (point-min)) | |
13957 | t)))))) | |
745bc783 | 13958 | |
b027f415 | 13959 | (defun gnus-article-show-all-headers () |
41487370 | 13960 | "Show all article headers in article mode buffer." |
231f989b | 13961 | (save-excursion |
41487370 LMI |
13962 | (gnus-article-setup-buffer) |
13963 | (set-buffer gnus-article-buffer) | |
13964 | (let ((buffer-read-only nil)) | |
231f989b | 13965 | (gnus-unhide-text (point-min) (point-max))))) |
745bc783 | 13966 | |
41487370 LMI |
13967 | (defun gnus-article-hide-headers-if-wanted () |
13968 | "Hide unwanted headers if `gnus-have-all-headers' is nil. | |
b94ae5f7 | 13969 | Provided for backwards compatibility." |
41487370 | 13970 | (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) |
231f989b | 13971 | gnus-inhibit-hiding |
41487370 | 13972 | (gnus-article-hide-headers))) |
745bc783 | 13973 | |
231f989b LMI |
13974 | (defsubst gnus-article-header-rank () |
13975 | "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." | |
13976 | (let ((list gnus-sorted-header-list) | |
13977 | (i 0)) | |
13978 | (while list | |
13979 | (when (looking-at (car list)) | |
13980 | (setq list nil)) | |
13981 | (setq list (cdr list)) | |
13982 | (incf i)) | |
13983 | i)) | |
13984 | ||
13985 | (defun gnus-article-hide-headers (&optional arg delete) | |
13986 | "Toggle whether to hide unwanted headers and possibly sort them as well. | |
13987 | If given a negative prefix, always show; if given a positive prefix, | |
13988 | always hide." | |
13989 | (interactive (gnus-hidden-arg)) | |
13990 | (if (gnus-article-check-hidden-text 'headers arg) | |
13991 | ;; Show boring headers as well. | |
13992 | (gnus-article-show-hidden-text 'boring-headers) | |
13993 | ;; This function might be inhibited. | |
13994 | (unless gnus-inhibit-hiding | |
13995 | (save-excursion | |
13996 | (set-buffer gnus-article-buffer) | |
13997 | (save-restriction | |
13998 | (let ((buffer-read-only nil) | |
13999 | (props (nconc (list 'gnus-type 'headers) | |
14000 | gnus-hidden-properties)) | |
14001 | (max (1+ (length gnus-sorted-header-list))) | |
14002 | (ignored (when (not (stringp gnus-visible-headers)) | |
14003 | (cond ((stringp gnus-ignored-headers) | |
14004 | gnus-ignored-headers) | |
14005 | ((listp gnus-ignored-headers) | |
14006 | (mapconcat 'identity gnus-ignored-headers | |
14007 | "\\|"))))) | |
14008 | (visible | |
14009 | (cond ((stringp gnus-visible-headers) | |
14010 | gnus-visible-headers) | |
14011 | ((and gnus-visible-headers | |
14012 | (listp gnus-visible-headers)) | |
14013 | (mapconcat 'identity gnus-visible-headers "\\|")))) | |
14014 | (inhibit-point-motion-hooks t) | |
14015 | want-list beg) | |
14016 | ;; First we narrow to just the headers. | |
14017 | (widen) | |
14018 | (goto-char (point-min)) | |
14019 | ;; Hide any "From " lines at the beginning of (mail) articles. | |
14020 | (while (looking-at "From ") | |
14021 | (forward-line 1)) | |
14022 | (unless (bobp) | |
14023 | (if delete | |
14024 | (delete-region (point-min) (point)) | |
14025 | (gnus-hide-text (point-min) (point) props))) | |
14026 | ;; Then treat the rest of the header lines. | |
14027 | (narrow-to-region | |
14028 | (point) | |
14029 | (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) | |
14030 | ;; Then we use the two regular expressions | |
14031 | ;; `gnus-ignored-headers' and `gnus-visible-headers' to | |
14032 | ;; select which header lines is to remain visible in the | |
14033 | ;; article buffer. | |
14034 | (goto-char (point-min)) | |
14035 | (while (re-search-forward "^[^ \t]*:" nil t) | |
14036 | (beginning-of-line) | |
14037 | ;; We add the headers we want to keep to a list and delete | |
14038 | ;; them from the buffer. | |
14039 | (gnus-put-text-property | |
14040 | (point) (1+ (point)) 'message-rank | |
14041 | (if (or (and visible (looking-at visible)) | |
14042 | (and ignored | |
14043 | (not (looking-at ignored)))) | |
14044 | (gnus-article-header-rank) | |
14045 | (+ 2 max))) | |
14046 | (forward-line 1)) | |
14047 | (message-sort-headers-1) | |
14048 | (when (setq beg (text-property-any | |
14049 | (point-min) (point-max) 'message-rank (+ 2 max))) | |
14050 | ;; We make the unwanted headers invisible. | |
14051 | (if delete | |
14052 | (delete-region beg (point-max)) | |
14053 | ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>. | |
14054 | (gnus-hide-text-type beg (point-max) 'headers)) | |
14055 | ;; Work around XEmacs lossage. | |
14056 | (gnus-put-text-property (point-min) beg 'invisible nil)))))))) | |
14057 | ||
14058 | (defun gnus-article-hide-boring-headers (&optional arg) | |
14059 | "Toggle hiding of headers that aren't very interesting. | |
14060 | If given a negative prefix, always show; if given a positive prefix, | |
14061 | always hide." | |
14062 | (interactive (gnus-hidden-arg)) | |
14063 | (unless (gnus-article-check-hidden-text 'boring-headers arg) | |
14064 | (save-excursion | |
14065 | (set-buffer gnus-article-buffer) | |
14066 | (save-restriction | |
14067 | (let ((buffer-read-only nil) | |
14068 | (list gnus-boring-article-headers) | |
14069 | (inhibit-point-motion-hooks t) | |
14070 | elem) | |
14071 | (nnheader-narrow-to-headers) | |
14072 | (while list | |
14073 | (setq elem (pop list)) | |
14074 | (goto-char (point-min)) | |
14075 | (cond | |
14076 | ;; Hide empty headers. | |
14077 | ((eq elem 'empty) | |
14078 | (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t) | |
14079 | (forward-line -1) | |
14080 | (gnus-hide-text-type | |
14081 | (progn (beginning-of-line) (point)) | |
14082 | (progn | |
14083 | (end-of-line) | |
14084 | (if (re-search-forward "^[^ \t]" nil t) | |
14085 | (match-beginning 0) | |
14086 | (point-max))) | |
14087 | 'boring-headers))) | |
14088 | ;; Hide boring Newsgroups header. | |
14089 | ((eq elem 'newsgroups) | |
14090 | (when (equal (message-fetch-field "newsgroups") | |
14091 | (gnus-group-real-name gnus-newsgroup-name)) | |
14092 | (gnus-article-hide-header "newsgroups"))) | |
14093 | ((eq elem 'followup-to) | |
14094 | (when (equal (message-fetch-field "followup-to") | |
14095 | (message-fetch-field "newsgroups")) | |
14096 | (gnus-article-hide-header "followup-to"))) | |
14097 | ((eq elem 'reply-to) | |
14098 | (let ((from (message-fetch-field "from")) | |
14099 | (reply-to (message-fetch-field "reply-to"))) | |
14100 | (when (and | |
14101 | from reply-to | |
14102 | (equal | |
14103 | (nth 1 (funcall gnus-extract-address-components from)) | |
14104 | (nth 1 (funcall gnus-extract-address-components | |
14105 | reply-to)))) | |
14106 | (gnus-article-hide-header "reply-to")))) | |
14107 | ((eq elem 'date) | |
14108 | (let ((date (message-fetch-field "date"))) | |
14109 | (when (and date | |
14110 | (< (gnus-days-between date (current-time-string)) | |
14111 | 4)) | |
14112 | (gnus-article-hide-header "date"))))))))))) | |
14113 | ||
14114 | (defun gnus-article-hide-header (header) | |
41487370 | 14115 | (save-excursion |
231f989b LMI |
14116 | (goto-char (point-min)) |
14117 | (when (re-search-forward (concat "^" header ":") nil t) | |
14118 | (gnus-hide-text-type | |
14119 | (progn (beginning-of-line) (point)) | |
14120 | (progn | |
14121 | (end-of-line) | |
14122 | (if (re-search-forward "^[^ \t]" nil t) | |
14123 | (match-beginning 0) | |
14124 | (point-max))) | |
14125 | 'boring-headers)))) | |
41487370 LMI |
14126 | |
14127 | ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>. | |
14128 | (defun gnus-article-treat-overstrike () | |
14129 | "Translate overstrikes into bold text." | |
745bc783 | 14130 | (interactive) |
41487370 LMI |
14131 | (save-excursion |
14132 | (set-buffer gnus-article-buffer) | |
14133 | (let ((buffer-read-only nil)) | |
14134 | (while (search-forward "\b" nil t) | |
14135 | (let ((next (following-char)) | |
14136 | (previous (char-after (- (point) 2)))) | |
231f989b LMI |
14137 | (cond |
14138 | ((eq next previous) | |
14139 | (gnus-put-text-property (- (point) 2) (point) 'invisible t) | |
14140 | (gnus-put-text-property (point) (1+ (point)) 'face 'bold)) | |
14141 | ((eq next ?_) | |
14142 | (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t) | |
14143 | (gnus-put-text-property | |
14144 | (- (point) 2) (1- (point)) 'face 'underline)) | |
14145 | ((eq previous ?_) | |
14146 | (gnus-put-text-property (- (point) 2) (point) 'invisible t) | |
14147 | (gnus-put-text-property | |
14148 | (point) (1+ (point)) 'face 'underline)))))))) | |
41487370 LMI |
14149 | |
14150 | (defun gnus-article-word-wrap () | |
14151 | "Format too long lines." | |
745bc783 | 14152 | (interactive) |
41487370 LMI |
14153 | (save-excursion |
14154 | (set-buffer gnus-article-buffer) | |
14155 | (let ((buffer-read-only nil)) | |
231f989b | 14156 | (widen) |
41487370 LMI |
14157 | (goto-char (point-min)) |
14158 | (search-forward "\n\n" nil t) | |
14159 | (end-of-line 1) | |
14160 | (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") | |
14161 | (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") | |
14162 | (adaptive-fill-mode t)) | |
14163 | (while (not (eobp)) | |
14164 | (and (>= (current-column) (min fill-column (window-width))) | |
14165 | (/= (preceding-char) ?:) | |
14166 | (fill-paragraph nil)) | |
14167 | (end-of-line 2)))))) | |
14168 | ||
14169 | (defun gnus-article-remove-cr () | |
14170 | "Remove carriage returns from an article." | |
745bc783 | 14171 | (interactive) |
41487370 LMI |
14172 | (save-excursion |
14173 | (set-buffer gnus-article-buffer) | |
14174 | (let ((buffer-read-only nil)) | |
14175 | (goto-char (point-min)) | |
14176 | (while (search-forward "\r" nil t) | |
14177 | (replace-match "" t t))))) | |
745bc783 | 14178 | |
231f989b LMI |
14179 | (defun gnus-article-remove-trailing-blank-lines () |
14180 | "Remove all trailing blank lines from the article." | |
14181 | (interactive) | |
14182 | (save-excursion | |
14183 | (set-buffer gnus-article-buffer) | |
14184 | (let ((buffer-read-only nil)) | |
14185 | (goto-char (point-max)) | |
14186 | (delete-region | |
14187 | (point) | |
14188 | (progn | |
14189 | (while (looking-at "^[ \t]*$") | |
14190 | (forward-line -1)) | |
14191 | (forward-line 1) | |
14192 | (point)))))) | |
14193 | ||
41487370 LMI |
14194 | (defun gnus-article-display-x-face (&optional force) |
14195 | "Look for an X-Face header and display it if present." | |
14196 | (interactive (list 'force)) | |
14197 | (save-excursion | |
14198 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
14199 | ;; Delete the old process, if any. |
14200 | (when (process-status "gnus-x-face") | |
14201 | (delete-process "gnus-x-face")) | |
41487370 LMI |
14202 | (let ((inhibit-point-motion-hooks t) |
14203 | (case-fold-search nil) | |
14204 | from) | |
14205 | (save-restriction | |
231f989b LMI |
14206 | (nnheader-narrow-to-headers) |
14207 | (setq from (message-fetch-field "from")) | |
41487370 | 14208 | (goto-char (point-min)) |
231f989b LMI |
14209 | (when (and gnus-article-x-face-command |
14210 | (or force | |
14211 | ;; Check whether this face is censored. | |
14212 | (not gnus-article-x-face-too-ugly) | |
14213 | (and gnus-article-x-face-too-ugly from | |
14214 | (not (string-match gnus-article-x-face-too-ugly | |
14215 | from)))) | |
14216 | ;; Has to be present. | |
14217 | (re-search-forward "^X-Face: " nil t)) | |
14218 | ;; We now have the area of the buffer where the X-Face is stored. | |
41487370 LMI |
14219 | (let ((beg (point)) |
14220 | (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) | |
231f989b | 14221 | ;; We display the face. |
41487370 | 14222 | (if (symbolp gnus-article-x-face-command) |
231f989b LMI |
14223 | ;; The command is a lisp function, so we call it. |
14224 | (if (gnus-functionp gnus-article-x-face-command) | |
14225 | (funcall gnus-article-x-face-command beg end) | |
14226 | (error "%s is not a function" gnus-article-x-face-command)) | |
14227 | ;; The command is a string, so we interpret the command | |
14228 | ;; as a, well, command, and fork it off. | |
14229 | (let ((process-connection-type nil)) | |
14230 | (process-kill-without-query | |
14231 | (start-process | |
14232 | "gnus-x-face" nil shell-file-name shell-command-switch | |
14233 | gnus-article-x-face-command)) | |
14234 | (process-send-region "gnus-x-face" beg end) | |
14235 | (process-send-eof "gnus-x-face"))))))))) | |
14236 | ||
14237 | (defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522) | |
14238 | (defun gnus-decode-rfc1522 () | |
14239 | "Hack to remove QP encoding from headers." | |
14240 | (let ((case-fold-search t) | |
14241 | (inhibit-point-motion-hooks t) | |
14242 | (buffer-read-only nil) | |
14243 | string) | |
14244 | (save-restriction | |
14245 | (narrow-to-region | |
14246 | (goto-char (point-min)) | |
14247 | (or (search-forward "\n\n" nil t) (point-max))) | |
14248 | ||
68f44e92 | 14249 | (goto-char (point-min)) |
231f989b LMI |
14250 | (while (re-search-forward |
14251 | "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) | |
14252 | (setq string (match-string 1)) | |
14253 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
14254 | (delete-region (point-min) (point-max)) | |
14255 | (insert string) | |
14256 | (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) | |
14257 | (subst-char-in-region (point-min) (point-max) ?_ ? ) | |
14258 | (widen) | |
14259 | (goto-char (point-min)))))) | |
41487370 LMI |
14260 | |
14261 | (defun gnus-article-de-quoted-unreadable (&optional force) | |
14262 | "Do a naive translation of a quoted-printable-encoded article. | |
14263 | This is in no way, shape or form meant as a replacement for real MIME | |
14264 | processing, but is simply a stop-gap measure until MIME support is | |
14265 | written. | |
14266 | If FORCE, decode the article whether it is marked as quoted-printable | |
231f989b | 14267 | or not." |
41487370 LMI |
14268 | (interactive (list 'force)) |
14269 | (save-excursion | |
14270 | (set-buffer gnus-article-buffer) | |
14271 | (let ((case-fold-search t) | |
14272 | (buffer-read-only nil) | |
14273 | (type (gnus-fetch-field "content-transfer-encoding"))) | |
231f989b LMI |
14274 | (gnus-decode-rfc1522) |
14275 | (when (or force | |
14276 | (and type (string-match "quoted-printable" (downcase type)))) | |
14277 | (goto-char (point-min)) | |
14278 | (search-forward "\n\n" nil 'move) | |
14279 | (gnus-mime-decode-quoted-printable (point) (point-max)))))) | |
745bc783 | 14280 | |
41487370 | 14281 | (defun gnus-mime-decode-quoted-printable (from to) |
231f989b LMI |
14282 | "Decode Quoted-Printable in the region between FROM and TO." |
14283 | (interactive "r") | |
14284 | (goto-char from) | |
14285 | (while (search-forward "=" to t) | |
14286 | (cond ((eq (following-char) ?\n) | |
14287 | (delete-char -1) | |
14288 | (delete-char 1)) | |
14289 | ((looking-at "[0-9A-F][0-9A-F]") | |
14290 | (subst-char-in-region | |
14291 | (1- (point)) (point) ?= | |
14292 | (hexl-hex-string-to-integer | |
14293 | (buffer-substring (point) (+ 2 (point))))) | |
14294 | (delete-char 2)) | |
14295 | ((looking-at "=") | |
14296 | (delete-char 1)) | |
14297 | ((gnus-message 3 "Malformed MIME quoted-printable message"))))) | |
14298 | ||
14299 | (defun gnus-article-hide-pgp (&optional arg) | |
14300 | "Toggle hiding of any PGP headers and signatures in the current article. | |
14301 | If given a negative prefix, always show; if given a positive prefix, | |
14302 | always hide." | |
14303 | (interactive (gnus-hidden-arg)) | |
14304 | (unless (gnus-article-check-hidden-text 'pgp arg) | |
14305 | (save-excursion | |
14306 | (set-buffer gnus-article-buffer) | |
14307 | (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties)) | |
14308 | buffer-read-only beg end) | |
14309 | (widen) | |
14310 | (goto-char (point-min)) | |
14311 | ;; Hide the "header". | |
14312 | (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) | |
14313 | (gnus-hide-text (match-beginning 0) (match-end 0) props)) | |
14314 | (setq beg (point)) | |
14315 | ;; Hide the actual signature. | |
14316 | (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) | |
14317 | (setq end (1+ (match-beginning 0))) | |
14318 | (gnus-hide-text | |
14319 | end | |
14320 | (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) | |
14321 | (match-end 0) | |
14322 | ;; Perhaps we shouldn't hide to the end of the buffer | |
14323 | ;; if there is no end to the signature? | |
14324 | (point-max)) | |
14325 | props)) | |
14326 | ;; Hide "- " PGP quotation markers. | |
14327 | (when (and beg end) | |
14328 | (narrow-to-region beg end) | |
14329 | (goto-char (point-min)) | |
14330 | (while (re-search-forward "^- " nil t) | |
14331 | (gnus-hide-text (match-beginning 0) (match-end 0) props)) | |
14332 | (widen)))))) | |
14333 | ||
14334 | (defun gnus-article-hide-signature (&optional arg) | |
14335 | "Hide the signature in the current article. | |
14336 | If given a negative prefix, always show; if given a positive prefix, | |
14337 | always hide." | |
14338 | (interactive (gnus-hidden-arg)) | |
14339 | (unless (gnus-article-check-hidden-text 'signature arg) | |
14340 | (save-excursion | |
14341 | (set-buffer gnus-article-buffer) | |
14342 | (save-restriction | |
14343 | (let ((buffer-read-only nil)) | |
14344 | (when (gnus-narrow-to-signature) | |
14345 | (gnus-hide-text-type (point-min) (point-max) 'signature))))))) | |
14346 | ||
14347 | (defun gnus-article-strip-leading-blank-lines () | |
14348 | "Remove all blank lines from the beginning of the article." | |
14349 | (interactive) | |
14350 | (save-excursion | |
14351 | (set-buffer gnus-article-buffer) | |
14352 | (let (buffer-read-only) | |
14353 | (goto-char (point-min)) | |
14354 | (when (search-forward "\n\n" nil t) | |
14355 | (while (looking-at "[ \t]$") | |
14356 | (gnus-delete-line)))))) | |
14357 | ||
14358 | (defvar mime::preview/content-list) | |
14359 | (defvar mime::preview-content-info/point-min) | |
14360 | (defun gnus-narrow-to-signature () | |
14361 | "Narrow to the signature." | |
14362 | (widen) | |
14363 | (if (and (boundp 'mime::preview/content-list) | |
14364 | mime::preview/content-list) | |
14365 | (let ((pcinfo (car (last mime::preview/content-list)))) | |
14366 | (condition-case () | |
14367 | (narrow-to-region | |
14368 | (funcall (intern "mime::preview-content-info/point-min") pcinfo) | |
14369 | (point-max)) | |
14370 | (error nil)))) | |
14371 | (goto-char (point-max)) | |
14372 | (when (re-search-backward gnus-signature-separator nil t) | |
14373 | (forward-line 1) | |
14374 | (when (or (null gnus-signature-limit) | |
14375 | (and (numberp gnus-signature-limit) | |
14376 | (< (- (point-max) (point)) gnus-signature-limit)) | |
14377 | (and (gnus-functionp gnus-signature-limit) | |
14378 | (funcall gnus-signature-limit)) | |
14379 | (and (stringp gnus-signature-limit) | |
14380 | (not (re-search-forward gnus-signature-limit nil t)))) | |
14381 | (narrow-to-region (point) (point-max)) | |
14382 | t))) | |
14383 | ||
14384 | (defun gnus-hidden-arg () | |
14385 | "Return the current prefix arg as a number, or 0 if no prefix." | |
14386 | (list (if current-prefix-arg | |
14387 | (prefix-numeric-value current-prefix-arg) | |
14388 | 0))) | |
14389 | ||
14390 | (defun gnus-article-check-hidden-text (type arg) | |
14391 | "Return nil if hiding is necessary. | |
14392 | Arg can be nil or a number. Nil and positive means hide, negative | |
14393 | means show, 0 means toggle." | |
14394 | (save-excursion | |
14395 | (set-buffer gnus-article-buffer) | |
14396 | (let ((hide (gnus-article-hidden-text-p type))) | |
14397 | (cond | |
14398 | ((or (null arg) | |
14399 | (> arg 0)) | |
14400 | nil) | |
14401 | ((< arg 0) | |
14402 | (gnus-article-show-hidden-text type)) | |
14403 | (t | |
14404 | (if (eq hide 'hidden) | |
14405 | (gnus-article-show-hidden-text type) | |
14406 | nil)))))) | |
14407 | ||
14408 | (defun gnus-article-hidden-text-p (type) | |
14409 | "Say whether the current buffer contains hidden text of type TYPE." | |
14410 | (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))) | |
14411 | (when pos | |
14412 | (if (get-text-property pos 'invisible) | |
14413 | 'hidden | |
14414 | 'shown)))) | |
14415 | ||
14416 | (defun gnus-article-hide (&optional arg force) | |
14417 | "Hide all the gruft in the current article. | |
14418 | This means that PGP stuff, signatures, cited text and (some) | |
14419 | headers will be hidden. | |
14420 | If given a prefix, show the hidden text instead." | |
14421 | (interactive (list current-prefix-arg 'force)) | |
14422 | (gnus-article-hide-headers arg) | |
14423 | (gnus-article-hide-pgp arg) | |
14424 | (gnus-article-hide-citation-maybe arg force) | |
14425 | (gnus-article-hide-signature arg)) | |
14426 | ||
14427 | (defun gnus-article-show-hidden-text (type &optional hide) | |
14428 | "Show all hidden text of type TYPE. | |
14429 | If HIDE, hide the text instead." | |
41487370 | 14430 | (save-excursion |
231f989b LMI |
14431 | (set-buffer gnus-article-buffer) |
14432 | (let ((buffer-read-only nil) | |
14433 | (inhibit-point-motion-hooks t) | |
14434 | (beg (point-min))) | |
14435 | (while (gnus-goto-char (text-property-any | |
14436 | beg (point-max) 'gnus-type type)) | |
14437 | (setq beg (point)) | |
14438 | (forward-char) | |
14439 | (if hide | |
14440 | (gnus-hide-text beg (point) gnus-hidden-properties) | |
14441 | (gnus-unhide-text beg (point))) | |
14442 | (setq beg (point))) | |
14443 | t))) | |
41487370 LMI |
14444 | |
14445 | (defvar gnus-article-time-units | |
231f989b LMI |
14446 | `((year . ,(* 365.25 24 60 60)) |
14447 | (week . ,(* 7 24 60 60)) | |
14448 | (day . ,(* 24 60 60)) | |
14449 | (hour . ,(* 60 60)) | |
14450 | (minute . 60) | |
14451 | (second . 1)) | |
14452 | "Mapping from time units to seconds.") | |
14453 | ||
14454 | (defun gnus-article-date-ut (&optional type highlight) | |
41487370 LMI |
14455 | "Convert DATE date to universal time in the current article. |
14456 | If TYPE is `local', convert to local time; if it is `lapsed', output | |
14457 | how much time has lapsed since DATE." | |
231f989b LMI |
14458 | (interactive (list 'ut t)) |
14459 | (let* ((header (or gnus-current-headers | |
14460 | (gnus-summary-article-header) "")) | |
14461 | (date (and (vectorp header) (mail-header-date header))) | |
14462 | (date-regexp "^Date: \\|^X-Sent: ") | |
14463 | (now (current-time)) | |
14464 | (inhibit-point-motion-hooks t) | |
14465 | bface eface) | |
14466 | (when (and date (not (string= date ""))) | |
41487370 LMI |
14467 | (save-excursion |
14468 | (set-buffer gnus-article-buffer) | |
231f989b LMI |
14469 | (save-restriction |
14470 | (nnheader-narrow-to-headers) | |
14471 | (let ((buffer-read-only nil)) | |
14472 | ;; Delete any old Date headers. | |
14473 | (if (re-search-forward date-regexp nil t) | |
14474 | (progn | |
14475 | (setq bface (get-text-property (gnus-point-at-bol) 'face) | |
14476 | eface (get-text-property (1- (gnus-point-at-eol)) | |
14477 | 'face)) | |
14478 | (message-remove-header date-regexp t) | |
14479 | (beginning-of-line)) | |
14480 | (goto-char (point-max))) | |
14481 | (insert (gnus-make-date-line date type)) | |
14482 | ;; Do highlighting. | |
14483 | (forward-line -1) | |
14484 | (when (and (gnus-visual-p 'article-highlight 'highlight) | |
14485 | (looking-at "\\([^:]+\\): *\\(.*\\)$")) | |
14486 | (gnus-put-text-property (match-beginning 1) (match-end 1) | |
14487 | 'face bface) | |
14488 | (gnus-put-text-property (match-beginning 2) (match-end 2) | |
14489 | 'face eface)))))))) | |
14490 | ||
14491 | (defun gnus-make-date-line (date type) | |
14492 | "Return a DATE line of TYPE." | |
14493 | (cond | |
14494 | ;; Convert to the local timezone. We have to slap a | |
14495 | ;; `condition-case' round the calls to the timezone | |
14496 | ;; functions since they aren't particularly resistant to | |
14497 | ;; buggy dates. | |
14498 | ((eq type 'local) | |
14499 | (concat "Date: " (condition-case () | |
14500 | (timezone-make-date-arpa-standard date) | |
41487370 | 14501 | (error date)) |
231f989b LMI |
14502 | "\n")) |
14503 | ;; Convert to Universal Time. | |
14504 | ((eq type 'ut) | |
14505 | (concat "Date: " | |
14506 | (condition-case () | |
14507 | (timezone-make-date-arpa-standard date nil "UT") | |
14508 | (error date)) | |
14509 | "\n")) | |
14510 | ;; Get the original date from the article. | |
14511 | ((eq type 'original) | |
14512 | (concat "Date: " date "\n")) | |
14513 | ;; Do an X-Sent lapsed format. | |
14514 | ((eq type 'lapsed) | |
14515 | ;; If the date is seriously mangled, the timezone | |
14516 | ;; functions are liable to bug out, so we condition-case | |
14517 | ;; the entire thing. | |
14518 | (let* ((now (current-time)) | |
14519 | (real-time | |
14520 | (condition-case () | |
14521 | (gnus-time-minus | |
14522 | (gnus-encode-date | |
14523 | (timezone-make-date-arpa-standard | |
14524 | (current-time-string now) | |
14525 | (current-time-zone now) "UT")) | |
14526 | (gnus-encode-date | |
14527 | (timezone-make-date-arpa-standard | |
14528 | date nil "UT"))) | |
14529 | (error '(0 0)))) | |
14530 | (real-sec (+ (* (float (car real-time)) 65536) | |
14531 | (cadr real-time))) | |
14532 | (sec (abs real-sec)) | |
14533 | num prev) | |
14534 | (cond | |
14535 | ((equal real-time '(0 0)) | |
14536 | "X-Sent: Unknown\n") | |
14537 | ((zerop sec) | |
14538 | "X-Sent: Now\n") | |
14539 | (t | |
14540 | (concat | |
14541 | "X-Sent: " | |
14542 | ;; This is a bit convoluted, but basically we go | |
14543 | ;; through the time units for years, weeks, etc, | |
14544 | ;; and divide things to see whether that results | |
14545 | ;; in positive answers. | |
14546 | (mapconcat | |
14547 | (lambda (unit) | |
14548 | (if (zerop (setq num (ffloor (/ sec (cdr unit))))) | |
14549 | ;; The (remaining) seconds are too few to | |
14550 | ;; be divided into this time unit. | |
14551 | "" | |
14552 | ;; It's big enough, so we output it. | |
14553 | (setq sec (- sec (* num (cdr unit)))) | |
14554 | (prog1 | |
14555 | (concat (if prev ", " "") (int-to-string | |
14556 | (floor num)) | |
14557 | " " (symbol-name (car unit)) | |
14558 | (if (> num 1) "s" "")) | |
14559 | (setq prev t)))) | |
14560 | gnus-article-time-units "") | |
14561 | ;; If dates are odd, then it might appear like the | |
14562 | ;; article was sent in the future. | |
14563 | (if (> real-sec 0) | |
14564 | " ago\n" | |
14565 | " in the future\n")))))) | |
14566 | (t | |
14567 | (error "Unknown conversion type: %s" type)))) | |
745bc783 | 14568 | |
231f989b | 14569 | (defun gnus-article-date-local (&optional highlight) |
41487370 | 14570 | "Convert the current article date to the local timezone." |
231f989b LMI |
14571 | (interactive (list t)) |
14572 | (gnus-article-date-ut 'local highlight)) | |
14573 | ||
14574 | (defun gnus-article-date-original (&optional highlight) | |
14575 | "Convert the current article date to what it was originally. | |
14576 | This is only useful if you have used some other date conversion | |
14577 | function and want to see what the date was before converting." | |
14578 | (interactive (list t)) | |
14579 | (gnus-article-date-ut 'original highlight)) | |
745bc783 | 14580 | |
231f989b | 14581 | (defun gnus-article-date-lapsed (&optional highlight) |
41487370 | 14582 | "Convert the current article date to time lapsed since it was sent." |
231f989b LMI |
14583 | (interactive (list t)) |
14584 | (gnus-article-date-ut 'lapsed highlight)) | |
745bc783 | 14585 | |
41487370 LMI |
14586 | (defun gnus-article-maybe-highlight () |
14587 | "Do some article highlighting if `gnus-visual' is non-nil." | |
231f989b LMI |
14588 | (if (gnus-visual-p 'article-highlight 'highlight) |
14589 | (gnus-article-highlight-some))) | |
745bc783 | 14590 | |
231f989b | 14591 | ;;; Article savers. |
745bc783 JB |
14592 | |
14593 | (defun gnus-output-to-rmail (file-name) | |
14594 | "Append the current article to an Rmail file named FILE-NAME." | |
14595 | (require 'rmail) | |
14596 | ;; Most of these codes are borrowed from rmailout.el. | |
14597 | (setq file-name (expand-file-name file-name)) | |
f670fcba | 14598 | (setq rmail-default-rmail-file file-name) |
745bc783 | 14599 | (let ((artbuf (current-buffer)) |
41487370 | 14600 | (tmpbuf (get-buffer-create " *Gnus-output*"))) |
745bc783 JB |
14601 | (save-excursion |
14602 | (or (get-file-buffer file-name) | |
14603 | (file-exists-p file-name) | |
41487370 | 14604 | (if (gnus-yes-or-no-p |
745bc783 JB |
14605 | (concat "\"" file-name "\" does not exist, create it? ")) |
14606 | (let ((file-buffer (create-file-buffer file-name))) | |
14607 | (save-excursion | |
14608 | (set-buffer file-buffer) | |
14609 | (rmail-insert-rmail-file-header) | |
14610 | (let ((require-final-newline nil)) | |
14611 | (write-region (point-min) (point-max) file-name t 1))) | |
14612 | (kill-buffer file-buffer)) | |
14613 | (error "Output file does not exist"))) | |
14614 | (set-buffer tmpbuf) | |
41487370 | 14615 | (buffer-disable-undo (current-buffer)) |
745bc783 JB |
14616 | (erase-buffer) |
14617 | (insert-buffer-substring artbuf) | |
14618 | (gnus-convert-article-to-rmail) | |
14619 | ;; Decide whether to append to a file or to an Emacs buffer. | |
14620 | (let ((outbuf (get-file-buffer file-name))) | |
14621 | (if (not outbuf) | |
14622 | (append-to-file (point-min) (point-max) file-name) | |
14623 | ;; File has been visited, in buffer OUTBUF. | |
14624 | (set-buffer outbuf) | |
14625 | (let ((buffer-read-only nil) | |
14626 | (msg (and (boundp 'rmail-current-message) | |
41487370 | 14627 | (symbol-value 'rmail-current-message)))) |
745bc783 JB |
14628 | ;; If MSG is non-nil, buffer is in RMAIL mode. |
14629 | (if msg | |
14630 | (progn (widen) | |
14631 | (narrow-to-region (point-max) (point-max)))) | |
14632 | (insert-buffer-substring tmpbuf) | |
14633 | (if msg | |
14634 | (progn | |
14635 | (goto-char (point-min)) | |
14636 | (widen) | |
14637 | (search-backward "\^_") | |
14638 | (narrow-to-region (point) (point-max)) | |
14639 | (goto-char (1+ (point-min))) | |
14640 | (rmail-count-new-messages t) | |
41487370 LMI |
14641 | (rmail-show-message msg))))))) |
14642 | (kill-buffer tmpbuf))) | |
745bc783 JB |
14643 | |
14644 | (defun gnus-output-to-file (file-name) | |
14645 | "Append the current article to a file named FILE-NAME." | |
231f989b LMI |
14646 | (let ((artbuf (current-buffer))) |
14647 | (nnheader-temp-write nil | |
745bc783 JB |
14648 | (insert-buffer-substring artbuf) |
14649 | ;; Append newline at end of the buffer as separator, and then | |
14650 | ;; save it to file. | |
14651 | (goto-char (point-max)) | |
14652 | (insert "\n") | |
231f989b | 14653 | (append-to-file (point-min) (point-max) file-name)))) |
745bc783 JB |
14654 | |
14655 | (defun gnus-convert-article-to-rmail () | |
14656 | "Convert article in current buffer to Rmail message format." | |
14657 | (let ((buffer-read-only nil)) | |
14658 | ;; Convert article directly into Babyl format. | |
14659 | ;; Suggested by Rob Austein <sra@lcs.mit.edu> | |
14660 | (goto-char (point-min)) | |
14661 | (insert "\^L\n0, unseen,,\n*** EOOH ***\n") | |
14662 | (while (search-forward "\n\^_" nil t) ;single char | |
41487370 | 14663 | (replace-match "\n^_" t t)) ;2 chars: "^" and "_" |
745bc783 JB |
14664 | (goto-char (point-max)) |
14665 | (insert "\^_"))) | |
14666 | ||
41487370 | 14667 | (defun gnus-narrow-to-page (&optional arg) |
231f989b LMI |
14668 | "Narrow the article buffer to a page. |
14669 | If given a numerical ARG, move forward ARG pages." | |
41487370 LMI |
14670 | (interactive "P") |
14671 | (setq arg (if arg (prefix-numeric-value arg) 0)) | |
14672 | (save-excursion | |
231f989b LMI |
14673 | (set-buffer gnus-article-buffer) |
14674 | (goto-char (point-min)) | |
41487370 | 14675 | (widen) |
231f989b LMI |
14676 | (when (gnus-visual-p 'page-marker) |
14677 | (let ((buffer-read-only nil)) | |
14678 | (gnus-remove-text-with-property 'gnus-prev) | |
14679 | (gnus-remove-text-with-property 'gnus-next))) | |
14680 | (when | |
14681 | (cond ((< arg 0) | |
14682 | (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) | |
14683 | ((> arg 0) | |
14684 | (re-search-forward page-delimiter nil 'move arg))) | |
14685 | (goto-char (match-end 0))) | |
14686 | (narrow-to-region | |
14687 | (point) | |
14688 | (if (re-search-forward page-delimiter nil 'move) | |
14689 | (match-beginning 0) | |
14690 | (point))) | |
14691 | (when (and (gnus-visual-p 'page-marker) | |
14692 | (not (= (point-min) 1))) | |
14693 | (save-excursion | |
14694 | (goto-char (point-min)) | |
14695 | (gnus-insert-prev-page-button))) | |
14696 | (when (and (gnus-visual-p 'page-marker) | |
14697 | (not (= (1- (point-max)) (buffer-size)))) | |
14698 | (save-excursion | |
14699 | (goto-char (point-max)) | |
14700 | (gnus-insert-next-page-button))))) | |
745bc783 | 14701 | |
41487370 | 14702 | ;; Article mode commands |
745bc783 | 14703 | |
231f989b LMI |
14704 | (defun gnus-article-goto-next-page () |
14705 | "Show the next page of the article." | |
14706 | (interactive) | |
14707 | (when (gnus-article-next-page) | |
14708 | (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) | |
14709 | ||
14710 | (defun gnus-article-goto-prev-page () | |
14711 | "Show the next page of the article." | |
14712 | (interactive) | |
14713 | (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)) | |
14714 | (gnus-article-prev-page nil))) | |
14715 | ||
41487370 | 14716 | (defun gnus-article-next-page (&optional lines) |
231f989b LMI |
14717 | "Show the next page of the current article. |
14718 | If end of article, return non-nil. Otherwise return nil. | |
41487370 | 14719 | Argument LINES specifies lines to be scrolled up." |
231f989b | 14720 | (interactive "p") |
41487370 LMI |
14721 | (move-to-window-line -1) |
14722 | ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) | |
14723 | (if (save-excursion | |
14724 | (end-of-line) | |
14725 | (and (pos-visible-in-window-p) ;Not continuation line. | |
14726 | (eobp))) | |
14727 | ;; Nothing in this page. | |
14728 | (if (or (not gnus-break-pages) | |
14729 | (save-excursion | |
14730 | (save-restriction | |
14731 | (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? | |
14732 | t ;Nothing more. | |
14733 | (gnus-narrow-to-page 1) ;Go to next page. | |
14734 | nil) | |
14735 | ;; More in this page. | |
14736 | (condition-case () | |
14737 | (scroll-up lines) | |
14738 | (end-of-buffer | |
14739 | ;; Long lines may cause an end-of-buffer error. | |
14740 | (goto-char (point-max)))) | |
231f989b | 14741 | (move-to-window-line 0) |
41487370 | 14742 | nil)) |
b027f415 | 14743 | |
41487370 LMI |
14744 | (defun gnus-article-prev-page (&optional lines) |
14745 | "Show previous page of current article. | |
14746 | Argument LINES specifies lines to be scrolled down." | |
231f989b | 14747 | (interactive "p") |
41487370 LMI |
14748 | (move-to-window-line 0) |
14749 | (if (and gnus-break-pages | |
14750 | (bobp) | |
14751 | (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? | |
14752 | (progn | |
14753 | (gnus-narrow-to-page -1) ;Go to previous page. | |
14754 | (goto-char (point-max)) | |
14755 | (recenter -1)) | |
231f989b LMI |
14756 | (prog1 |
14757 | (condition-case () | |
14758 | (scroll-down lines) | |
14759 | (error nil)) | |
14760 | (move-to-window-line 0)))) | |
745bc783 | 14761 | |
41487370 LMI |
14762 | (defun gnus-article-refer-article () |
14763 | "Read article specified by message-id around point." | |
14764 | (interactive) | |
231f989b LMI |
14765 | (let ((point (point))) |
14766 | (search-forward ">" nil t) ;Move point to end of "<....>". | |
14767 | (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) | |
14768 | (let ((message-id (match-string 1))) | |
14769 | (goto-char point) | |
14770 | (set-buffer gnus-summary-buffer) | |
14771 | (gnus-summary-refer-article message-id)) | |
14772 | (goto-char (point)) | |
14773 | (error "No references around point")))) | |
745bc783 | 14774 | |
41487370 LMI |
14775 | (defun gnus-article-show-summary () |
14776 | "Reconfigure windows to show summary buffer." | |
14777 | (interactive) | |
14778 | (gnus-configure-windows 'article) | |
14779 | (gnus-summary-goto-subject gnus-current-article)) | |
745bc783 | 14780 | |
41487370 LMI |
14781 | (defun gnus-article-describe-briefly () |
14782 | "Describe article mode commands briefly." | |
745bc783 | 14783 | (interactive) |
41487370 | 14784 | (gnus-message 6 |
564b670b | 14785 | (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 | 14786 | |
41487370 LMI |
14787 | (defun gnus-article-summary-command () |
14788 | "Execute the last keystroke in the summary buffer." | |
745bc783 | 14789 | (interactive) |
41487370 LMI |
14790 | (let ((obuf (current-buffer)) |
14791 | (owin (current-window-configuration)) | |
14792 | func) | |
14793 | (switch-to-buffer gnus-summary-buffer 'norecord) | |
14794 | (setq func (lookup-key (current-local-map) (this-command-keys))) | |
14795 | (call-interactively func) | |
14796 | (set-buffer obuf) | |
14797 | (set-window-configuration owin) | |
14798 | (set-window-point (get-buffer-window (current-buffer)) (point)))) | |
14799 | ||
14800 | (defun gnus-article-summary-command-nosave () | |
14801 | "Execute the last keystroke in the summary buffer." | |
14802 | (interactive) | |
14803 | (let (func) | |
14804 | (pop-to-buffer gnus-summary-buffer 'norecord) | |
14805 | (setq func (lookup-key (current-local-map) (this-command-keys))) | |
14806 | (call-interactively func))) | |
745bc783 | 14807 | |
231f989b LMI |
14808 | (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) |
14809 | "Read a summary buffer key sequence and execute it from the article buffer." | |
14810 | (interactive "P") | |
14811 | (let ((nosaves | |
14812 | '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" | |
14813 | "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" | |
14814 | "=" "^" "\M-^" "|")) | |
564b670b LMI |
14815 | (nosave-but-article |
14816 | '("A\r")) | |
231f989b LMI |
14817 | keys) |
14818 | (save-excursion | |
14819 | (set-buffer gnus-summary-buffer) | |
14820 | (push (or key last-command-event) unread-command-events) | |
14821 | (setq keys (read-key-sequence nil))) | |
14822 | (message "") | |
14823 | ||
564b670b LMI |
14824 | (if (or (member keys nosaves) |
14825 | (member keys nosave-but-article)) | |
231f989b | 14826 | (let (func) |
564b670b LMI |
14827 | (save-window-excursion |
14828 | (pop-to-buffer gnus-summary-buffer 'norecord) | |
14829 | (setq func (lookup-key (current-local-map) keys))) | |
14830 | (if (not func) | |
14831 | (ding) | |
14832 | (set-buffer gnus-summary-buffer) | |
14833 | (call-interactively func)) | |
14834 | (when (member keys nosave-but-article) | |
14835 | (pop-to-buffer gnus-article-buffer 'norecord))) | |
231f989b LMI |
14836 | (let ((obuf (current-buffer)) |
14837 | (owin (current-window-configuration)) | |
14838 | (opoint (point)) | |
14839 | func in-buffer) | |
14840 | (if not-restore-window | |
14841 | (pop-to-buffer gnus-summary-buffer 'norecord) | |
14842 | (switch-to-buffer gnus-summary-buffer 'norecord)) | |
14843 | (setq in-buffer (current-buffer)) | |
14844 | (if (setq func (lookup-key (current-local-map) keys)) | |
14845 | (call-interactively func) | |
14846 | (ding)) | |
14847 | (when (eq in-buffer (current-buffer)) | |
14848 | (set-buffer obuf) | |
14849 | (unless not-restore-window | |
14850 | (set-window-configuration owin)) | |
14851 | (set-window-point (get-buffer-window (current-buffer)) opoint)))))) | |
14852 | ||
41487370 | 14853 | \f |
231f989b LMI |
14854 | ;;; |
14855 | ;;; Kill file handling. | |
14856 | ;;; | |
41487370 LMI |
14857 | |
14858 | ;;;###autoload | |
14859 | (defalias 'gnus-batch-kill 'gnus-batch-score) | |
14860 | ;;;###autoload | |
14861 | (defun gnus-batch-score () | |
14862 | "Run batched scoring. | |
14863 | Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ... | |
14864 | Newsgroups is a list of strings in Bnews format. If you want to score | |
231f989b | 14865 | the comp hierarchy, you'd say \"comp.all\". If you would not like to |
41487370 LMI |
14866 | score the alt hierarchy, you'd say \"!alt.all\"." |
14867 | (interactive) | |
14868 | (let* ((yes-and-no | |
14869 | (gnus-newsrc-parse-options | |
14870 | (apply (function concat) | |
14871 | (mapcar (lambda (g) (concat g " ")) | |
14872 | command-line-args-left)))) | |
14873 | (gnus-expert-user t) | |
14874 | (nnmail-spool-file nil) | |
14875 | (gnus-use-dribble-file nil) | |
14876 | (yes (car yes-and-no)) | |
14877 | (no (cdr yes-and-no)) | |
14878 | group newsrc entry | |
14879 | ;; Disable verbose message. | |
14880 | gnus-novice-user gnus-large-newsgroup) | |
14881 | ;; Eat all arguments. | |
14882 | (setq command-line-args-left nil) | |
14883 | ;; Start Gnus. | |
14884 | (gnus) | |
14885 | ;; Apply kills to specified newsgroups in command line arguments. | |
14886 | (setq newsrc (cdr gnus-newsrc-alist)) | |
14887 | (while newsrc | |
231f989b | 14888 | (setq group (caar newsrc)) |
41487370 LMI |
14889 | (setq entry (gnus-gethash group gnus-newsrc-hashtb)) |
14890 | (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) | |
14891 | (and (car entry) | |
14892 | (or (eq (car entry) t) | |
14893 | (not (zerop (car entry))))) | |
14894 | (if yes (string-match yes group) t) | |
14895 | (or (null no) (not (string-match no group)))) | |
745bc783 | 14896 | (progn |
231f989b | 14897 | (gnus-summary-read-group group nil t nil t) |
41487370 LMI |
14898 | (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) |
14899 | (gnus-summary-exit)))) | |
14900 | (setq newsrc (cdr newsrc))) | |
14901 | ;; Exit Emacs. | |
14902 | (switch-to-buffer gnus-group-buffer) | |
14903 | (gnus-group-save-newsrc))) | |
745bc783 | 14904 | |
41487370 LMI |
14905 | (defun gnus-apply-kill-file () |
14906 | "Apply a kill file to the current newsgroup. | |
14907 | Returns the number of articles marked as read." | |
14908 | (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) | |
14909 | (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) | |
14910 | (gnus-apply-kill-file-internal) | |
14911 | 0)) | |
14912 | ||
14913 | (defun gnus-kill-save-kill-buffer () | |
231f989b LMI |
14914 | (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) |
14915 | (when (get-file-buffer file) | |
14916 | (save-excursion | |
14917 | (set-buffer (get-file-buffer file)) | |
14918 | (and (buffer-modified-p) (save-buffer)) | |
14919 | (kill-buffer (current-buffer)))))) | |
745bc783 | 14920 | |
41487370 LMI |
14921 | (defvar gnus-kill-file-name "KILL" |
14922 | "Suffix of the kill files.") | |
b027f415 | 14923 | |
41487370 LMI |
14924 | (defun gnus-newsgroup-kill-file (newsgroup) |
14925 | "Return the name of a kill file name for NEWSGROUP. | |
14926 | If NEWSGROUP is nil, return the global kill file name instead." | |
231f989b LMI |
14927 | (cond |
14928 | ;; The global KILL file is placed at top of the directory. | |
14929 | ((or (null newsgroup) | |
14930 | (string-equal newsgroup "")) | |
14931 | (expand-file-name gnus-kill-file-name | |
14932 | gnus-kill-files-directory)) | |
14933 | ;; Append ".KILL" to newsgroup name. | |
14934 | ((gnus-use-long-file-name 'not-kill) | |
14935 | (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) | |
14936 | "." gnus-kill-file-name) | |
14937 | gnus-kill-files-directory)) | |
14938 | ;; Place "KILL" under the hierarchical directory. | |
14939 | (t | |
14940 | (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) | |
14941 | "/" gnus-kill-file-name) | |
14942 | gnus-kill-files-directory)))) | |
b027f415 | 14943 | |
41487370 LMI |
14944 | \f |
14945 | ;;; | |
14946 | ;;; Dribble file | |
14947 | ;;; | |
745bc783 | 14948 | |
41487370 LMI |
14949 | (defvar gnus-dribble-ignore nil) |
14950 | (defvar gnus-dribble-eval-file nil) | |
14951 | ||
14952 | (defun gnus-dribble-file-name () | |
231f989b LMI |
14953 | "Return the dribble file for the current .newsrc." |
14954 | (concat | |
14955 | (if gnus-dribble-directory | |
14956 | (concat (file-name-as-directory gnus-dribble-directory) | |
14957 | (file-name-nondirectory gnus-current-startup-file)) | |
14958 | gnus-current-startup-file) | |
14959 | "-dribble")) | |
41487370 LMI |
14960 | |
14961 | (defun gnus-dribble-enter (string) | |
231f989b | 14962 | "Enter STRING into the dribble buffer." |
41487370 LMI |
14963 | (if (and (not gnus-dribble-ignore) |
14964 | gnus-dribble-buffer | |
14965 | (buffer-name gnus-dribble-buffer)) | |
14966 | (let ((obuf (current-buffer))) | |
14967 | (set-buffer gnus-dribble-buffer) | |
14968 | (insert string "\n") | |
14969 | (set-window-point (get-buffer-window (current-buffer)) (point-max)) | |
564b670b | 14970 | (bury-buffer gnus-dribble-buffer) |
41487370 LMI |
14971 | (set-buffer obuf)))) |
14972 | ||
14973 | (defun gnus-dribble-read-file () | |
231f989b | 14974 | "Read the dribble file from disk." |
41487370 | 14975 | (let ((dribble-file (gnus-dribble-file-name))) |
231f989b LMI |
14976 | (save-excursion |
14977 | (set-buffer (setq gnus-dribble-buffer | |
14978 | (get-buffer-create | |
41487370 LMI |
14979 | (file-name-nondirectory dribble-file)))) |
14980 | (gnus-add-current-to-buffer-list) | |
14981 | (erase-buffer) | |
231f989b LMI |
14982 | (setq buffer-file-name dribble-file) |
14983 | (auto-save-mode t) | |
41487370 LMI |
14984 | (buffer-disable-undo (current-buffer)) |
14985 | (bury-buffer (current-buffer)) | |
14986 | (set-buffer-modified-p nil) | |
14987 | (let ((auto (make-auto-save-file-name)) | |
231f989b LMI |
14988 | (gnus-dribble-ignore t) |
14989 | modes) | |
14990 | (when (or (file-exists-p auto) (file-exists-p dribble-file)) | |
14991 | ;; Load whichever file is newest -- the auto save file | |
14992 | ;; or the "real" file. | |
14993 | (if (file-newer-than-file-p auto dribble-file) | |
14994 | (insert-file-contents auto) | |
14995 | (insert-file-contents dribble-file)) | |
14996 | (unless (zerop (buffer-size)) | |
14997 | (set-buffer-modified-p t)) | |
14998 | ;; Set the file modes to reflect the .newsrc file modes. | |
14999 | (save-buffer) | |
15000 | (when (and (file-exists-p gnus-current-startup-file) | |
15001 | (setq modes (file-modes gnus-current-startup-file))) | |
15002 | (set-file-modes dribble-file modes)) | |
15003 | ;; Possibly eval the file later. | |
15004 | (when (gnus-y-or-n-p | |
15005 | "Auto-save file exists. Do you want to read it? ") | |
15006 | (setq gnus-dribble-eval-file t))))))) | |
41487370 LMI |
15007 | |
15008 | (defun gnus-dribble-eval-file () | |
231f989b | 15009 | (when gnus-dribble-eval-file |
41487370 LMI |
15010 | (setq gnus-dribble-eval-file nil) |
15011 | (save-excursion | |
15012 | (let ((gnus-dribble-ignore t)) | |
15013 | (set-buffer gnus-dribble-buffer) | |
15014 | (eval-buffer (current-buffer)))))) | |
15015 | ||
15016 | (defun gnus-dribble-delete-file () | |
231f989b LMI |
15017 | (when (file-exists-p (gnus-dribble-file-name)) |
15018 | (delete-file (gnus-dribble-file-name))) | |
15019 | (when gnus-dribble-buffer | |
15020 | (save-excursion | |
15021 | (set-buffer gnus-dribble-buffer) | |
15022 | (let ((auto (make-auto-save-file-name))) | |
15023 | (if (file-exists-p auto) | |
15024 | (delete-file auto)) | |
15025 | (erase-buffer) | |
15026 | (set-buffer-modified-p nil))))) | |
41487370 LMI |
15027 | |
15028 | (defun gnus-dribble-save () | |
231f989b LMI |
15029 | (when (and gnus-dribble-buffer |
15030 | (buffer-name gnus-dribble-buffer)) | |
15031 | (save-excursion | |
15032 | (set-buffer gnus-dribble-buffer) | |
15033 | (save-buffer)))) | |
745bc783 | 15034 | |
41487370 | 15035 | (defun gnus-dribble-clear () |
231f989b LMI |
15036 | (when (gnus-buffer-exists-p gnus-dribble-buffer) |
15037 | (save-excursion | |
15038 | (set-buffer gnus-dribble-buffer) | |
15039 | (erase-buffer) | |
15040 | (set-buffer-modified-p nil) | |
15041 | (setq buffer-saved-size (buffer-size))))) | |
745bc783 | 15042 | |
231f989b | 15043 | \f |
745bc783 | 15044 | ;;; |
41487370 | 15045 | ;;; Server Communication |
745bc783 JB |
15046 | ;;; |
15047 | ||
41487370 LMI |
15048 | (defun gnus-start-news-server (&optional confirm) |
15049 | "Open a method for getting news. | |
15050 | If CONFIRM is non-nil, the user will be asked for an NNTP server." | |
15051 | (let (how) | |
15052 | (if gnus-current-select-method | |
15053 | ;; Stream is already opened. | |
15054 | nil | |
15055 | ;; Open NNTP server. | |
15056 | (if (null gnus-nntp-service) (setq gnus-nntp-server nil)) | |
15057 | (if confirm | |
15058 | (progn | |
15059 | ;; Read server name with completion. | |
15060 | (setq gnus-nntp-server | |
15061 | (completing-read "NNTP server: " | |
15062 | (mapcar (lambda (server) (list server)) | |
15063 | (cons (list gnus-nntp-server) | |
15064 | gnus-secondary-servers)) | |
15065 | nil nil gnus-nntp-server)))) | |
15066 | ||
231f989b | 15067 | (if (and gnus-nntp-server |
41487370 LMI |
15068 | (stringp gnus-nntp-server) |
15069 | (not (string= gnus-nntp-server ""))) | |
15070 | (setq gnus-select-method | |
15071 | (cond ((or (string= gnus-nntp-server "") | |
15072 | (string= gnus-nntp-server "::")) | |
15073 | (list 'nnspool (system-name))) | |
15074 | ((string-match "^:" gnus-nntp-server) | |
231f989b LMI |
15075 | (list 'nnmh gnus-nntp-server |
15076 | (list 'nnmh-directory | |
41487370 LMI |
15077 | (file-name-as-directory |
15078 | (expand-file-name | |
15079 | (concat "~/" (substring | |
15080 | gnus-nntp-server 1))))) | |
15081 | (list 'nnmh-get-new-mail nil))) | |
15082 | (t | |
15083 | (list 'nntp gnus-nntp-server))))) | |
15084 | ||
15085 | (setq how (car gnus-select-method)) | |
15086 | (cond ((eq how 'nnspool) | |
15087 | (require 'nnspool) | |
15088 | (gnus-message 5 "Looking up local news spool...")) | |
15089 | ((eq how 'nnmh) | |
15090 | (require 'nnmh) | |
15091 | (gnus-message 5 "Looking up mh spool...")) | |
15092 | (t | |
15093 | (require 'nntp))) | |
15094 | (setq gnus-current-select-method gnus-select-method) | |
15095 | (run-hooks 'gnus-open-server-hook) | |
231f989b | 15096 | (or |
41487370 | 15097 | ;; gnus-open-server-hook might have opened it |
231f989b | 15098 | (gnus-server-opened gnus-select-method) |
41487370 LMI |
15099 | (gnus-open-server gnus-select-method) |
15100 | (gnus-y-or-n-p | |
15101 | (format | |
231f989b LMI |
15102 | "%s (%s) open error: '%s'. Continue? " |
15103 | (car gnus-select-method) (cadr gnus-select-method) | |
41487370 | 15104 | (gnus-status-message gnus-select-method))) |
231f989b LMI |
15105 | (gnus-error 1 "Couldn't open server on %s" |
15106 | (nth 1 gnus-select-method)))))) | |
15107 | ||
15108 | (defun gnus-check-group (group) | |
15109 | "Try to make sure that the server where GROUP exists is alive." | |
15110 | (let ((method (gnus-find-method-for-group group))) | |
15111 | (or (gnus-server-opened method) | |
15112 | (gnus-open-server method)))) | |
15113 | ||
15114 | (defun gnus-check-server (&optional method silent) | |
15115 | "Check whether the connection to METHOD is down. | |
15116 | If METHOD is nil, use `gnus-select-method'. | |
15117 | If it is down, start it up (again)." | |
15118 | (let ((method (or method gnus-select-method))) | |
15119 | ;; Transform virtual server names into select methods. | |
15120 | (when (stringp method) | |
15121 | (setq method (gnus-server-to-method method))) | |
41487370 | 15122 | (if (gnus-server-opened method) |
231f989b | 15123 | ;; The stream is already opened. |
41487370 | 15124 | t |
231f989b LMI |
15125 | ;; Open the server. |
15126 | (unless silent | |
15127 | (gnus-message 5 "Opening %s server%s..." (car method) | |
15128 | (if (equal (nth 1 method) "") "" | |
15129 | (format " on %s" (nth 1 method))))) | |
41487370 LMI |
15130 | (run-hooks 'gnus-open-server-hook) |
15131 | (prog1 | |
15132 | (gnus-open-server method) | |
231f989b LMI |
15133 | (unless silent |
15134 | (message "")))))) | |
15135 | ||
15136 | (defun gnus-get-function (method function &optional noerror) | |
15137 | "Return a function symbol based on METHOD and FUNCTION." | |
15138 | ;; Translate server names into methods. | |
15139 | (unless method | |
15140 | (error "Attempted use of a nil select method")) | |
15141 | (when (stringp method) | |
15142 | (setq method (gnus-server-to-method method))) | |
41487370 | 15143 | (let ((func (intern (format "%s-%s" (car method) function)))) |
231f989b LMI |
15144 | ;; If the functions isn't bound, we require the backend in |
15145 | ;; question. | |
15146 | (unless (fboundp func) | |
15147 | (require (car method)) | |
15148 | (when (and (not (fboundp func)) | |
15149 | (not noerror)) | |
15150 | ;; This backend doesn't implement this function. | |
15151 | (error "No such function: %s" func))) | |
41487370 LMI |
15152 | func)) |
15153 | ||
231f989b LMI |
15154 | \f |
15155 | ;;; | |
41487370 | 15156 | ;;; Interface functions to the backends. |
231f989b | 15157 | ;;; |
41487370 LMI |
15158 | |
15159 | (defun gnus-open-server (method) | |
231f989b LMI |
15160 | "Open a connection to METHOD." |
15161 | (when (stringp method) | |
15162 | (setq method (gnus-server-to-method method))) | |
15163 | (let ((elem (assoc method gnus-opened-servers))) | |
15164 | ;; If this method was previously denied, we just return nil. | |
15165 | (if (eq (nth 1 elem) 'denied) | |
15166 | (progn | |
15167 | (gnus-message 1 "Denied server") | |
15168 | nil) | |
15169 | ;; Open the server. | |
15170 | (let ((result | |
15171 | (funcall (gnus-get-function method 'open-server) | |
15172 | (nth 1 method) (nthcdr 2 method)))) | |
15173 | ;; If this hasn't been opened before, we add it to the list. | |
15174 | (unless elem | |
15175 | (setq elem (list method nil) | |
15176 | gnus-opened-servers (cons elem gnus-opened-servers))) | |
15177 | ;; Set the status of this server. | |
15178 | (setcar (cdr elem) (if result 'ok 'denied)) | |
15179 | ;; Return the result from the "open" call. | |
15180 | result)))) | |
41487370 LMI |
15181 | |
15182 | (defun gnus-close-server (method) | |
231f989b LMI |
15183 | "Close the connection to METHOD." |
15184 | (when (stringp method) | |
15185 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15186 | (funcall (gnus-get-function method 'close-server) (nth 1 method))) |
15187 | ||
15188 | (defun gnus-request-list (method) | |
231f989b LMI |
15189 | "Request the active file from METHOD." |
15190 | (when (stringp method) | |
15191 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15192 | (funcall (gnus-get-function method 'request-list) (nth 1 method))) |
15193 | ||
15194 | (defun gnus-request-list-newsgroups (method) | |
231f989b LMI |
15195 | "Request the newsgroups file from METHOD." |
15196 | (when (stringp method) | |
15197 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15198 | (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) |
15199 | ||
15200 | (defun gnus-request-newgroups (date method) | |
231f989b LMI |
15201 | "Request all new groups since DATE from METHOD." |
15202 | (when (stringp method) | |
15203 | (setq method (gnus-server-to-method method))) | |
15204 | (funcall (gnus-get-function method 'request-newgroups) | |
41487370 LMI |
15205 | date (nth 1 method))) |
15206 | ||
15207 | (defun gnus-server-opened (method) | |
231f989b LMI |
15208 | "Check whether a connection to METHOD has been opened." |
15209 | (when (stringp method) | |
15210 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15211 | (funcall (gnus-get-function method 'server-opened) (nth 1 method))) |
15212 | ||
15213 | (defun gnus-status-message (method) | |
231f989b LMI |
15214 | "Return the status message from METHOD. |
15215 | If METHOD is a string, it is interpreted as a group name. The method | |
15216 | this group uses will be queried." | |
41487370 LMI |
15217 | (let ((method (if (stringp method) (gnus-find-method-for-group method) |
15218 | method))) | |
15219 | (funcall (gnus-get-function method 'status-message) (nth 1 method)))) | |
15220 | ||
231f989b LMI |
15221 | (defun gnus-request-group (group &optional dont-check method) |
15222 | "Request GROUP. If DONT-CHECK, no information is required." | |
15223 | (let ((method (or method (gnus-find-method-for-group group)))) | |
15224 | (when (stringp method) | |
15225 | (setq method (gnus-server-to-method method))) | |
15226 | (funcall (gnus-get-function method 'request-group) | |
41487370 LMI |
15227 | (gnus-group-real-name group) (nth 1 method) dont-check))) |
15228 | ||
15229 | (defun gnus-request-asynchronous (group &optional articles) | |
231f989b LMI |
15230 | "Request that GROUP behave asynchronously. |
15231 | ARTICLES is the `data' of the group." | |
41487370 | 15232 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15233 | (funcall (gnus-get-function method 'request-asynchronous) |
41487370 LMI |
15234 | (gnus-group-real-name group) (nth 1 method) articles))) |
15235 | ||
15236 | (defun gnus-list-active-group (group) | |
231f989b | 15237 | "Request active information on GROUP." |
41487370 LMI |
15238 | (let ((method (gnus-find-method-for-group group)) |
15239 | (func 'list-active-group)) | |
231f989b LMI |
15240 | (when (gnus-check-backend-function func group) |
15241 | (funcall (gnus-get-function method func) | |
15242 | (gnus-group-real-name group) (nth 1 method))))) | |
41487370 LMI |
15243 | |
15244 | (defun gnus-request-group-description (group) | |
231f989b | 15245 | "Request a description of GROUP." |
41487370 LMI |
15246 | (let ((method (gnus-find-method-for-group group)) |
15247 | (func 'request-group-description)) | |
231f989b LMI |
15248 | (when (gnus-check-backend-function func group) |
15249 | (funcall (gnus-get-function method func) | |
15250 | (gnus-group-real-name group) (nth 1 method))))) | |
41487370 LMI |
15251 | |
15252 | (defun gnus-close-group (group) | |
231f989b | 15253 | "Request the GROUP be closed." |
41487370 | 15254 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15255 | (funcall (gnus-get-function method 'close-group) |
41487370 LMI |
15256 | (gnus-group-real-name group) (nth 1 method)))) |
15257 | ||
231f989b LMI |
15258 | (defun gnus-retrieve-headers (articles group &optional fetch-old) |
15259 | "Request headers for ARTICLES in GROUP. | |
15260 | If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." | |
41487370 LMI |
15261 | (let ((method (gnus-find-method-for-group group))) |
15262 | (if (and gnus-use-cache (numberp (car articles))) | |
231f989b LMI |
15263 | (gnus-cache-retrieve-headers articles group fetch-old) |
15264 | (funcall (gnus-get-function method 'retrieve-headers) | |
15265 | articles (gnus-group-real-name group) (nth 1 method) | |
15266 | fetch-old)))) | |
41487370 LMI |
15267 | |
15268 | (defun gnus-retrieve-groups (groups method) | |
231f989b LMI |
15269 | "Request active information on GROUPS from METHOD." |
15270 | (when (stringp method) | |
15271 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
15272 | (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) |
15273 | ||
231f989b LMI |
15274 | (defun gnus-request-type (group &optional article) |
15275 | "Return the type (`post' or `mail') of GROUP (and ARTICLE)." | |
15276 | (let ((method (gnus-find-method-for-group group))) | |
15277 | (if (not (gnus-check-backend-function 'request-type (car method))) | |
15278 | 'unknown | |
15279 | (funcall (gnus-get-function method 'request-type) | |
15280 | (gnus-group-real-name group) article)))) | |
15281 | ||
15282 | (defun gnus-request-update-mark (group article mark) | |
15283 | "Return the type (`post' or `mail') of GROUP (and ARTICLE)." | |
15284 | (let ((method (gnus-find-method-for-group group))) | |
15285 | (if (not (gnus-check-backend-function 'request-update-mark (car method))) | |
15286 | mark | |
15287 | (funcall (gnus-get-function method 'request-update-mark) | |
15288 | (gnus-group-real-name group) article mark)))) | |
15289 | ||
41487370 | 15290 | (defun gnus-request-article (article group &optional buffer) |
231f989b LMI |
15291 | "Request the ARTICLE in GROUP. |
15292 | ARTICLE can either be an article number or an article Message-ID. | |
15293 | If BUFFER, insert the article in that group." | |
41487370 | 15294 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15295 | (funcall (gnus-get-function method 'request-article) |
41487370 LMI |
15296 | article (gnus-group-real-name group) (nth 1 method) buffer))) |
15297 | ||
15298 | (defun gnus-request-head (article group) | |
231f989b LMI |
15299 | "Request the head of ARTICLE in GROUP." |
15300 | (let* ((method (gnus-find-method-for-group group)) | |
15301 | (head (gnus-get-function method 'request-head t))) | |
15302 | (if (fboundp head) | |
15303 | (funcall head article (gnus-group-real-name group) (nth 1 method)) | |
15304 | (let ((res (gnus-request-article article group))) | |
15305 | (when res | |
15306 | (save-excursion | |
15307 | (set-buffer nntp-server-buffer) | |
15308 | (goto-char (point-min)) | |
15309 | (when (search-forward "\n\n" nil t) | |
15310 | (delete-region (1- (point)) (point-max))) | |
15311 | (nnheader-fold-continuation-lines))) | |
15312 | res)))) | |
41487370 LMI |
15313 | |
15314 | (defun gnus-request-body (article group) | |
231f989b | 15315 | "Request the body of ARTICLE in GROUP." |
41487370 | 15316 | (let ((method (gnus-find-method-for-group group))) |
231f989b | 15317 | (funcall (gnus-get-function method 'request-body) |
41487370 LMI |
15318 | article (gnus-group-real-name group) (nth 1 method)))) |
15319 | ||
231f989b LMI |
15320 | (defun gnus-request-post (method) |
15321 | "Post the current buffer using METHOD." | |
15322 | (when (stringp method) | |
15323 | (setq method (gnus-server-to-method method))) | |
15324 | (funcall (gnus-get-function method 'request-post) (nth 1 method))) | |
15325 | ||
15326 | (defun gnus-request-scan (group method) | |
15327 | "Request a SCAN being performed in GROUP from METHOD. | |
15328 | If GROUP is nil, all groups on METHOD are scanned." | |
15329 | (let ((method (if group (gnus-find-method-for-group group) method))) | |
15330 | (funcall (gnus-get-function method 'request-scan) | |
15331 | (and group (gnus-group-real-name group)) (nth 1 method)))) | |
15332 | ||
15333 | (defsubst gnus-request-update-info (info method) | |
15334 | "Request that METHOD update INFO." | |
15335 | (when (stringp method) | |
15336 | (setq method (gnus-server-to-method method))) | |
15337 | (when (gnus-check-backend-function 'request-update-info (car method)) | |
15338 | (funcall (gnus-get-function method 'request-update-info) | |
15339 | (gnus-group-real-name (gnus-info-group info)) | |
15340 | info (nth 1 method)))) | |
41487370 LMI |
15341 | |
15342 | (defun gnus-request-expire-articles (articles group &optional force) | |
15343 | (let ((method (gnus-find-method-for-group group))) | |
231f989b | 15344 | (funcall (gnus-get-function method 'request-expire-articles) |
41487370 LMI |
15345 | articles (gnus-group-real-name group) (nth 1 method) |
15346 | force))) | |
15347 | ||
231f989b | 15348 | (defun gnus-request-move-article |
41487370 LMI |
15349 | (article group server accept-function &optional last) |
15350 | (let ((method (gnus-find-method-for-group group))) | |
231f989b LMI |
15351 | (funcall (gnus-get-function method 'request-move-article) |
15352 | article (gnus-group-real-name group) | |
41487370 LMI |
15353 | (nth 1 method) accept-function last))) |
15354 | ||
231f989b LMI |
15355 | (defun gnus-request-accept-article (group method &optional last) |
15356 | ;; Make sure there's a newline at the end of the article. | |
15357 | (when (stringp method) | |
15358 | (setq method (gnus-server-to-method method))) | |
15359 | (when (and (not method) | |
15360 | (stringp group)) | |
15361 | (setq method (gnus-group-name-to-method group))) | |
fc103e78 | 15362 | (goto-char (point-max)) |
231f989b LMI |
15363 | (unless (bolp) |
15364 | (insert "\n")) | |
15365 | (let ((func (car (or method (gnus-find-method-for-group group))))) | |
41487370 LMI |
15366 | (funcall (intern (format "%s-request-accept-article" func)) |
15367 | (if (stringp group) (gnus-group-real-name group) group) | |
231f989b | 15368 | (cadr method) |
41487370 LMI |
15369 | last))) |
15370 | ||
15371 | (defun gnus-request-replace-article (article group buffer) | |
15372 | (let ((func (car (gnus-find-method-for-group group)))) | |
15373 | (funcall (intern (format "%s-request-replace-article" func)) | |
15374 | article (gnus-group-real-name group) buffer))) | |
15375 | ||
231f989b LMI |
15376 | (defun gnus-request-associate-buffer (group) |
15377 | (let ((method (gnus-find-method-for-group group))) | |
15378 | (funcall (gnus-get-function method 'request-associate-buffer) | |
15379 | (gnus-group-real-name group)))) | |
15380 | ||
15381 | (defun gnus-request-restore-buffer (article group) | |
15382 | "Request a new buffer restored to the state of ARTICLE." | |
41487370 | 15383 | (let ((method (gnus-find-method-for-group group))) |
231f989b LMI |
15384 | (funcall (gnus-get-function method 'request-restore-buffer) |
15385 | article (gnus-group-real-name group) (nth 1 method)))) | |
15386 | ||
15387 | (defun gnus-request-create-group (group &optional method) | |
15388 | (when (stringp method) | |
15389 | (setq method (gnus-server-to-method method))) | |
15390 | (let ((method (or method (gnus-find-method-for-group group)))) | |
15391 | (funcall (gnus-get-function method 'request-create-group) | |
41487370 LMI |
15392 | (gnus-group-real-name group) (nth 1 method)))) |
15393 | ||
231f989b LMI |
15394 | (defun gnus-request-delete-group (group &optional force) |
15395 | (let ((method (gnus-find-method-for-group group))) | |
15396 | (funcall (gnus-get-function method 'request-delete-group) | |
15397 | (gnus-group-real-name group) force (nth 1 method)))) | |
15398 | ||
15399 | (defun gnus-request-rename-group (group new-name) | |
15400 | (let ((method (gnus-find-method-for-group group))) | |
15401 | (funcall (gnus-get-function method 'request-rename-group) | |
15402 | (gnus-group-real-name group) | |
15403 | (gnus-group-real-name new-name) (nth 1 method)))) | |
15404 | ||
41487370 | 15405 | (defun gnus-member-of-valid (symbol group) |
231f989b | 15406 | "Find out if GROUP has SYMBOL as part of its \"valid\" spec." |
41487370 | 15407 | (memq symbol (assoc |
231f989b | 15408 | (symbol-name (car (gnus-find-method-for-group group))) |
41487370 LMI |
15409 | gnus-valid-select-methods))) |
15410 | ||
231f989b LMI |
15411 | (defun gnus-method-option-p (method option) |
15412 | "Return non-nil if select METHOD has OPTION as a parameter." | |
15413 | (when (stringp method) | |
15414 | (setq method (gnus-server-to-method method))) | |
15415 | (memq option (assoc (format "%s" (car method)) | |
15416 | gnus-valid-select-methods))) | |
15417 | ||
15418 | (defun gnus-server-extend-method (group method) | |
15419 | ;; This function "extends" a virtual server. If the server is | |
15420 | ;; "hello", and the select method is ("hello" (my-var "something")) | |
15421 | ;; in the group "alt.alt", this will result in a new virtual server | |
15422 | ;; called "hello+alt.alt". | |
15423 | (let ((entry | |
15424 | (gnus-copy-sequence | |
15425 | (if (equal (car method) "native") gnus-select-method | |
15426 | (cdr (assoc (car method) gnus-server-alist)))))) | |
15427 | (setcar (cdr entry) (concat (nth 1 entry) "+" group)) | |
15428 | (nconc entry (cdr method)))) | |
15429 | ||
564b670b LMI |
15430 | (defun gnus-server-status (method) |
15431 | "Return the status of METHOD." | |
15432 | (nth 1 (assoc method gnus-opened-servers))) | |
15433 | ||
231f989b LMI |
15434 | (defun gnus-group-name-to-method (group) |
15435 | "Return a select method suitable for GROUP." | |
15436 | (if (string-match ":" group) | |
15437 | (let ((server (substring group 0 (match-beginning 0)))) | |
15438 | (if (string-match "\\+" server) | |
15439 | (list (intern (substring server 0 (match-beginning 0))) | |
15440 | (substring server (match-end 0))) | |
15441 | (list (intern server) ""))) | |
15442 | gnus-select-method)) | |
41487370 LMI |
15443 | |
15444 | (defun gnus-find-method-for-group (group &optional info) | |
231f989b | 15445 | "Find the select method that GROUP uses." |
41487370 LMI |
15446 | (or gnus-override-method |
15447 | (and (not group) | |
15448 | gnus-select-method) | |
231f989b | 15449 | (let ((info (or info (gnus-get-info group))) |
41487370 LMI |
15450 | method) |
15451 | (if (or (not info) | |
231f989b LMI |
15452 | (not (setq method (gnus-info-method info))) |
15453 | (equal method "native")) | |
15454 | gnus-select-method | |
41487370 LMI |
15455 | (setq method |
15456 | (cond ((stringp method) | |
15457 | (gnus-server-to-method method)) | |
15458 | ((stringp (car method)) | |
15459 | (gnus-server-extend-method group method)) | |
15460 | (t | |
231f989b LMI |
15461 | method))) |
15462 | (cond ((equal (cadr method) "") | |
15463 | method) | |
15464 | ((null (cadr method)) | |
15465 | (list (car method) "")) | |
15466 | (t | |
15467 | (gnus-server-add-address method))))))) | |
41487370 LMI |
15468 | |
15469 | (defun gnus-check-backend-function (func group) | |
231f989b | 15470 | "Check whether GROUP supports function FUNC." |
41487370 LMI |
15471 | (let ((method (if (stringp group) (car (gnus-find-method-for-group group)) |
15472 | group))) | |
15473 | (fboundp (intern (format "%s-%s" method func))))) | |
15474 | ||
231f989b LMI |
15475 | (defun gnus-methods-using (feature) |
15476 | "Find all methods that have FEATURE." | |
41487370 LMI |
15477 | (let ((valids gnus-valid-select-methods) |
15478 | outs) | |
15479 | (while valids | |
231f989b | 15480 | (if (memq feature (car valids)) |
41487370 LMI |
15481 | (setq outs (cons (car valids) outs))) |
15482 | (setq valids (cdr valids))) | |
15483 | outs)) | |
15484 | ||
231f989b LMI |
15485 | \f |
15486 | ;;; | |
41487370 LMI |
15487 | ;;; Active & Newsrc File Handling |
15488 | ;;; | |
15489 | ||
231f989b | 15490 | (defun gnus-setup-news (&optional rawfile level dont-connect) |
41487370 LMI |
15491 | "Setup news information. |
15492 | If RAWFILE is non-nil, the .newsrc file will also be read. | |
15493 | If LEVEL is non-nil, the news will be set up at level LEVEL." | |
15494 | (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) | |
41487370 | 15495 | |
231f989b LMI |
15496 | (when init |
15497 | ;; Clear some variables to re-initialize news information. | |
15498 | (setq gnus-newsrc-alist nil | |
15499 | gnus-active-hashtb nil) | |
15500 | ;; Read the newsrc file and create `gnus-newsrc-hashtb'. | |
15501 | (gnus-read-newsrc-file rawfile)) | |
15502 | ||
15503 | (when (and (not (assoc "archive" gnus-server-alist)) | |
564b670b | 15504 | (gnus-archive-server-wanted-p)) |
231f989b LMI |
15505 | (push (cons "archive" gnus-message-archive-method) |
15506 | gnus-server-alist)) | |
41487370 LMI |
15507 | |
15508 | ;; If we don't read the complete active file, we fill in the | |
231f989b | 15509 | ;; hashtb here. |
41487370 LMI |
15510 | (if (or (null gnus-read-active-file) |
15511 | (eq gnus-read-active-file 'some)) | |
15512 | (gnus-update-active-hashtb-from-killed)) | |
15513 | ||
15514 | ;; Read the active file and create `gnus-active-hashtb'. | |
15515 | ;; If `gnus-read-active-file' is nil, then we just create an empty | |
231f989b | 15516 | ;; hash table. The partial filling out of the hash table will be |
41487370 | 15517 | ;; done in `gnus-get-unread-articles'. |
231f989b | 15518 | (and gnus-read-active-file |
41487370 LMI |
15519 | (not level) |
15520 | (gnus-read-active-file)) | |
15521 | ||
15522 | (or gnus-active-hashtb | |
15523 | (setq gnus-active-hashtb (make-vector 4095 0))) | |
15524 | ||
231f989b LMI |
15525 | ;; Initialize the cache. |
15526 | (when gnus-use-cache | |
15527 | (gnus-cache-open)) | |
15528 | ||
41487370 | 15529 | ;; Possibly eval the dribble file. |
231f989b LMI |
15530 | (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) |
15531 | ||
15532 | ;; Slave Gnusii should then clear the dribble buffer. | |
15533 | (when (and init gnus-slave) | |
15534 | (gnus-dribble-clear)) | |
41487370 LMI |
15535 | |
15536 | (gnus-update-format-specifications) | |
15537 | ||
231f989b LMI |
15538 | ;; See whether we need to read the description file. |
15539 | (if (and (string-match "%[-,0-9]*D" gnus-group-line-format) | |
15540 | (not gnus-description-hashtb) | |
15541 | (not dont-connect) | |
15542 | gnus-read-active-file) | |
15543 | (gnus-read-all-descriptions-files)) | |
15544 | ||
41487370 | 15545 | ;; Find new newsgroups and treat them. |
231f989b | 15546 | (if (and init gnus-check-new-newsgroups (not level) |
7e988fb6 | 15547 | (gnus-check-server gnus-select-method)) |
41487370 LMI |
15548 | (gnus-find-new-newsgroups)) |
15549 | ||
231f989b LMI |
15550 | ;; We might read in new NoCeM messages here. |
15551 | (when (and gnus-use-nocem | |
15552 | (not level) | |
15553 | (not dont-connect)) | |
15554 | (gnus-nocem-scan-groups)) | |
15555 | ||
41487370 LMI |
15556 | ;; Find the number of unread articles in each non-dead group. |
15557 | (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) | |
231f989b | 15558 | (gnus-get-unread-articles level)) |
41487370 | 15559 | |
231f989b | 15560 | (if (and init gnus-check-bogus-newsgroups |
41487370 LMI |
15561 | gnus-read-active-file (not level) |
15562 | (gnus-server-opened gnus-select-method)) | |
15563 | (gnus-check-bogus-newsgroups)))) | |
745bc783 | 15564 | |
231f989b | 15565 | (defun gnus-find-new-newsgroups (&optional arg) |
41487370 LMI |
15566 | "Search for new newsgroups and add them. |
15567 | Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' | |
231f989b LMI |
15568 | The `-n' option line from .newsrc is respected. |
15569 | If ARG (the prefix), use the `ask-server' method to query | |
15570 | the server for new groups." | |
15571 | (interactive "P") | |
15572 | (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) | |
15573 | (null gnus-read-active-file) | |
15574 | (eq gnus-read-active-file 'some)) | |
15575 | 'ask-server gnus-check-new-newsgroups))) | |
15576 | (unless (gnus-check-first-time-used) | |
15577 | (if (or (consp check) | |
15578 | (eq check 'ask-server)) | |
15579 | ;; Ask the server for new groups. | |
41487370 | 15580 | (gnus-ask-server-for-new-groups) |
231f989b | 15581 | ;; Go through the active hashtb and look for new groups. |
41487370 LMI |
15582 | (let ((groups 0) |
15583 | group new-newsgroups) | |
15584 | (gnus-message 5 "Looking for new newsgroups...") | |
231f989b LMI |
15585 | (unless gnus-have-read-active-file |
15586 | (gnus-read-active-file)) | |
41487370 | 15587 | (setq gnus-newsrc-last-checked-date (current-time-string)) |
231f989b LMI |
15588 | (unless gnus-killed-hashtb |
15589 | (gnus-make-hashtable-from-killed)) | |
41487370 LMI |
15590 | ;; Go though every newsgroup in `gnus-active-hashtb' and compare |
15591 | ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. | |
15592 | (mapatoms | |
15593 | (lambda (sym) | |
15594 | (if (or (null (setq group (symbol-name sym))) | |
231f989b | 15595 | (not (boundp sym)) |
41487370 LMI |
15596 | (null (symbol-value sym)) |
15597 | (gnus-gethash group gnus-killed-hashtb) | |
15598 | (gnus-gethash group gnus-newsrc-hashtb)) | |
15599 | () | |
15600 | (let ((do-sub (gnus-matches-options-n group))) | |
231f989b | 15601 | (cond |
41487370 LMI |
15602 | ((eq do-sub 'subscribe) |
15603 | (setq groups (1+ groups)) | |
15604 | (gnus-sethash group group gnus-killed-hashtb) | |
15605 | (funcall gnus-subscribe-options-newsgroup-method group)) | |
15606 | ((eq do-sub 'ignore) | |
15607 | nil) | |
15608 | (t | |
15609 | (setq groups (1+ groups)) | |
15610 | (gnus-sethash group group gnus-killed-hashtb) | |
15611 | (if gnus-subscribe-hierarchical-interactive | |
15612 | (setq new-newsgroups (cons group new-newsgroups)) | |
15613 | (funcall gnus-subscribe-newsgroup-method group))))))) | |
15614 | gnus-active-hashtb) | |
231f989b LMI |
15615 | (when new-newsgroups |
15616 | (gnus-subscribe-hierarchical-interactive new-newsgroups)) | |
41487370 LMI |
15617 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. |
15618 | (if (> groups 0) | |
231f989b | 15619 | (gnus-message 6 "%d new newsgroup%s arrived." |
41487370 | 15620 | groups (if (> groups 1) "s have" " has")) |
231f989b | 15621 | (gnus-message 6 "No new newsgroups."))))))) |
41487370 LMI |
15622 | |
15623 | (defun gnus-matches-options-n (group) | |
b94ae5f7 | 15624 | ;; Returns `subscribe' if the group is to be unconditionally |
41487370 LMI |
15625 | ;; subscribed, `ignore' if it is to be ignored, and nil if there is |
15626 | ;; no match for the group. | |
15627 | ||
15628 | ;; First we check the two user variables. | |
15629 | (cond | |
15630 | ((and gnus-options-subscribe | |
15631 | (string-match gnus-options-subscribe group)) | |
15632 | 'subscribe) | |
231f989b LMI |
15633 | ((and gnus-auto-subscribed-groups |
15634 | (string-match gnus-auto-subscribed-groups group)) | |
15635 | 'subscribe) | |
41487370 LMI |
15636 | ((and gnus-options-not-subscribe |
15637 | (string-match gnus-options-not-subscribe group)) | |
15638 | 'ignore) | |
15639 | ;; Then we go through the list that was retrieved from the .newsrc | |
231f989b LMI |
15640 | ;; file. This list has elements on the form |
15641 | ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list | |
41487370 LMI |
15642 | ;; is in the reverse order of the options line) is returned. |
15643 | (t | |
15644 | (let ((regs gnus-newsrc-options-n)) | |
15645 | (while (and regs | |
231f989b | 15646 | (not (string-match (caar regs) group))) |
41487370 | 15647 | (setq regs (cdr regs))) |
231f989b | 15648 | (and regs (cdar regs)))))) |
41487370 LMI |
15649 | |
15650 | (defun gnus-ask-server-for-new-groups () | |
15651 | (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) | |
231f989b LMI |
15652 | (methods (cons gnus-select-method |
15653 | (nconc | |
564b670b | 15654 | (when (gnus-archive-server-wanted-p) |
231f989b LMI |
15655 | (list "archive")) |
15656 | (append | |
15657 | (and (consp gnus-check-new-newsgroups) | |
15658 | gnus-check-new-newsgroups) | |
15659 | gnus-secondary-select-methods)))) | |
41487370 LMI |
15660 | (groups 0) |
15661 | (new-date (current-time-string)) | |
231f989b LMI |
15662 | group new-newsgroups got-new method hashtb |
15663 | gnus-override-subscribe-method) | |
15664 | ;; Go through both primary and secondary select methods and | |
15665 | ;; request new newsgroups. | |
15666 | (while (setq method (gnus-server-get-method nil (pop methods))) | |
15667 | (setq new-newsgroups nil) | |
15668 | (setq gnus-override-subscribe-method method) | |
15669 | (when (and (gnus-check-server method) | |
15670 | (gnus-request-newgroups date method)) | |
15671 | (save-excursion | |
15672 | (setq got-new t) | |
15673 | (setq hashtb (gnus-make-hashtable 100)) | |
15674 | (set-buffer nntp-server-buffer) | |
15675 | ;; Enter all the new groups into a hashtable. | |
15676 | (gnus-active-to-gnus-format method hashtb 'ignore)) | |
15677 | ;; Now all new groups from `method' are in `hashtb'. | |
15678 | (mapatoms | |
15679 | (lambda (group-sym) | |
15680 | (if (or (null (setq group (symbol-name group-sym))) | |
15681 | (not (boundp group-sym)) | |
15682 | (null (symbol-value group-sym)) | |
15683 | (gnus-gethash group gnus-newsrc-hashtb) | |
15684 | (member group gnus-zombie-list) | |
15685 | (member group gnus-killed-list)) | |
15686 | ;; The group is already known. | |
15687 | () | |
15688 | ;; Make this group active. | |
15689 | (when (symbol-value group-sym) | |
15690 | (gnus-set-active group (symbol-value group-sym))) | |
15691 | ;; Check whether we want it or not. | |
15692 | (let ((do-sub (gnus-matches-options-n group))) | |
15693 | (cond | |
15694 | ((eq do-sub 'subscribe) | |
15695 | (incf groups) | |
15696 | (gnus-sethash group group gnus-killed-hashtb) | |
15697 | (funcall gnus-subscribe-options-newsgroup-method group)) | |
15698 | ((eq do-sub 'ignore) | |
15699 | nil) | |
15700 | (t | |
15701 | (incf groups) | |
15702 | (gnus-sethash group group gnus-killed-hashtb) | |
15703 | (if gnus-subscribe-hierarchical-interactive | |
15704 | (push group new-newsgroups) | |
15705 | (funcall gnus-subscribe-newsgroup-method group))))))) | |
15706 | hashtb)) | |
15707 | (when new-newsgroups | |
15708 | (gnus-subscribe-hierarchical-interactive new-newsgroups))) | |
41487370 | 15709 | ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. |
231f989b LMI |
15710 | (when (> groups 0) |
15711 | (gnus-message 6 "%d new newsgroup%s arrived." | |
15712 | groups (if (> groups 1) "s have" " has"))) | |
15713 | (and got-new (setq gnus-newsrc-last-checked-date new-date)) | |
41487370 LMI |
15714 | got-new)) |
15715 | ||
15716 | (defun gnus-check-first-time-used () | |
15717 | (if (or (> (length gnus-newsrc-alist) 1) | |
15718 | (file-exists-p gnus-startup-file) | |
15719 | (file-exists-p (concat gnus-startup-file ".el")) | |
15720 | (file-exists-p (concat gnus-startup-file ".eld"))) | |
15721 | nil | |
15722 | (gnus-message 6 "First time user; subscribing you to default groups") | |
231f989b LMI |
15723 | (unless (gnus-read-active-file-p) |
15724 | (gnus-read-active-file)) | |
41487370 LMI |
15725 | (setq gnus-newsrc-last-checked-date (current-time-string)) |
15726 | (let ((groups gnus-default-subscribed-newsgroups) | |
15727 | group) | |
15728 | (if (eq groups t) | |
15729 | nil | |
15730 | (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) | |
15731 | (mapatoms | |
15732 | (lambda (sym) | |
15733 | (if (null (setq group (symbol-name sym))) | |
15734 | () | |
15735 | (let ((do-sub (gnus-matches-options-n group))) | |
231f989b | 15736 | (cond |
41487370 LMI |
15737 | ((eq do-sub 'subscribe) |
15738 | (gnus-sethash group group gnus-killed-hashtb) | |
15739 | (funcall gnus-subscribe-options-newsgroup-method group)) | |
15740 | ((eq do-sub 'ignore) | |
15741 | nil) | |
15742 | (t | |
15743 | (setq gnus-killed-list (cons group gnus-killed-list))))))) | |
15744 | gnus-active-hashtb) | |
15745 | (while groups | |
231f989b LMI |
15746 | (if (gnus-active (car groups)) |
15747 | (gnus-group-change-level | |
41487370 LMI |
15748 | (car groups) gnus-level-default-subscribed gnus-level-killed)) |
15749 | (setq groups (cdr groups))) | |
15750 | (gnus-group-make-help-group) | |
15751 | (and gnus-novice-user | |
15752 | (gnus-message 7 "`A k' to list killed groups")))))) | |
15753 | ||
15754 | (defun gnus-subscribe-group (group previous &optional method) | |
231f989b | 15755 | (gnus-group-change-level |
41487370 LMI |
15756 | (if method |
15757 | (list t group gnus-level-default-subscribed nil nil method) | |
231f989b | 15758 | group) |
41487370 LMI |
15759 | gnus-level-default-subscribed gnus-level-killed previous t)) |
15760 | ||
15761 | ;; `gnus-group-change-level' is the fundamental function for changing | |
231f989b | 15762 | ;; subscription levels of newsgroups. This might mean just changing |
41487370 LMI |
15763 | ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back |
15764 | ;; again, which subscribes/unsubscribes a group, which is equally | |
231f989b | 15765 | ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and |
41487370 LMI |
15766 | ;; from 8-9 to 1-7 means that you remove the group from the list of |
15767 | ;; killed (or zombie) groups and add them to the (kinda) subscribed | |
231f989b | 15768 | ;; groups. And last but not least, moving from 8 to 9 and 9 to 8, |
41487370 LMI |
15769 | ;; which is trivial. |
15770 | ;; ENTRY can either be a string (newsgroup name) or a list (if | |
15771 | ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), | |
15772 | ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' | |
231f989b | 15773 | ;; entries. |
41487370 LMI |
15774 | ;; LEVEL is the new level of the group, OLDLEVEL is the old level and |
15775 | ;; PREVIOUS is the group (in hashtb entry format) to insert this group | |
231f989b | 15776 | ;; after. |
41487370 LMI |
15777 | (defun gnus-group-change-level (entry level &optional oldlevel |
15778 | previous fromkilled) | |
15779 | (let (group info active num) | |
15780 | ;; Glean what info we can from the arguments | |
15781 | (if (consp entry) | |
15782 | (if fromkilled (setq group (nth 1 entry)) | |
15783 | (setq group (car (nth 2 entry)))) | |
15784 | (setq group entry)) | |
15785 | (if (and (stringp entry) | |
231f989b | 15786 | oldlevel |
41487370 LMI |
15787 | (< oldlevel gnus-level-zombie)) |
15788 | (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) | |
15789 | (if (and (not oldlevel) | |
15790 | (consp entry)) | |
231f989b LMI |
15791 | (setq oldlevel (gnus-info-level (nth 2 entry))) |
15792 | (setq oldlevel (or oldlevel 9))) | |
41487370 LMI |
15793 | (if (stringp previous) |
15794 | (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) | |
15795 | ||
15796 | (if (and (>= oldlevel gnus-level-zombie) | |
15797 | (gnus-gethash group gnus-newsrc-hashtb)) | |
15798 | ;; We are trying to subscribe a group that is already | |
231f989b LMI |
15799 | ;; subscribed. |
15800 | () ; Do nothing. | |
41487370 LMI |
15801 | |
15802 | (or (gnus-ephemeral-group-p group) | |
15803 | (gnus-dribble-enter | |
231f989b | 15804 | (format "(gnus-group-change-level %S %S %S %S %S)" |
41487370 | 15805 | group level oldlevel (car (nth 2 previous)) fromkilled))) |
231f989b | 15806 | |
41487370 LMI |
15807 | ;; Then we remove the newgroup from any old structures, if needed. |
15808 | ;; If the group was killed, we remove it from the killed or zombie | |
231f989b | 15809 | ;; list. If not, and it is in fact going to be killed, we remove |
41487370 | 15810 | ;; it from the newsrc hash table and assoc. |
231f989b LMI |
15811 | (cond |
15812 | ((>= oldlevel gnus-level-zombie) | |
15813 | (if (= oldlevel gnus-level-zombie) | |
15814 | (setq gnus-zombie-list (delete group gnus-zombie-list)) | |
15815 | (setq gnus-killed-list (delete group gnus-killed-list)))) | |
15816 | (t | |
15817 | (if (and (>= level gnus-level-zombie) | |
15818 | entry) | |
15819 | (progn | |
15820 | (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) | |
15821 | (if (nth 3 entry) | |
15822 | (setcdr (gnus-gethash (car (nth 3 entry)) | |
15823 | gnus-newsrc-hashtb) | |
15824 | (cdr entry))) | |
15825 | (setcdr (cdr entry) (cdddr entry)))))) | |
41487370 LMI |
15826 | |
15827 | ;; Finally we enter (if needed) the list where it is supposed to | |
231f989b | 15828 | ;; go, and change the subscription level. If it is to be killed, |
41487370 | 15829 | ;; we enter it into the killed or zombie list. |
231f989b LMI |
15830 | (cond |
15831 | ((>= level gnus-level-zombie) | |
15832 | ;; Remove from the hash table. | |
15833 | (gnus-sethash group nil gnus-newsrc-hashtb) | |
15834 | ;; We do not enter foreign groups into the list of dead | |
15835 | ;; groups. | |
15836 | (unless (gnus-group-foreign-p group) | |
15837 | (if (= level gnus-level-zombie) | |
15838 | (setq gnus-zombie-list (cons group gnus-zombie-list)) | |
15839 | (setq gnus-killed-list (cons group gnus-killed-list))))) | |
15840 | (t | |
15841 | ;; If the list is to be entered into the newsrc assoc, and | |
15842 | ;; it was killed, we have to create an entry in the newsrc | |
15843 | ;; hashtb format and fix the pointers in the newsrc assoc. | |
15844 | (if (< oldlevel gnus-level-zombie) | |
15845 | ;; It was alive, and it is going to stay alive, so we | |
15846 | ;; just change the level and don't change any pointers or | |
15847 | ;; hash table entries. | |
15848 | (setcar (cdaddr entry) level) | |
15849 | (if (listp entry) | |
15850 | (setq info (cdr entry) | |
15851 | num (car entry)) | |
15852 | (setq active (gnus-active group)) | |
15853 | (setq num | |
15854 | (if active (- (1+ (cdr active)) (car active)) t)) | |
15855 | ;; Check whether the group is foreign. If so, the | |
15856 | ;; foreign select method has to be entered into the | |
15857 | ;; info. | |
15858 | (let ((method (or gnus-override-subscribe-method | |
15859 | (gnus-group-method group)))) | |
15860 | (if (eq method gnus-select-method) | |
15861 | (setq info (list group level nil)) | |
15862 | (setq info (list group level nil nil method))))) | |
15863 | (unless previous | |
15864 | (setq previous | |
15865 | (let ((p gnus-newsrc-alist)) | |
15866 | (while (cddr p) | |
15867 | (setq p (cdr p))) | |
15868 | p))) | |
15869 | (setq entry (cons info (cddr previous))) | |
15870 | (if (cdr previous) | |
15871 | (progn | |
15872 | (setcdr (cdr previous) entry) | |
15873 | (gnus-sethash group (cons num (cdr previous)) | |
15874 | gnus-newsrc-hashtb)) | |
15875 | (setcdr previous entry) | |
15876 | (gnus-sethash group (cons num previous) | |
15877 | gnus-newsrc-hashtb)) | |
15878 | (when (cdr entry) | |
15879 | (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))))) | |
15880 | (when gnus-group-change-level-function | |
15881 | (funcall gnus-group-change-level-function group level oldlevel))))) | |
41487370 LMI |
15882 | |
15883 | (defun gnus-kill-newsgroup (newsgroup) | |
231f989b | 15884 | "Obsolete function. Kills a newsgroup." |
41487370 LMI |
15885 | (gnus-group-change-level |
15886 | (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) | |
745bc783 JB |
15887 | |
15888 | (defun gnus-check-bogus-newsgroups (&optional confirm) | |
41487370 LMI |
15889 | "Remove bogus newsgroups. |
15890 | If CONFIRM is non-nil, the user has to confirm the deletion of every | |
231f989b | 15891 | newsgroup." |
41487370 | 15892 | (let ((newsrc (cdr gnus-newsrc-alist)) |
231f989b | 15893 | bogus group entry info) |
41487370 | 15894 | (gnus-message 5 "Checking bogus newsgroups...") |
231f989b LMI |
15895 | (unless (gnus-read-active-file-p) |
15896 | (gnus-read-active-file)) | |
15897 | (when (gnus-read-active-file-p) | |
15898 | ;; Find all bogus newsgroup that are subscribed. | |
15899 | (while newsrc | |
15900 | (setq info (pop newsrc) | |
15901 | group (gnus-info-group info)) | |
15902 | (unless (or (gnus-active group) ; Active | |
15903 | (gnus-info-method info) ; Foreign | |
15904 | (and confirm | |
15905 | (not (gnus-y-or-n-p | |
15906 | (format "Remove bogus newsgroup: %s " group))))) | |
15907 | ;; Found a bogus newsgroup. | |
15908 | (push group bogus))) | |
15909 | ;; Remove all bogus subscribed groups by first killing them, and | |
15910 | ;; then removing them from the list of killed groups. | |
15911 | (while bogus | |
15912 | (when (setq entry (gnus-gethash (setq group (pop bogus)) | |
15913 | gnus-newsrc-hashtb)) | |
15914 | (gnus-group-change-level entry gnus-level-killed) | |
15915 | (setq gnus-killed-list (delete group gnus-killed-list)))) | |
15916 | ;; Then we remove all bogus groups from the list of killed and | |
15917 | ;; zombie groups. They are are removed without confirmation. | |
15918 | (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) | |
15919 | killed) | |
15920 | (while dead-lists | |
15921 | (setq killed (symbol-value (car dead-lists))) | |
15922 | (while killed | |
15923 | (unless (gnus-active (setq group (pop killed))) | |
41487370 | 15924 | ;; The group is bogus. |
231f989b | 15925 | ;; !!!Slow as hell. |
41487370 | 15926 | (set (car dead-lists) |
231f989b LMI |
15927 | (delete group (symbol-value (car dead-lists)))))) |
15928 | (setq dead-lists (cdr dead-lists)))) | |
15929 | (gnus-message 5 "Checking bogus newsgroups...done")))) | |
41487370 LMI |
15930 | |
15931 | (defun gnus-check-duplicate-killed-groups () | |
15932 | "Remove duplicates from the list of killed groups." | |
15933 | (interactive) | |
15934 | (let ((killed gnus-killed-list)) | |
15935 | (while killed | |
15936 | (gnus-message 9 "%d" (length killed)) | |
15937 | (setcdr killed (delete (car killed) (cdr killed))) | |
15938 | (setq killed (cdr killed))))) | |
15939 | ||
231f989b LMI |
15940 | ;; We want to inline a function from gnus-cache, so we cheat here: |
15941 | (eval-when-compile | |
15942 | (provide 'gnus) | |
750ff6a8 | 15943 | (setq gnus-directory (or (getenv "SAVEDIR") "~/News/")) |
231f989b LMI |
15944 | (require 'gnus-cache)) |
15945 | ||
15946 | (defun gnus-get-unread-articles-in-group (info active &optional update) | |
15947 | (when active | |
15948 | ;; Allow the backend to update the info in the group. | |
15949 | (when (and update | |
15950 | (gnus-request-update-info | |
15951 | info (gnus-find-method-for-group (gnus-info-group info)))) | |
15952 | (gnus-activate-group (gnus-info-group info) nil t)) | |
15953 | (let* ((range (gnus-info-read info)) | |
15954 | (num 0)) | |
15955 | ;; If a cache is present, we may have to alter the active info. | |
15956 | (when (and gnus-use-cache info) | |
15957 | (inline (gnus-cache-possibly-alter-active | |
15958 | (gnus-info-group info) active))) | |
15959 | ;; Modify the list of read articles according to what articles | |
15960 | ;; are available; then tally the unread articles and add the | |
15961 | ;; number to the group hash table entry. | |
15962 | (cond | |
15963 | ((zerop (cdr active)) | |
15964 | (setq num 0)) | |
15965 | ((not range) | |
15966 | (setq num (- (1+ (cdr active)) (car active)))) | |
15967 | ((not (listp (cdr range))) | |
15968 | ;; Fix a single (num . num) range according to the | |
15969 | ;; active hash table. | |
15970 | ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>. | |
15971 | (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) | |
15972 | (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) | |
15973 | ;; Compute number of unread articles. | |
15974 | (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) | |
15975 | (t | |
15976 | ;; The read list is a list of ranges. Fix them according to | |
15977 | ;; the active hash table. | |
15978 | ;; First peel off any elements that are below the lower | |
15979 | ;; active limit. | |
15980 | (while (and (cdr range) | |
15981 | (>= (car active) | |
15982 | (or (and (atom (cadr range)) (cadr range)) | |
15983 | (caadr range)))) | |
15984 | (if (numberp (car range)) | |
15985 | (setcar range | |
15986 | (cons (car range) | |
15987 | (or (and (numberp (cadr range)) | |
15988 | (cadr range)) | |
15989 | (cdadr range)))) | |
15990 | (setcdr (car range) | |
15991 | (or (and (numberp (nth 1 range)) (nth 1 range)) | |
15992 | (cdadr range)))) | |
15993 | (setcdr range (cddr range))) | |
15994 | ;; Adjust the first element to be the same as the lower limit. | |
15995 | (if (and (not (atom (car range))) | |
15996 | (< (cdar range) (car active))) | |
15997 | (setcdr (car range) (1- (car active)))) | |
15998 | ;; Then we want to peel off any elements that are higher | |
15999 | ;; than the upper active limit. | |
16000 | (let ((srange range)) | |
16001 | ;; Go past all legal elements. | |
16002 | (while (and (cdr srange) | |
16003 | (<= (or (and (atom (cadr srange)) | |
16004 | (cadr srange)) | |
16005 | (caadr srange)) (cdr active))) | |
16006 | (setq srange (cdr srange))) | |
16007 | (if (cdr srange) | |
16008 | ;; Nuke all remaining illegal elements. | |
16009 | (setcdr srange nil)) | |
16010 | ||
16011 | ;; Adjust the final element. | |
16012 | (if (and (not (atom (car srange))) | |
16013 | (> (cdar srange) (cdr active))) | |
16014 | (setcdr (car srange) (cdr active)))) | |
16015 | ;; Compute the number of unread articles. | |
16016 | (while range | |
16017 | (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) | |
16018 | (cdar range))) | |
16019 | (or (and (atom (car range)) (car range)) | |
16020 | (caar range))))) | |
16021 | (setq range (cdr range))) | |
16022 | (setq num (max 0 (- (cdr active) num))))) | |
16023 | ;; Set the number of unread articles. | |
16024 | (when info | |
16025 | (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) | |
16026 | num))) | |
16027 | ||
41487370 LMI |
16028 | ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' |
16029 | ;; and compute how many unread articles there are in each group. | |
231f989b | 16030 | (defun gnus-get-unread-articles (&optional level) |
41487370 | 16031 | (let* ((newsrc (cdr gnus-newsrc-alist)) |
231f989b | 16032 | (level (or level gnus-activate-level (1+ gnus-level-subscribed))) |
41487370 | 16033 | (foreign-level |
231f989b LMI |
16034 | (min |
16035 | (cond ((and gnus-activate-foreign-newsgroups | |
41487370 LMI |
16036 | (not (numberp gnus-activate-foreign-newsgroups))) |
16037 | (1+ gnus-level-subscribed)) | |
16038 | ((numberp gnus-activate-foreign-newsgroups) | |
16039 | gnus-activate-foreign-newsgroups) | |
16040 | (t 0)) | |
16041 | level)) | |
231f989b | 16042 | info group active method) |
41487370 | 16043 | (gnus-message 5 "Checking new news...") |
745bc783 | 16044 | |
41487370 | 16045 | (while newsrc |
231f989b LMI |
16046 | (setq active (gnus-active (setq group (gnus-info-group |
16047 | (setq info (pop newsrc)))))) | |
41487370 | 16048 | |
231f989b | 16049 | ;; Check newsgroups. If the user doesn't want to check them, or |
41487370 LMI |
16050 | ;; they can't be checked (for instance, if the news server can't |
16051 | ;; be reached) we just set the number of unread articles in this | |
231f989b | 16052 | ;; newsgroup to t. This means that Gnus thinks that there are |
41487370 | 16053 | ;; unread articles, but it has no idea how many. |
231f989b LMI |
16054 | (if (and (setq method (gnus-info-method info)) |
16055 | (not (gnus-server-equal | |
16056 | gnus-select-method | |
16057 | (setq method (gnus-server-get-method nil method)))) | |
41487370 | 16058 | (not (gnus-secondary-method-p method))) |
231f989b LMI |
16059 | ;; These groups are foreign. Check the level. |
16060 | (when (<= (gnus-info-level info) foreign-level) | |
16061 | (setq active (gnus-activate-group group 'scan)) | |
16062 | (unless (inline (gnus-virtual-group-p group)) | |
16063 | (inline (gnus-close-group group))) | |
16064 | (when (fboundp (intern (concat (symbol-name (car method)) | |
16065 | "-request-update-info"))) | |
16066 | (inline (gnus-request-update-info info method)))) | |
16067 | ;; These groups are native or secondary. | |
16068 | (when (and (<= (gnus-info-level info) level) | |
16069 | (not gnus-read-active-file)) | |
16070 | (setq active (gnus-activate-group group 'scan)) | |
16071 | (inline (gnus-close-group group)))) | |
16072 | ||
16073 | ;; Get the number of unread articles in the group. | |
41487370 | 16074 | (if active |
231f989b | 16075 | (inline (gnus-get-unread-articles-in-group info active)) |
41487370 LMI |
16076 | ;; The group couldn't be reached, so we nix out the number of |
16077 | ;; unread articles and stuff. | |
231f989b LMI |
16078 | (gnus-set-active group nil) |
16079 | (setcar (gnus-gethash group gnus-newsrc-hashtb) t))) | |
41487370 LMI |
16080 | |
16081 | (gnus-message 5 "Checking new news...done"))) | |
16082 | ||
231f989b | 16083 | ;; Create a hash table out of the newsrc alist. The `car's of the |
41487370 LMI |
16084 | ;; alist elements are used as keys. |
16085 | (defun gnus-make-hashtable-from-newsrc-alist () | |
16086 | (let ((alist gnus-newsrc-alist) | |
16087 | (ohashtb gnus-newsrc-hashtb) | |
16088 | prev) | |
16089 | (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) | |
231f989b LMI |
16090 | (setq alist |
16091 | (setq prev (setq gnus-newsrc-alist | |
16092 | (if (equal (caar gnus-newsrc-alist) | |
41487370 LMI |
16093 | "dummy.group") |
16094 | gnus-newsrc-alist | |
16095 | (cons (list "dummy.group" 0 nil) alist))))) | |
16096 | (while alist | |
231f989b LMI |
16097 | (gnus-sethash |
16098 | (caar alist) | |
16099 | (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) | |
16100 | prev) | |
16101 | gnus-newsrc-hashtb) | |
41487370 LMI |
16102 | (setq prev alist |
16103 | alist (cdr alist))))) | |
16104 | ||
16105 | (defun gnus-make-hashtable-from-killed () | |
16106 | "Create a hash table from the killed and zombie lists." | |
16107 | (let ((lists '(gnus-killed-list gnus-zombie-list)) | |
16108 | list) | |
231f989b LMI |
16109 | (setq gnus-killed-hashtb |
16110 | (gnus-make-hashtable | |
41487370 | 16111 | (+ (length gnus-killed-list) (length gnus-zombie-list)))) |
231f989b LMI |
16112 | (while (setq list (pop lists)) |
16113 | (setq list (symbol-value list)) | |
41487370 | 16114 | (while list |
231f989b LMI |
16115 | (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) |
16116 | ||
16117 | (defun gnus-activate-group (group &optional scan dont-check method) | |
41487370 | 16118 | ;; Check whether a group has been activated or not. |
231f989b LMI |
16119 | ;; If SCAN, request a scan of that group as well. |
16120 | (let ((method (or method (gnus-find-method-for-group group))) | |
41487370 LMI |
16121 | active) |
16122 | (and (gnus-check-server method) | |
16123 | ;; We escape all bugs and quit here to make it possible to | |
16124 | ;; continue if a group is so out-there that it reports bugs | |
16125 | ;; and stuff. | |
231f989b LMI |
16126 | (progn |
16127 | (and scan | |
16128 | (gnus-check-backend-function 'request-scan (car method)) | |
16129 | (gnus-request-scan group method)) | |
16130 | t) | |
41487370 | 16131 | (condition-case () |
231f989b LMI |
16132 | (gnus-request-group group dont-check method) |
16133 | ; (error nil) | |
41487370 LMI |
16134 | (quit nil)) |
16135 | (save-excursion | |
16136 | (set-buffer nntp-server-buffer) | |
16137 | (goto-char (point-min)) | |
16138 | ;; Parse the result we got from `gnus-request-group'. | |
16139 | (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") | |
16140 | (progn | |
16141 | (goto-char (match-beginning 1)) | |
231f989b | 16142 | (gnus-set-active |
41487370 | 16143 | group (setq active (cons (read (current-buffer)) |
231f989b LMI |
16144 | (read (current-buffer))))) |
16145 | ;; Return the new active info. | |
16146 | active)))))) | |
16147 | ||
16148 | (defun gnus-update-read-articles (group unread) | |
41487370 LMI |
16149 | "Update the list of read and ticked articles in GROUP using the |
16150 | UNREAD and TICKED lists. | |
16151 | Note: UNSELECTED has to be sorted over `<'. | |
16152 | Returns whether the updating was successful." | |
231f989b | 16153 | (let* ((active (or gnus-newsgroup-active (gnus-active group))) |
41487370 LMI |
16154 | (entry (gnus-gethash group gnus-newsrc-hashtb)) |
16155 | (info (nth 2 entry)) | |
41487370 | 16156 | (prev 1) |
231f989b | 16157 | (unread (sort (copy-sequence unread) '<)) |
41487370 LMI |
16158 | read) |
16159 | (if (or (not info) (not active)) | |
16160 | ;; There is no info on this group if it was, in fact, | |
231f989b LMI |
16161 | ;; killed. Gnus stores no information on killed groups, so |
16162 | ;; there's nothing to be done. | |
41487370 | 16163 | ;; One could store the information somewhere temporarily, |
231f989b | 16164 | ;; perhaps... Hmmm... |
41487370 LMI |
16165 | () |
16166 | ;; Remove any negative articles numbers. | |
16167 | (while (and unread (< (car unread) 0)) | |
16168 | (setq unread (cdr unread))) | |
16169 | ;; Remove any expired article numbers | |
16170 | (while (and unread (< (car unread) (car active))) | |
16171 | (setq unread (cdr unread))) | |
41487370 | 16172 | ;; Compute the ranges of read articles by looking at the list of |
231f989b | 16173 | ;; unread articles. |
41487370 LMI |
16174 | (while unread |
16175 | (if (/= (car unread) prev) | |
16176 | (setq read (cons (if (= prev (1- (car unread))) prev | |
16177 | (cons prev (1- (car unread)))) read))) | |
16178 | (setq prev (1+ (car unread))) | |
16179 | (setq unread (cdr unread))) | |
231f989b LMI |
16180 | (when (<= prev (cdr active)) |
16181 | (setq read (cons (cons prev (cdr active)) read))) | |
41487370 | 16182 | ;; Enter this list into the group info. |
231f989b LMI |
16183 | (gnus-info-set-read |
16184 | info (if (> (length read) 1) (nreverse read) read)) | |
41487370 | 16185 | ;; Set the number of unread articles in gnus-newsrc-hashtb. |
231f989b | 16186 | (gnus-get-unread-articles-in-group info (gnus-active group)) |
41487370 LMI |
16187 | t))) |
16188 | ||
16189 | (defun gnus-make-articles-unread (group articles) | |
16190 | "Mark ARTICLES in GROUP as unread." | |
16191 | (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) | |
16192 | (gnus-gethash (gnus-group-real-name group) | |
16193 | gnus-newsrc-hashtb)))) | |
231f989b LMI |
16194 | (ranges (gnus-info-read info)) |
16195 | news article) | |
41487370 | 16196 | (while articles |
231f989b LMI |
16197 | (when (gnus-member-of-range |
16198 | (setq article (pop articles)) ranges) | |
16199 | (setq news (cons article news)))) | |
16200 | (when news | |
16201 | (gnus-info-set-read | |
16202 | info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) | |
41487370 LMI |
16203 | (gnus-group-update-group group t)))) |
16204 | ||
16205 | ;; Enter all dead groups into the hashtb. | |
16206 | (defun gnus-update-active-hashtb-from-killed () | |
16207 | (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0))) | |
16208 | (lists (list gnus-killed-list gnus-zombie-list)) | |
16209 | killed) | |
16210 | (while lists | |
16211 | (setq killed (car lists)) | |
16212 | (while killed | |
16213 | (gnus-sethash (car killed) nil hashtb) | |
16214 | (setq killed (cdr killed))) | |
16215 | (setq lists (cdr lists))))) | |
16216 | ||
231f989b LMI |
16217 | (defun gnus-get-killed-groups () |
16218 | "Go through the active hashtb and all all unknown groups as killed." | |
16219 | ;; First make sure active file has been read. | |
16220 | (unless (gnus-read-active-file-p) | |
16221 | (let ((gnus-read-active-file t)) | |
16222 | (gnus-read-active-file))) | |
16223 | (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) | |
16224 | ;; Go through all newsgroups that are known to Gnus - enlarge kill list. | |
16225 | (mapatoms | |
16226 | (lambda (sym) | |
16227 | (let ((groups 0) | |
16228 | (group (symbol-name sym))) | |
16229 | (if (or (null group) | |
16230 | (gnus-gethash group gnus-killed-hashtb) | |
16231 | (gnus-gethash group gnus-newsrc-hashtb)) | |
16232 | () | |
16233 | (let ((do-sub (gnus-matches-options-n group))) | |
16234 | (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) | |
16235 | () | |
16236 | (setq groups (1+ groups)) | |
16237 | (setq gnus-killed-list | |
16238 | (cons group gnus-killed-list)) | |
16239 | (gnus-sethash group group gnus-killed-hashtb)))))) | |
16240 | gnus-active-hashtb)) | |
16241 | ||
41487370 | 16242 | ;; Get the active file(s) from the backend(s). |
745bc783 | 16243 | (defun gnus-read-active-file () |
41487370 | 16244 | (gnus-group-set-mode-line) |
231f989b LMI |
16245 | (let ((methods |
16246 | (append | |
16247 | (if (gnus-check-server gnus-select-method) | |
16248 | ;; The native server is available. | |
16249 | (cons gnus-select-method gnus-secondary-select-methods) | |
16250 | ;; The native server is down, so we just do the | |
16251 | ;; secondary ones. | |
16252 | gnus-secondary-select-methods) | |
16253 | ;; Also read from the archive server. | |
564b670b | 16254 | (when (gnus-archive-server-wanted-p) |
231f989b | 16255 | (list "archive")))) |
41487370 LMI |
16256 | list-type) |
16257 | (setq gnus-have-read-active-file nil) | |
16258 | (save-excursion | |
16259 | (set-buffer nntp-server-buffer) | |
16260 | (while methods | |
231f989b LMI |
16261 | (let* ((method (if (stringp (car methods)) |
16262 | (gnus-server-get-method nil (car methods)) | |
16263 | (car methods))) | |
41487370 LMI |
16264 | (where (nth 1 method)) |
16265 | (mesg (format "Reading active file%s via %s..." | |
16266 | (if (and where (not (zerop (length where)))) | |
16267 | (concat " from " where) "") | |
16268 | (car method)))) | |
16269 | (gnus-message 5 mesg) | |
231f989b LMI |
16270 | (when (gnus-check-server method) |
16271 | ;; Request that the backend scan its incoming messages. | |
16272 | (and (gnus-check-backend-function 'request-scan (car method)) | |
16273 | (gnus-request-scan nil method)) | |
16274 | (cond | |
41487370 LMI |
16275 | ((and (eq gnus-read-active-file 'some) |
16276 | (gnus-check-backend-function 'retrieve-groups (car method))) | |
16277 | (let ((newsrc (cdr gnus-newsrc-alist)) | |
16278 | (gmethod (gnus-server-get-method nil method)) | |
231f989b LMI |
16279 | groups info) |
16280 | (while (setq info (pop newsrc)) | |
16281 | (when (gnus-server-equal | |
16282 | (gnus-find-method-for-group | |
16283 | (gnus-info-group info) info) | |
16284 | gmethod) | |
16285 | (push (gnus-group-real-name (gnus-info-group info)) | |
16286 | groups))) | |
16287 | (when groups | |
16288 | (gnus-check-server method) | |
16289 | (setq list-type (gnus-retrieve-groups groups method)) | |
16290 | (cond | |
16291 | ((not list-type) | |
16292 | (gnus-error | |
16293 | 1.2 "Cannot read partial active file from %s server." | |
16294 | (car method))) | |
16295 | ((eq list-type 'active) | |
16296 | (gnus-active-to-gnus-format method gnus-active-hashtb)) | |
16297 | (t | |
16298 | (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) | |
41487370 LMI |
16299 | (t |
16300 | (if (not (gnus-request-list method)) | |
231f989b LMI |
16301 | (unless (equal method gnus-message-archive-method) |
16302 | (gnus-error 1 "Cannot read active file from %s server." | |
16303 | (car method))) | |
16304 | (gnus-message 5 mesg) | |
16305 | (gnus-active-to-gnus-format method gnus-active-hashtb) | |
41487370 | 16306 | ;; We mark this active file as read. |
231f989b | 16307 | (push method gnus-have-read-active-file) |
41487370 LMI |
16308 | (gnus-message 5 "%sdone" mesg)))))) |
16309 | (setq methods (cdr methods)))))) | |
16310 | ||
16311 | ;; Read an active file and place the results in `gnus-active-hashtb'. | |
231f989b LMI |
16312 | (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) |
16313 | (unless method | |
16314 | (setq method gnus-select-method)) | |
41487370 | 16315 | (let ((cur (current-buffer)) |
231f989b LMI |
16316 | (hashtb (or hashtb |
16317 | (if (and gnus-active-hashtb | |
41487370 LMI |
16318 | (not (equal method gnus-select-method))) |
16319 | gnus-active-hashtb | |
16320 | (setq gnus-active-hashtb | |
16321 | (if (equal method gnus-select-method) | |
231f989b | 16322 | (gnus-make-hashtable |
41487370 | 16323 | (count-lines (point-min) (point-max))) |
231f989b | 16324 | (gnus-make-hashtable 4096))))))) |
41487370 LMI |
16325 | ;; Delete unnecessary lines. |
16326 | (goto-char (point-min)) | |
16327 | (while (search-forward "\nto." nil t) | |
231f989b | 16328 | (delete-region (1+ (match-beginning 0)) |
41487370 LMI |
16329 | (progn (forward-line 1) (point)))) |
16330 | (or (string= gnus-ignored-newsgroups "") | |
16331 | (progn | |
16332 | (goto-char (point-min)) | |
16333 | (delete-matching-lines gnus-ignored-newsgroups))) | |
16334 | ;; Make the group names readable as a lisp expression even if they | |
16335 | ;; contain special characters. | |
16336 | ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>. | |
16337 | (goto-char (point-max)) | |
16338 | (while (re-search-backward "[][';?()#]" nil t) | |
16339 | (insert ?\\)) | |
16340 | ;; If these are groups from a foreign select method, we insert the | |
231f989b | 16341 | ;; group prefix in front of the group names. |
41487370 LMI |
16342 | (and method (not (gnus-server-equal |
16343 | (gnus-server-get-method nil method) | |
16344 | (gnus-server-get-method nil gnus-select-method))) | |
16345 | (let ((prefix (gnus-group-prefixed-name "" method))) | |
16346 | (goto-char (point-min)) | |
16347 | (while (and (not (eobp)) | |
16348 | (progn (insert prefix) | |
16349 | (zerop (forward-line 1))))))) | |
16350 | ;; Store the active file in a hash table. | |
16351 | (goto-char (point-min)) | |
16352 | (if (string-match "%[oO]" gnus-group-line-format) | |
16353 | ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>. | |
16354 | ;; If we want information on moderated groups, we use this | |
231f989b | 16355 | ;; loop... |
41487370 LMI |
16356 | (let* ((mod-hashtb (make-vector 7 0)) |
16357 | (m (intern "m" mod-hashtb)) | |
16358 | group max min) | |
16359 | (while (not (eobp)) | |
16360 | (condition-case nil | |
16361 | (progn | |
16362 | (narrow-to-region (point) (gnus-point-at-eol)) | |
16363 | (setq group (let ((obarray hashtb)) (read cur))) | |
16364 | (if (and (numberp (setq max (read cur))) | |
16365 | (numberp (setq min (read cur))) | |
231f989b | 16366 | (progn |
41487370 LMI |
16367 | (skip-chars-forward " \t") |
16368 | (not | |
16369 | (or (= (following-char) ?=) | |
16370 | (= (following-char) ?x) | |
16371 | (= (following-char) ?j))))) | |
16372 | (set group (cons min max)) | |
16373 | (set group nil)) | |
16374 | ;; Enter moderated groups into a list. | |
16375 | (if (eq (let ((obarray mod-hashtb)) (read cur)) m) | |
231f989b | 16376 | (setq gnus-moderated-list |
41487370 | 16377 | (cons (symbol-name group) gnus-moderated-list)))) |
231f989b | 16378 | (error |
41487370 LMI |
16379 | (and group |
16380 | (symbolp group) | |
16381 | (set group nil)))) | |
16382 | (widen) | |
16383 | (forward-line 1))) | |
16384 | ;; And if we do not care about moderation, we use this loop, | |
16385 | ;; which is faster. | |
16386 | (let (group max min) | |
16387 | (while (not (eobp)) | |
16388 | (condition-case () | |
16389 | (progn | |
16390 | (narrow-to-region (point) (gnus-point-at-eol)) | |
16391 | ;; group gets set to a symbol interned in the hash table | |
16392 | ;; (what a hack!!) - jwz | |
16393 | (setq group (let ((obarray hashtb)) (read cur))) | |
16394 | (if (and (numberp (setq max (read cur))) | |
16395 | (numberp (setq min (read cur))) | |
231f989b | 16396 | (progn |
41487370 LMI |
16397 | (skip-chars-forward " \t") |
16398 | (not | |
16399 | (or (= (following-char) ?=) | |
16400 | (= (following-char) ?x) | |
16401 | (= (following-char) ?j))))) | |
16402 | (set group (cons min max)) | |
16403 | (set group nil))) | |
231f989b LMI |
16404 | (error |
16405 | (progn | |
41487370 LMI |
16406 | (and group |
16407 | (symbolp group) | |
16408 | (set group nil)) | |
16409 | (or ignore-errors | |
16410 | (gnus-message 3 "Warning - illegal active: %s" | |
231f989b | 16411 | (buffer-substring |
41487370 LMI |
16412 | (gnus-point-at-bol) (gnus-point-at-eol))))))) |
16413 | (widen) | |
16414 | (forward-line 1)))))) | |
16415 | ||
16416 | (defun gnus-groups-to-gnus-format (method &optional hashtb) | |
16417 | ;; Parse a "groups" active file. | |
16418 | (let ((cur (current-buffer)) | |
231f989b | 16419 | (hashtb (or hashtb |
41487370 LMI |
16420 | (if (and method gnus-active-hashtb) |
16421 | gnus-active-hashtb | |
16422 | (setq gnus-active-hashtb | |
231f989b | 16423 | (gnus-make-hashtable |
41487370 | 16424 | (count-lines (point-min) (point-max))))))) |
231f989b | 16425 | (prefix (and method |
41487370 LMI |
16426 | (not (gnus-server-equal |
16427 | (gnus-server-get-method nil method) | |
16428 | (gnus-server-get-method nil gnus-select-method))) | |
16429 | (gnus-group-prefixed-name "" method)))) | |
745bc783 | 16430 | |
41487370 LMI |
16431 | (goto-char (point-min)) |
16432 | ;; We split this into to separate loops, one with the prefix | |
16433 | ;; and one without to speed the reading up somewhat. | |
16434 | (if prefix | |
16435 | (let (min max opoint group) | |
16436 | (while (not (eobp)) | |
16437 | (condition-case () | |
16438 | (progn | |
16439 | (read cur) (read cur) | |
16440 | (setq min (read cur) | |
16441 | max (read cur) | |
16442 | opoint (point)) | |
16443 | (skip-chars-forward " \t") | |
16444 | (insert prefix) | |
16445 | (goto-char opoint) | |
231f989b | 16446 | (set (let ((obarray hashtb)) (read cur)) |
41487370 LMI |
16447 | (cons min max))) |
16448 | (error (and group (symbolp group) (set group nil)))) | |
16449 | (forward-line 1))) | |
16450 | (let (min max group) | |
16451 | (while (not (eobp)) | |
16452 | (condition-case () | |
16453 | (if (= (following-char) ?2) | |
16454 | (progn | |
16455 | (read cur) (read cur) | |
16456 | (setq min (read cur) | |
16457 | max (read cur)) | |
16458 | (set (setq group (let ((obarray hashtb)) (read cur))) | |
16459 | (cons min max)))) | |
16460 | (error (and group (symbolp group) (set group nil)))) | |
16461 | (forward-line 1)))))) | |
16462 | ||
16463 | (defun gnus-read-newsrc-file (&optional force) | |
16464 | "Read startup file. | |
16465 | If FORCE is non-nil, the .newsrc file is read." | |
16466 | ;; Reset variables that might be defined in the .newsrc.eld file. | |
745bc783 JB |
16467 | (let ((variables gnus-variable-list)) |
16468 | (while variables | |
16469 | (set (car variables) nil) | |
16470 | (setq variables (cdr variables)))) | |
16471 | (let* ((newsrc-file gnus-current-startup-file) | |
41487370 | 16472 | (quick-file (concat newsrc-file ".el"))) |
745bc783 | 16473 | (save-excursion |
231f989b | 16474 | ;; We always load the .newsrc.eld file. If always contains |
41487370 LMI |
16475 | ;; much information that can not be gotten from the .newsrc |
16476 | ;; file (ticked articles, killed groups, foreign methods, etc.) | |
16477 | (gnus-read-newsrc-el-file quick-file) | |
231f989b LMI |
16478 | |
16479 | (if (and (file-exists-p gnus-current-startup-file) | |
16480 | (or force | |
16481 | (and (file-newer-than-file-p newsrc-file quick-file) | |
16482 | (file-newer-than-file-p newsrc-file | |
16483 | (concat quick-file "d"))) | |
16484 | (not gnus-newsrc-alist))) | |
16485 | ;; We read the .newsrc file. Note that if there if a | |
41487370 | 16486 | ;; .newsrc.eld file exists, it has already been read, and |
231f989b | 16487 | ;; the `gnus-newsrc-hashtb' has been created. While reading |
41487370 LMI |
16488 | ;; the .newsrc file, Gnus will only use the information it |
16489 | ;; can find there for changing the data already read - | |
16490 | ;; ie. reading the .newsrc file will not trash the data | |
16491 | ;; already read (except for read articles). | |
16492 | (save-excursion | |
16493 | (gnus-message 5 "Reading %s..." newsrc-file) | |
16494 | (set-buffer (find-file-noselect newsrc-file)) | |
16495 | (buffer-disable-undo (current-buffer)) | |
16496 | (gnus-newsrc-to-gnus-format) | |
16497 | (kill-buffer (current-buffer)) | |
231f989b LMI |
16498 | (gnus-message 5 "Reading %s...done" newsrc-file))) |
16499 | ||
16500 | ;; Read any slave files. | |
16501 | (unless gnus-slave | |
16502 | (gnus-master-read-slave-newsrc)) | |
16503 | ||
16504 | ;; Convert old to new. | |
16505 | (gnus-convert-old-newsrc)))) | |
16506 | ||
16507 | (defun gnus-continuum-version (version) | |
16508 | "Return VERSION as a floating point number." | |
16509 | (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) | |
16510 | (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) | |
16511 | (let* ((alpha (and (match-beginning 1) (match-string 1 version))) | |
16512 | (number (match-string 2 version)) | |
16513 | major minor least) | |
16514 | (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) | |
16515 | (setq major (string-to-number (match-string 1 number))) | |
16516 | (setq minor (string-to-number (match-string 2 number))) | |
16517 | (setq least (if (match-beginning 3) | |
16518 | (string-to-number (match-string 3 number)) | |
16519 | 0)) | |
16520 | (string-to-number | |
16521 | (if (zerop major) | |
16522 | (format "%s00%02d%02d" | |
16523 | (cond | |
16524 | ((member alpha '("(ding)" "d")) "4.99") | |
16525 | ((member alpha '("September" "s")) "5.01") | |
16526 | ((member alpha '("Red" "r")) "5.03")) | |
16527 | minor least) | |
16528 | (format "%d.%02d%02d" major minor least)))))) | |
16529 | ||
16530 | (defun gnus-convert-old-newsrc () | |
16531 | "Convert old newsrc into the new format, if needed." | |
16532 | (let ((fcv (and gnus-newsrc-file-version | |
16533 | (gnus-continuum-version gnus-newsrc-file-version)))) | |
16534 | (cond | |
16535 | ;; No .newsrc.eld file was loaded. | |
16536 | ((null fcv) nil) | |
16537 | ;; Gnus 5 .newsrc.eld was loaded. | |
16538 | ((< fcv (gnus-continuum-version "September Gnus v0.1")) | |
16539 | (gnus-convert-old-ticks))))) | |
16540 | ||
16541 | (defun gnus-convert-old-ticks () | |
16542 | (let ((newsrc (cdr gnus-newsrc-alist)) | |
16543 | marks info dormant ticked) | |
16544 | (while (setq info (pop newsrc)) | |
16545 | (when (setq marks (gnus-info-marks info)) | |
16546 | (setq dormant (cdr (assq 'dormant marks)) | |
16547 | ticked (cdr (assq 'tick marks))) | |
16548 | (when (or dormant ticked) | |
16549 | (gnus-info-set-read | |
16550 | info | |
16551 | (gnus-add-to-range | |
16552 | (gnus-info-read info) | |
16553 | (nconc (gnus-uncompress-range dormant) | |
16554 | (gnus-uncompress-range ticked))))))))) | |
41487370 LMI |
16555 | |
16556 | (defun gnus-read-newsrc-el-file (file) | |
16557 | (let ((ding-file (concat file "d"))) | |
16558 | ;; We always, always read the .eld file. | |
16559 | (gnus-message 5 "Reading %s..." ding-file) | |
16560 | (let (gnus-newsrc-assoc) | |
745bc783 | 16561 | (condition-case nil |
41487370 | 16562 | (load ding-file t t t) |
231f989b LMI |
16563 | (error |
16564 | (gnus-error 1 "Error in %s" ding-file))) | |
16565 | (when gnus-newsrc-assoc | |
16566 | (setq gnus-newsrc-alist gnus-newsrc-assoc))) | |
41487370 | 16567 | (gnus-make-hashtable-from-newsrc-alist) |
231f989b | 16568 | (when (file-newer-than-file-p file ding-file) |
41487370 LMI |
16569 | ;; Old format quick file |
16570 | (gnus-message 5 "Reading %s..." file) | |
16571 | ;; The .el file is newer than the .eld file, so we read that one | |
231f989b | 16572 | ;; as well. |
41487370 LMI |
16573 | (gnus-read-old-newsrc-el-file file)))) |
16574 | ||
16575 | ;; Parse the old-style quick startup file | |
16576 | (defun gnus-read-old-newsrc-el-file (file) | |
231f989b | 16577 | (let (newsrc killed marked group m info) |
41487370 LMI |
16578 | (prog1 |
16579 | (let ((gnus-killed-assoc nil) | |
16580 | gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) | |
16581 | (prog1 | |
16582 | (condition-case nil | |
16583 | (load file t t t) | |
16584 | (error nil)) | |
16585 | (setq newsrc gnus-newsrc-assoc | |
16586 | killed gnus-killed-assoc | |
16587 | marked gnus-marked-assoc))) | |
16588 | (setq gnus-newsrc-alist nil) | |
231f989b LMI |
16589 | (while (setq group (pop newsrc)) |
16590 | (if (setq info (gnus-get-info (car group))) | |
16591 | (progn | |
16592 | (gnus-info-set-read info (cddr group)) | |
16593 | (gnus-info-set-level | |
16594 | info (if (nth 1 group) gnus-level-default-subscribed | |
16595 | gnus-level-default-unsubscribed)) | |
16596 | (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) | |
16597 | (push (setq info | |
16598 | (list (car group) | |
16599 | (if (nth 1 group) gnus-level-default-subscribed | |
16600 | gnus-level-default-unsubscribed) | |
16601 | (cddr group))) | |
16602 | gnus-newsrc-alist)) | |
16603 | ;; Copy marks into info. | |
16604 | (when (setq m (assoc (car group) marked)) | |
16605 | (unless (nthcdr 3 info) | |
16606 | (nconc info (list nil))) | |
16607 | (gnus-info-set-marks | |
16608 | info (list (cons 'tick (gnus-compress-sequence | |
16609 | (sort (cdr m) '<) t)))))) | |
41487370 LMI |
16610 | (setq newsrc killed) |
16611 | (while newsrc | |
231f989b | 16612 | (setcar newsrc (caar newsrc)) |
41487370 LMI |
16613 | (setq newsrc (cdr newsrc))) |
16614 | (setq gnus-killed-list killed)) | |
16615 | ;; The .el file version of this variable does not begin with | |
16616 | ;; "options", while the .eld version does, so we just add it if it | |
16617 | ;; isn't there. | |
16618 | (and | |
231f989b | 16619 | gnus-newsrc-options |
41487370 LMI |
16620 | (progn |
16621 | (and (not (string-match "^ *options" gnus-newsrc-options)) | |
16622 | (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) | |
16623 | (and (not (string-match "\n$" gnus-newsrc-options)) | |
16624 | (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) | |
16625 | ;; Finally, if we read some options lines, we parse them. | |
16626 | (or (string= gnus-newsrc-options "") | |
16627 | (gnus-newsrc-parse-options gnus-newsrc-options)))) | |
16628 | ||
16629 | (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) | |
16630 | (gnus-make-hashtable-from-newsrc-alist))) | |
231f989b | 16631 | |
745bc783 JB |
16632 | (defun gnus-make-newsrc-file (file) |
16633 | "Make server dependent file name by catenating FILE and server host name." | |
16634 | (let* ((file (expand-file-name file nil)) | |
41487370 LMI |
16635 | (real-file (concat file "-" (nth 1 gnus-select-method)))) |
16636 | (if (or (file-exists-p real-file) | |
16637 | (file-exists-p (concat real-file ".el")) | |
16638 | (file-exists-p (concat real-file ".eld"))) | |
16639 | real-file file))) | |
16640 | ||
745bc783 | 16641 | (defun gnus-newsrc-to-gnus-format () |
41487370 LMI |
16642 | (setq gnus-newsrc-options "") |
16643 | (setq gnus-newsrc-options-n nil) | |
16644 | ||
16645 | (or gnus-active-hashtb | |
16646 | (setq gnus-active-hashtb (make-vector 4095 0))) | |
16647 | (let ((buf (current-buffer)) | |
16648 | (already-read (> (length gnus-newsrc-alist) 1)) | |
16649 | group subscribed options-symbol newsrc Options-symbol | |
16650 | symbol reads num1) | |
745bc783 | 16651 | (goto-char (point-min)) |
41487370 LMI |
16652 | ;; We intern the symbol `options' in the active hashtb so that we |
16653 | ;; can `eq' against it later. | |
16654 | (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) | |
16655 | (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) | |
231f989b | 16656 | |
41487370 LMI |
16657 | (while (not (eobp)) |
16658 | ;; We first read the first word on the line by narrowing and | |
16659 | ;; then reading into `gnus-active-hashtb'. Most groups will | |
16660 | ;; already exist in that hashtb, so this will save some string | |
16661 | ;; space. | |
16662 | (narrow-to-region | |
16663 | (point) | |
16664 | (progn (skip-chars-forward "^ \t!:\n") (point))) | |
16665 | (goto-char (point-min)) | |
231f989b | 16666 | (setq symbol |
41487370 LMI |
16667 | (and (/= (point-min) (point-max)) |
16668 | (let ((obarray gnus-active-hashtb)) (read buf)))) | |
16669 | (widen) | |
16670 | ;; Now, the symbol we have read is either `options' or a group | |
231f989b LMI |
16671 | ;; name. If it is an options line, we just add it to a string. |
16672 | (cond | |
41487370 LMI |
16673 | ((or (eq symbol options-symbol) |
16674 | (eq symbol Options-symbol)) | |
16675 | (setq gnus-newsrc-options | |
b94ae5f7 | 16676 | ;; This concating is quite inefficient, but since our |
41487370 LMI |
16677 | ;; thorough studies show that approx 99.37% of all |
16678 | ;; .newsrc files only contain a single options line, we | |
16679 | ;; don't give a damn, frankly, my dear. | |
16680 | (concat gnus-newsrc-options | |
231f989b | 16681 | (buffer-substring |
41487370 LMI |
16682 | (gnus-point-at-bol) |
16683 | ;; Options may continue on the next line. | |
16684 | (or (and (re-search-forward "^[^ \t]" nil 'move) | |
16685 | (progn (beginning-of-line) (point))) | |
16686 | (point))))) | |
16687 | (forward-line -1)) | |
16688 | (symbol | |
231f989b LMI |
16689 | ;; Group names can be just numbers. |
16690 | (when (numberp symbol) | |
16691 | (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) | |
41487370 LMI |
16692 | (or (boundp symbol) (set symbol nil)) |
16693 | ;; It was a group name. | |
16694 | (setq subscribed (= (following-char) ?:) | |
16695 | group (symbol-name symbol) | |
16696 | reads nil) | |
16697 | (if (eolp) | |
16698 | ;; If the line ends here, this is clearly a buggy line, so | |
16699 | ;; we put point a the beginning of line and let the cond | |
16700 | ;; below do the error handling. | |
16701 | (beginning-of-line) | |
16702 | ;; We skip to the beginning of the ranges. | |
16703 | (skip-chars-forward "!: \t")) | |
16704 | ;; We are now at the beginning of the list of read articles. | |
16705 | ;; We read them range by range. | |
16706 | (while | |
231f989b | 16707 | (cond |
41487370 LMI |
16708 | ((looking-at "[0-9]+") |
16709 | ;; We narrow and read a number instead of buffer-substring/ | |
231f989b | 16710 | ;; string-to-int because it's faster. narrow/widen is |
41487370 LMI |
16711 | ;; faster than save-restriction/narrow, and save-restriction |
16712 | ;; produces a garbage object. | |
16713 | (setq num1 (progn | |
16714 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
16715 | (read buf))) | |
16716 | (widen) | |
16717 | ;; If the next character is a dash, then this is a range. | |
16718 | (if (= (following-char) ?-) | |
16719 | (progn | |
16720 | ;; We read the upper bound of the range. | |
16721 | (forward-char 1) | |
16722 | (if (not (looking-at "[0-9]+")) | |
16723 | ;; This is a buggy line, by we pretend that | |
231f989b LMI |
16724 | ;; it's kinda OK. Perhaps the user should be |
16725 | ;; dinged? | |
41487370 | 16726 | (setq reads (cons num1 reads)) |
231f989b LMI |
16727 | (setq reads |
16728 | (cons | |
41487370 LMI |
16729 | (cons num1 |
16730 | (progn | |
231f989b | 16731 | (narrow-to-region (match-beginning 0) |
41487370 LMI |
16732 | (match-end 0)) |
16733 | (read buf))) | |
16734 | reads)) | |
16735 | (widen))) | |
16736 | ;; It was just a simple number, so we add it to the | |
16737 | ;; list of ranges. | |
16738 | (setq reads (cons num1 reads))) | |
16739 | ;; If the next char in ?\n, then we have reached the end | |
16740 | ;; of the line and return nil. | |
16741 | (/= (following-char) ?\n)) | |
16742 | ((= (following-char) ?\n) | |
16743 | ;; End of line, so we end. | |
16744 | nil) | |
16745 | (t | |
16746 | ;; Not numbers and not eol, so this might be a buggy | |
231f989b LMI |
16747 | ;; line... |
16748 | (or (eobp) | |
41487370 LMI |
16749 | ;; If it was eob instead of ?\n, we allow it. |
16750 | (progn | |
16751 | ;; The line was buggy. | |
16752 | (setq group nil) | |
231f989b LMI |
16753 | (gnus-error 3.1 "Mangled line: %s" |
16754 | (buffer-substring (gnus-point-at-bol) | |
16755 | (gnus-point-at-eol))))) | |
41487370 | 16756 | nil)) |
231f989b | 16757 | ;; Skip past ", ". Spaces are illegal in these ranges, but |
41487370 LMI |
16758 | ;; we allow them, because it's a common mistake to put a |
16759 | ;; space after the comma. | |
16760 | (skip-chars-forward ", ")) | |
16761 | ||
16762 | ;; We have already read .newsrc.eld, so we gently update the | |
16763 | ;; data in the hash table with the information we have just | |
231f989b LMI |
16764 | ;; read. |
16765 | (when group | |
16766 | (let ((info (gnus-get-info group)) | |
41487370 LMI |
16767 | level) |
16768 | (if info | |
16769 | ;; There is an entry for this file in the alist. | |
16770 | (progn | |
231f989b | 16771 | (gnus-info-set-read info (nreverse reads)) |
41487370 LMI |
16772 | ;; We update the level very gently. In fact, we |
16773 | ;; only change it if there's been a status change | |
16774 | ;; from subscribed to unsubscribed, or vice versa. | |
231f989b | 16775 | (setq level (gnus-info-level info)) |
41487370 LMI |
16776 | (cond ((and (<= level gnus-level-subscribed) |
16777 | (not subscribed)) | |
16778 | (setq level (if reads | |
231f989b | 16779 | gnus-level-default-unsubscribed |
41487370 LMI |
16780 | (1+ gnus-level-default-unsubscribed)))) |
16781 | ((and (> level gnus-level-subscribed) subscribed) | |
16782 | (setq level gnus-level-default-subscribed))) | |
231f989b | 16783 | (gnus-info-set-level info level)) |
41487370 | 16784 | ;; This is a new group. |
231f989b | 16785 | (setq info (list group |
41487370 | 16786 | (if subscribed |
231f989b | 16787 | gnus-level-default-subscribed |
41487370 LMI |
16788 | (if reads |
16789 | (1+ gnus-level-subscribed) | |
16790 | gnus-level-default-unsubscribed)) | |
16791 | (nreverse reads)))) | |
16792 | (setq newsrc (cons info newsrc)))))) | |
16793 | (forward-line 1)) | |
231f989b | 16794 | |
41487370 LMI |
16795 | (setq newsrc (nreverse newsrc)) |
16796 | ||
16797 | (if (not already-read) | |
16798 | () | |
16799 | ;; We now have two newsrc lists - `newsrc', which is what we | |
16800 | ;; have read from .newsrc, and `gnus-newsrc-alist', which is | |
231f989b LMI |
16801 | ;; what we've read from .newsrc.eld. We have to merge these |
16802 | ;; lists. We do this by "attaching" any (foreign) groups in the | |
16803 | ;; gnus-newsrc-alist to the (native) group that precedes them. | |
41487370 LMI |
16804 | (let ((rc (cdr gnus-newsrc-alist)) |
16805 | (prev gnus-newsrc-alist) | |
16806 | entry mentry) | |
16807 | (while rc | |
16808 | (or (null (nth 4 (car rc))) ; It's a native group. | |
231f989b LMI |
16809 | (assoc (caar rc) newsrc) ; It's already in the alist. |
16810 | (if (setq entry (assoc (caar prev) newsrc)) | |
41487370 LMI |
16811 | (setcdr (setq mentry (memq entry newsrc)) |
16812 | (cons (car rc) (cdr mentry))) | |
16813 | (setq newsrc (cons (car rc) newsrc)))) | |
16814 | (setq prev rc | |
16815 | rc (cdr rc))))) | |
16816 | ||
16817 | (setq gnus-newsrc-alist newsrc) | |
16818 | ;; We make the newsrc hashtb. | |
16819 | (gnus-make-hashtable-from-newsrc-alist) | |
16820 | ||
16821 | ;; Finally, if we read some options lines, we parse them. | |
16822 | (or (string= gnus-newsrc-options "") | |
16823 | (gnus-newsrc-parse-options gnus-newsrc-options)))) | |
16824 | ||
16825 | ;; Parse options lines to find "options -n !all rec.all" and stuff. | |
16826 | ;; The return value will be a list on the form | |
16827 | ;; ((regexp1 . ignore) | |
16828 | ;; (regexp2 . subscribe)...) | |
16829 | ;; When handling new newsgroups, groups that match a `ignore' regexp | |
16830 | ;; will be ignored, and groups that match a `subscribe' regexp will be | |
231f989b | 16831 | ;; subscribed. A line like |
41487370 LMI |
16832 | ;; options -n !all rec.all |
16833 | ;; will lead to a list that looks like | |
231f989b | 16834 | ;; (("^rec\\..+" . subscribe) |
41487370 LMI |
16835 | ;; ("^.+" . ignore)) |
16836 | ;; So all "rec.*" groups will be subscribed, while all the other | |
231f989b LMI |
16837 | ;; groups will be ignored. Note that "options -n !all rec.all" is very |
16838 | ;; different from "options -n rec.all !all". | |
41487370 LMI |
16839 | (defun gnus-newsrc-parse-options (options) |
16840 | (let (out eol) | |
16841 | (save-excursion | |
16842 | (gnus-set-work-buffer) | |
16843 | (insert (regexp-quote options)) | |
16844 | ;; First we treat all continuation lines. | |
16845 | (goto-char (point-min)) | |
16846 | (while (re-search-forward "\n[ \t]+" nil t) | |
16847 | (replace-match " " t t)) | |
16848 | ;; Then we transform all "all"s into ".+"s. | |
16849 | (goto-char (point-min)) | |
16850 | (while (re-search-forward "\\ball\\b" nil t) | |
16851 | (replace-match ".+" t t)) | |
16852 | (goto-char (point-min)) | |
16853 | ;; We remove all other options than the "-n" ones. | |
16854 | (while (re-search-forward "[ \t]-[^n][^-]*" nil t) | |
16855 | (replace-match " ") | |
16856 | (forward-char -1)) | |
16857 | (goto-char (point-min)) | |
16858 | ||
16859 | ;; We are only interested in "options -n" lines - we | |
16860 | ;; ignore the other option lines. | |
16861 | (while (re-search-forward "[ \t]-n" nil t) | |
231f989b | 16862 | (setq eol |
41487370 LMI |
16863 | (or (save-excursion |
16864 | (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) | |
16865 | (- (point) 2))) | |
16866 | (gnus-point-at-eol))) | |
16867 | ;; Search for all "words"... | |
16868 | (while (re-search-forward "[^ \t,\n]+" eol t) | |
16869 | (if (= (char-after (match-beginning 0)) ?!) | |
16870 | ;; If the word begins with a bang (!), this is a "not" | |
231f989b | 16871 | ;; spec. We put this spec (minus the bang) and the |
41487370 | 16872 | ;; symbol `ignore' into the list. |
231f989b LMI |
16873 | (setq out (cons (cons (concat |
16874 | "^" (buffer-substring | |
41487370 LMI |
16875 | (1+ (match-beginning 0)) |
16876 | (match-end 0))) | |
16877 | 'ignore) out)) | |
16878 | ;; There was no bang, so this is a "yes" spec. | |
231f989b | 16879 | (setq out (cons (cons (concat "^" (match-string 0)) |
41487370 | 16880 | 'subscribe) out))))) |
231f989b | 16881 | |
41487370 | 16882 | (setq gnus-newsrc-options-n out)))) |
745bc783 | 16883 | |
231f989b | 16884 | (defun gnus-save-newsrc-file (&optional force) |
41487370 | 16885 | "Save .newsrc file." |
745bc783 | 16886 | ;; Note: We cannot save .newsrc file if all newsgroups are removed |
41487370 | 16887 | ;; from the variable gnus-newsrc-alist. |
231f989b LMI |
16888 | (when (and (or gnus-newsrc-alist gnus-killed-list) |
16889 | gnus-current-startup-file) | |
16890 | (save-excursion | |
16891 | (if (and (or gnus-use-dribble-file gnus-slave) | |
16892 | (not force) | |
16893 | (or (not gnus-dribble-buffer) | |
16894 | (not (buffer-name gnus-dribble-buffer)) | |
16895 | (zerop (save-excursion | |
16896 | (set-buffer gnus-dribble-buffer) | |
16897 | (buffer-size))))) | |
16898 | (gnus-message 4 "(No changes need to be saved)") | |
16899 | (run-hooks 'gnus-save-newsrc-hook) | |
16900 | (if gnus-slave | |
16901 | (gnus-slave-save-newsrc) | |
16902 | ;; Save .newsrc. | |
16903 | (when gnus-save-newsrc-file | |
16904 | (gnus-message 5 "Saving %s..." gnus-current-startup-file) | |
16905 | (gnus-gnus-to-newsrc-format) | |
16906 | (gnus-message 5 "Saving %s...done" gnus-current-startup-file)) | |
16907 | ;; Save .newsrc.eld. | |
16908 | (set-buffer (get-buffer-create " *Gnus-newsrc*")) | |
16909 | (make-local-variable 'version-control) | |
16910 | (setq version-control 'never) | |
16911 | (setq buffer-file-name | |
16912 | (concat gnus-current-startup-file ".eld")) | |
16913 | (setq default-directory (file-name-directory buffer-file-name)) | |
16914 | (gnus-add-current-to-buffer-list) | |
16915 | (buffer-disable-undo (current-buffer)) | |
16916 | (erase-buffer) | |
16917 | (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) | |
16918 | (gnus-gnus-to-quick-newsrc-format) | |
16919 | (run-hooks 'gnus-save-quick-newsrc-hook) | |
16920 | (save-buffer) | |
16921 | (kill-buffer (current-buffer)) | |
16922 | (gnus-message | |
16923 | 5 "Saving %s.eld...done" gnus-current-startup-file)) | |
16924 | (gnus-dribble-delete-file) | |
16925 | (gnus-group-set-mode-line))))) | |
745bc783 JB |
16926 | |
16927 | (defun gnus-gnus-to-quick-newsrc-format () | |
41487370 LMI |
16928 | "Insert Gnus variables such as gnus-newsrc-alist in lisp format." |
16929 | (insert ";; Gnus startup file.\n") | |
16930 | (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n") | |
16931 | (insert ";; to read .newsrc.\n") | |
16932 | (insert "(setq gnus-newsrc-file-version " | |
16933 | (prin1-to-string gnus-version) ")\n") | |
231f989b LMI |
16934 | (let ((variables |
16935 | (if gnus-save-killed-list gnus-variable-list | |
16936 | ;; Remove the `gnus-killed-list' from the list of variables | |
16937 | ;; to be saved, if required. | |
16938 | (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) | |
16939 | ;; Peel off the "dummy" group. | |
41487370 LMI |
16940 | (gnus-newsrc-alist (cdr gnus-newsrc-alist)) |
16941 | variable) | |
231f989b | 16942 | ;; Insert the variables into the file. |
745bc783 | 16943 | (while variables |
231f989b LMI |
16944 | (when (and (boundp (setq variable (pop variables))) |
16945 | (symbol-value variable)) | |
16946 | (insert "(setq " (symbol-name variable) " '") | |
16947 | (prin1 (symbol-value variable) (current-buffer)) | |
16948 | (insert ")\n"))))) | |
41487370 LMI |
16949 | |
16950 | (defun gnus-gnus-to-newsrc-format () | |
16951 | ;; Generate and save the .newsrc file. | |
231f989b LMI |
16952 | (save-excursion |
16953 | (set-buffer (create-file-buffer gnus-current-startup-file)) | |
16954 | (let ((newsrc (cdr gnus-newsrc-alist)) | |
16955 | (standard-output (current-buffer)) | |
16956 | info ranges range method) | |
41487370 | 16957 | (setq buffer-file-name gnus-current-startup-file) |
231f989b | 16958 | (setq default-directory (file-name-directory buffer-file-name)) |
41487370 LMI |
16959 | (buffer-disable-undo (current-buffer)) |
16960 | (erase-buffer) | |
16961 | ;; Write options. | |
16962 | (if gnus-newsrc-options (insert gnus-newsrc-options)) | |
16963 | ;; Write subscribed and unsubscribed. | |
231f989b LMI |
16964 | (while (setq info (pop newsrc)) |
16965 | ;; Don't write foreign groups to .newsrc. | |
16966 | (when (or (null (setq method (gnus-info-method info))) | |
16967 | (equal method "native") | |
16968 | (gnus-server-equal method gnus-select-method)) | |
16969 | (insert (gnus-info-group info) | |
16970 | (if (> (gnus-info-level info) gnus-level-subscribed) | |
16971 | "!" ":")) | |
16972 | (when (setq ranges (gnus-info-read info)) | |
16973 | (insert " ") | |
16974 | (if (not (listp (cdr ranges))) | |
16975 | (if (= (car ranges) (cdr ranges)) | |
16976 | (princ (car ranges)) | |
16977 | (princ (car ranges)) | |
16978 | (insert "-") | |
16979 | (princ (cdr ranges))) | |
16980 | (while (setq range (pop ranges)) | |
16981 | (if (or (atom range) (= (car range) (cdr range))) | |
16982 | (princ (or (and (atom range) range) (car range))) | |
16983 | (princ (car range)) | |
16984 | (insert "-") | |
16985 | (princ (cdr range))) | |
16986 | (if ranges (insert ","))))) | |
16987 | (insert "\n"))) | |
e9110dc5 RS |
16988 | (make-local-variable 'version-control) |
16989 | (setq version-control 'never) | |
41487370 | 16990 | ;; It has been reported that sometime the modtime on the .newsrc |
231f989b LMI |
16991 | ;; file seems to be off. We really do want to overwrite it, so |
16992 | ;; we clear the modtime here before saving. It's a bit odd, | |
16993 | ;; though... | |
41487370 LMI |
16994 | ;; sometimes the modtime clear isn't sufficient. most brute force: |
16995 | ;; delete the silly thing entirely first. but this fails to provide | |
16996 | ;; such niceties as .newsrc~ creation. | |
16997 | (if gnus-modtime-botch | |
16998 | (delete-file gnus-startup-file) | |
16999 | (clear-visited-file-modtime)) | |
231f989b | 17000 | (run-hooks 'gnus-save-standard-newsrc-hook) |
41487370 LMI |
17001 | (save-buffer) |
17002 | (kill-buffer (current-buffer))))) | |
17003 | ||
231f989b LMI |
17004 | \f |
17005 | ;;; | |
17006 | ;;; Slave functions. | |
17007 | ;;; | |
17008 | ||
17009 | (defun gnus-slave-save-newsrc () | |
17010 | (save-excursion | |
17011 | (set-buffer gnus-dribble-buffer) | |
17012 | (let ((slave-name | |
17013 | (make-temp-name (concat gnus-current-startup-file "-slave-")))) | |
17014 | (write-region (point-min) (point-max) slave-name nil 'nomesg)))) | |
17015 | ||
17016 | (defun gnus-master-read-slave-newsrc () | |
17017 | (let ((slave-files | |
17018 | (directory-files | |
17019 | (file-name-directory gnus-current-startup-file) | |
17020 | t (concat | |
17021 | "^" (regexp-quote | |
17022 | (concat | |
17023 | (file-name-nondirectory gnus-current-startup-file) | |
17024 | "-slave-"))) | |
17025 | t)) | |
17026 | file) | |
17027 | (if (not slave-files) | |
17028 | () ; There are no slave files to read. | |
17029 | (gnus-message 7 "Reading slave newsrcs...") | |
17030 | (save-excursion | |
17031 | (set-buffer (get-buffer-create " *gnus slave*")) | |
17032 | (buffer-disable-undo (current-buffer)) | |
17033 | (setq slave-files | |
17034 | (sort (mapcar (lambda (file) | |
17035 | (list (nth 5 (file-attributes file)) file)) | |
17036 | slave-files) | |
17037 | (lambda (f1 f2) | |
17038 | (or (< (caar f1) (caar f2)) | |
17039 | (< (nth 1 (car f1)) (nth 1 (car f2))))))) | |
17040 | (while slave-files | |
17041 | (erase-buffer) | |
17042 | (setq file (nth 1 (car slave-files))) | |
17043 | (insert-file-contents file) | |
17044 | (if (condition-case () | |
17045 | (progn | |
17046 | (eval-buffer (current-buffer)) | |
17047 | t) | |
17048 | (error | |
17049 | (gnus-error 3.2 "Possible error in %s" file) | |
17050 | nil)) | |
17051 | (or gnus-slave ; Slaves shouldn't delete these files. | |
17052 | (condition-case () | |
17053 | (delete-file file) | |
17054 | (error nil)))) | |
17055 | (setq slave-files (cdr slave-files)))) | |
17056 | (gnus-message 7 "Reading slave newsrcs...done")))) | |
17057 | ||
17058 | \f | |
17059 | ;;; | |
17060 | ;;; Group description. | |
17061 | ;;; | |
17062 | ||
41487370 | 17063 | (defun gnus-read-all-descriptions-files () |
231f989b LMI |
17064 | (let ((methods (cons gnus-select-method |
17065 | (nconc | |
564b670b | 17066 | (when (gnus-archive-server-wanted-p) |
231f989b LMI |
17067 | (list "archive")) |
17068 | gnus-secondary-select-methods)))) | |
41487370 LMI |
17069 | (while methods |
17070 | (gnus-read-descriptions-file (car methods)) | |
17071 | (setq methods (cdr methods))) | |
17072 | t)) | |
17073 | ||
17074 | (defun gnus-read-descriptions-file (&optional method) | |
231f989b LMI |
17075 | (let ((method (or method gnus-select-method)) |
17076 | group) | |
17077 | (when (stringp method) | |
17078 | (setq method (gnus-server-to-method method))) | |
41487370 LMI |
17079 | ;; We create the hashtable whether we manage to read the desc file |
17080 | ;; to avoid trying to re-read after a failed read. | |
17081 | (or gnus-description-hashtb | |
231f989b | 17082 | (setq gnus-description-hashtb |
41487370 LMI |
17083 | (gnus-make-hashtable (length gnus-active-hashtb)))) |
17084 | ;; Mark this method's desc file as read. | |
17085 | (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" | |
17086 | gnus-description-hashtb) | |
17087 | ||
17088 | (gnus-message 5 "Reading descriptions file via %s..." (car method)) | |
231f989b | 17089 | (cond |
41487370 LMI |
17090 | ((not (gnus-check-server method)) |
17091 | (gnus-message 1 "Couldn't open server") | |
17092 | nil) | |
17093 | ((not (gnus-request-list-newsgroups method)) | |
17094 | (gnus-message 1 "Couldn't read newsgroups descriptions") | |
17095 | nil) | |
17096 | (t | |
231f989b LMI |
17097 | (save-excursion |
17098 | (save-restriction | |
17099 | (set-buffer nntp-server-buffer) | |
17100 | (goto-char (point-min)) | |
17101 | (when (or (search-forward "\n.\n" nil t) | |
41487370 | 17102 | (goto-char (point-max))) |
231f989b LMI |
17103 | (beginning-of-line) |
17104 | (narrow-to-region (point-min) (point))) | |
17105 | ;; If these are groups from a foreign select method, we insert the | |
17106 | ;; group prefix in front of the group names. | |
17107 | (and method (not (gnus-server-equal | |
17108 | (gnus-server-get-method nil method) | |
17109 | (gnus-server-get-method nil gnus-select-method))) | |
17110 | (let ((prefix (gnus-group-prefixed-name "" method))) | |
17111 | (goto-char (point-min)) | |
17112 | (while (and (not (eobp)) | |
17113 | (progn (insert prefix) | |
17114 | (zerop (forward-line 1))))))) | |
17115 | (goto-char (point-min)) | |
17116 | (while (not (eobp)) | |
17117 | ;; If we get an error, we set group to 0, which is not a | |
17118 | ;; symbol... | |
17119 | (setq group | |
17120 | (condition-case () | |
17121 | (let ((obarray gnus-description-hashtb)) | |
17122 | ;; Group is set to a symbol interned in this | |
17123 | ;; hash table. | |
17124 | (read nntp-server-buffer)) | |
17125 | (error 0))) | |
17126 | (skip-chars-forward " \t") | |
17127 | ;; ... which leads to this line being effectively ignored. | |
17128 | (and (symbolp group) | |
17129 | (set group (buffer-substring | |
17130 | (point) (progn (end-of-line) (point))))) | |
17131 | (forward-line 1)))) | |
17132 | (gnus-message 5 "Reading descriptions file...done") | |
17133 | t)))) | |
41487370 LMI |
17134 | |
17135 | (defun gnus-group-get-description (group) | |
231f989b LMI |
17136 | "Get the description of a group by sending XGTITLE to the server." |
17137 | (when (gnus-request-group-description group) | |
17138 | (save-excursion | |
17139 | (set-buffer nntp-server-buffer) | |
17140 | (goto-char (point-min)) | |
17141 | (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") | |
17142 | (match-string 1))))) | |
41487370 | 17143 | |
231f989b | 17144 | \f |
41487370 | 17145 | ;;; |
231f989b | 17146 | ;;; Buffering of read articles. |
41487370 LMI |
17147 | ;;; |
17148 | ||
231f989b LMI |
17149 | (defvar gnus-backlog-buffer " *Gnus Backlog*") |
17150 | (defvar gnus-backlog-articles nil) | |
17151 | (defvar gnus-backlog-hashtb nil) | |
41487370 | 17152 | |
231f989b LMI |
17153 | (defun gnus-backlog-buffer () |
17154 | "Return the backlog buffer." | |
17155 | (or (get-buffer gnus-backlog-buffer) | |
17156 | (save-excursion | |
17157 | (set-buffer (get-buffer-create gnus-backlog-buffer)) | |
17158 | (buffer-disable-undo (current-buffer)) | |
17159 | (setq buffer-read-only t) | |
17160 | (gnus-add-current-to-buffer-list) | |
17161 | (get-buffer gnus-backlog-buffer)))) | |
17162 | ||
17163 | (defun gnus-backlog-setup () | |
17164 | "Initialize backlog variables." | |
17165 | (unless gnus-backlog-hashtb | |
17166 | (setq gnus-backlog-hashtb (make-vector 1023 0)))) | |
17167 | ||
17168 | (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) | |
17169 | ||
17170 | (defun gnus-backlog-shutdown () | |
17171 | "Clear all backlog variables and buffers." | |
17172 | (when (get-buffer gnus-backlog-buffer) | |
17173 | (kill-buffer gnus-backlog-buffer)) | |
17174 | (setq gnus-backlog-hashtb nil | |
17175 | gnus-backlog-articles nil)) | |
17176 | ||
17177 | (defun gnus-backlog-enter-article (group number buffer) | |
17178 | (gnus-backlog-setup) | |
17179 | (let ((ident (intern (concat group ":" (int-to-string number)) | |
17180 | gnus-backlog-hashtb)) | |
17181 | b) | |
17182 | (if (memq ident gnus-backlog-articles) | |
17183 | () ; It's already kept. | |
17184 | ;; Remove the oldest article, if necessary. | |
17185 | (and (numberp gnus-keep-backlog) | |
17186 | (>= (length gnus-backlog-articles) gnus-keep-backlog) | |
17187 | (gnus-backlog-remove-oldest-article)) | |
17188 | (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) | |
17189 | ;; Insert the new article. | |
17190 | (save-excursion | |
17191 | (set-buffer (gnus-backlog-buffer)) | |
17192 | (let (buffer-read-only) | |
17193 | (goto-char (point-max)) | |
17194 | (or (bolp) (insert "\n")) | |
17195 | (setq b (point)) | |
17196 | (insert-buffer-substring buffer) | |
17197 | ;; Tag the beginning of the article with the ident. | |
17198 | (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) | |
41487370 | 17199 | |
231f989b | 17200 | (defun gnus-backlog-remove-oldest-article () |
41487370 | 17201 | (save-excursion |
231f989b LMI |
17202 | (set-buffer (gnus-backlog-buffer)) |
17203 | (goto-char (point-min)) | |
17204 | (if (zerop (buffer-size)) | |
17205 | () ; The buffer is empty. | |
17206 | (let ((ident (get-text-property (point) 'gnus-backlog)) | |
17207 | buffer-read-only) | |
17208 | ;; Remove the ident from the list of articles. | |
17209 | (when ident | |
17210 | (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) | |
17211 | ;; Delete the article itself. | |
17212 | (delete-region | |
17213 | (point) (next-single-property-change | |
17214 | (1+ (point)) 'gnus-backlog nil (point-max))))))) | |
17215 | ||
17216 | (defun gnus-backlog-remove-article (group number) | |
17217 | "Remove article NUMBER in GROUP from the backlog." | |
17218 | (when (numberp number) | |
17219 | (gnus-backlog-setup) | |
17220 | (let ((ident (intern (concat group ":" (int-to-string number)) | |
17221 | gnus-backlog-hashtb)) | |
17222 | beg end) | |
17223 | (when (memq ident gnus-backlog-articles) | |
17224 | ;; It was in the backlog. | |
17225 | (save-excursion | |
17226 | (set-buffer (gnus-backlog-buffer)) | |
17227 | (let (buffer-read-only) | |
17228 | (when (setq beg (text-property-any | |
17229 | (point-min) (point-max) 'gnus-backlog | |
17230 | ident)) | |
17231 | ;; Find the end (i. e., the beginning of the next article). | |
17232 | (setq end | |
17233 | (next-single-property-change | |
17234 | (1+ beg) 'gnus-backlog (current-buffer) (point-max))) | |
17235 | (delete-region beg end) | |
17236 | ;; Return success. | |
17237 | t))))))) | |
17238 | ||
17239 | (defun gnus-backlog-request-article (group number buffer) | |
17240 | (when (numberp number) | |
17241 | (gnus-backlog-setup) | |
17242 | (let ((ident (intern (concat group ":" (int-to-string number)) | |
17243 | gnus-backlog-hashtb)) | |
17244 | beg end) | |
17245 | (when (memq ident gnus-backlog-articles) | |
17246 | ;; It was in the backlog. | |
17247 | (save-excursion | |
17248 | (set-buffer (gnus-backlog-buffer)) | |
17249 | (if (not (setq beg (text-property-any | |
17250 | (point-min) (point-max) 'gnus-backlog | |
17251 | ident))) | |
17252 | ;; It wasn't in the backlog after all. | |
17253 | (ignore | |
17254 | (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) | |
17255 | ;; Find the end (i. e., the beginning of the next article). | |
17256 | (setq end | |
17257 | (next-single-property-change | |
17258 | (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) | |
17259 | (let ((buffer-read-only nil)) | |
17260 | (erase-buffer) | |
17261 | (insert-buffer-substring gnus-backlog-buffer beg end) | |
17262 | t))))) | |
41487370 LMI |
17263 | |
17264 | ;; Allow redefinition of Gnus functions. | |
17265 | ||
17266 | (gnus-ems-redefine) | |
17267 | ||
17268 | (provide 'gnus) | |
44cdca98 RS |
17269 | |
17270 | ;;; gnus.el ends here |