Mercurial > emacs
comparison lisp/gnus/gnus-group.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; gnus-group.el --- group mode commands for Gnus | 1 ;;; gnus-group.el --- group mode commands for Gnus |
2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 | 2 |
3 ;; Free Software Foundation, Inc. | 3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
4 ;; 2005 Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
6 ;; Keywords: news | 7 ;; Keywords: news |
7 | 8 |
8 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 ;; GNU General Public License for more details. | 19 ;; GNU General Public License for more details. |
19 | 20 |
20 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02110-1301, USA. |
24 | 25 |
25 ;;; Commentary: | 26 ;;; Commentary: |
26 | 27 |
27 ;;; Code: | 28 ;;; Code: |
28 | 29 |
29 (eval-when-compile (require 'cl)) | 30 (eval-when-compile |
31 (require 'cl) | |
32 (defvar tool-bar-map)) | |
30 | 33 |
31 (require 'gnus) | 34 (require 'gnus) |
32 (require 'gnus-start) | 35 (require 'gnus-start) |
33 (require 'nnmail) | 36 (require 'nnmail) |
34 (require 'gnus-spec) | 37 (require 'gnus-spec) |
35 (require 'gnus-int) | 38 (require 'gnus-int) |
36 (require 'gnus-range) | 39 (require 'gnus-range) |
37 (require 'gnus-win) | 40 (require 'gnus-win) |
38 (require 'gnus-undo) | 41 (require 'gnus-undo) |
39 (require 'time-date) | 42 (require 'time-date) |
43 (require 'gnus-ems) | |
44 | |
45 (eval-when-compile | |
46 (require 'mm-url) | |
47 (let ((features (cons 'gnus-group features))) | |
48 (require 'gnus-sum)) | |
49 (defvar gnus-cache-active-hashtb)) | |
40 | 50 |
41 (defcustom gnus-group-archive-directory | 51 (defcustom gnus-group-archive-directory |
42 "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" | 52 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" |
43 "*The address of the (ding) archives." | 53 "*The address of the (ding) archives." |
44 :group 'gnus-group-foreign | 54 :group 'gnus-group-foreign |
45 :type 'directory) | 55 :type 'directory) |
46 | 56 |
47 (defcustom gnus-group-recent-archive-directory | 57 (defcustom gnus-group-recent-archive-directory |
48 "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" | 58 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" |
49 "*The address of the most recent (ding) articles." | 59 "*The address of the most recent (ding) articles." |
50 :group 'gnus-group-foreign | 60 :group 'gnus-group-foreign |
51 :type 'directory) | 61 :type 'directory) |
52 | 62 |
53 (defcustom gnus-no-groups-message "No gnus is bad news" | 63 (defcustom gnus-no-groups-message "No gnus is bad news" |
115 "*Function used for sorting the group buffer. | 125 "*Function used for sorting the group buffer. |
116 This function will be called with group info entries as the arguments | 126 This function will be called with group info entries as the arguments |
117 for the groups to be sorted. Pre-made functions include | 127 for the groups to be sorted. Pre-made functions include |
118 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', | 128 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', |
119 `gnus-group-sort-by-unread', `gnus-group-sort-by-level', | 129 `gnus-group-sort-by-unread', `gnus-group-sort-by-level', |
120 `gnus-group-sort-by-score', `gnus-group-sort-by-method', and | 130 `gnus-group-sort-by-score', `gnus-group-sort-by-method', |
121 `gnus-group-sort-by-rank'. | 131 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'. |
122 | 132 |
123 This variable can also be a list of sorting functions. In that case, | 133 This variable can also be a list of sorting functions. In that case, |
124 the most significant sort function should be the last function in the | 134 the most significant sort function should be the last function in the |
125 list." | 135 list." |
126 :group 'gnus-group-listing | 136 :group 'gnus-group-listing |
127 :link '(custom-manual "(gnus)Sorting Groups") | 137 :link '(custom-manual "(gnus)Sorting Groups") |
128 :type '(radio (function-item gnus-group-sort-by-alphabet) | 138 :type '(repeat :value-to-internal (lambda (widget value) |
129 (function-item gnus-group-sort-by-real-name) | 139 (if (listp value) value (list value))) |
130 (function-item gnus-group-sort-by-unread) | 140 :match (lambda (widget value) |
131 (function-item gnus-group-sort-by-level) | 141 (or (symbolp value) |
132 (function-item gnus-group-sort-by-score) | 142 (widget-editable-list-match widget value))) |
133 (function-item gnus-group-sort-by-method) | 143 (choice (function-item gnus-group-sort-by-alphabet) |
134 (function-item gnus-group-sort-by-rank) | 144 (function-item gnus-group-sort-by-real-name) |
135 (function :tag "other" nil))) | 145 (function-item gnus-group-sort-by-unread) |
136 | 146 (function-item gnus-group-sort-by-level) |
137 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" | 147 (function-item gnus-group-sort-by-score) |
148 (function-item gnus-group-sort-by-method) | |
149 (function-item gnus-group-sort-by-server) | |
150 (function-item gnus-group-sort-by-rank) | |
151 (function :tag "other" nil)))) | |
152 | |
153 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n" | |
138 "*Format of group lines. | 154 "*Format of group lines. |
139 It works along the same lines as a normal formatting string, | 155 It works along the same lines as a normal formatting string, |
140 with some simple extensions. | 156 with some simple extensions. |
141 | 157 |
142 %M Only marked articles (character, \"*\" or \" \") | 158 %M Only marked articles (character, \"*\" or \" \") |
145 %N Number of unread articles (integer) | 161 %N Number of unread articles (integer) |
146 %I Number of dormant articles (integer) | 162 %I Number of dormant articles (integer) |
147 %i Number of ticked and dormant (integer) | 163 %i Number of ticked and dormant (integer) |
148 %T Number of ticked articles (integer) | 164 %T Number of ticked articles (integer) |
149 %R Number of read articles (integer) | 165 %R Number of read articles (integer) |
166 %U Number of unseen articles (integer) | |
150 %t Estimated total number of articles (integer) | 167 %t Estimated total number of articles (integer) |
151 %y Number of unread, unticked articles (integer) | 168 %y Number of unread, unticked articles (integer) |
152 %G Group name (string) | 169 %G Group name (string) |
153 %g Qualified group name (string) | 170 %g Qualified group name (string) |
171 %c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'. | |
172 %C Group comment (string) | |
154 %D Group description (string) | 173 %D Group description (string) |
155 %s Select method (string) | 174 %s Select method (string) |
156 %o Moderated group (char, \"m\") | 175 %o Moderated group (char, \"m\") |
157 %p Process mark (char) | 176 %p Process mark (char) |
177 %B Whether a summary buffer for the group is open (char, \"*\") | |
158 %O Moderated group (string, \"(m)\" or \"\") | 178 %O Moderated group (string, \"(m)\" or \"\") |
159 %P Topic indentation (string) | 179 %P Topic indentation (string) |
160 %m Whether there is new(ish) mail in the group (char, \"%\") | 180 %m Whether there is new(ish) mail in the group (char, \"%\") |
161 %l Whether there are GroupLens predictions for this group (string) | 181 %l Whether there are GroupLens predictions for this group (string) |
162 %n Select from where (string) | 182 %n Select from where (string) |
163 %z A string that look like `<%s:%n>' if a foreign select method is used | 183 %z A string that look like `<%s:%n>' if a foreign select method is used |
164 %d The date the group was last entered. | 184 %d The date the group was last entered. |
165 %E Icon as defined by `gnus-group-icon-list'. | 185 %E Icon as defined by `gnus-group-icon-list'. |
166 %u User defined specifier. The next character in the format string should | 186 %u User defined specifier. The next character in the format string should |
167 be a letter. Gnus will call the function gnus-user-format-function-X, | 187 be a letter. Gnus will call the function gnus-user-format-function-X, |
168 where X is the letter following %u. The function will be passed the | 188 where X is the letter following %u. The function will be passed a |
169 current header as argument. The function should return a string, which | 189 single dummy parameter as argument. The function should return a |
170 will be inserted into the buffer just like information from any other | 190 string, which will be inserted into the buffer just like information |
171 group specifier. | 191 from any other group specifier. |
172 | |
173 Text between %( and %) will be highlighted with `gnus-mouse-face' when | |
174 the mouse point move inside the area. There can only be one such area. | |
175 | 192 |
176 Note that this format specification is not always respected. For | 193 Note that this format specification is not always respected. For |
177 reasons of efficiency, when listing killed groups, this specification | 194 reasons of efficiency, when listing killed groups, this specification |
178 is ignored altogether. If the spec is changed considerably, your | 195 is ignored altogether. If the spec is changed considerably, your |
179 output may end up looking strange when listing both alive and killed | 196 output may end up looking strange when listing both alive and killed |
181 | 198 |
182 If you use %o or %O, reading the active file will be slower and quite | 199 If you use %o or %O, reading the active file will be slower and quite |
183 a bit of extra memory will be used. %D will also worsen performance. | 200 a bit of extra memory will be used. %D will also worsen performance. |
184 Also note that if you change the format specification to include any | 201 Also note that if you change the format specification to include any |
185 of these specs, you must probably re-start Gnus to see them go into | 202 of these specs, you must probably re-start Gnus to see them go into |
186 effect." | 203 effect. |
204 | |
205 General format specifiers can also be used. | |
206 See Info node `(gnus)Formatting Variables'." | |
207 :link '(custom-manual "(gnus)Formatting Variables") | |
187 :group 'gnus-group-visual | 208 :group 'gnus-group-visual |
188 :type 'string) | 209 :type 'string) |
189 | 210 |
190 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" | 211 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" |
191 "*The format specification for the group mode line. | 212 "*The format specification for the group mode line. |
196 %M The native select method. | 217 %M The native select method. |
197 %: \":\" if %S isn't \"\"." | 218 %: \":\" if %S isn't \"\"." |
198 :group 'gnus-group-visual | 219 :group 'gnus-group-visual |
199 :type 'string) | 220 :type 'string) |
200 | 221 |
201 (defcustom gnus-group-mode-hook nil | 222 ;; Extracted from gnus-xmas-redefine in order to preserve user settings |
202 "Hook for Gnus group mode." | 223 (when (featurep 'xemacs) |
203 :group 'gnus-group-various | 224 (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) |
204 :options '(gnus-topic-mode) | 225 (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)) |
205 :type 'hook) | |
206 | 226 |
207 (defcustom gnus-group-menu-hook nil | 227 (defcustom gnus-group-menu-hook nil |
208 "Hook run after the creation of the group mode menu." | 228 "Hook run after the creation of the group mode menu." |
209 :group 'gnus-group-various | 229 :group 'gnus-group-various |
210 :type 'hook) | 230 :type 'hook) |
262 variable." | 282 variable." |
263 :group 'gnus-group-visual | 283 :group 'gnus-group-visual |
264 :type 'hook) | 284 :type 'hook) |
265 | 285 |
266 (defcustom gnus-useful-groups | 286 (defcustom gnus-useful-groups |
267 '(("(ding) mailing list mirrored at sunsite.auc.dk" | 287 '(("(ding) mailing list mirrored at gmane.org" |
268 "emacs.ding" | 288 "gmane.emacs.gnus.general" |
269 (nntp "sunsite.auc.dk" | 289 (nntp "Gmane" |
270 (nntp-address "sunsite.auc.dk"))) | 290 (nntp-address "news.gmane.org"))) |
271 ("gnus-bug archive" | 291 ("Gnus bug archive" |
272 "gnus-bug" | 292 "gnus.gnus-bug" |
273 (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/")) | 293 (nntp "news.gnus.org" |
274 ("Gnus help group" | 294 (nntp-address "news.gnus.org"))) |
295 ("Local Gnus help group" | |
275 "gnus-help" | 296 "gnus-help" |
276 (nndoc "gnus-help" | 297 (nndoc "gnus-help" |
277 (nndoc-article-type mbox) | 298 (nndoc-article-type mbox) |
278 (eval `(nndoc-address | 299 (eval `(nndoc-address |
279 ,(let ((file (nnheader-find-etc-directory | 300 ,(let ((file (nnheader-find-etc-directory |
286 :type '(repeat (list (string :tag "Description") | 307 :type '(repeat (list (string :tag "Description") |
287 (string :tag "Name") | 308 (string :tag "Name") |
288 (sexp :tag "Method")))) | 309 (sexp :tag "Method")))) |
289 | 310 |
290 (defcustom gnus-group-highlight | 311 (defcustom gnus-group-highlight |
291 '(;; News. | 312 '(;; Mail. |
292 ((and (= unread 0) (not mailp) (eq level 1)) . | 313 ((and mailp (= unread 0) (eq level 1)) . |
293 gnus-group-news-1-empty-face) | 314 gnus-group-mail-1-empty) |
294 ((and (not mailp) (eq level 1)) . | 315 ((and mailp (eq level 1)) . |
295 gnus-group-news-1-face) | 316 gnus-group-mail-1) |
296 ((and (= unread 0) (not mailp) (eq level 2)) . | 317 ((and mailp (= unread 0) (eq level 2)) . |
297 gnus-group-news-2-empty-face) | 318 gnus-group-mail-2-empty) |
298 ((and (not mailp) (eq level 2)) . | 319 ((and mailp (eq level 2)) . |
299 gnus-group-news-2-face) | 320 gnus-group-mail-2) |
300 ((and (= unread 0) (not mailp) (eq level 3)) . | 321 ((and mailp (= unread 0) (eq level 3)) . |
301 gnus-group-news-3-empty-face) | 322 gnus-group-mail-3-empty) |
302 ((and (not mailp) (eq level 3)) . | 323 ((and mailp (eq level 3)) . |
303 gnus-group-news-3-face) | 324 gnus-group-mail-3) |
304 ((and (= unread 0) (not mailp) (eq level 4)) . | 325 ((and mailp (= unread 0)) . |
305 gnus-group-news-4-empty-face) | 326 gnus-group-mail-low-empty) |
306 ((and (not mailp) (eq level 4)) . | 327 ((and mailp) . |
307 gnus-group-news-4-face) | 328 gnus-group-mail-low) |
308 ((and (= unread 0) (not mailp) (eq level 5)) . | 329 ;; News. |
309 gnus-group-news-5-empty-face) | |
310 ((and (not mailp) (eq level 5)) . | |
311 gnus-group-news-5-face) | |
312 ((and (= unread 0) (not mailp) (eq level 6)) . | |
313 gnus-group-news-6-empty-face) | |
314 ((and (not mailp) (eq level 6)) . | |
315 gnus-group-news-6-face) | |
316 ((and (= unread 0) (not mailp)) . | |
317 gnus-group-news-low-empty-face) | |
318 ((and (not mailp)) . | |
319 gnus-group-news-low-face) | |
320 ;; Mail. | |
321 ((and (= unread 0) (eq level 1)) . | 330 ((and (= unread 0) (eq level 1)) . |
322 gnus-group-mail-1-empty-face) | 331 gnus-group-news-1-empty) |
323 ((eq level 1) . | 332 ((and (eq level 1)) . |
324 gnus-group-mail-1-face) | 333 gnus-group-news-1) |
325 ((and (= unread 0) (eq level 2)) . | 334 ((and (= unread 0) (eq level 2)) . |
326 gnus-group-mail-2-empty-face) | 335 gnus-group-news-2-empty) |
327 ((eq level 2) . | 336 ((and (eq level 2)) . |
328 gnus-group-mail-2-face) | 337 gnus-group-news-2) |
329 ((and (= unread 0) (eq level 3)) . | 338 ((and (= unread 0) (eq level 3)) . |
330 gnus-group-mail-3-empty-face) | 339 gnus-group-news-3-empty) |
331 ((eq level 3) . | 340 ((and (eq level 3)) . |
332 gnus-group-mail-3-face) | 341 gnus-group-news-3) |
333 ((= unread 0) . | 342 ((and (= unread 0) (eq level 4)) . |
334 gnus-group-mail-low-empty-face) | 343 gnus-group-news-4-empty) |
344 ((and (eq level 4)) . | |
345 gnus-group-news-4) | |
346 ((and (= unread 0) (eq level 5)) . | |
347 gnus-group-news-5-empty) | |
348 ((and (eq level 5)) . | |
349 gnus-group-news-5) | |
350 ((and (= unread 0) (eq level 6)) . | |
351 gnus-group-news-6-empty) | |
352 ((and (eq level 6)) . | |
353 gnus-group-news-6) | |
354 ((and (= unread 0)) . | |
355 gnus-group-news-low-empty) | |
335 (t . | 356 (t . |
336 gnus-group-mail-low-face)) | 357 gnus-group-news-low)) |
337 "*Controls the highlighting of group buffer lines. | 358 "*Controls the highlighting of group buffer lines. |
338 | 359 |
339 Below is a list of `Form'/`Face' pairs. When deciding how a a | 360 Below is a list of `Form'/`Face' pairs. When deciding how a a |
340 particular group line should be displayed, each form is | 361 particular group line should be displayed, each form is |
341 evaluated. The content of the face field after the first true form is | 362 evaluated. The content of the face field after the first true form is |
361 "Mark used for groups with new mail." | 382 "Mark used for groups with new mail." |
362 :group 'gnus-group-visual | 383 :group 'gnus-group-visual |
363 :type 'character) | 384 :type 'character) |
364 | 385 |
365 (defgroup gnus-group-icons nil | 386 (defgroup gnus-group-icons nil |
366 "Add Icons to your group buffer. " | 387 "Add Icons to your group buffer." |
367 :group 'gnus-group-visual) | 388 :group 'gnus-group-visual) |
368 | 389 |
369 (defcustom gnus-group-icon-list | 390 (defcustom gnus-group-icon-list |
370 nil | 391 nil |
371 "*Controls the insertion of icons into group buffer lines. | 392 "*Controls the insertion of icons into group buffer lines. |
393 ticked: The number of ticked articles." | 414 ticked: The number of ticked articles." |
394 :group 'gnus-group-icons | 415 :group 'gnus-group-icons |
395 :type '(repeat (cons (sexp :tag "Form") file))) | 416 :type '(repeat (cons (sexp :tag "Form") file))) |
396 | 417 |
397 (defcustom gnus-group-name-charset-method-alist nil | 418 (defcustom gnus-group-name-charset-method-alist nil |
398 "*Alist of method and the charset for group names. | 419 "Alist of method and the charset for group names. |
399 | 420 |
400 For example: | 421 For example: |
401 (((nntp \"news.com.cn\") . cn-gb-2312)) | 422 (((nntp \"news.com.cn\") . cn-gb-2312))" |
402 " | |
403 :version "21.1" | 423 :version "21.1" |
404 :group 'gnus-charset | 424 :group 'gnus-charset |
405 :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) | 425 :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) |
406 | 426 |
407 (defcustom gnus-group-name-charset-group-alist nil | 427 (defcustom gnus-group-name-charset-group-alist |
408 "*Alist of group regexp and the charset for group names. | 428 (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8)) |
429 (mm-coding-system-p 'utf-8)) | |
430 '((".*" . utf-8)) | |
431 nil) | |
432 "Alist of group regexp and the charset for group names. | |
409 | 433 |
410 For example: | 434 For example: |
411 ((\"\\.com\\.cn:\" . cn-gb-2312)) | 435 ((\"\\.com\\.cn:\" . cn-gb-2312))" |
412 " | |
413 :group 'gnus-charset | 436 :group 'gnus-charset |
414 :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) | 437 :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) |
415 | 438 |
439 (defcustom gnus-group-jump-to-group-prompt nil | |
440 "Default prompt for `gnus-group-jump-to-group'. | |
441 If non-nil, the value should be a string, e.g. \"nnml:\", | |
442 in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" | |
443 in the minibuffer prompt." | |
444 :version "22.1" | |
445 :group 'gnus-group-various | |
446 :type '(choice (string :tag "Prompt string") | |
447 (const :tag "Empty" nil))) | |
448 | |
449 (defvar gnus-group-listing-limit 1000 | |
450 "*A limit of the number of groups when listing. | |
451 If the number of groups is larger than the limit, list them in a | |
452 simple manner.") | |
453 | |
416 ;;; Internal variables | 454 ;;; Internal variables |
417 | 455 |
456 (defvar gnus-group-is-exiting-p nil) | |
457 (defvar gnus-group-is-exiting-without-update-p nil) | |
418 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat | 458 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat |
419 "Function for sorting the group buffer.") | 459 "Function for sorting the group buffer.") |
420 | 460 |
421 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat | 461 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat |
422 "Function for sorting the selected groups in the group buffer.") | 462 "Function for sorting the selected groups in the group buffer.") |
439 (+ number | 479 (+ number |
440 (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) | 480 (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) |
441 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) | 481 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) |
442 (t number)) ?s) | 482 (t number)) ?s) |
443 (?R gnus-tmp-number-of-read ?s) | 483 (?R gnus-tmp-number-of-read ?s) |
484 (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d) | |
444 (?t gnus-tmp-number-total ?d) | 485 (?t gnus-tmp-number-total ?d) |
445 (?y gnus-tmp-number-of-unread ?s) | 486 (?y gnus-tmp-number-of-unread ?s) |
446 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) | 487 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) |
447 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) | 488 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) |
448 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) | 489 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) |
449 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) | 490 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) |
450 (?g gnus-tmp-group ?s) | 491 (?g (if (boundp 'gnus-tmp-decoded-group) |
492 gnus-tmp-decoded-group | |
493 gnus-tmp-group) | |
494 ?s) | |
451 (?G gnus-tmp-qualified-group ?s) | 495 (?G gnus-tmp-qualified-group ?s) |
452 (?c (gnus-short-group-name gnus-tmp-group) ?s) | 496 (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group) |
497 gnus-tmp-decoded-group | |
498 gnus-tmp-group)) | |
499 ?s) | |
500 (?C gnus-tmp-comment ?s) | |
453 (?D gnus-tmp-newsgroup-description ?s) | 501 (?D gnus-tmp-newsgroup-description ?s) |
454 (?o gnus-tmp-moderated ?c) | 502 (?o gnus-tmp-moderated ?c) |
455 (?O gnus-tmp-moderated-string ?s) | 503 (?O gnus-tmp-moderated-string ?s) |
456 (?p gnus-tmp-process-marked ?c) | 504 (?p gnus-tmp-process-marked ?c) |
457 (?s gnus-tmp-news-server ?s) | 505 (?s gnus-tmp-news-server ?s) |
458 (?n gnus-tmp-news-method ?s) | 506 (?n ,(if (featurep 'xemacs) |
507 '(symbol-name gnus-tmp-news-method) | |
508 'gnus-tmp-news-method) | |
509 ?s) | |
459 (?P gnus-group-indentation ?s) | 510 (?P gnus-group-indentation ?s) |
460 (?E gnus-tmp-group-icon ?s) | 511 (?E gnus-tmp-group-icon ?s) |
512 (?B gnus-tmp-summary-live ?c) | |
461 (?l gnus-tmp-grouplens ?s) | 513 (?l gnus-tmp-grouplens ?s) |
462 (?z gnus-tmp-news-method-string ?s) | 514 (?z gnus-tmp-news-method-string ?s) |
463 (?m (gnus-group-new-mail gnus-tmp-group) ?c) | 515 (?m (gnus-group-new-mail gnus-tmp-group) ?c) |
464 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) | 516 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) |
465 (?u gnus-tmp-user-defined ?s))) | 517 (?u gnus-tmp-user-defined ?s))) |
481 (defvar gnus-group-list-mode nil) | 533 (defvar gnus-group-list-mode nil) |
482 | 534 |
483 | 535 |
484 (defvar gnus-group-icon-cache nil) | 536 (defvar gnus-group-icon-cache nil) |
485 | 537 |
538 (defvar gnus-group-listed-groups nil) | |
539 (defvar gnus-group-list-option nil) | |
540 | |
486 ;;; | 541 ;;; |
487 ;;; Gnus group mode | 542 ;;; Gnus group mode |
488 ;;; | 543 ;;; |
489 | 544 |
490 (put 'gnus-group-mode 'mode-class 'special) | 545 (put 'gnus-group-mode 'mode-class 'special) |
491 | 546 |
492 (when t | 547 (gnus-define-keys gnus-group-mode-map |
493 (gnus-define-keys gnus-group-mode-map | 548 " " gnus-group-read-group |
494 " " gnus-group-read-group | 549 "=" gnus-group-select-group |
495 "=" gnus-group-select-group | 550 "\r" gnus-group-select-group |
496 "\r" gnus-group-select-group | 551 "\M-\r" gnus-group-quick-select-group |
497 "\M-\r" gnus-group-quick-select-group | 552 "\M- " gnus-group-visible-select-group |
498 "\M- " gnus-group-visible-select-group | 553 [(meta control return)] gnus-group-select-group-ephemerally |
499 [(meta control return)] gnus-group-select-group-ephemerally | 554 "j" gnus-group-jump-to-group |
500 "j" gnus-group-jump-to-group | 555 "n" gnus-group-next-unread-group |
501 "n" gnus-group-next-unread-group | 556 "p" gnus-group-prev-unread-group |
502 "p" gnus-group-prev-unread-group | 557 "\177" gnus-group-prev-unread-group |
503 "\177" gnus-group-prev-unread-group | 558 [delete] gnus-group-prev-unread-group |
504 [delete] gnus-group-prev-unread-group | 559 [backspace] gnus-group-prev-unread-group |
505 [backspace] gnus-group-prev-unread-group | 560 "N" gnus-group-next-group |
506 "N" gnus-group-next-group | 561 "P" gnus-group-prev-group |
507 "P" gnus-group-prev-group | 562 "\M-n" gnus-group-next-unread-group-same-level |
508 "\M-n" gnus-group-next-unread-group-same-level | 563 "\M-p" gnus-group-prev-unread-group-same-level |
509 "\M-p" gnus-group-prev-unread-group-same-level | 564 "," gnus-group-best-unread-group |
510 "," gnus-group-best-unread-group | 565 "." gnus-group-first-unread-group |
511 "." gnus-group-first-unread-group | 566 "u" gnus-group-unsubscribe-current-group |
512 "u" gnus-group-unsubscribe-current-group | 567 "U" gnus-group-unsubscribe-group |
513 "U" gnus-group-unsubscribe-group | 568 "c" gnus-group-catchup-current |
514 "c" gnus-group-catchup-current | 569 "C" gnus-group-catchup-current-all |
515 "C" gnus-group-catchup-current-all | 570 "\M-c" gnus-group-clear-data |
516 "\M-c" gnus-group-clear-data | 571 "l" gnus-group-list-groups |
517 "l" gnus-group-list-groups | 572 "L" gnus-group-list-all-groups |
518 "L" gnus-group-list-all-groups | 573 "m" gnus-group-mail |
519 "m" gnus-group-mail | 574 "i" gnus-group-news |
520 "g" gnus-group-get-new-news | 575 "g" gnus-group-get-new-news |
521 "\M-g" gnus-group-get-new-news-this-group | 576 "\M-g" gnus-group-get-new-news-this-group |
522 "R" gnus-group-restart | 577 "R" gnus-group-restart |
523 "r" gnus-group-read-init-file | 578 "r" gnus-group-read-init-file |
524 "B" gnus-group-browse-foreign-server | 579 "B" gnus-group-browse-foreign-server |
525 "b" gnus-group-check-bogus-groups | 580 "b" gnus-group-check-bogus-groups |
526 "F" gnus-group-find-new-groups | 581 "F" gnus-group-find-new-groups |
527 "\C-c\C-d" gnus-group-describe-group | 582 "\C-c\C-d" gnus-group-describe-group |
528 "\M-d" gnus-group-describe-all-groups | 583 "\M-d" gnus-group-describe-all-groups |
529 "\C-c\C-a" gnus-group-apropos | 584 "\C-c\C-a" gnus-group-apropos |
530 "\C-c\M-\C-a" gnus-group-description-apropos | 585 "\C-c\M-\C-a" gnus-group-description-apropos |
531 "a" gnus-group-post-news | 586 "a" gnus-group-post-news |
532 "\ek" gnus-group-edit-local-kill | 587 "\ek" gnus-group-edit-local-kill |
533 "\eK" gnus-group-edit-global-kill | 588 "\eK" gnus-group-edit-global-kill |
534 "\C-k" gnus-group-kill-group | 589 "\C-k" gnus-group-kill-group |
535 "\C-y" gnus-group-yank-group | 590 "\C-y" gnus-group-yank-group |
536 "\C-w" gnus-group-kill-region | 591 "\C-w" gnus-group-kill-region |
537 "\C-x\C-t" gnus-group-transpose-groups | 592 "\C-x\C-t" gnus-group-transpose-groups |
538 "\C-c\C-l" gnus-group-list-killed | 593 "\C-c\C-l" gnus-group-list-killed |
539 "\C-c\C-x" gnus-group-expire-articles | 594 "\C-c\C-x" gnus-group-expire-articles |
540 "\C-c\M-\C-x" gnus-group-expire-all-groups | 595 "\C-c\M-\C-x" gnus-group-expire-all-groups |
541 "V" gnus-version | 596 "V" gnus-version |
542 "s" gnus-group-save-newsrc | 597 "s" gnus-group-save-newsrc |
543 "z" gnus-group-suspend | 598 "z" gnus-group-suspend |
544 "q" gnus-group-exit | 599 "q" gnus-group-exit |
545 "Q" gnus-group-quit | 600 "Q" gnus-group-quit |
546 "?" gnus-group-describe-briefly | 601 "?" gnus-group-describe-briefly |
547 "\C-c\C-i" gnus-info-find-node | 602 "\C-c\C-i" gnus-info-find-node |
548 "\M-e" gnus-group-edit-group-method | 603 "\M-e" gnus-group-edit-group-method |
549 "^" gnus-group-enter-server-mode | 604 "^" gnus-group-enter-server-mode |
550 gnus-mouse-2 gnus-mouse-pick-group | 605 gnus-mouse-2 gnus-mouse-pick-group |
551 "<" beginning-of-buffer | 606 [follow-link] mouse-face |
552 ">" end-of-buffer | 607 "<" beginning-of-buffer |
553 "\C-c\C-b" gnus-bug | 608 ">" end-of-buffer |
554 "\C-c\C-s" gnus-group-sort-groups | 609 "\C-c\C-b" gnus-bug |
555 "t" gnus-topic-mode | 610 "\C-c\C-s" gnus-group-sort-groups |
556 "\C-c\M-g" gnus-activate-all-groups | 611 "t" gnus-topic-mode |
557 "\M-&" gnus-group-universal-argument | 612 "\C-c\M-g" gnus-activate-all-groups |
558 "#" gnus-group-mark-group | 613 "\M-&" gnus-group-universal-argument |
559 "\M-#" gnus-group-unmark-group) | 614 "#" gnus-group-mark-group |
560 | 615 "\M-#" gnus-group-unmark-group) |
561 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) | 616 |
562 "m" gnus-group-mark-group | 617 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) |
563 "u" gnus-group-unmark-group | 618 "m" gnus-group-mark-group |
564 "w" gnus-group-mark-region | 619 "u" gnus-group-unmark-group |
565 "b" gnus-group-mark-buffer | 620 "w" gnus-group-mark-region |
566 "r" gnus-group-mark-regexp | 621 "b" gnus-group-mark-buffer |
567 "U" gnus-group-unmark-all-groups) | 622 "r" gnus-group-mark-regexp |
568 | 623 "U" gnus-group-unmark-all-groups) |
569 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) | 624 |
570 "d" gnus-group-make-directory-group | 625 (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) |
571 "h" gnus-group-make-help-group | 626 "u" gnus-sieve-update |
572 "u" gnus-group-make-useful-group | 627 "g" gnus-sieve-generate) |
573 "a" gnus-group-make-archive-group | 628 |
574 "k" gnus-group-make-kiboze-group | 629 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) |
575 "l" gnus-group-nnimap-edit-acl | 630 "d" gnus-group-make-directory-group |
576 "m" gnus-group-make-group | 631 "h" gnus-group-make-help-group |
577 "E" gnus-group-edit-group | 632 "u" gnus-group-make-useful-group |
578 "e" gnus-group-edit-group-method | 633 "a" gnus-group-make-archive-group |
579 "p" gnus-group-edit-group-parameters | 634 "k" gnus-group-make-kiboze-group |
580 "v" gnus-group-add-to-virtual | 635 "l" gnus-group-nnimap-edit-acl |
581 "V" gnus-group-make-empty-virtual | 636 "m" gnus-group-make-group |
582 "D" gnus-group-enter-directory | 637 "E" gnus-group-edit-group |
583 "f" gnus-group-make-doc-group | 638 "e" gnus-group-edit-group-method |
584 "w" gnus-group-make-web-group | 639 "p" gnus-group-edit-group-parameters |
585 "r" gnus-group-rename-group | 640 "v" gnus-group-add-to-virtual |
586 "c" gnus-group-customize | 641 "V" gnus-group-make-empty-virtual |
587 "x" gnus-group-nnimap-expunge | 642 "D" gnus-group-enter-directory |
588 "\177" gnus-group-delete-group | 643 "f" gnus-group-make-doc-group |
589 [delete] gnus-group-delete-group) | 644 "w" gnus-group-make-web-group |
590 | 645 "M" gnus-group-read-ephemeral-group |
591 (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) | 646 "r" gnus-group-rename-group |
592 "b" gnus-group-brew-soup | 647 "R" gnus-group-make-rss-group |
593 "w" gnus-soup-save-areas | 648 "c" gnus-group-customize |
594 "s" gnus-soup-send-replies | 649 "x" gnus-group-nnimap-expunge |
595 "p" gnus-soup-pack-packet | 650 "\177" gnus-group-delete-group |
596 "r" nnsoup-pack-replies) | 651 [delete] gnus-group-delete-group) |
597 | 652 |
598 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) | 653 (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) |
599 "s" gnus-group-sort-groups | 654 "b" gnus-group-brew-soup |
600 "a" gnus-group-sort-groups-by-alphabet | 655 "w" gnus-soup-save-areas |
601 "u" gnus-group-sort-groups-by-unread | 656 "s" gnus-soup-send-replies |
602 "l" gnus-group-sort-groups-by-level | 657 "p" gnus-soup-pack-packet |
603 "v" gnus-group-sort-groups-by-score | 658 "r" nnsoup-pack-replies) |
604 "r" gnus-group-sort-groups-by-rank | 659 |
605 "m" gnus-group-sort-groups-by-method) | 660 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) |
606 | 661 "s" gnus-group-sort-groups |
607 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) | 662 "a" gnus-group-sort-groups-by-alphabet |
608 "s" gnus-group-sort-selected-groups | 663 "u" gnus-group-sort-groups-by-unread |
609 "a" gnus-group-sort-selected-groups-by-alphabet | 664 "l" gnus-group-sort-groups-by-level |
610 "u" gnus-group-sort-selected-groups-by-unread | 665 "v" gnus-group-sort-groups-by-score |
611 "l" gnus-group-sort-selected-groups-by-level | 666 "r" gnus-group-sort-groups-by-rank |
612 "v" gnus-group-sort-selected-groups-by-score | 667 "m" gnus-group-sort-groups-by-method |
613 "r" gnus-group-sort-selected-groups-by-rank | 668 "n" gnus-group-sort-groups-by-real-name) |
614 "m" gnus-group-sort-selected-groups-by-method) | 669 |
615 | 670 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) |
616 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) | 671 "s" gnus-group-sort-selected-groups |
617 "k" gnus-group-list-killed | 672 "a" gnus-group-sort-selected-groups-by-alphabet |
618 "z" gnus-group-list-zombies | 673 "u" gnus-group-sort-selected-groups-by-unread |
619 "s" gnus-group-list-groups | 674 "l" gnus-group-sort-selected-groups-by-level |
620 "u" gnus-group-list-all-groups | 675 "v" gnus-group-sort-selected-groups-by-score |
621 "A" gnus-group-list-active | 676 "r" gnus-group-sort-selected-groups-by-rank |
622 "a" gnus-group-apropos | 677 "m" gnus-group-sort-selected-groups-by-method |
623 "d" gnus-group-description-apropos | 678 "n" gnus-group-sort-selected-groups-by-real-name) |
624 "m" gnus-group-list-matching | 679 |
625 "M" gnus-group-list-all-matching | 680 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) |
626 "l" gnus-group-list-level | 681 "k" gnus-group-list-killed |
627 "c" gnus-group-list-cached | 682 "z" gnus-group-list-zombies |
628 "?" gnus-group-list-dormant) | 683 "s" gnus-group-list-groups |
629 | 684 "u" gnus-group-list-all-groups |
630 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) | 685 "A" gnus-group-list-active |
631 "f" gnus-score-flush-cache) | 686 "a" gnus-group-apropos |
632 | 687 "d" gnus-group-description-apropos |
633 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) | 688 "m" gnus-group-list-matching |
634 "d" gnus-group-describe-group | 689 "M" gnus-group-list-all-matching |
635 "f" gnus-group-fetch-faq | 690 "l" gnus-group-list-level |
636 "v" gnus-version) | 691 "c" gnus-group-list-cached |
637 | 692 "?" gnus-group-list-dormant) |
638 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) | 693 |
639 "l" gnus-group-set-current-level | 694 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) |
640 "t" gnus-group-unsubscribe-current-group | 695 "k" gnus-group-list-limit |
641 "s" gnus-group-unsubscribe-group | 696 "z" gnus-group-list-limit |
642 "k" gnus-group-kill-group | 697 "s" gnus-group-list-limit |
643 "y" gnus-group-yank-group | 698 "u" gnus-group-list-limit |
644 "w" gnus-group-kill-region | 699 "A" gnus-group-list-limit |
645 "\C-k" gnus-group-kill-level | 700 "m" gnus-group-list-limit |
646 "z" gnus-group-kill-all-zombies)) | 701 "M" gnus-group-list-limit |
702 "l" gnus-group-list-limit | |
703 "c" gnus-group-list-limit | |
704 "?" gnus-group-list-limit) | |
705 | |
706 (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) | |
707 "k" gnus-group-list-flush | |
708 "z" gnus-group-list-flush | |
709 "s" gnus-group-list-flush | |
710 "u" gnus-group-list-flush | |
711 "A" gnus-group-list-flush | |
712 "m" gnus-group-list-flush | |
713 "M" gnus-group-list-flush | |
714 "l" gnus-group-list-flush | |
715 "c" gnus-group-list-flush | |
716 "?" gnus-group-list-flush) | |
717 | |
718 (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) | |
719 "k" gnus-group-list-plus | |
720 "z" gnus-group-list-plus | |
721 "s" gnus-group-list-plus | |
722 "u" gnus-group-list-plus | |
723 "A" gnus-group-list-plus | |
724 "m" gnus-group-list-plus | |
725 "M" gnus-group-list-plus | |
726 "l" gnus-group-list-plus | |
727 "c" gnus-group-list-plus | |
728 "?" gnus-group-list-plus) | |
729 | |
730 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) | |
731 "f" gnus-score-flush-cache) | |
732 | |
733 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) | |
734 "c" gnus-group-fetch-charter | |
735 "C" gnus-group-fetch-control | |
736 "d" gnus-group-describe-group | |
737 "f" gnus-group-fetch-faq | |
738 "v" gnus-version) | |
739 | |
740 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) | |
741 "l" gnus-group-set-current-level | |
742 "t" gnus-group-unsubscribe-current-group | |
743 "s" gnus-group-unsubscribe-group | |
744 "k" gnus-group-kill-group | |
745 "y" gnus-group-yank-group | |
746 "w" gnus-group-kill-region | |
747 "\C-k" gnus-group-kill-level | |
748 "z" gnus-group-kill-all-zombies) | |
749 | |
750 (defun gnus-topic-mode-p () | |
751 "Return non-nil in `gnus-topic-mode'." | |
752 (and (boundp 'gnus-topic-mode) | |
753 (symbol-value 'gnus-topic-mode))) | |
647 | 754 |
648 (defun gnus-group-make-menu-bar () | 755 (defun gnus-group-make-menu-bar () |
649 (gnus-turn-off-edit-menu 'group) | 756 (gnus-turn-off-edit-menu 'group) |
650 (unless (boundp 'gnus-group-reading-menu) | 757 (unless (boundp 'gnus-group-reading-menu) |
651 | 758 |
652 (easy-menu-define | 759 (easy-menu-define |
653 gnus-group-reading-menu gnus-group-mode-map "" | 760 gnus-group-reading-menu gnus-group-mode-map "" |
654 '("Group" | 761 `("Group" |
655 ["Read" gnus-group-read-group (gnus-group-group-name)] | 762 ["Read" gnus-group-read-group |
656 ["Select" gnus-group-select-group (gnus-group-group-name)] | 763 :included (not (gnus-topic-mode-p)) |
764 :active (gnus-group-group-name)] | |
765 ["Read " gnus-topic-read-group | |
766 :included (gnus-topic-mode-p)] | |
767 ["Select" gnus-group-select-group | |
768 :included (not (gnus-topic-mode-p)) | |
769 :active (gnus-group-group-name)] | |
770 ["Select " gnus-topic-select-group | |
771 :included (gnus-topic-mode-p)] | |
657 ["See old articles" (gnus-group-select-group 'all) | 772 ["See old articles" (gnus-group-select-group 'all) |
658 :keys "C-u SPC" :active (gnus-group-group-name)] | 773 :keys "C-u SPC" :active (gnus-group-group-name)] |
659 ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name) | 774 ["Catch up" gnus-group-catchup-current |
660 :help "Mark unread articles in the current group as read"] | 775 :included (not (gnus-topic-mode-p)) |
776 :active (gnus-group-group-name) | |
777 ,@(if (featurep 'xemacs) nil | |
778 '(:help "Mark unread articles in the current group as read"))] | |
779 ["Catch up " gnus-topic-catchup-articles | |
780 :included (gnus-topic-mode-p) | |
781 ,@(if (featurep 'xemacs) nil | |
782 '(:help "Mark unread articles in the current group or topic as read"))] | |
661 ["Catch up all articles" gnus-group-catchup-current-all | 783 ["Catch up all articles" gnus-group-catchup-current-all |
662 (gnus-group-group-name)] | 784 (gnus-group-group-name)] |
663 ["Check for new articles" gnus-group-get-new-news-this-group | 785 ["Check for new articles" gnus-group-get-new-news-this-group |
786 :included (not (gnus-topic-mode-p)) | |
664 :active (gnus-group-group-name) | 787 :active (gnus-group-group-name) |
665 :help "Check for new messages in current group"] | 788 ,@(if (featurep 'xemacs) nil |
789 '(:help "Check for new messages in current group"))] | |
790 ["Check for new articles " gnus-topic-get-new-news-this-topic | |
791 :included (gnus-topic-mode-p) | |
792 ,@(if (featurep 'xemacs) nil | |
793 '(:help "Check for new messages in current group or topic"))] | |
666 ["Toggle subscription" gnus-group-unsubscribe-current-group | 794 ["Toggle subscription" gnus-group-unsubscribe-current-group |
667 (gnus-group-group-name)] | 795 (gnus-group-group-name)] |
668 ["Kill" gnus-group-kill-group :active (gnus-group-group-name) | 796 ["Kill" gnus-group-kill-group :active (gnus-group-group-name) |
669 :help "Kill (remove) current group"] | 797 ,@(if (featurep 'xemacs) nil |
798 '(:help "Kill (remove) current group"))] | |
670 ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] | 799 ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] |
671 ["Describe" gnus-group-describe-group :active (gnus-group-group-name) | 800 ["Describe" gnus-group-describe-group :active (gnus-group-group-name) |
672 :help "Display description of the current group"] | 801 ,@(if (featurep 'xemacs) nil |
802 '(:help "Display description of the current group"))] | |
673 ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] | 803 ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] |
804 ["Fetch charter" gnus-group-fetch-charter | |
805 :active (gnus-group-group-name) | |
806 ,@(if (featurep 'xemacs) nil | |
807 '(:help "Display the charter of the current group"))] | |
808 ["Fetch control message" gnus-group-fetch-control | |
809 :active (gnus-group-group-name) | |
810 ,@(if (featurep 'xemacs) nil | |
811 '(:help "Display the archived control message for the current group"))] | |
674 ;; Actually one should check, if any of the marked groups gives t for | 812 ;; Actually one should check, if any of the marked groups gives t for |
675 ;; (gnus-check-backend-function 'request-expire-articles ...) | 813 ;; (gnus-check-backend-function 'request-expire-articles ...) |
676 ["Expire articles" gnus-group-expire-articles | 814 ["Expire articles" gnus-group-expire-articles |
677 (or (and (gnus-group-group-name) | 815 :included (not (gnus-topic-mode-p)) |
678 (gnus-check-backend-function | 816 :active (or (and (gnus-group-group-name) |
679 'request-expire-articles | 817 (gnus-check-backend-function |
680 (gnus-group-group-name))) gnus-group-marked)] | 818 'request-expire-articles |
681 ["Set group level" gnus-group-set-current-level | 819 (gnus-group-group-name))) gnus-group-marked)] |
820 ["Expire articles " gnus-topic-expire-articles | |
821 :included (gnus-topic-mode-p)] | |
822 ["Set group level..." gnus-group-set-current-level | |
682 (gnus-group-group-name)] | 823 (gnus-group-group-name)] |
683 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] | 824 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] |
684 ["Customize" gnus-group-customize (gnus-group-group-name)] | 825 ["Customize" gnus-group-customize (gnus-group-group-name)] |
685 ("Edit" | 826 ("Edit" |
686 ["Parameters" gnus-group-edit-group-parameters | 827 ["Parameters" gnus-group-edit-group-parameters |
687 (gnus-group-group-name)] | 828 :included (not (gnus-topic-mode-p)) |
829 :active (gnus-group-group-name)] | |
830 ["Parameters " gnus-topic-edit-parameters | |
831 :included (gnus-topic-mode-p)] | |
688 ["Select method" gnus-group-edit-group-method | 832 ["Select method" gnus-group-edit-group-method |
689 (gnus-group-group-name)] | 833 (gnus-group-group-name)] |
690 ["Info" gnus-group-edit-group (gnus-group-group-name)] | 834 ["Info" gnus-group-edit-group (gnus-group-group-name)] |
691 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] | 835 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] |
692 ["Global kill file" gnus-group-edit-global-kill t]))) | 836 ["Global kill file" gnus-group-edit-global-kill t]))) |
713 ["Sort by method" gnus-group-sort-groups-by-method t] | 857 ["Sort by method" gnus-group-sort-groups-by-method t] |
714 ["Sort by rank" gnus-group-sort-groups-by-rank t] | 858 ["Sort by rank" gnus-group-sort-groups-by-rank t] |
715 ["Sort by score" gnus-group-sort-groups-by-score t] | 859 ["Sort by score" gnus-group-sort-groups-by-score t] |
716 ["Sort by level" gnus-group-sort-groups-by-level t] | 860 ["Sort by level" gnus-group-sort-groups-by-level t] |
717 ["Sort by unread" gnus-group-sort-groups-by-unread t] | 861 ["Sort by unread" gnus-group-sort-groups-by-unread t] |
718 ["Sort by name" gnus-group-sort-groups-by-alphabet t]) | 862 ["Sort by name" gnus-group-sort-groups-by-alphabet t] |
863 ["Sort by real name" gnus-group-sort-groups-by-real-name t]) | |
719 ("Sort process/prefixed" | 864 ("Sort process/prefixed" |
720 ["Default sort" gnus-group-sort-selected-groups | 865 ["Default sort" gnus-group-sort-selected-groups |
721 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | 866 (not (gnus-topic-mode-p))] |
722 ["Sort by method" gnus-group-sort-selected-groups-by-method | 867 ["Sort by method" gnus-group-sort-selected-groups-by-method |
723 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | 868 (not (gnus-topic-mode-p))] |
724 ["Sort by rank" gnus-group-sort-selected-groups-by-rank | 869 ["Sort by rank" gnus-group-sort-selected-groups-by-rank |
725 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | 870 (not (gnus-topic-mode-p))] |
726 ["Sort by score" gnus-group-sort-selected-groups-by-score | 871 ["Sort by score" gnus-group-sort-selected-groups-by-score |
727 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | 872 (not (gnus-topic-mode-p))] |
728 ["Sort by level" gnus-group-sort-selected-groups-by-level | 873 ["Sort by level" gnus-group-sort-selected-groups-by-level |
729 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | 874 (not (gnus-topic-mode-p))] |
730 ["Sort by unread" gnus-group-sort-selected-groups-by-unread | 875 ["Sort by unread" gnus-group-sort-selected-groups-by-unread |
731 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] | 876 (not (gnus-topic-mode-p))] |
732 ["Sort by name" gnus-group-sort-selected-groups-by-alphabet | 877 ["Sort by name" gnus-group-sort-selected-groups-by-alphabet |
733 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) | 878 (not (gnus-topic-mode-p))] |
879 ["Sort by real name" gnus-group-sort-selected-groups-by-real-name | |
880 (not (gnus-topic-mode-p))]) | |
734 ("Mark" | 881 ("Mark" |
735 ["Mark group" gnus-group-mark-group | 882 ["Mark group" gnus-group-mark-group |
736 (and (gnus-group-group-name) | 883 (and (gnus-group-group-name) |
737 (not (memq (gnus-group-group-name) gnus-group-marked)))] | 884 (not (memq (gnus-group-group-name) gnus-group-marked)))] |
738 ["Unmark group" gnus-group-unmark-group | 885 ["Unmark group" gnus-group-unmark-group |
739 (and (gnus-group-group-name) | 886 (and (gnus-group-group-name) |
740 (memq (gnus-group-group-name) gnus-group-marked))] | 887 (memq (gnus-group-group-name) gnus-group-marked))] |
741 ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] | 888 ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] |
742 ["Mark regexp..." gnus-group-mark-regexp t] | 889 ["Mark regexp..." gnus-group-mark-regexp t] |
743 ["Mark region" gnus-group-mark-region t] | 890 ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)] |
744 ["Mark buffer" gnus-group-mark-buffer t] | 891 ["Mark buffer" gnus-group-mark-buffer t] |
745 ["Execute command" gnus-group-universal-argument | 892 ["Execute command" gnus-group-universal-argument |
746 (or gnus-group-marked (gnus-group-group-name))]) | 893 (or gnus-group-marked (gnus-group-group-name))]) |
747 ("Subscribe" | 894 ("Subscribe" |
748 ["Subscribe to a group" gnus-group-unsubscribe-group t] | 895 ["Subscribe to a group..." gnus-group-unsubscribe-group t] |
749 ["Kill all newsgroups in region" gnus-group-kill-region t] | 896 ["Kill all newsgroups in region" gnus-group-kill-region |
897 :active (gnus-mark-active-p)] | |
750 ["Kill all zombie groups" gnus-group-kill-all-zombies | 898 ["Kill all zombie groups" gnus-group-kill-all-zombies |
751 gnus-zombie-list] | 899 gnus-zombie-list] |
752 ["Kill all groups on level..." gnus-group-kill-level t]) | 900 ["Kill all groups on level..." gnus-group-kill-level t]) |
753 ("Foreign groups" | 901 ("Foreign groups" |
754 ["Make a foreign group" gnus-group-make-group t] | 902 ["Make a foreign group..." gnus-group-make-group t] |
755 ["Add a directory group" gnus-group-make-directory-group t] | 903 ["Add a directory group..." gnus-group-make-directory-group t] |
756 ["Add the help group" gnus-group-make-help-group t] | 904 ["Add the help group" gnus-group-make-help-group t] |
757 ["Add the archive group" gnus-group-make-archive-group t] | 905 ["Add the archive group" gnus-group-make-archive-group t] |
758 ["Make a doc group" gnus-group-make-doc-group t] | 906 ["Make a doc group..." gnus-group-make-doc-group t] |
759 ["Make a web group" gnus-group-make-web-group t] | 907 ["Make a web group..." gnus-group-make-web-group t] |
760 ["Make a kiboze group" gnus-group-make-kiboze-group t] | 908 ["Make a kiboze group..." gnus-group-make-kiboze-group t] |
761 ["Make a virtual group" gnus-group-make-empty-virtual t] | 909 ["Make a virtual group..." gnus-group-make-empty-virtual t] |
762 ["Add a group to a virtual" gnus-group-add-to-virtual t] | 910 ["Add a group to a virtual..." gnus-group-add-to-virtual t] |
763 ["Rename group" gnus-group-rename-group | 911 ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] |
912 ["Make an RSS group..." gnus-group-make-rss-group t] | |
913 ["Rename group..." gnus-group-rename-group | |
764 (gnus-check-backend-function | 914 (gnus-check-backend-function |
765 'request-rename-group (gnus-group-group-name))] | 915 'request-rename-group (gnus-group-group-name))] |
766 ["Delete group" gnus-group-delete-group | 916 ["Delete group" gnus-group-delete-group |
767 (gnus-check-backend-function | 917 (gnus-check-backend-function |
768 'request-delete-group (gnus-group-group-name))]) | 918 'request-delete-group (gnus-group-group-name))]) |
772 ["Next unread" gnus-group-next-unread-group t] | 922 ["Next unread" gnus-group-next-unread-group t] |
773 ["Previous unread" gnus-group-prev-unread-group t] | 923 ["Previous unread" gnus-group-prev-unread-group t] |
774 ["Next unread same level" gnus-group-next-unread-group-same-level t] | 924 ["Next unread same level" gnus-group-next-unread-group-same-level t] |
775 ["Previous unread same level" | 925 ["Previous unread same level" |
776 gnus-group-prev-unread-group-same-level t] | 926 gnus-group-prev-unread-group-same-level t] |
777 ["Jump to group" gnus-group-jump-to-group t] | 927 ["Jump to group..." gnus-group-jump-to-group t] |
778 ["First unread group" gnus-group-first-unread-group t] | 928 ["First unread group" gnus-group-first-unread-group t] |
779 ["Best unread group" gnus-group-best-unread-group t]) | 929 ["Best unread group" gnus-group-best-unread-group t]) |
930 ("Sieve" | |
931 ["Generate" gnus-sieve-generate t] | |
932 ["Generate and update" gnus-sieve-update t]) | |
780 ["Delete bogus groups" gnus-group-check-bogus-groups t] | 933 ["Delete bogus groups" gnus-group-check-bogus-groups t] |
781 ["Find new newsgroups" gnus-group-find-new-groups t] | 934 ["Find new newsgroups" gnus-group-find-new-groups t] |
782 ["Transpose" gnus-group-transpose-groups | 935 ["Transpose" gnus-group-transpose-groups |
783 (gnus-group-group-name)] | 936 (gnus-group-group-name)] |
784 ["Read a directory as a group..." gnus-group-enter-directory t])) | 937 ["Read a directory as a group..." gnus-group-enter-directory t])) |
785 | 938 |
786 (easy-menu-define | 939 (easy-menu-define |
787 gnus-group-misc-menu gnus-group-mode-map "" | 940 gnus-group-misc-menu gnus-group-mode-map "" |
788 '("Misc" | 941 `("Gnus" |
789 ("SOUP" | 942 ("SOUP" |
790 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] | 943 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] |
791 ["Send replies" gnus-soup-send-replies | 944 ["Send replies" gnus-soup-send-replies |
792 (fboundp 'gnus-soup-pack-packet)] | 945 (fboundp 'gnus-soup-pack-packet)] |
793 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] | 946 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] |
794 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] | 947 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] |
795 ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) | 948 ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) |
796 ["Send a mail" gnus-group-mail t] | 949 ["Send a mail" gnus-group-mail t] |
797 ["Post an article..." gnus-group-post-news t] | 950 ["Send a message (mail or news)" gnus-group-post-news t] |
951 ["Create a local message" gnus-group-news t] | |
798 ["Check for new news" gnus-group-get-new-news | 952 ["Check for new news" gnus-group-get-new-news |
799 :help "Get newly arrived articles"] | 953 ,@(if (featurep 'xemacs) '(t) |
954 '(:help "Get newly arrived articles")) | |
955 ] | |
956 ["Send queued messages" gnus-delay-send-queue | |
957 ,@(if (featurep 'xemacs) '(t) | |
958 '(:help "Send all messages that are scheduled to be sent now")) | |
959 ] | |
800 ["Activate all groups" gnus-activate-all-groups t] | 960 ["Activate all groups" gnus-activate-all-groups t] |
801 ["Restart Gnus" gnus-group-restart t] | 961 ["Restart Gnus" gnus-group-restart t] |
802 ["Read init file" gnus-group-read-init-file t] | 962 ["Read init file" gnus-group-read-init-file t] |
803 ["Browse foreign server" gnus-group-browse-foreign-server t] | 963 ["Browse foreign server..." gnus-group-browse-foreign-server t] |
804 ["Enter server buffer" gnus-group-enter-server-mode t] | 964 ["Enter server buffer" gnus-group-enter-server-mode t] |
805 ["Expire all expirable articles" gnus-group-expire-all-groups t] | 965 ["Expire all expirable articles" gnus-group-expire-all-groups t] |
806 ["Generate any kiboze groups" nnkiboze-generate-groups t] | 966 ["Generate any kiboze groups" nnkiboze-generate-groups t] |
807 ["Gnus version" gnus-version t] | 967 ["Gnus version" gnus-version t] |
808 ["Save .newsrc files" gnus-group-save-newsrc t] | 968 ["Save .newsrc files" gnus-group-save-newsrc t] |
811 ["Read manual" gnus-info-find-node t] | 971 ["Read manual" gnus-info-find-node t] |
812 ["Flush score cache" gnus-score-flush-cache t] | 972 ["Flush score cache" gnus-score-flush-cache t] |
813 ["Toggle topics" gnus-topic-mode t] | 973 ["Toggle topics" gnus-topic-mode t] |
814 ["Send a bug report" gnus-bug t] | 974 ["Send a bug report" gnus-bug t] |
815 ["Exit from Gnus" gnus-group-exit | 975 ["Exit from Gnus" gnus-group-exit |
816 :help "Quit reading news"] | 976 ,@(if (featurep 'xemacs) '(t) |
977 '(:help "Quit reading news"))] | |
817 ["Exit without saving" gnus-group-quit t])) | 978 ["Exit without saving" gnus-group-quit t])) |
818 | 979 |
819 (gnus-run-hooks 'gnus-group-menu-hook))) | 980 (gnus-run-hooks 'gnus-group-menu-hook))) |
820 | 981 |
821 (defvar gnus-group-toolbar-map nil) | 982 (defvar gnus-group-toolbar-map nil) |
826 (condition-case nil (require 'tool-bar) (error nil)) | 987 (condition-case nil (require 'tool-bar) (error nil)) |
827 (fboundp 'tool-bar-add-item-from-menu) | 988 (fboundp 'tool-bar-add-item-from-menu) |
828 (default-value 'tool-bar-mode) | 989 (default-value 'tool-bar-mode) |
829 (not gnus-group-toolbar-map)) | 990 (not gnus-group-toolbar-map)) |
830 (setq gnus-group-toolbar-map | 991 (setq gnus-group-toolbar-map |
831 (let ((tool-bar-map (make-sparse-keymap))) | 992 (let ((tool-bar-map (make-sparse-keymap)) |
993 (load-path (mm-image-load-path))) | |
832 (tool-bar-add-item-from-menu | 994 (tool-bar-add-item-from-menu |
833 'gnus-group-get-new-news "get-news" gnus-group-mode-map) | 995 'gnus-group-get-new-news "get-news" gnus-group-mode-map) |
834 (tool-bar-add-item-from-menu | 996 (tool-bar-add-item-from-menu |
835 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map) | 997 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map) |
836 (tool-bar-add-item-from-menu | 998 (tool-bar-add-item-from-menu |
884 (gnus-update-group-mark-positions) | 1046 (gnus-update-group-mark-positions) |
885 (when gnus-use-undo | 1047 (when gnus-use-undo |
886 (gnus-undo-mode 1)) | 1048 (gnus-undo-mode 1)) |
887 (when gnus-slave | 1049 (when gnus-slave |
888 (gnus-slave-mode)) | 1050 (gnus-slave-mode)) |
889 (gnus-run-hooks 'gnus-group-mode-hook)) | 1051 (gnus-run-mode-hooks 'gnus-group-mode-hook)) |
890 | 1052 |
891 (defun gnus-update-group-mark-positions () | 1053 (defun gnus-update-group-mark-positions () |
892 (save-excursion | 1054 (save-excursion |
893 (let ((gnus-process-mark ?\200) | 1055 (let ((gnus-process-mark ?\200) |
1056 (gnus-group-update-hook nil) | |
894 (gnus-group-marked '("dummy.group")) | 1057 (gnus-group-marked '("dummy.group")) |
895 (gnus-active-hashtb (make-vector 10 0)) | 1058 (gnus-active-hashtb (make-vector 10 0)) |
896 (topic "")) | 1059 (topic "")) |
897 (gnus-set-active "dummy.group" '(0 . 0)) | 1060 (gnus-set-active "dummy.group" '(0 . 0)) |
898 (gnus-set-work-buffer) | 1061 (gnus-set-work-buffer) |
899 (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) | 1062 (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) |
900 (goto-char (point-min)) | 1063 (goto-char (point-min)) |
901 (setq gnus-group-mark-positions | 1064 (setq gnus-group-mark-positions |
902 (list (cons 'process (and (search-forward "\200" nil t) | 1065 (list (cons 'process (and (search-forward |
1066 (mm-string-as-multibyte "\200") nil t) | |
903 (- (point) 2)))))))) | 1067 (- (point) 2)))))))) |
904 | 1068 |
905 (defun gnus-mouse-pick-group (e) | 1069 (defun gnus-mouse-pick-group (e) |
906 "Enter the group under the mouse pointer." | 1070 "Enter the group under the mouse pointer." |
907 (interactive "e") | 1071 (interactive "e") |
930 (unless (eq major-mode 'gnus-group-mode) | 1094 (unless (eq major-mode 'gnus-group-mode) |
931 (gnus-group-mode) | 1095 (gnus-group-mode) |
932 (when gnus-carpal | 1096 (when gnus-carpal |
933 (gnus-carpal-setup-buffer 'group)))) | 1097 (gnus-carpal-setup-buffer 'group)))) |
934 | 1098 |
935 (defsubst gnus-group-name-charset (method group) | 1099 (defun gnus-group-name-charset (method group) |
936 (if (null method) | 1100 (if (null method) |
937 (setq method (gnus-find-method-for-group group))) | 1101 (setq method (gnus-find-method-for-group group))) |
938 (let ((item (assoc method gnus-group-name-charset-method-alist)) | 1102 (let ((item (assoc method gnus-group-name-charset-method-alist)) |
939 (alist gnus-group-name-charset-group-alist) | 1103 (alist gnus-group-name-charset-group-alist) |
940 result) | 1104 result) |
944 (if (string-match (car item) group) | 1108 (if (string-match (car item) group) |
945 (setq alist nil | 1109 (setq alist nil |
946 result (cdr item)))) | 1110 result (cdr item)))) |
947 result))) | 1111 result))) |
948 | 1112 |
949 (defsubst gnus-group-name-decode (string charset) | 1113 (defun gnus-group-name-decode (string charset) |
1114 ;; Fixme: Don't decode in unibyte mode. | |
950 (if (and string charset (featurep 'mule)) | 1115 (if (and string charset (featurep 'mule)) |
951 (mm-decode-coding-string string charset) | 1116 (mm-decode-coding-string string charset) |
952 string)) | 1117 string)) |
953 | 1118 |
954 (defun gnus-group-decoded-name (string) | 1119 (defun gnus-group-decoded-name (string) |
1026 "List groups on LEVEL. | 1191 "List groups on LEVEL. |
1027 If ALL (the prefix), also list groups that have no unread articles." | 1192 If ALL (the prefix), also list groups that have no unread articles." |
1028 (interactive "nList groups on level: \nP") | 1193 (interactive "nList groups on level: \nP") |
1029 (gnus-group-list-groups level all level)) | 1194 (gnus-group-list-groups level all level)) |
1030 | 1195 |
1031 (defun gnus-group-prepare-flat (level &optional all lowest regexp) | 1196 (defun gnus-group-prepare-logic (group test) |
1197 (or (and gnus-group-listed-groups | |
1198 (null gnus-group-list-option) | |
1199 (member group gnus-group-listed-groups)) | |
1200 (cond | |
1201 ((null gnus-group-listed-groups) test) | |
1202 ((null gnus-group-list-option) test) | |
1203 (t (and (member group gnus-group-listed-groups) | |
1204 (if (eq gnus-group-list-option 'flush) | |
1205 (not test) | |
1206 test)))))) | |
1207 | |
1208 (defun gnus-group-prepare-flat (level &optional predicate lowest regexp) | |
1032 "List all newsgroups with unread articles of level LEVEL or lower. | 1209 "List all newsgroups with unread articles of level LEVEL or lower. |
1033 If ALL is non-nil, list groups that have no unread articles. | 1210 If PREDICATE is a function, list groups that the function returns non-nil; |
1211 if it is t, list groups that have no unread articles. | |
1034 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. | 1212 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. |
1035 If REGEXP, only list groups matching REGEXP." | 1213 If REGEXP is a function, list dead groups that the function returns non-nil; |
1214 if it is a string, only list groups matching REGEXP." | |
1036 (set-buffer gnus-group-buffer) | 1215 (set-buffer gnus-group-buffer) |
1037 (let ((buffer-read-only nil) | 1216 (let ((buffer-read-only nil) |
1038 (newsrc (cdr gnus-newsrc-alist)) | 1217 (newsrc (cdr gnus-newsrc-alist)) |
1039 (lowest (or lowest 1)) | 1218 (lowest (or lowest 1)) |
1219 (not-in-list (and gnus-group-listed-groups | |
1220 (copy-sequence gnus-group-listed-groups))) | |
1040 info clevel unread group params) | 1221 info clevel unread group params) |
1041 (erase-buffer) | 1222 (erase-buffer) |
1042 (when (< lowest gnus-level-zombie) | 1223 (when (or (< lowest gnus-level-zombie) |
1224 gnus-group-listed-groups) | |
1043 ;; List living groups. | 1225 ;; List living groups. |
1044 (while newsrc | 1226 (while newsrc |
1045 (setq info (car newsrc) | 1227 (setq info (car newsrc) |
1046 group (gnus-info-group info) | 1228 group (gnus-info-group info) |
1047 params (gnus-info-params info) | 1229 params (gnus-info-params info) |
1048 newsrc (cdr newsrc) | 1230 newsrc (cdr newsrc) |
1049 unread (car (gnus-gethash group gnus-newsrc-hashtb))) | 1231 unread (car (gnus-gethash group gnus-newsrc-hashtb))) |
1050 (and unread ; This group might be unchecked | 1232 (when not-in-list |
1051 (or (not regexp) | 1233 (setq not-in-list (delete group not-in-list))) |
1052 (string-match regexp group)) | 1234 (when (gnus-group-prepare-logic |
1053 (<= (setq clevel (gnus-info-level info)) level) | 1235 group |
1054 (>= clevel lowest) | 1236 (and unread ; This group might be unchecked |
1055 (or all ; We list all groups? | 1237 (or (not (stringp regexp)) |
1056 (if (eq unread t) ; Unactivated? | 1238 (string-match regexp group)) |
1057 gnus-group-list-inactive-groups ; We list unactivated | 1239 (<= (setq clevel (gnus-info-level info)) level) |
1058 (> unread 0)) ; We list groups with unread articles | 1240 (>= clevel lowest) |
1059 (and gnus-list-groups-with-ticked-articles | 1241 (cond |
1060 (cdr (assq 'tick (gnus-info-marks info)))) | 1242 ((functionp predicate) |
1243 (funcall predicate info)) | |
1244 (predicate t) ; We list all groups? | |
1245 (t | |
1246 (or | |
1247 (if (eq unread t) ; Unactivated? | |
1248 gnus-group-list-inactive-groups | |
1249 ; We list unactivated | |
1250 (> unread 0)) | |
1251 ; We list groups with unread articles | |
1252 (and gnus-list-groups-with-ticked-articles | |
1253 (cdr (assq 'tick (gnus-info-marks info)))) | |
1061 ; And groups with tickeds | 1254 ; And groups with tickeds |
1062 ;; Check for permanent visibility. | 1255 ;; Check for permanent visibility. |
1063 (and gnus-permanently-visible-groups | 1256 (and gnus-permanently-visible-groups |
1064 (string-match gnus-permanently-visible-groups | 1257 (string-match gnus-permanently-visible-groups |
1065 group)) | 1258 group)) |
1066 (memq 'visible params) | 1259 (memq 'visible params) |
1067 (cdr (assq 'visible params))) | 1260 (cdr (assq 'visible params))))))) |
1068 (gnus-group-insert-group-line | 1261 (gnus-group-insert-group-line |
1069 group (gnus-info-level info) | 1262 group (gnus-info-level info) |
1070 (gnus-info-marks info) unread (gnus-info-method info))))) | 1263 (gnus-info-marks info) unread (gnus-info-method info))))) |
1071 | 1264 |
1072 ;; List dead groups. | 1265 ;; List dead groups. |
1073 (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) | 1266 (when (or gnus-group-listed-groups |
1074 (gnus-group-prepare-flat-list-dead | 1267 (and (>= level gnus-level-zombie) |
1075 (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) | 1268 (<= lowest gnus-level-zombie))) |
1076 gnus-level-zombie ?Z | 1269 (gnus-group-prepare-flat-list-dead |
1077 regexp)) | 1270 (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) |
1078 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) | 1271 gnus-level-zombie ?Z |
1079 (gnus-group-prepare-flat-list-dead | 1272 regexp)) |
1080 (setq gnus-killed-list (sort gnus-killed-list 'string<)) | 1273 (when not-in-list |
1081 gnus-level-killed ?K regexp)) | 1274 (dolist (group gnus-zombie-list) |
1275 (setq not-in-list (delete group not-in-list)))) | |
1276 (when (or gnus-group-listed-groups | |
1277 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) | |
1278 (gnus-group-prepare-flat-list-dead | |
1279 (gnus-union | |
1280 not-in-list | |
1281 (setq gnus-killed-list (sort gnus-killed-list 'string<))) | |
1282 gnus-level-killed ?K regexp)) | |
1082 | 1283 |
1083 (gnus-group-set-mode-line) | 1284 (gnus-group-set-mode-line) |
1084 (setq gnus-group-list-mode (cons level all)) | 1285 (setq gnus-group-list-mode (cons level predicate)) |
1085 (gnus-run-hooks 'gnus-group-prepare-hook) | 1286 (gnus-run-hooks 'gnus-group-prepare-hook) |
1086 t)) | 1287 t)) |
1087 | 1288 |
1088 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) | 1289 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) |
1089 ;; List zombies and killed lists somewhat faster, which was | 1290 ;; List zombies and killed lists somewhat faster, which was |
1090 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does | 1291 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does |
1091 ;; this by ignoring the group format specification altogether. | 1292 ;; this by ignoring the group format specification altogether. |
1092 (let (group) | 1293 (let (group) |
1093 (if regexp | 1294 (if (> (length groups) gnus-group-listing-limit) |
1094 ;; This loop is used when listing groups that match some | |
1095 ;; regexp. | |
1096 (while groups | 1295 (while groups |
1097 (setq group (pop groups)) | 1296 (setq group (pop groups)) |
1098 (when (string-match regexp group) | 1297 (when (gnus-group-prepare-logic |
1298 group | |
1299 (or (not regexp) | |
1300 (and (stringp regexp) (string-match regexp group)) | |
1301 (and (functionp regexp) (funcall regexp group)))) | |
1099 (gnus-add-text-properties | 1302 (gnus-add-text-properties |
1100 (point) (prog1 (1+ (point)) | 1303 (point) (prog1 (1+ (point)) |
1101 (insert " " mark " *: " | 1304 (insert " " mark " *: " |
1102 (gnus-group-name-decode group | 1305 (gnus-group-decoded-name group) |
1103 (gnus-group-name-charset | |
1104 nil group)) | |
1105 "\n")) | 1306 "\n")) |
1106 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | 1307 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) |
1107 'gnus-unread t | 1308 'gnus-unread t |
1108 'gnus-level level)))) | 1309 'gnus-level level)))) |
1109 ;; This loop is used when listing all groups. | |
1110 (while groups | 1310 (while groups |
1111 (setq group (pop groups)) | 1311 (setq group (pop groups)) |
1112 (gnus-add-text-properties | 1312 (when (gnus-group-prepare-logic |
1113 (point) (prog1 (1+ (point)) | 1313 group |
1114 (insert " " mark " *: " | 1314 (or (not regexp) |
1115 (gnus-group-name-decode group | 1315 (and (stringp regexp) (string-match regexp group)) |
1116 (gnus-group-name-charset | 1316 (and (functionp regexp) (funcall regexp group)))) |
1117 nil group)) | 1317 (gnus-group-insert-group-line |
1118 "\n")) | 1318 group level nil |
1119 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | 1319 (let ((active (gnus-active group))) |
1120 'gnus-unread t | 1320 (if active |
1121 'gnus-level level)))))) | 1321 (if (zerop (cdr active)) |
1322 0 | |
1323 (- (1+ (cdr active)) (car active))) | |
1324 nil)) | |
1325 (gnus-method-simplify (gnus-find-method-for-group group)))))))) | |
1122 | 1326 |
1123 (defun gnus-group-update-group-line () | 1327 (defun gnus-group-update-group-line () |
1124 "Update the current line in the group buffer." | 1328 "Update the current line in the group buffer." |
1125 (let* ((buffer-read-only nil) | 1329 (let* ((buffer-read-only nil) |
1126 (group (gnus-group-group-name)) | 1330 (group (gnus-group-group-name)) |
1159 (if (setq active (gnus-active group)) | 1363 (if (setq active (gnus-active group)) |
1160 (if (zerop (cdr active)) | 1364 (if (zerop (cdr active)) |
1161 0 | 1365 0 |
1162 (- (1+ (cdr active)) (car active))) | 1366 (- (1+ (cdr active)) (car active))) |
1163 nil) | 1367 nil) |
1164 nil)))) | 1368 (gnus-method-simplify (gnus-find-method-for-group group)))))) |
1369 | |
1370 (defun gnus-number-of-unseen-articles-in-group (group) | |
1371 (let* ((info (nth 2 (gnus-group-entry group))) | |
1372 (marked (gnus-info-marks info)) | |
1373 (seen (cdr (assq 'seen marked))) | |
1374 (active (gnus-active group))) | |
1375 (if (not active) | |
1376 0 | |
1377 (length (gnus-uncompress-range | |
1378 (gnus-range-difference | |
1379 (gnus-range-difference (list active) (gnus-info-read info)) | |
1380 seen)))))) | |
1165 | 1381 |
1166 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level | 1382 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level |
1167 gnus-tmp-marked number | 1383 gnus-tmp-marked number |
1168 gnus-tmp-method) | 1384 gnus-tmp-method) |
1169 "Insert a group line in the group buffer." | 1385 "Insert a group line in the group buffer." |
1189 ((= gnus-tmp-level gnus-level-zombie) ?Z) | 1405 ((= gnus-tmp-level gnus-level-zombie) ?Z) |
1190 (t ?K))) | 1406 (t ?K))) |
1191 (gnus-tmp-qualified-group | 1407 (gnus-tmp-qualified-group |
1192 (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) | 1408 (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) |
1193 group-name-charset)) | 1409 group-name-charset)) |
1410 (gnus-tmp-comment | |
1411 (or (gnus-group-get-parameter gnus-tmp-group 'comment t) | |
1412 gnus-tmp-group)) | |
1194 (gnus-tmp-newsgroup-description | 1413 (gnus-tmp-newsgroup-description |
1195 (if gnus-description-hashtb | 1414 (if gnus-description-hashtb |
1196 (or (gnus-group-name-decode | 1415 (or (gnus-group-name-decode |
1197 (gnus-gethash gnus-tmp-group gnus-description-hashtb) | 1416 (gnus-gethash gnus-tmp-group gnus-description-hashtb) |
1198 group-name-charset) "") | 1417 group-name-charset) "") |
1213 (gnus-tmp-marked-mark | 1432 (gnus-tmp-marked-mark |
1214 (if (and (numberp number) | 1433 (if (and (numberp number) |
1215 (zerop number) | 1434 (zerop number) |
1216 (cdr (assq 'tick gnus-tmp-marked))) | 1435 (cdr (assq 'tick gnus-tmp-marked))) |
1217 ?* ? )) | 1436 ?* ? )) |
1437 (gnus-tmp-summary-live | |
1438 (if (and (not gnus-group-is-exiting-p) | |
1439 (gnus-buffer-live-p (gnus-summary-buffer-name | |
1440 gnus-tmp-group))) | |
1441 ?* ? )) | |
1218 (gnus-tmp-process-marked | 1442 (gnus-tmp-process-marked |
1219 (if (member gnus-tmp-group gnus-group-marked) | 1443 (if (member gnus-tmp-group gnus-group-marked) |
1220 gnus-process-mark ? )) | 1444 gnus-process-mark ? )) |
1221 (gnus-tmp-grouplens | 1445 (gnus-tmp-grouplens |
1222 (or (and gnus-use-grouplens | 1446 (or (and gnus-use-grouplens |
1227 (beginning-of-line) | 1451 (beginning-of-line) |
1228 (gnus-add-text-properties | 1452 (gnus-add-text-properties |
1229 (point) | 1453 (point) |
1230 (prog1 (1+ (point)) | 1454 (prog1 (1+ (point)) |
1231 ;; Insert the text. | 1455 ;; Insert the text. |
1232 (eval gnus-group-line-format-spec)) | 1456 (let ((gnus-tmp-decoded-group (gnus-group-name-decode |
1457 gnus-tmp-group group-name-charset))) | |
1458 (eval gnus-group-line-format-spec))) | |
1233 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) | 1459 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) |
1234 gnus-unread ,(if (numberp number) | 1460 gnus-unread ,(if (numberp number) |
1235 (string-to-int gnus-tmp-number-of-unread) | 1461 (string-to-number gnus-tmp-number-of-unread) |
1236 t) | 1462 t) |
1237 gnus-marked ,gnus-tmp-marked-mark | 1463 gnus-marked ,gnus-tmp-marked-mark |
1238 gnus-indentation ,gnus-group-indentation | 1464 gnus-indentation ,gnus-group-indentation |
1239 gnus-level ,gnus-tmp-level)) | 1465 gnus-level ,gnus-tmp-level)) |
1240 (forward-line -1) | 1466 (forward-line -1) |
1246 | 1472 |
1247 (defun gnus-group-highlight-line () | 1473 (defun gnus-group-highlight-line () |
1248 "Highlight the current line according to `gnus-group-highlight'." | 1474 "Highlight the current line according to `gnus-group-highlight'." |
1249 (let* ((list gnus-group-highlight) | 1475 (let* ((list gnus-group-highlight) |
1250 (p (point)) | 1476 (p (point)) |
1251 (end (progn (end-of-line) (point))) | 1477 (end (gnus-point-at-eol)) |
1252 ;; now find out where the line starts and leave point there. | 1478 ;; now find out where the line starts and leave point there. |
1253 (beg (progn (beginning-of-line) (point))) | 1479 (beg (progn (beginning-of-line) (point))) |
1254 (group (gnus-group-group-name)) | 1480 (group (gnus-group-group-name)) |
1255 (entry (gnus-group-entry group)) | 1481 (entry (gnus-group-entry group)) |
1256 (unread (if (numberp (car entry)) (car entry) 0)) | 1482 (unread (if (numberp (car entry)) (car entry) 0)) |
1257 (active (gnus-active group)) | 1483 (active (gnus-active group)) |
1258 (total (if active (1+ (- (cdr active) (car active))) 0)) | 1484 (total (if active (1+ (- (cdr active) (car active))) 0)) |
1259 (info (nth 2 entry)) | 1485 (info (nth 2 entry)) |
1260 (method (gnus-server-get-method group (gnus-info-method info))) | 1486 (method (inline (gnus-server-get-method group (gnus-info-method info)))) |
1261 (marked (gnus-info-marks info)) | 1487 (marked (gnus-info-marks info)) |
1262 (mailp (memq 'mail (assoc (symbol-name | 1488 (mailp (apply 'append |
1263 (car (or method gnus-select-method))) | 1489 (mapcar |
1264 gnus-valid-select-methods))) | 1490 (lambda (x) |
1491 (memq x (assoc (symbol-name | |
1492 (car (or method gnus-select-method))) | |
1493 gnus-valid-select-methods))) | |
1494 '(mail post-mail)))) | |
1265 (level (or (gnus-info-level info) gnus-level-killed)) | 1495 (level (or (gnus-info-level info) gnus-level-killed)) |
1266 (score (or (gnus-info-score info) 0)) | 1496 (score (or (gnus-info-score info) 0)) |
1267 (ticked (gnus-range-length (cdr (assq 'tick marked)))) | 1497 (ticked (gnus-range-length (cdr (assq 'tick marked)))) |
1268 (group-age (gnus-group-timestamp-delta group)) | 1498 (group-age (gnus-group-timestamp-delta group)) |
1269 (inhibit-read-only t)) | 1499 (inhibit-read-only t)) |
1524 (defun gnus-group-mark-regexp (regexp) | 1754 (defun gnus-group-mark-regexp (regexp) |
1525 "Mark all groups that match some regexp." | 1755 "Mark all groups that match some regexp." |
1526 (interactive "sMark (regexp): ") | 1756 (interactive "sMark (regexp): ") |
1527 (let ((alist (cdr gnus-newsrc-alist)) | 1757 (let ((alist (cdr gnus-newsrc-alist)) |
1528 group) | 1758 group) |
1529 (while alist | 1759 (save-excursion |
1530 (when (string-match regexp (setq group (gnus-info-group (pop alist)))) | 1760 (while alist |
1531 (gnus-group-set-mark group)))) | 1761 (when (string-match regexp (setq group (gnus-info-group (pop alist)))) |
1762 (gnus-group-jump-to-group group) | |
1763 (gnus-group-set-mark group))))) | |
1532 (gnus-group-position-point)) | 1764 (gnus-group-position-point)) |
1533 | 1765 |
1534 (defun gnus-group-remove-mark (group &optional test-marked) | 1766 (defun gnus-group-remove-mark (group &optional test-marked) |
1535 "Remove the process mark from GROUP and move point there. | 1767 "Remove the process mark from GROUP and move point there. |
1536 Return nil if the group isn't displayed." | 1768 Return nil if the group isn't displayed." |
1580 (if (setq group (gnus-group-group-name)) | 1812 (if (setq group (gnus-group-group-name)) |
1581 (push group groups)) | 1813 (push group groups)) |
1582 (setq n (1- n)) | 1814 (setq n (1- n)) |
1583 (gnus-group-next-group way))) | 1815 (gnus-group-next-group way))) |
1584 (nreverse groups))) | 1816 (nreverse groups))) |
1585 ((gnus-region-active-p) | 1817 ((and (gnus-region-active-p) (mark)) |
1586 ;; Work on the region between point and mark. | 1818 ;; Work on the region between point and mark. |
1587 (let ((max (max (point) (mark))) | 1819 (let ((max (max (point) (mark))) |
1588 groups) | 1820 groups) |
1589 (save-excursion | 1821 (save-excursion |
1590 (goto-char (min (point) (mark))) | 1822 (goto-char (min (point) (mark))) |
1665 no-article nil no-display nil select-articles))) | 1897 no-article nil no-display nil select-articles))) |
1666 | 1898 |
1667 (defun gnus-group-select-group (&optional all) | 1899 (defun gnus-group-select-group (&optional all) |
1668 "Select this newsgroup. | 1900 "Select this newsgroup. |
1669 No article is selected automatically. | 1901 No article is selected automatically. |
1902 If the group is opened, just switch the summary buffer. | |
1670 If ALL is non-nil, already read articles become readable. | 1903 If ALL is non-nil, already read articles become readable. |
1671 If ALL is a number, fetch this number of articles." | 1904 If ALL is a number, fetch this number of articles." |
1672 (interactive "P") | 1905 (interactive "P") |
1906 (when (and (eobp) (not (gnus-group-group-name))) | |
1907 (forward-line -1)) | |
1673 (gnus-group-read-group all t)) | 1908 (gnus-group-read-group all t)) |
1674 | 1909 |
1675 (defun gnus-group-quick-select-group (&optional all) | 1910 (defun gnus-group-quick-select-group (&optional all) |
1676 "Select the current group \"quickly\". | 1911 "Select the current group \"quickly\". |
1677 This means that no highlighting or scoring will be performed. | 1912 This means that no highlighting or scoring will be performed. |
1710 (method (gnus-find-method-for-group group))) | 1945 (method (gnus-find-method-for-group group))) |
1711 (gnus-group-read-ephemeral-group | 1946 (gnus-group-read-ephemeral-group |
1712 (gnus-group-prefixed-name group method) method))) | 1947 (gnus-group-prefixed-name group method) method))) |
1713 | 1948 |
1714 ;;;###autoload | 1949 ;;;###autoload |
1715 (defun gnus-fetch-group (group) | 1950 (defun gnus-fetch-group (group &optional articles) |
1716 "Start Gnus if necessary and enter GROUP. | 1951 "Start Gnus if necessary and enter GROUP. |
1717 Returns whether the fetching was successful or not." | 1952 Returns whether the fetching was successful or not." |
1718 (interactive (list (completing-read "Group name: " gnus-active-hashtb))) | 1953 (interactive (list (completing-read "Group name: " gnus-active-hashtb))) |
1719 (unless (get-buffer gnus-group-buffer) | 1954 (unless (get-buffer gnus-group-buffer) |
1720 (gnus-no-server)) | 1955 (gnus-no-server)) |
1721 (gnus-group-read-group nil nil group)) | 1956 (gnus-group-read-group articles nil group)) |
1722 | 1957 |
1723 ;;;###autoload | 1958 ;;;###autoload |
1724 (defun gnus-fetch-group-other-frame (group) | 1959 (defun gnus-fetch-group-other-frame (group) |
1725 "Pop up a frame and enter GROUP." | 1960 "Pop up a frame and enter GROUP." |
1726 (interactive "P") | 1961 (interactive "P") |
1733 (other-frame 1)))) | 1968 (other-frame 1)))) |
1734 (gnus-fetch-group group)) | 1969 (gnus-fetch-group group)) |
1735 | 1970 |
1736 (defvar gnus-ephemeral-group-server 0) | 1971 (defvar gnus-ephemeral-group-server 0) |
1737 | 1972 |
1973 (defcustom gnus-large-ephemeral-newsgroup 200 | |
1974 "The number of articles which indicates a large ephemeral newsgroup. | |
1975 Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups. | |
1976 | |
1977 If the number of articles in a newsgroup is greater than this value, | |
1978 confirmation is required for selecting the newsgroup. If it is nil, no | |
1979 confirmation is required." | |
1980 :version "22.1" | |
1981 :group 'gnus-group-select | |
1982 :type '(choice (const :tag "No limit" nil) | |
1983 integer)) | |
1984 | |
1985 (defcustom gnus-fetch-old-ephemeral-headers nil | |
1986 "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups." | |
1987 :version "22.1" | |
1988 :group 'gnus-thread | |
1989 :type '(choice (const :tag "off" nil) | |
1990 (const some) | |
1991 number | |
1992 (sexp :menu-tag "other" t))) | |
1993 | |
1738 ;; Enter a group that is not in the group buffer. Non-nil is returned | 1994 ;; Enter a group that is not in the group buffer. Non-nil is returned |
1739 ;; if selection was successful. | 1995 ;; if selection was successful. |
1740 (defun gnus-group-read-ephemeral-group (group method &optional activate | 1996 (defun gnus-group-read-ephemeral-group (group method &optional activate |
1741 quit-config request-only | 1997 quit-config request-only |
1742 select-articles) | 1998 select-articles |
1999 parameters | |
2000 number) | |
1743 "Read GROUP from METHOD as an ephemeral group. | 2001 "Read GROUP from METHOD as an ephemeral group. |
1744 If ACTIVATE, request the group first. | 2002 If ACTIVATE, request the group first. |
1745 If QUIT-CONFIG, use that window configuration when exiting from the | 2003 If QUIT-CONFIG, use that window configuration when exiting from the |
1746 ephemeral group. | 2004 ephemeral group. |
1747 If REQUEST-ONLY, don't actually read the group; just request it. | 2005 If REQUEST-ONLY, don't actually read the group; just request it. |
1748 If SELECT-ARTICLES, only select those articles. | 2006 If SELECT-ARTICLES, only select those articles. |
2007 If PARAMETERS, use those as the group parameters. | |
2008 If NUMBER, fetch this number of articles. | |
1749 | 2009 |
1750 Return the name of the group if selection was successful." | 2010 Return the name of the group if selection was successful." |
2011 (interactive | |
2012 (list | |
2013 ;; (gnus-read-group "Group name: ") | |
2014 (completing-read | |
2015 "Group: " gnus-active-hashtb | |
2016 nil nil nil | |
2017 'gnus-group-history) | |
2018 (gnus-read-method "From method: "))) | |
1751 ;; Transform the select method into a unique server. | 2019 ;; Transform the select method into a unique server. |
1752 (when (stringp method) | 2020 (when (stringp method) |
1753 (setq method (gnus-server-to-method method))) | 2021 (setq method (gnus-server-to-method method))) |
1754 (setq method | 2022 (setq method |
1755 `(,(car method) ,(concat (cadr method) "-ephemeral") | 2023 `(,(car method) ,(concat (cadr method) "-ephemeral") |
1756 (,(intern (format "%s-address" (car method))) ,(cadr method)) | 2024 (,(intern (format "%s-address" (car method))) ,(cadr method)) |
1757 ,@(cddr method))) | 2025 ,@(cddr method))) |
1758 (let ((group (if (gnus-group-foreign-p group) group | 2026 (let ((group (if (gnus-group-foreign-p group) group |
1759 (gnus-group-prefixed-name group method)))) | 2027 (gnus-group-prefixed-name (gnus-group-real-name group) |
2028 method)))) | |
1760 (gnus-sethash | 2029 (gnus-sethash |
1761 group | 2030 group |
1762 `(-1 nil (,group | 2031 `(-1 nil (,group |
1763 ,gnus-level-default-subscribed nil nil ,method | 2032 ,gnus-level-default-subscribed nil nil ,method |
1764 ((quit-config . | 2033 ,(cons |
1765 ,(if quit-config quit-config | 2034 (if quit-config |
1766 (cons gnus-summary-buffer | 2035 (cons 'quit-config quit-config) |
1767 gnus-current-window-configuration)))))) | 2036 (cons 'quit-config |
2037 (cons gnus-summary-buffer | |
2038 gnus-current-window-configuration))) | |
2039 parameters))) | |
1768 gnus-newsrc-hashtb) | 2040 gnus-newsrc-hashtb) |
1769 (push method gnus-ephemeral-servers) | 2041 (push method gnus-ephemeral-servers) |
1770 (set-buffer gnus-group-buffer) | 2042 (set-buffer gnus-group-buffer) |
1771 (unless (gnus-check-server method) | 2043 (unless (gnus-check-server method) |
1772 (error "Unable to contact server: %s" (gnus-status-message method))) | 2044 (error "Unable to contact server: %s" (gnus-status-message method))) |
1776 (error "Couldn't request group: %s" | 2048 (error "Couldn't request group: %s" |
1777 (nnheader-get-report (car method))))) | 2049 (nnheader-get-report (car method))))) |
1778 (if request-only | 2050 (if request-only |
1779 group | 2051 group |
1780 (condition-case () | 2052 (condition-case () |
1781 (when (gnus-group-read-group t t group select-articles) | 2053 (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup) |
2054 (gnus-fetch-old-headers | |
2055 gnus-fetch-old-ephemeral-headers)) | |
2056 (gnus-group-read-group (or number t) t group select-articles)) | |
1782 group) | 2057 group) |
1783 ;;(error nil) | 2058 ;;(error nil) |
1784 (quit | 2059 (quit |
1785 (message "Quit reading the ephemeral group") | 2060 (message "Quit reading the ephemeral group") |
1786 nil))))) | 2061 nil))))) |
1787 | 2062 |
1788 (defun gnus-group-jump-to-group (group) | 2063 (defun gnus-group-jump-to-group (group) |
1789 "Jump to newsgroup GROUP." | 2064 "Jump to newsgroup GROUP." |
1790 (interactive | 2065 (interactive |
1791 (list (completing-read | 2066 (list (mm-string-make-unibyte |
1792 "Group: " gnus-active-hashtb nil | 2067 (completing-read |
1793 (gnus-read-active-file-p) | 2068 "Group: " gnus-active-hashtb nil |
1794 nil | 2069 (gnus-read-active-file-p) |
1795 'gnus-group-history))) | 2070 gnus-group-jump-to-group-prompt |
2071 'gnus-group-history)))) | |
1796 | 2072 |
1797 (when (equal group "") | 2073 (when (equal group "") |
1798 (error "Empty group name")) | 2074 (error "Empty group name")) |
1799 | 2075 |
1800 (unless (gnus-ephemeral-group-p group) | 2076 (unless (gnus-ephemeral-group-p group) |
1935 (setq best (get-text-property (point) 'gnus-level)) | 2211 (setq best (get-text-property (point) 'gnus-level)) |
1936 (setq best-point (point)))) | 2212 (setq best-point (point)))) |
1937 (forward-line 1)) | 2213 (forward-line 1)) |
1938 (when best-point | 2214 (when best-point |
1939 (goto-char best-point)) | 2215 (goto-char best-point)) |
1940 (gnus-summary-position-point) | 2216 (gnus-group-position-point) |
1941 (and best-point (gnus-group-group-name)))) | 2217 (and best-point (gnus-group-group-name)))) |
1942 | 2218 |
1943 (defun gnus-group-first-unread-group () | 2219 (defun gnus-group-first-unread-group () |
1944 "Go to the first group with unread articles." | 2220 "Go to the first group with unread articles." |
1945 (interactive) | 2221 (interactive) |
1978 (if address (list (intern method) address) | 2254 (if address (list (intern method) address) |
1979 method)))) | 2255 method)))) |
1980 (nname (if method (gnus-group-prefixed-name name meth) name)) | 2256 (nname (if method (gnus-group-prefixed-name name meth) name)) |
1981 backend info) | 2257 backend info) |
1982 (when (gnus-gethash nname gnus-newsrc-hashtb) | 2258 (when (gnus-gethash nname gnus-newsrc-hashtb) |
1983 (error "Group %s already exists" nname)) | 2259 (error "Group %s already exists" (gnus-group-decoded-name nname))) |
1984 ;; Subscribe to the new group. | 2260 ;; Subscribe to the new group. |
1985 (gnus-group-change-level | 2261 (gnus-group-change-level |
1986 (setq info (list t nname gnus-level-default-subscribed nil nil meth)) | 2262 (setq info (list t nname gnus-level-default-subscribed nil nil meth)) |
1987 gnus-level-default-subscribed gnus-level-killed | 2263 gnus-level-default-subscribed gnus-level-killed |
1988 (and (gnus-group-group-name) | 2264 (and (gnus-group-group-name) |
1998 ;; Insert the line. | 2274 ;; Insert the line. |
1999 (gnus-group-insert-group-line-info nname) | 2275 (gnus-group-insert-group-line-info nname) |
2000 (forward-line -1) | 2276 (forward-line -1) |
2001 (gnus-group-position-point) | 2277 (gnus-group-position-point) |
2002 | 2278 |
2003 ;; Load the backend and try to make the backend create | 2279 ;; Load the back end and try to make the back end create |
2004 ;; the group as well. | 2280 ;; the group as well. |
2005 (when (assoc (symbol-name (setq backend (car (gnus-server-get-method | 2281 (when (assoc (symbol-name (setq backend (car (gnus-server-get-method |
2006 nil meth)))) | 2282 nil meth)))) |
2007 gnus-valid-select-methods) | 2283 gnus-valid-select-methods) |
2008 (require backend)) | 2284 (require backend)) |
2009 (gnus-check-server meth) | 2285 (gnus-check-server meth) |
2010 (when (gnus-check-backend-function 'request-create-group nname) | 2286 (when (gnus-check-backend-function 'request-create-group nname) |
2011 (gnus-request-create-group nname nil args)) | 2287 (unless (gnus-request-create-group nname nil args) |
2288 (error "Could not create group on server: %s" | |
2289 (nnheader-get-report backend)))) | |
2012 t)) | 2290 t)) |
2013 | 2291 |
2014 (defun gnus-group-delete-groups (&optional arg) | 2292 (defun gnus-group-delete-groups (&optional arg) |
2015 "Delete the current group. Only meaningful with editable groups." | 2293 "Delete the current group. Only meaningful with editable groups." |
2016 (interactive "P") | 2294 (interactive "P") |
2026 (defun gnus-group-delete-group (group &optional force no-prompt) | 2304 (defun gnus-group-delete-group (group &optional force no-prompt) |
2027 "Delete the current group. Only meaningful with editable groups. | 2305 "Delete the current group. Only meaningful with editable groups. |
2028 If FORCE (the prefix) is non-nil, all the articles in the group will | 2306 If FORCE (the prefix) is non-nil, all the articles in the group will |
2029 be deleted. This is \"deleted\" as in \"removed forever from the face | 2307 be deleted. This is \"deleted\" as in \"removed forever from the face |
2030 of the Earth\". There is no undo. The user will be prompted before | 2308 of the Earth\". There is no undo. The user will be prompted before |
2031 doing the deletion." | 2309 doing the deletion. |
2310 Note that you also have to specify FORCE if you want the group to | |
2311 be removed from the server, even when it's empty." | |
2032 (interactive | 2312 (interactive |
2033 (list (gnus-group-group-name) | 2313 (list (gnus-group-group-name) |
2034 current-prefix-arg)) | 2314 current-prefix-arg)) |
2035 (unless group | 2315 (unless group |
2036 (error "No group to rename")) | 2316 (error "No group to delete")) |
2037 (unless (gnus-check-backend-function 'request-delete-group group) | 2317 (unless (gnus-check-backend-function 'request-delete-group group) |
2038 (error "This backend does not support group deletion")) | 2318 (error "This back end does not support group deletion")) |
2039 (prog1 | 2319 (prog1 |
2040 (if (and (not no-prompt) | 2320 (let ((group-decoded (gnus-group-decoded-name group))) |
2041 (not (gnus-yes-or-no-p | 2321 (if (and (not no-prompt) |
2042 (format | 2322 (not (gnus-yes-or-no-p |
2043 "Do you really want to delete %s%s? " | 2323 (format |
2044 group (if force " and all its contents" ""))))) | 2324 "Do you really want to delete %s%s? " |
2045 () ; Whew! | 2325 group-decoded (if force " and all its contents" ""))))) |
2046 (gnus-message 6 "Deleting group %s..." group) | 2326 () ; Whew! |
2047 (if (not (gnus-request-delete-group group force)) | 2327 (gnus-message 6 "Deleting group %s..." group-decoded) |
2048 (gnus-error 3 "Couldn't delete group %s" group) | 2328 (if (not (gnus-request-delete-group group force)) |
2049 (gnus-message 6 "Deleting group %s...done" group) | 2329 (gnus-error 3 "Couldn't delete group %s" group-decoded) |
2050 (gnus-group-goto-group group) | 2330 (gnus-message 6 "Deleting group %s...done" group-decoded) |
2051 (gnus-group-kill-group 1 t) | 2331 (gnus-group-goto-group group) |
2052 (gnus-sethash group nil gnus-active-hashtb) | 2332 (gnus-group-kill-group 1 t) |
2053 t)) | 2333 (gnus-sethash group nil gnus-active-hashtb) |
2334 t))) | |
2054 (gnus-group-position-point))) | 2335 (gnus-group-position-point))) |
2055 | 2336 |
2056 (defun gnus-group-rename-group (group new-name) | 2337 (defun gnus-group-rename-group (group new-name) |
2057 "Rename group from GROUP to NEW-NAME. | 2338 "Rename group from GROUP to NEW-NAME. |
2058 When used interactively, GROUP is the group under point | 2339 When used interactively, GROUP is the group under point |
2061 (list | 2342 (list |
2062 (gnus-group-group-name) | 2343 (gnus-group-group-name) |
2063 (progn | 2344 (progn |
2064 (unless (gnus-check-backend-function | 2345 (unless (gnus-check-backend-function |
2065 'request-rename-group (gnus-group-group-name)) | 2346 'request-rename-group (gnus-group-group-name)) |
2066 (error "This backend does not support renaming groups")) | 2347 (error "This back end does not support renaming groups")) |
2067 (gnus-read-group "Rename group to: " | 2348 (gnus-read-group "Rename group to: " |
2068 (gnus-group-real-name (gnus-group-group-name)))))) | 2349 (gnus-group-real-name (gnus-group-group-name)))))) |
2069 | 2350 |
2070 (unless (gnus-check-backend-function 'request-rename-group group) | 2351 (unless (gnus-check-backend-function 'request-rename-group group) |
2071 (error "This backend does not support renaming groups")) | 2352 (error "This back end does not support renaming groups")) |
2072 (unless group | 2353 (unless group |
2073 (error "No group to rename")) | 2354 (error "No group to rename")) |
2074 (when (equal (gnus-group-real-name group) new-name) | 2355 (when (equal (gnus-group-real-name group) new-name) |
2075 (error "Can't rename to the same name")) | 2356 (error "Can't rename to the same name")) |
2076 | 2357 |
2081 new-name | 2362 new-name |
2082 ;; Foreign group. | 2363 ;; Foreign group. |
2083 (gnus-group-prefixed-name | 2364 (gnus-group-prefixed-name |
2084 (gnus-group-real-name new-name) | 2365 (gnus-group-real-name new-name) |
2085 (gnus-info-method (gnus-get-info group))))) | 2366 (gnus-info-method (gnus-get-info group))))) |
2367 | |
2368 (when (gnus-active new-name) | |
2369 (error "The group %s already exists" new-name)) | |
2086 | 2370 |
2087 (gnus-message 6 "Renaming group %s to %s..." group new-name) | 2371 (gnus-message 6 "Renaming group %s to %s..." group new-name) |
2088 (prog1 | 2372 (prog1 |
2089 (if (progn | 2373 (if (progn |
2090 (gnus-group-goto-group group) | 2374 (gnus-group-goto-group group) |
2130 ((eq part 'method) "select method") | 2414 ((eq part 'method) "select method") |
2131 ((eq part 'params) "group parameters") | 2415 ((eq part 'params) "group parameters") |
2132 (t "group info")) | 2416 (t "group info")) |
2133 (gnus-group-decoded-name group)) | 2417 (gnus-group-decoded-name group)) |
2134 `(lambda (form) | 2418 `(lambda (form) |
2135 (gnus-group-edit-group-done ',part ,group form))))) | 2419 (gnus-group-edit-group-done ',part ,group form))) |
2420 (local-set-key | |
2421 "\C-c\C-i" | |
2422 (gnus-create-info-command | |
2423 (cond | |
2424 ((eq part 'method) | |
2425 "(gnus)Select Methods") | |
2426 ((eq part 'params) | |
2427 "(gnus)Group Parameters") | |
2428 (t | |
2429 "(gnus)Group Info")))))) | |
2136 | 2430 |
2137 (defun gnus-group-edit-group-method (group) | 2431 (defun gnus-group-edit-group-method (group) |
2138 "Edit the select method of GROUP." | 2432 "Edit the select method of GROUP." |
2139 (interactive (list (gnus-group-group-name))) | 2433 (interactive (list (gnus-group-group-name))) |
2140 (gnus-group-edit-group group 'method)) | 2434 (gnus-group-edit-group group 'method)) |
2191 (let (entry) | 2485 (let (entry) |
2192 (while (setq entry (memq (assq 'eval method) method)) | 2486 (while (setq entry (memq (assq 'eval method) method)) |
2193 (setcar entry (eval (cadar entry))))) | 2487 (setcar entry (eval (cadar entry))))) |
2194 (gnus-group-make-group group method)) | 2488 (gnus-group-make-group group method)) |
2195 | 2489 |
2196 (defun gnus-group-make-help-group () | 2490 (defun gnus-group-make-help-group (&optional noerror) |
2197 "Create the Gnus documentation group." | 2491 "Create the Gnus documentation group. |
2492 Optional argument NOERROR modifies the behavior of this function when the | |
2493 group already exists: | |
2494 - if not given, and error is signaled, | |
2495 - if t, stay silent, | |
2496 - if anything else, just print a message." | |
2198 (interactive) | 2497 (interactive) |
2199 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) | 2498 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) |
2200 (file (nnheader-find-etc-directory "gnus-tut.txt" t))) | 2499 (file (nnheader-find-etc-directory "gnus-tut.txt" t))) |
2201 (when (gnus-gethash name gnus-newsrc-hashtb) | 2500 (if (gnus-gethash name gnus-newsrc-hashtb) |
2202 (error "Documentation group already exists")) | 2501 (cond ((eq noerror nil) |
2203 (if (not file) | 2502 (error "Documentation group already exists")) |
2204 (gnus-message 1 "Couldn't find doc group") | 2503 ((eq noerror t) |
2205 (gnus-group-make-group | 2504 ;; stay silent |
2206 (gnus-group-real-name name) | 2505 ) |
2207 (list 'nndoc "gnus-help" | 2506 (t |
2208 (list 'nndoc-address file) | 2507 (gnus-message 1 "Documentation group already exists"))) |
2209 (list 'nndoc-article-type 'mbox))))) | 2508 ;; else: |
2509 (if (not file) | |
2510 (gnus-message 1 "Couldn't find doc group") | |
2511 (gnus-group-make-group | |
2512 (gnus-group-real-name name) | |
2513 (list 'nndoc "gnus-help" | |
2514 (list 'nndoc-address file) | |
2515 (list 'nndoc-article-type 'mbox)))) | |
2516 )) | |
2210 (gnus-group-position-point)) | 2517 (gnus-group-position-point)) |
2211 | 2518 |
2212 (defun gnus-group-make-doc-group (file type) | 2519 (defun gnus-group-make-doc-group (file type) |
2213 "Create a group that uses a single file as the source." | 2520 "Create a group that uses a single file as the source. |
2521 | |
2522 If called with a prefix argument, ask for the file type." | |
2214 (interactive | 2523 (interactive |
2215 (list (read-file-name "File name: ") | 2524 (list (read-file-name "File name: ") |
2216 (and current-prefix-arg 'ask))) | 2525 (and current-prefix-arg 'ask))) |
2217 (when (eq type 'ask) | 2526 (when (eq type 'ask) |
2218 (let ((err "") | 2527 (let ((err "") |
2219 char found) | 2528 char found) |
2220 (while (not found) | 2529 (while (not found) |
2221 (message | 2530 (message |
2222 "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: " | 2531 "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: " |
2223 err) | 2532 err) |
2224 (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) | 2533 (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) |
2225 ((= char ?b) 'babyl) | 2534 ((= char ?b) 'babyl) |
2226 ((= char ?d) 'digest) | 2535 ((= char ?d) 'digest) |
2227 ((= char ?f) 'forward) | 2536 ((= char ?f) 'forward) |
2269 (method | 2578 (method |
2270 `(nnweb ,group (nnweb-search ,search) | 2579 `(nnweb ,group (nnweb-search ,search) |
2271 (nnweb-type ,(intern type)) | 2580 (nnweb-type ,(intern type)) |
2272 (nnweb-ephemeral-p t)))) | 2581 (nnweb-ephemeral-p t)))) |
2273 (if solid | 2582 (if solid |
2274 (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search)) | 2583 (progn |
2584 (gnus-pull 'nnweb-ephemeral-p method) | |
2585 (gnus-group-make-group group method)) | |
2275 (gnus-group-read-ephemeral-group | 2586 (gnus-group-read-ephemeral-group |
2276 group method t | 2587 group method t |
2277 (cons (current-buffer) | 2588 (cons (current-buffer) |
2278 (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) | 2589 (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) |
2590 | |
2591 (eval-when-compile | |
2592 (defvar nnrss-group-alist) | |
2593 (defun nnrss-discover-feed (arg)) | |
2594 (defun nnrss-save-server-data (arg))) | |
2595 (defun gnus-group-make-rss-group (&optional url) | |
2596 "Given a URL, discover if there is an RSS feed. | |
2597 If there is, use Gnus to create an nnrss group" | |
2598 (interactive) | |
2599 (require 'nnrss) | |
2600 (if (not url) | |
2601 (setq url (read-from-minibuffer "URL to Search for RSS: "))) | |
2602 (let ((feedinfo (nnrss-discover-feed url))) | |
2603 (if feedinfo | |
2604 (let ((title (gnus-newsgroup-savable-name | |
2605 (read-from-minibuffer "Title: " | |
2606 (gnus-newsgroup-savable-name | |
2607 (or (cdr (assoc 'title | |
2608 feedinfo)) | |
2609 ""))))) | |
2610 (desc (read-from-minibuffer "Description: " | |
2611 (cdr (assoc 'description | |
2612 feedinfo)))) | |
2613 (href (cdr (assoc 'href feedinfo))) | |
2614 (encodable (mm-coding-system-p 'utf-8))) | |
2615 (when encodable | |
2616 ;; Unify non-ASCII text. | |
2617 (setq title (mm-decode-coding-string | |
2618 (mm-encode-coding-string title 'utf-8) 'utf-8))) | |
2619 (gnus-group-make-group (if encodable | |
2620 (mm-encode-coding-string title 'utf-8) | |
2621 title) | |
2622 '(nnrss "")) | |
2623 (push (list title href desc) nnrss-group-alist) | |
2624 (nnrss-save-server-data nil)) | |
2625 (error "No feeds found for %s" url)))) | |
2279 | 2626 |
2280 (defvar nnwarchive-type-definition) | 2627 (defvar nnwarchive-type-definition) |
2281 (defvar gnus-group-warchive-type-history nil) | 2628 (defvar gnus-group-warchive-type-history nil) |
2282 (defvar gnus-group-warchive-login-history nil) | 2629 (defvar gnus-group-warchive-login-history nil) |
2283 (defvar gnus-group-warchive-address-history nil) | 2630 (defvar gnus-group-warchive-address-history nil) |
2351 (setq ext (format "<%d>" (setq i (1+ i))))) | 2698 (setq ext (format "<%d>" (setq i (1+ i))))) |
2352 (gnus-group-make-group | 2699 (gnus-group-make-group |
2353 (gnus-group-real-name group) | 2700 (gnus-group-real-name group) |
2354 (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) | 2701 (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) |
2355 | 2702 |
2356 (eval-when-compile (defvar nnkiboze-score-file)) | 2703 (defvar nnkiboze-score-file) |
2357 (defun gnus-group-make-kiboze-group (group address scores) | 2704 (defun gnus-group-make-kiboze-group (group address scores) |
2358 "Create an nnkiboze group. | 2705 "Create an nnkiboze group. |
2359 The user will be prompted for a name, a regexp to match groups, and | 2706 The user will be prompted for a name, a regexp to match groups, and |
2360 score file entries for articles to include in the group." | 2707 score file entries for articles to include in the group." |
2361 (interactive | 2708 (interactive |
2382 (score-dir (file-name-directory score-file))) | 2729 (score-dir (file-name-directory score-file))) |
2383 (unless (file-exists-p score-dir) | 2730 (unless (file-exists-p score-dir) |
2384 (make-directory score-dir)) | 2731 (make-directory score-dir)) |
2385 (with-temp-file score-file | 2732 (with-temp-file score-file |
2386 (let (emacs-lisp-mode-hook) | 2733 (let (emacs-lisp-mode-hook) |
2387 (pp scores (current-buffer)))))) | 2734 (gnus-pp scores))))) |
2388 | 2735 |
2389 (defun gnus-group-add-to-virtual (n vgroup) | 2736 (defun gnus-group-add-to-virtual (n vgroup) |
2390 "Add the current group to a virtual group." | 2737 "Add the current group to a virtual group." |
2391 (interactive | 2738 (interactive |
2392 (list current-prefix-arg | 2739 (list current-prefix-arg |
2502 determined by the `gnus-group-sort-function' variable. | 2849 determined by the `gnus-group-sort-function' variable. |
2503 If REVERSE (the prefix), reverse the sorting order." | 2850 If REVERSE (the prefix), reverse the sorting order." |
2504 (interactive (list gnus-group-sort-function current-prefix-arg)) | 2851 (interactive (list gnus-group-sort-function current-prefix-arg)) |
2505 (funcall gnus-group-sort-alist-function | 2852 (funcall gnus-group-sort-alist-function |
2506 (gnus-make-sort-function func) reverse) | 2853 (gnus-make-sort-function func) reverse) |
2854 (gnus-group-unmark-all-groups) | |
2507 (gnus-group-list-groups) | 2855 (gnus-group-list-groups) |
2508 (gnus-dribble-touch)) | 2856 (gnus-dribble-touch)) |
2509 | 2857 |
2510 (defun gnus-group-sort-flat (func reverse) | 2858 (defun gnus-group-sort-flat (func reverse) |
2511 ;; We peel off the dummy group from the alist. | 2859 ;; We peel off the dummy group from the alist. |
2524 "Sort the group buffer alphabetically by group name. | 2872 "Sort the group buffer alphabetically by group name. |
2525 If REVERSE, sort in reverse order." | 2873 If REVERSE, sort in reverse order." |
2526 (interactive "P") | 2874 (interactive "P") |
2527 (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) | 2875 (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) |
2528 | 2876 |
2877 (defun gnus-group-sort-groups-by-real-name (&optional reverse) | |
2878 "Sort the group buffer alphabetically by real (unprefixed) group name. | |
2879 If REVERSE, sort in reverse order." | |
2880 (interactive "P") | |
2881 (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse)) | |
2882 | |
2529 (defun gnus-group-sort-groups-by-unread (&optional reverse) | 2883 (defun gnus-group-sort-groups-by-unread (&optional reverse) |
2530 "Sort the group buffer by number of unread articles. | 2884 "Sort the group buffer by number of unread articles. |
2531 If REVERSE, sort in reverse order." | 2885 If REVERSE, sort in reverse order." |
2532 (interactive "P") | 2886 (interactive "P") |
2533 (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) | 2887 (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) |
2549 If REVERSE, sort in reverse order." | 2903 If REVERSE, sort in reverse order." |
2550 (interactive "P") | 2904 (interactive "P") |
2551 (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) | 2905 (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) |
2552 | 2906 |
2553 (defun gnus-group-sort-groups-by-method (&optional reverse) | 2907 (defun gnus-group-sort-groups-by-method (&optional reverse) |
2554 "Sort the group buffer alphabetically by backend name. | 2908 "Sort the group buffer alphabetically by back end name. |
2555 If REVERSE, sort in reverse order." | 2909 If REVERSE, sort in reverse order." |
2556 (interactive "P") | 2910 (interactive "P") |
2557 (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) | 2911 (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) |
2912 | |
2913 (defun gnus-group-sort-groups-by-server (&optional reverse) | |
2914 "Sort the group buffer alphabetically by server name. | |
2915 If REVERSE, sort in reverse order." | |
2916 (interactive "P") | |
2917 (gnus-group-sort-groups 'gnus-group-sort-by-server reverse)) | |
2558 | 2918 |
2559 ;;; Selected group sorting. | 2919 ;;; Selected group sorting. |
2560 | 2920 |
2561 (defun gnus-group-sort-selected-groups (n func &optional reverse) | 2921 (defun gnus-group-sort-selected-groups (n func &optional reverse) |
2562 "Sort the process/prefixed groups." | 2922 "Sort the process/prefixed groups." |
2563 (interactive (list current-prefix-arg gnus-group-sort-function)) | 2923 (interactive (list current-prefix-arg gnus-group-sort-function)) |
2564 (let ((groups (gnus-group-process-prefix n))) | 2924 (let ((groups (gnus-group-process-prefix n))) |
2565 (funcall gnus-group-sort-selected-function | 2925 (funcall gnus-group-sort-selected-function |
2566 groups (gnus-make-sort-function func) reverse) | 2926 groups (gnus-make-sort-function func) reverse) |
2567 (gnus-group-list-groups))) | 2927 (gnus-group-unmark-all-groups) |
2928 (gnus-group-list-groups) | |
2929 (gnus-dribble-touch))) | |
2568 | 2930 |
2569 (defun gnus-group-sort-selected-flat (groups func reverse) | 2931 (defun gnus-group-sort-selected-flat (groups func reverse) |
2570 (let (entries infos) | 2932 (let (entries infos) |
2571 ;; First find all the group entries for these groups. | 2933 ;; First find all the group entries for these groups. |
2572 (while groups | 2934 (while groups |
2594 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), | 2956 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), |
2595 sort in reverse order." | 2957 sort in reverse order." |
2596 (interactive (gnus-interactive "P\ny")) | 2958 (interactive (gnus-interactive "P\ny")) |
2597 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) | 2959 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) |
2598 | 2960 |
2961 (defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse) | |
2962 "Sort the group buffer alphabetically by real group name. | |
2963 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), | |
2964 sort in reverse order." | |
2965 (interactive (gnus-interactive "P\ny")) | |
2966 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse)) | |
2967 | |
2599 (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) | 2968 (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) |
2600 "Sort the group buffer by number of unread articles. | 2969 "Sort the group buffer by number of unread articles. |
2601 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), | 2970 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), |
2602 sort in reverse order." | 2971 sort in reverse order." |
2603 (interactive (gnus-interactive "P\ny")) | 2972 (interactive (gnus-interactive "P\ny")) |
2623 sort in reverse order." | 2992 sort in reverse order." |
2624 (interactive (gnus-interactive "P\ny")) | 2993 (interactive (gnus-interactive "P\ny")) |
2625 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) | 2994 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) |
2626 | 2995 |
2627 (defun gnus-group-sort-selected-groups-by-method (&optional n reverse) | 2996 (defun gnus-group-sort-selected-groups-by-method (&optional n reverse) |
2628 "Sort the group buffer alphabetically by backend name. | 2997 "Sort the group buffer alphabetically by back end name. |
2629 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), | 2998 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), |
2630 sort in reverse order." | 2999 sort in reverse order." |
2631 (interactive (gnus-interactive "P\ny")) | 3000 (interactive (gnus-interactive "P\ny")) |
2632 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse)) | 3001 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse)) |
2633 | 3002 |
2652 (defun gnus-group-sort-by-level (info1 info2) | 3021 (defun gnus-group-sort-by-level (info1 info2) |
2653 "Sort by level." | 3022 "Sort by level." |
2654 (< (gnus-info-level info1) (gnus-info-level info2))) | 3023 (< (gnus-info-level info1) (gnus-info-level info2))) |
2655 | 3024 |
2656 (defun gnus-group-sort-by-method (info1 info2) | 3025 (defun gnus-group-sort-by-method (info1 info2) |
2657 "Sort alphabetically by backend name." | 3026 "Sort alphabetically by back end name." |
2658 (string< (symbol-name (car (gnus-find-method-for-group | 3027 (string< (car (gnus-find-method-for-group |
2659 (gnus-info-group info1) info1))) | 3028 (gnus-info-group info1) info1)) |
2660 (symbol-name (car (gnus-find-method-for-group | 3029 (car (gnus-find-method-for-group |
2661 (gnus-info-group info2) info2))))) | 3030 (gnus-info-group info2) info2)))) |
3031 | |
3032 (defun gnus-group-sort-by-server (info1 info2) | |
3033 "Sort alphabetically by server name." | |
3034 (string< (gnus-method-to-full-server-name | |
3035 (gnus-find-method-for-group | |
3036 (gnus-info-group info1) info1)) | |
3037 (gnus-method-to-full-server-name | |
3038 (gnus-find-method-for-group | |
3039 (gnus-info-group info2) info2)))) | |
2662 | 3040 |
2663 (defun gnus-group-sort-by-score (info1 info2) | 3041 (defun gnus-group-sort-by-score (info1 info2) |
2664 "Sort by group score." | 3042 "Sort by group score." |
2665 (< (gnus-info-score info1) (gnus-info-score info2))) | 3043 (> (gnus-info-score info1) (gnus-info-score info2))) |
2666 | 3044 |
2667 (defun gnus-group-sort-by-rank (info1 info2) | 3045 (defun gnus-group-sort-by-rank (info1 info2) |
2668 "Sort by level and score." | 3046 "Sort by level and score." |
2669 (let ((level1 (gnus-info-level info1)) | 3047 (let ((level1 (gnus-info-level info1)) |
2670 (level2 (gnus-info-level info2))) | 3048 (level2 (gnus-info-level info2))) |
2673 (> (gnus-info-score info1) (gnus-info-score info2)))))) | 3051 (> (gnus-info-score info1) (gnus-info-score info2)))))) |
2674 | 3052 |
2675 ;;; Clearing data | 3053 ;;; Clearing data |
2676 | 3054 |
2677 (defun gnus-group-clear-data (&optional arg) | 3055 (defun gnus-group-clear-data (&optional arg) |
2678 "Clear all marks and read ranges from the current group." | 3056 "Clear all marks and read ranges from the current group. |
3057 Obeys the process/prefix convention." | |
2679 (interactive "P") | 3058 (interactive "P") |
2680 (gnus-group-iterate arg | 3059 (gnus-group-iterate arg |
2681 (lambda (group) | 3060 (lambda (group) |
2682 (let (info) | 3061 (let (info) |
2683 (gnus-info-clear-data (setq info (gnus-get-info group))) | 3062 (gnus-info-clear-data (setq info (gnus-get-info group))) |
2700 "Move the cache away to avoid problems in the future? ") | 3079 "Move the cache away to avoid problems in the future? ") |
2701 (call-interactively 'gnus-cache-move-cache))))) | 3080 (call-interactively 'gnus-cache-move-cache))))) |
2702 | 3081 |
2703 (defun gnus-info-clear-data (info) | 3082 (defun gnus-info-clear-data (info) |
2704 "Clear all marks and read ranges from INFO." | 3083 "Clear all marks and read ranges from INFO." |
2705 (let ((group (gnus-info-group info))) | 3084 (let ((group (gnus-info-group info)) |
3085 action) | |
3086 (dolist (el (gnus-info-marks info)) | |
3087 (push `(,(cdr el) add (,(car el))) action)) | |
3088 (push `(,(gnus-info-read info) add (read)) action) | |
2706 (gnus-undo-register | 3089 (gnus-undo-register |
2707 `(progn | 3090 `(progn |
3091 (gnus-request-set-mark ,group ',action) | |
2708 (gnus-info-set-marks ',info ',(gnus-info-marks info) t) | 3092 (gnus-info-set-marks ',info ',(gnus-info-marks info) t) |
2709 (gnus-info-set-read ',info ',(gnus-info-read info)) | 3093 (gnus-info-set-read ',info ',(gnus-info-read info)) |
2710 (when (gnus-group-goto-group ,group) | 3094 (when (gnus-group-goto-group ,group) |
3095 (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t) | |
2711 (gnus-group-update-group-line)))) | 3096 (gnus-group-update-group-line)))) |
3097 (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el))) | |
3098 action)) | |
3099 (gnus-request-set-mark group action) | |
2712 (gnus-info-set-read info nil) | 3100 (gnus-info-set-read info nil) |
2713 (when (gnus-info-marks info) | 3101 (when (gnus-info-marks info) |
2714 (gnus-info-set-marks info nil)))) | 3102 (gnus-info-set-marks info nil)))) |
2715 | 3103 |
2716 ;; Group catching up. | 3104 ;; Group catching up. |
2734 (format | 3122 (format |
2735 (if all | 3123 (if all |
2736 "Do you really want to mark all articles in %s as read? " | 3124 "Do you really want to mark all articles in %s as read? " |
2737 "Mark all unread articles in %s as read? ") | 3125 "Mark all unread articles in %s as read? ") |
2738 (if (= (length groups) 1) | 3126 (if (= (length groups) 1) |
2739 (car groups) | 3127 (gnus-group-decoded-name (car groups)) |
2740 (format "these %d groups" (length groups))))))) | 3128 (format "these %d groups" (length groups))))))) |
2741 n | 3129 n |
2742 (while (setq group (pop groups)) | 3130 (while (setq group (pop groups)) |
2743 (gnus-group-remove-mark group) | 3131 (gnus-group-remove-mark group) |
2744 ;; Virtual groups have to be given special treatment. | 3132 ;; Virtual groups have to be given special treatment. |
2766 "Mark all articles in GROUP as read. | 3154 "Mark all articles in GROUP as read. |
2767 If ALL is non-nil, all articles are marked as read. | 3155 If ALL is non-nil, all articles are marked as read. |
2768 The return value is the number of articles that were marked as read, | 3156 The return value is the number of articles that were marked as read, |
2769 or nil if no action could be taken." | 3157 or nil if no action could be taken." |
2770 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) | 3158 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) |
2771 (num (car entry))) | 3159 (num (car entry)) |
3160 (marks (nth 3 (nth 2 entry))) | |
3161 (unread (gnus-sequence-of-unread-articles group))) | |
2772 ;; Remove entries for this group. | 3162 ;; Remove entries for this group. |
2773 (nnmail-purge-split-history (gnus-group-real-name group)) | 3163 (nnmail-purge-split-history (gnus-group-real-name group)) |
2774 ;; Do the updating only if the newsgroup isn't killed. | 3164 ;; Do the updating only if the newsgroup isn't killed. |
2775 (if (not (numberp (car entry))) | 3165 (if (not (numberp (car entry))) |
2776 (gnus-message 1 "Can't catch up %s; non-active group" group) | 3166 (gnus-message 1 "Can't catch up %s; non-active group" group) |
3167 (gnus-update-read-articles group nil) | |
3168 (when all | |
3169 ;; Nix out the lists of marks and dormants. | |
3170 (gnus-request-set-mark group (list (list (cdr (assq 'tick marks)) | |
3171 'del '(tick)) | |
3172 (list (cdr (assq 'dormant marks)) | |
3173 'del '(dormant)))) | |
3174 (setq unread (gnus-range-add (gnus-range-add | |
3175 unread (cdr (assq 'dormant marks))) | |
3176 (cdr (assq 'tick marks)))) | |
3177 (gnus-add-marked-articles group 'tick nil nil 'force) | |
3178 (gnus-add-marked-articles group 'dormant nil nil 'force)) | |
2777 ;; Do auto-expirable marks if that's required. | 3179 ;; Do auto-expirable marks if that's required. |
2778 (when (gnus-group-auto-expirable-p group) | 3180 (when (gnus-group-auto-expirable-p group) |
2779 (gnus-add-marked-articles | 3181 (gnus-range-map (lambda (article) |
2780 group 'expire (gnus-list-of-unread-articles group)) | 3182 (gnus-add-marked-articles group 'expire (list article)) |
2781 (when all | 3183 (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) |
2782 (let ((marks (nth 3 (nth 2 entry)))) | 3184 unread)) |
2783 (gnus-add-marked-articles | 3185 (let ((gnus-newsgroup-name group)) |
2784 group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) | 3186 (gnus-run-hooks 'gnus-group-catchup-group-hook)) |
2785 (gnus-add-marked-articles | 3187 num))) |
2786 group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) | |
2787 (when entry | |
2788 (gnus-update-read-articles group nil) | |
2789 ;; Also nix out the lists of marks and dormants. | |
2790 (when all | |
2791 (gnus-add-marked-articles group 'tick nil nil 'force) | |
2792 (gnus-add-marked-articles group 'dormant nil nil 'force)) | |
2793 (let ((gnus-newsgroup-name group)) | |
2794 (gnus-run-hooks 'gnus-group-catchup-group-hook)) | |
2795 num)))) | |
2796 | 3188 |
2797 (defun gnus-group-expire-articles (&optional n) | 3189 (defun gnus-group-expire-articles (&optional n) |
2798 "Expire all expirable articles in the current newsgroup." | 3190 "Expire all expirable articles in the current newsgroup. |
3191 Uses the process/prefix convention." | |
2799 (interactive "P") | 3192 (interactive "P") |
2800 (let ((groups (gnus-group-process-prefix n)) | 3193 (let ((groups (gnus-group-process-prefix n)) |
2801 group) | 3194 group) |
2802 (unless groups | 3195 (unless groups |
2803 (error "No groups to expire")) | 3196 (error "No groups to expire")) |
2807 (gnus-dribble-touch) | 3200 (gnus-dribble-touch) |
2808 (gnus-group-position-point)))) | 3201 (gnus-group-position-point)))) |
2809 | 3202 |
2810 (defun gnus-group-expire-articles-1 (group) | 3203 (defun gnus-group-expire-articles-1 (group) |
2811 (when (gnus-check-backend-function 'request-expire-articles group) | 3204 (when (gnus-check-backend-function 'request-expire-articles group) |
2812 (gnus-message 6 "Expiring articles in %s..." group) | 3205 (gnus-message 6 "Expiring articles in %s..." |
3206 (gnus-group-decoded-name group)) | |
2813 (let* ((info (gnus-get-info group)) | 3207 (let* ((info (gnus-get-info group)) |
2814 (expirable (if (gnus-group-total-expirable-p group) | 3208 (expirable (if (gnus-group-total-expirable-p group) |
2815 (cons nil (gnus-list-of-read-articles group)) | 3209 (cons nil (gnus-list-of-read-articles group)) |
2816 (assq 'expire (gnus-info-marks info)))) | 3210 (assq 'expire (gnus-info-marks info)))) |
2817 (expiry-wait (gnus-group-find-parameter group 'expiry-wait)) | 3211 (expiry-wait (gnus-group-find-parameter group 'expiry-wait)) |
2832 (gnus-uncompress-sequence (cdr expirable)) group)) | 3226 (gnus-uncompress-sequence (cdr expirable)) group)) |
2833 ;; Just expire using the normal expiry values. | 3227 ;; Just expire using the normal expiry values. |
2834 (gnus-request-expire-articles | 3228 (gnus-request-expire-articles |
2835 (gnus-uncompress-sequence (cdr expirable)) group)))) | 3229 (gnus-uncompress-sequence (cdr expirable)) group)))) |
2836 (gnus-close-group group)) | 3230 (gnus-close-group group)) |
2837 (gnus-message 6 "Expiring articles in %s...done" group) | 3231 (gnus-message 6 "Expiring articles in %s...done" |
3232 (gnus-group-decoded-name group)) | |
2838 ;; Return the list of un-expired articles. | 3233 ;; Return the list of un-expired articles. |
2839 (cdr expirable)))) | 3234 (cdr expirable)))) |
2840 | 3235 |
2841 (defun gnus-group-expire-all-groups () | 3236 (defun gnus-group-expire-all-groups () |
2842 "Expire all expirable articles in all newsgroups." | 3237 "Expire all expirable articles in all newsgroups." |
2852 (defun gnus-group-set-current-level (n level) | 3247 (defun gnus-group-set-current-level (n level) |
2853 "Set the level of the next N groups to LEVEL." | 3248 "Set the level of the next N groups to LEVEL." |
2854 (interactive | 3249 (interactive |
2855 (list | 3250 (list |
2856 current-prefix-arg | 3251 current-prefix-arg |
2857 (string-to-int | 3252 (progn |
2858 (let ((s (read-string | 3253 (unless (gnus-group-process-prefix current-prefix-arg) |
2859 (format "Level (default %s): " | 3254 (error "No group on the current line")) |
2860 (or (gnus-group-group-level) | 3255 (string-to-number |
2861 gnus-level-default-subscribed))))) | 3256 (let ((s (read-string |
2862 (if (string-match "^\\s-*$" s) | 3257 (format "Level (default %s): " |
2863 (int-to-string (or (gnus-group-group-level) | 3258 (or (gnus-group-group-level) |
2864 gnus-level-default-subscribed)) | 3259 gnus-level-default-subscribed))))) |
2865 s))))) | 3260 (if (string-match "^\\s-*$" s) |
3261 (int-to-string (or (gnus-group-group-level) | |
3262 gnus-level-default-subscribed)) | |
3263 s)))))) | |
2866 (unless (and (>= level 1) (<= level gnus-level-killed)) | 3264 (unless (and (>= level 1) (<= level gnus-level-killed)) |
2867 (error "Invalid level: %d" level)) | 3265 (error "Invalid level: %d" level)) |
2868 (let ((groups (gnus-group-process-prefix n)) | 3266 (let ((groups (gnus-group-process-prefix n)) |
2869 group) | 3267 group) |
2870 (while (setq group (pop groups)) | 3268 (while (setq group (pop groups)) |
2871 (gnus-group-remove-mark group) | 3269 (gnus-group-remove-mark group) |
2872 (gnus-message 6 "Changed level of %s from %d to %d" | 3270 (gnus-message 6 "Changed level of %s from %d to %d" |
2873 group (or (gnus-group-group-level) gnus-level-killed) | 3271 (gnus-group-decoded-name group) |
3272 (or (gnus-group-group-level) gnus-level-killed) | |
2874 level) | 3273 level) |
2875 (gnus-group-change-level | 3274 (gnus-group-change-level |
2876 group level (or (gnus-group-group-level) gnus-level-killed)) | 3275 group level (or (gnus-group-group-level) gnus-level-killed)) |
2877 (gnus-group-update-group-line))) | 3276 (gnus-group-update-group-line))) |
2878 (gnus-group-position-point)) | 3277 (gnus-group-position-point)) |
2889 | 3288 |
2890 (defun gnus-group-unsubscribe-current-group (&optional n do-sub) | 3289 (defun gnus-group-unsubscribe-current-group (&optional n do-sub) |
2891 "Toggle subscription of the current group. | 3290 "Toggle subscription of the current group. |
2892 If given numerical prefix, toggle the N next groups." | 3291 If given numerical prefix, toggle the N next groups." |
2893 (interactive "P") | 3292 (interactive "P") |
2894 (let ((groups (gnus-group-process-prefix n)) | 3293 (dolist (group (gnus-group-process-prefix n)) |
2895 group) | 3294 (gnus-group-remove-mark group) |
2896 (while groups | 3295 (gnus-group-unsubscribe-group |
2897 (setq group (car groups) | 3296 group |
2898 groups (cdr groups)) | 3297 (cond |
2899 (gnus-group-remove-mark group) | 3298 ((eq do-sub 'unsubscribe) |
2900 (gnus-group-unsubscribe-group | 3299 gnus-level-default-unsubscribed) |
2901 group | 3300 ((eq do-sub 'subscribe) |
2902 (cond | 3301 gnus-level-default-subscribed) |
2903 ((eq do-sub 'unsubscribe) | 3302 ((<= (gnus-group-group-level) gnus-level-subscribed) |
2904 gnus-level-default-unsubscribed) | 3303 gnus-level-default-unsubscribed) |
2905 ((eq do-sub 'subscribe) | 3304 (t |
2906 gnus-level-default-subscribed) | 3305 gnus-level-default-subscribed)) |
2907 ((<= (gnus-group-group-level) gnus-level-subscribed) | 3306 t) |
2908 gnus-level-default-unsubscribed) | 3307 (gnus-group-update-group-line)) |
2909 (t | 3308 (gnus-group-next-group 1)) |
2910 gnus-level-default-subscribed)) | |
2911 t) | |
2912 (gnus-group-update-group-line)) | |
2913 (gnus-group-next-group 1))) | |
2914 | 3309 |
2915 (defun gnus-group-unsubscribe-group (group &optional level silent) | 3310 (defun gnus-group-unsubscribe-group (group &optional level silent) |
2916 "Toggle subscription to GROUP. | 3311 "Toggle subscription to GROUP. |
2917 Killed newsgroups are subscribed. If SILENT, don't try to update the | 3312 Killed newsgroups are subscribed. If SILENT, don't try to update the |
2918 group line." | 3313 group line." |
3021 (gnus-group-yank-group))) | 3416 (gnus-group-yank-group))) |
3022 (push (cons (car entry) (nth 2 entry)) | 3417 (push (cons (car entry) (nth 2 entry)) |
3023 gnus-list-of-killed-groups)) | 3418 gnus-list-of-killed-groups)) |
3024 (gnus-group-change-level | 3419 (gnus-group-change-level |
3025 (if entry entry group) gnus-level-killed (if entry nil level)) | 3420 (if entry entry group) gnus-level-killed (if entry nil level)) |
3026 (message "Killed group %s" group)) | 3421 (message "Killed group %s" (gnus-group-decoded-name group))) |
3027 ;; If there are lots and lots of groups to be killed, we use | 3422 ;; If there are lots and lots of groups to be killed, we use |
3028 ;; this thing instead. | 3423 ;; this thing instead. |
3029 (let (entry) | 3424 (dolist (group (nreverse groups)) |
3030 (setq groups (nreverse groups)) | 3425 (gnus-group-remove-mark group) |
3031 (while groups | 3426 (gnus-delete-line) |
3032 (gnus-group-remove-mark (setq group (pop groups))) | 3427 (push group gnus-killed-list) |
3033 (gnus-delete-line) | 3428 (setq gnus-newsrc-alist |
3034 (push group gnus-killed-list) | 3429 (delq (assoc group gnus-newsrc-alist) |
3035 (setq gnus-newsrc-alist | 3430 gnus-newsrc-alist)) |
3036 (delq (assoc group gnus-newsrc-alist) | 3431 (when gnus-group-change-level-function |
3037 gnus-newsrc-alist)) | 3432 (funcall gnus-group-change-level-function |
3038 (when gnus-group-change-level-function | 3433 group gnus-level-killed 3)) |
3039 (funcall gnus-group-change-level-function | 3434 (cond |
3040 group gnus-level-killed 3)) | 3435 ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) |
3041 (cond | 3436 (push (cons (car entry) (nth 2 entry)) |
3042 ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) | 3437 gnus-list-of-killed-groups) |
3043 (push (cons (car entry) (nth 2 entry)) | 3438 (setcdr (cdr entry) (cdddr entry))) |
3044 gnus-list-of-killed-groups) | 3439 ((member group gnus-zombie-list) |
3045 (setcdr (cdr entry) (cdddr entry))) | 3440 (setq gnus-zombie-list (delete group gnus-zombie-list)))) |
3046 ((member group gnus-zombie-list) | 3441 ;; There may be more than one instance displayed. |
3047 (setq gnus-zombie-list (delete group gnus-zombie-list)))) | 3442 (while (gnus-group-goto-group group) |
3048 ;; There may be more than one instance displayed. | 3443 (gnus-delete-line))) |
3049 (while (gnus-group-goto-group group) | 3444 (gnus-make-hashtable-from-newsrc-alist)) |
3050 (gnus-delete-line))) | |
3051 (gnus-make-hashtable-from-newsrc-alist))) | |
3052 | 3445 |
3053 (gnus-group-position-point) | 3446 (gnus-group-position-point) |
3054 (if (< (length out) 2) (car out) (nreverse out)))) | 3447 (if (< (length out) 2) (car out) (nreverse out)))) |
3055 | 3448 |
3056 (defun gnus-group-yank-group (&optional arg) | 3449 (defun gnus-group-yank-group (&optional arg) |
3111 (t | 3504 (t |
3112 (error "Can't kill; invalid level: %d" level)))) | 3505 (error "Can't kill; invalid level: %d" level)))) |
3113 | 3506 |
3114 (defun gnus-group-list-all-groups (&optional arg) | 3507 (defun gnus-group-list-all-groups (&optional arg) |
3115 "List all newsgroups with level ARG or lower. | 3508 "List all newsgroups with level ARG or lower. |
3116 Default is gnus-level-unsubscribed, which lists all subscribed and most | 3509 Default is `gnus-level-unsubscribed', which lists all subscribed and most |
3117 unsubscribed groups." | 3510 unsubscribed groups." |
3118 (interactive "P") | 3511 (interactive "P") |
3119 (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) | 3512 (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) |
3120 | 3513 |
3121 ;; Redefine this to list ALL killed groups if prefix arg used. | 3514 ;; Redefine this to list ALL killed groups if prefix arg used. |
3151 "List all groups that are available from the server(s)." | 3544 "List all groups that are available from the server(s)." |
3152 (interactive) | 3545 (interactive) |
3153 ;; First we make sure that we have really read the active file. | 3546 ;; First we make sure that we have really read the active file. |
3154 (unless (gnus-read-active-file-p) | 3547 (unless (gnus-read-active-file-p) |
3155 (let ((gnus-read-active-file t) | 3548 (let ((gnus-read-active-file t) |
3156 (gnus-agent nil)) ; Trick the agent into ignoring the active file. | 3549 (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent. |
3157 (gnus-read-active-file))) | 3550 (gnus-read-active-file))) |
3158 ;; Find all groups and sort them. | 3551 ;; Find all groups and sort them. |
3159 (let ((groups | 3552 (let ((groups |
3160 (sort | 3553 (sort |
3161 (let (list) | 3554 (let (list) |
3173 (while groups | 3566 (while groups |
3174 (setq group (pop groups)) | 3567 (setq group (pop groups)) |
3175 (gnus-add-text-properties | 3568 (gnus-add-text-properties |
3176 (point) (prog1 (1+ (point)) | 3569 (point) (prog1 (1+ (point)) |
3177 (insert " *: " | 3570 (insert " *: " |
3178 (gnus-group-name-decode group | 3571 (gnus-group-decoded-name group) |
3179 (gnus-group-name-charset | |
3180 nil group)) | |
3181 "\n")) | 3572 "\n")) |
3182 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | 3573 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) |
3183 'gnus-unread t | 3574 'gnus-unread t |
3184 'gnus-level (inline (gnus-group-level group))))) | 3575 'gnus-level (inline (gnus-group-level group))))) |
3185 (goto-char (point-min)))) | 3576 (goto-char (point-min)))) |
3200 (require 'nnmail) | 3591 (require 'nnmail) |
3201 (let ((gnus-inhibit-demon t) | 3592 (let ((gnus-inhibit-demon t) |
3202 ;; Binding this variable will inhibit multiple fetchings | 3593 ;; Binding this variable will inhibit multiple fetchings |
3203 ;; of the same mail source. | 3594 ;; of the same mail source. |
3204 (nnmail-fetched-sources (list t))) | 3595 (nnmail-fetched-sources (list t))) |
3596 (gnus-run-hooks 'gnus-get-top-new-news-hook) | |
3205 (gnus-run-hooks 'gnus-get-new-news-hook) | 3597 (gnus-run-hooks 'gnus-get-new-news-hook) |
3206 | 3598 |
3207 ;; Read any slave files. | 3599 ;; Read any slave files. |
3208 (unless gnus-slave | 3600 (unless gnus-slave |
3209 (gnus-master-read-slave-newsrc)) | 3601 (gnus-master-read-slave-newsrc)) |
3234 (max (car gnus-group-list-mode) arg))))) | 3626 (max (car gnus-group-list-mode) arg))))) |
3235 | 3627 |
3236 (defun gnus-group-get-new-news-this-group (&optional n dont-scan) | 3628 (defun gnus-group-get-new-news-this-group (&optional n dont-scan) |
3237 "Check for newly arrived news in the current group (and the N-1 next groups). | 3629 "Check for newly arrived news in the current group (and the N-1 next groups). |
3238 The difference between N and the number of newsgroup checked is returned. | 3630 The difference between N and the number of newsgroup checked is returned. |
3239 If N is negative, this group and the N-1 previous groups will be checked." | 3631 If N is negative, this group and the N-1 previous groups will be checked. |
3632 If DONT-SCAN is non-nil, scan non-activated groups as well." | |
3240 (interactive "P") | 3633 (interactive "P") |
3241 (let* ((groups (gnus-group-process-prefix n)) | 3634 (let* ((groups (gnus-group-process-prefix n)) |
3242 (ret (if (numberp n) (- n (length groups)) 0)) | 3635 (ret (if (numberp n) (- n (length groups)) 0)) |
3243 (beg (unless n | 3636 (beg (unless n |
3244 (point))) | 3637 (point))) |
3298 (if (not (file-exists-p file)) | 3691 (if (not (file-exists-p file)) |
3299 (gnus-message 1 "No such file: %s" file) | 3692 (gnus-message 1 "No such file: %s" file) |
3300 (let ((enable-local-variables nil)) | 3693 (let ((enable-local-variables nil)) |
3301 (find-file file) | 3694 (find-file file) |
3302 (setq found t)))))) | 3695 (setq found t)))))) |
3696 | |
3697 (defun gnus-group-fetch-charter (group) | |
3698 "Fetch the charter for the current group. | |
3699 If given a prefix argument, prompt for a group." | |
3700 (interactive | |
3701 (list (or (when current-prefix-arg | |
3702 (completing-read "Group: " gnus-active-hashtb)) | |
3703 (gnus-group-group-name) | |
3704 gnus-newsgroup-name))) | |
3705 (unless group | |
3706 (error "No group name given")) | |
3707 (require 'mm-url) | |
3708 (condition-case nil (require 'url-http) (error nil)) | |
3709 (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group))) | |
3710 url hierarchy) | |
3711 (when (string-match "\\(^[^\\.]+\\)\\..*" name) | |
3712 (setq hierarchy (match-string 1 name)) | |
3713 (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) | |
3714 (if (fboundp 'url-http-file-exists-p) | |
3715 (url-http-file-exists-p (eval url)) | |
3716 t)) | |
3717 (browse-url (eval url)) | |
3718 (setq url (concat "http://" hierarchy | |
3719 ".news-admin.org/charters/" name)) | |
3720 (if (and (fboundp 'url-http-file-exists-p) | |
3721 (url-http-file-exists-p url)) | |
3722 (browse-url url) | |
3723 (gnus-group-fetch-control group)))))) | |
3724 | |
3725 (defun gnus-group-fetch-control (group) | |
3726 "Fetch the archived control messages for the current group. | |
3727 If given a prefix argument, prompt for a group." | |
3728 (interactive | |
3729 (list (or (when current-prefix-arg | |
3730 (completing-read "Group: " gnus-active-hashtb)) | |
3731 (gnus-group-group-name) | |
3732 gnus-newsgroup-name))) | |
3733 (unless group | |
3734 (error "No group name given")) | |
3735 (let ((name (gnus-group-real-name group)) | |
3736 hierarchy) | |
3737 (when (string-match "\\(^[^\\.]+\\)\\..*" name) | |
3738 (setq hierarchy (match-string 1 name)) | |
3739 (if gnus-group-fetch-control-use-browse-url | |
3740 (browse-url (concat "ftp://ftp.isc.org/usenet/control/" | |
3741 hierarchy "/" name ".gz")) | |
3742 (let ((enable-local-variables nil)) | |
3743 (gnus-group-read-ephemeral-group | |
3744 group | |
3745 `(nndoc ,group (nndoc-address | |
3746 ,(find-file-noselect | |
3747 (concat "/ftp@ftp.isc.org:/usenet/control/" | |
3748 hierarchy "/" name ".gz"))) | |
3749 (nndoc-article-type mbox)) t nil nil)))))) | |
3303 | 3750 |
3304 (defun gnus-group-describe-group (force &optional group) | 3751 (defun gnus-group-describe-group (force &optional group) |
3305 "Display a description of the current newsgroup." | 3752 "Display a description of the current newsgroup." |
3306 (interactive (list current-prefix-arg (gnus-group-group-name))) | 3753 (interactive (list current-prefix-arg (gnus-group-group-name))) |
3307 (let* ((method (gnus-find-method-for-group group)) | 3754 (let* ((method (gnus-find-method-for-group group)) |
3394 (setq groups (cdr groups))) | 3841 (setq groups (cdr groups))) |
3395 (goto-char (point-min)))) | 3842 (goto-char (point-min)))) |
3396 (pop-to-buffer obuf))) | 3843 (pop-to-buffer obuf))) |
3397 | 3844 |
3398 (defun gnus-group-description-apropos (regexp) | 3845 (defun gnus-group-description-apropos (regexp) |
3399 "List all newsgroups that have names or descriptions that match a regexp." | 3846 "List all newsgroups that have names or descriptions that match REGEXP." |
3400 (interactive "sGnus description apropos (regexp): ") | 3847 (interactive "sGnus description apropos (regexp): ") |
3401 (when (not (or gnus-description-hashtb | 3848 (when (not (or gnus-description-hashtb |
3402 (gnus-read-all-descriptions-files))) | 3849 (gnus-read-all-descriptions-files))) |
3403 (error "Couldn't request descriptions file")) | 3850 (error "Couldn't request descriptions file")) |
3404 (gnus-group-apropos regexp t)) | 3851 (gnus-group-apropos regexp t)) |
3415 (interactive "P\nsList newsgroups matching: ") | 3862 (interactive "P\nsList newsgroups matching: ") |
3416 ;; First make sure active file has been read. | 3863 ;; First make sure active file has been read. |
3417 (when (and level | 3864 (when (and level |
3418 (> (prefix-numeric-value level) gnus-level-killed)) | 3865 (> (prefix-numeric-value level) gnus-level-killed)) |
3419 (gnus-get-killed-groups)) | 3866 (gnus-get-killed-groups)) |
3420 (gnus-group-prepare-flat | 3867 (funcall gnus-group-prepare-function |
3421 (or level gnus-level-subscribed) all (or lowest 1) regexp) | 3868 (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp) |
3422 (goto-char (point-min)) | 3869 (goto-char (point-min)) |
3423 (gnus-group-position-point)) | 3870 (gnus-group-position-point)) |
3424 | 3871 |
3425 (defun gnus-group-list-all-matching (level regexp &optional lowest) | 3872 (defun gnus-group-list-all-matching (level regexp &optional lowest) |
3426 "List all groups that match REGEXP. | 3873 "List all groups that match REGEXP. |
3493 (defun gnus-group-force-update () | 3940 (defun gnus-group-force-update () |
3494 "Update `.newsrc' file." | 3941 "Update `.newsrc' file." |
3495 (interactive) | 3942 (interactive) |
3496 (gnus-save-newsrc-file)) | 3943 (gnus-save-newsrc-file)) |
3497 | 3944 |
3945 (defvar gnus-backlog-articles) | |
3946 | |
3498 (defun gnus-group-suspend () | 3947 (defun gnus-group-suspend () |
3499 "Suspend the current Gnus session. | 3948 "Suspend the current Gnus session. |
3500 In fact, cleanup buffers except for group mode buffer. | 3949 In fact, cleanup buffers except for group mode buffer. |
3501 The hook gnus-suspend-gnus-hook is called before actually suspending." | 3950 The hook `gnus-suspend-gnus-hook' is called before actually suspending." |
3502 (interactive) | 3951 (interactive) |
3503 (gnus-run-hooks 'gnus-suspend-gnus-hook) | 3952 (gnus-run-hooks 'gnus-suspend-gnus-hook) |
3953 (gnus-offer-save-summaries) | |
3504 ;; Kill Gnus buffers except for group mode buffer. | 3954 ;; Kill Gnus buffers except for group mode buffer. |
3505 (let ((group-buf (get-buffer gnus-group-buffer))) | 3955 (let ((group-buf (get-buffer gnus-group-buffer))) |
3506 (mapcar (lambda (buf) | 3956 (mapcar (lambda (buf) |
3507 (unless (member buf (list group-buf gnus-dribble-buffer)) | 3957 (unless (or (member buf (list group-buf gnus-dribble-buffer)) |
3508 (kill-buffer buf))) | 3958 (progn |
3959 (save-excursion | |
3960 (set-buffer buf) | |
3961 (eq major-mode 'message-mode)))) | |
3962 (gnus-kill-buffer buf))) | |
3509 (gnus-buffers)) | 3963 (gnus-buffers)) |
3964 (setq gnus-backlog-articles nil) | |
3510 (gnus-kill-gnus-frames) | 3965 (gnus-kill-gnus-frames) |
3511 (when group-buf | 3966 (when group-buf |
3512 (bury-buffer group-buf) | 3967 (bury-buffer group-buf) |
3513 (delete-windows-on group-buf t)))) | 3968 (delete-windows-on group-buf t)))) |
3514 | 3969 |
3551 (gnus-yes-or-no-p | 4006 (gnus-yes-or-no-p |
3552 (format "Quit reading news without saving %s? " | 4007 (format "Quit reading news without saving %s? " |
3553 (file-name-nondirectory gnus-current-startup-file)))) | 4008 (file-name-nondirectory gnus-current-startup-file)))) |
3554 (gnus-run-hooks 'gnus-exit-gnus-hook) | 4009 (gnus-run-hooks 'gnus-exit-gnus-hook) |
3555 (gnus-configure-windows 'group t) | 4010 (gnus-configure-windows 'group t) |
4011 (when (and (gnus-buffer-live-p gnus-dribble-buffer) | |
4012 (not (zerop (save-excursion | |
4013 (set-buffer gnus-dribble-buffer) | |
4014 (buffer-size))))) | |
4015 (gnus-dribble-enter | |
4016 ";;; Gnus was exited on purpose without saving the .newsrc files.")) | |
3556 (gnus-dribble-save) | 4017 (gnus-dribble-save) |
3557 (gnus-close-backends) | 4018 (gnus-close-backends) |
3558 (gnus-clear-system) | 4019 (gnus-clear-system) |
3559 (gnus-kill-buffer gnus-group-buffer) | 4020 (gnus-kill-buffer gnus-group-buffer) |
3560 ;; Allow the user to do things after cleaning up. | 4021 ;; Allow the user to do things after cleaning up. |
3571 (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). | 4032 (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). |
3572 If not, METHOD should be a list where the first element is the method | 4033 If not, METHOD should be a list where the first element is the method |
3573 and the second element is the address." | 4034 and the second element is the address." |
3574 (interactive | 4035 (interactive |
3575 (list (let ((how (completing-read | 4036 (list (let ((how (completing-read |
3576 "Which backend: " | 4037 "Which back end: " |
3577 (append gnus-valid-select-methods gnus-server-alist) | 4038 (append gnus-valid-select-methods gnus-server-alist) |
3578 nil t (cons "nntp" 0) 'gnus-method-history))) | 4039 nil t (cons "nntp" 0) 'gnus-method-history))) |
3579 ;; We either got a backend name or a virtual server name. | 4040 ;; We either got a back end name or a virtual server name. |
3580 ;; If the first, we also need an address. | 4041 ;; If the first, we also need an address. |
3581 (if (assoc how gnus-valid-select-methods) | 4042 (if (assoc how gnus-valid-select-methods) |
3582 (list (intern how) | 4043 (list (intern how) |
3583 ;; Suggested by mapjph@bath.ac.uk. | 4044 ;; Suggested by mapjph@bath.ac.uk. |
3584 (completing-read | 4045 (completing-read |
3640 (if entry | 4101 (if entry |
3641 (progn | 4102 (progn |
3642 (setcar (nthcdr 2 entry) info) | 4103 (setcar (nthcdr 2 entry) info) |
3643 (when (and (not (eq (car entry) t)) | 4104 (when (and (not (eq (car entry) t)) |
3644 (gnus-active (gnus-info-group info))) | 4105 (gnus-active (gnus-info-group info))) |
3645 (setcar entry (length (gnus-list-of-unread-articles (car info)))))) | 4106 (setcar entry (length |
4107 (gnus-list-of-unread-articles (car info)))))) | |
3646 (error "No such group: %s" (gnus-info-group info)))))) | 4108 (error "No such group: %s" (gnus-info-group info)))))) |
3647 | 4109 |
3648 (defun gnus-group-set-method-info (group select-method) | 4110 (defun gnus-group-set-method-info (group select-method) |
3649 (gnus-group-set-info select-method group 'method)) | 4111 (gnus-group-set-info select-method group 'method)) |
3650 | 4112 |
3675 (setcdr m (gnus-compress-sequence articles t))) | 4137 (setcdr m (gnus-compress-sequence articles t))) |
3676 (setcdr m (gnus-compress-sequence | 4138 (setcdr m (gnus-compress-sequence |
3677 (sort (nconc (gnus-uncompress-range (cdr m)) | 4139 (sort (nconc (gnus-uncompress-range (cdr m)) |
3678 (copy-sequence articles)) '<) t)))))) | 4140 (copy-sequence articles)) '<) t)))))) |
3679 | 4141 |
4142 (defun gnus-add-mark (group mark article) | |
4143 "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." | |
4144 (let ((buffer (gnus-summary-buffer-name group))) | |
4145 (if (gnus-buffer-live-p buffer) | |
4146 (save-excursion | |
4147 (set-buffer (get-buffer buffer)) | |
4148 (gnus-summary-add-mark article mark)) | |
4149 (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) | |
4150 (list article))))) | |
4151 | |
3680 ;;; | 4152 ;;; |
3681 ;;; Group timestamps | 4153 ;;; Group timestamps |
3682 ;;; | 4154 ;;; |
3683 | 4155 |
3684 (defun gnus-group-set-timestamp () | 4156 (defun gnus-group-set-timestamp () |
3696 | 4168 |
3697 (defun gnus-group-timestamp-delta (group) | 4169 (defun gnus-group-timestamp-delta (group) |
3698 "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." | 4170 "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." |
3699 (let* ((time (or (gnus-group-timestamp group) | 4171 (let* ((time (or (gnus-group-timestamp group) |
3700 (list 0 0))) | 4172 (list 0 0))) |
3701 (delta (subtract-time (current-time) time))) | 4173 (delta (subtract-time (current-time) time))) |
3702 (+ (* (nth 0 delta) 65536.0) | 4174 (+ (* (nth 0 delta) 65536.0) |
3703 (nth 1 delta)))) | 4175 (nth 1 delta)))) |
3704 | 4176 |
3705 (defun gnus-group-timestamp-string (group) | 4177 (defun gnus-group-timestamp-string (group) |
3706 "Return a string of the timestamp for GROUP." | 4178 "Return a string of the timestamp for GROUP." |
3707 (let ((time (gnus-group-timestamp group))) | 4179 (let ((time (gnus-group-timestamp group))) |
3708 (if (not time) | 4180 (if (not time) |
3709 "" | 4181 "" |
3710 (gnus-time-iso8601 time)))) | 4182 (gnus-time-iso8601 time)))) |
3711 | 4183 |
3712 (defun gnus-group-prepare-flat-list-dead-predicate | |
3713 (groups level mark predicate) | |
3714 (let (group) | |
3715 (if predicate | |
3716 ;; This loop is used when listing groups that match some | |
3717 ;; regexp. | |
3718 (while (setq group (pop groups)) | |
3719 (when (funcall predicate group) | |
3720 (gnus-add-text-properties | |
3721 (point) (prog1 (1+ (point)) | |
3722 (insert " " mark " *: " | |
3723 (gnus-group-name-decode group | |
3724 (gnus-group-name-charset | |
3725 nil group)) | |
3726 "\n")) | |
3727 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) | |
3728 'gnus-unread t | |
3729 'gnus-level level))))))) | |
3730 | |
3731 (defun gnus-group-prepare-flat-predicate (level predicate &optional lowest | |
3732 dead-predicate) | |
3733 "List all newsgroups with unread articles of level LEVEL or lower. | |
3734 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. | |
3735 If PREDICATE, only list groups which PREDICATE returns non-nil. | |
3736 If DEAD-PREDICATE, list dead groups which DEAD-PREDICATE returns non-nil." | |
3737 (set-buffer gnus-group-buffer) | |
3738 (let ((buffer-read-only nil) | |
3739 (newsrc (cdr gnus-newsrc-alist)) | |
3740 (lowest (or lowest 1)) | |
3741 info clevel unread group params) | |
3742 (erase-buffer) | |
3743 ;; List living groups. | |
3744 (while newsrc | |
3745 (setq info (car newsrc) | |
3746 group (gnus-info-group info) | |
3747 params (gnus-info-params info) | |
3748 newsrc (cdr newsrc) | |
3749 unread (car (gnus-gethash group gnus-newsrc-hashtb))) | |
3750 (and unread ; This group might be unchecked | |
3751 (funcall predicate info) | |
3752 (<= (setq clevel (gnus-info-level info)) level) | |
3753 (>= clevel lowest) | |
3754 (gnus-group-insert-group-line | |
3755 group (gnus-info-level info) | |
3756 (gnus-info-marks info) unread (gnus-info-method info)))) | |
3757 | |
3758 ;; List dead groups. | |
3759 (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) | |
3760 (gnus-group-prepare-flat-list-dead-predicate | |
3761 (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) | |
3762 gnus-level-zombie ?Z | |
3763 dead-predicate)) | |
3764 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) | |
3765 (gnus-group-prepare-flat-list-dead-predicate | |
3766 (setq gnus-killed-list (sort gnus-killed-list 'string<)) | |
3767 gnus-level-killed ?K dead-predicate)) | |
3768 | |
3769 (gnus-group-set-mode-line) | |
3770 (setq gnus-group-list-mode (cons level t)) | |
3771 (gnus-run-hooks 'gnus-group-prepare-hook) | |
3772 t)) | |
3773 | |
3774 (defun gnus-group-list-cached (level &optional lowest) | 4184 (defun gnus-group-list-cached (level &optional lowest) |
3775 "List all groups with cached articles. | 4185 "List all groups with cached articles. |
3776 If the prefix LEVEL is non-nil, it should be a number that says which | 4186 If the prefix LEVEL is non-nil, it should be a number that says which |
3777 level to cut off listing groups. | 4187 level to cut off listing groups. |
3778 If LOWEST, don't list groups with level lower than LOWEST. | 4188 If LOWEST, don't list groups with level lower than LOWEST. |
3781 (interactive "P") | 4191 (interactive "P") |
3782 (when level | 4192 (when level |
3783 (setq level (prefix-numeric-value level))) | 4193 (setq level (prefix-numeric-value level))) |
3784 (when (or (not level) (>= level gnus-level-zombie)) | 4194 (when (or (not level) (>= level gnus-level-zombie)) |
3785 (gnus-cache-open)) | 4195 (gnus-cache-open)) |
3786 (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) | 4196 (funcall gnus-group-prepare-function |
3787 #'(lambda (info) | 4197 (or level gnus-level-subscribed) |
3788 (let ((marks (gnus-info-marks info))) | 4198 #'(lambda (info) |
3789 (assq 'cache marks))) | 4199 (let ((marks (gnus-info-marks info))) |
3790 lowest | 4200 (assq 'cache marks))) |
3791 #'(lambda (group) | 4201 lowest |
3792 (or (gnus-gethash group | 4202 #'(lambda (group) |
3793 gnus-cache-active-hashtb) | 4203 (or (gnus-gethash group |
3794 ;; Cache active file might use "." | 4204 gnus-cache-active-hashtb) |
3795 ;; instead of ":". | 4205 ;; Cache active file might use "." |
3796 (gnus-gethash | 4206 ;; instead of ":". |
3797 (mapconcat 'identity | 4207 (gnus-gethash |
3798 (split-string group ":") | 4208 (mapconcat 'identity |
3799 ".") | 4209 (split-string group ":") |
3800 gnus-cache-active-hashtb)))) | 4210 ".") |
4211 gnus-cache-active-hashtb)))) | |
3801 (goto-char (point-min)) | 4212 (goto-char (point-min)) |
3802 (gnus-group-position-point)) | 4213 (gnus-group-position-point)) |
3803 | 4214 |
3804 (defun gnus-group-list-dormant (level &optional lowest) | 4215 (defun gnus-group-list-dormant (level &optional lowest) |
3805 "List all groups with dormant articles. | 4216 "List all groups with dormant articles. |
3811 (interactive "P") | 4222 (interactive "P") |
3812 (when level | 4223 (when level |
3813 (setq level (prefix-numeric-value level))) | 4224 (setq level (prefix-numeric-value level))) |
3814 (when (or (not level) (>= level gnus-level-zombie)) | 4225 (when (or (not level) (>= level gnus-level-zombie)) |
3815 (gnus-cache-open)) | 4226 (gnus-cache-open)) |
3816 (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) | 4227 (funcall gnus-group-prepare-function |
3817 #'(lambda (info) | 4228 (or level gnus-level-subscribed) |
3818 (let ((marks (gnus-info-marks info))) | 4229 #'(lambda (info) |
3819 (assq 'dormant marks))) | 4230 (let ((marks (gnus-info-marks info))) |
3820 lowest) | 4231 (assq 'dormant marks))) |
4232 lowest | |
4233 'ignore) | |
3821 (goto-char (point-min)) | 4234 (goto-char (point-min)) |
3822 (gnus-group-position-point)) | 4235 (gnus-group-position-point)) |
3823 | 4236 |
4237 (defun gnus-group-listed-groups () | |
4238 "Return a list of listed groups." | |
4239 (let (point groups) | |
4240 (goto-char (point-min)) | |
4241 (while (setq point (text-property-not-all (point) (point-max) | |
4242 'gnus-group nil)) | |
4243 (goto-char point) | |
4244 (push (symbol-name (get-text-property point 'gnus-group)) groups) | |
4245 (forward-char 1)) | |
4246 groups)) | |
4247 | |
4248 (defun gnus-group-list-plus (&optional args) | |
4249 "List groups plus the current selection." | |
4250 (interactive "P") | |
4251 (let ((gnus-group-listed-groups (gnus-group-listed-groups)) | |
4252 (gnus-group-list-mode gnus-group-list-mode) ;; Save it. | |
4253 func) | |
4254 (push last-command-event unread-command-events) | |
4255 (if (featurep 'xemacs) | |
4256 (push (make-event 'key-press '(key ?A)) unread-command-events) | |
4257 (push ?A unread-command-events)) | |
4258 (let (gnus-pick-mode keys) | |
4259 (setq keys (if (featurep 'xemacs) | |
4260 (events-to-keys (read-key-sequence nil)) | |
4261 (read-key-sequence nil))) | |
4262 (setq func (lookup-key (current-local-map) keys))) | |
4263 (if (or (not func) | |
4264 (numberp func)) | |
4265 (ding) | |
4266 (call-interactively func)))) | |
4267 | |
4268 (defun gnus-group-list-flush (&optional args) | |
4269 "Flush groups from the current selection." | |
4270 (interactive "P") | |
4271 (let ((gnus-group-list-option 'flush)) | |
4272 (gnus-group-list-plus args))) | |
4273 | |
4274 (defun gnus-group-list-limit (&optional args) | |
4275 "List groups limited within the current selection." | |
4276 (interactive "P") | |
4277 (let ((gnus-group-list-option 'limit)) | |
4278 (gnus-group-list-plus args))) | |
4279 | |
4280 (defun gnus-group-mark-article-read (group article) | |
4281 "Mark ARTICLE read." | |
4282 (let ((buffer (gnus-summary-buffer-name group)) | |
4283 (mark gnus-read-mark) | |
4284 active n) | |
4285 (if (get-buffer buffer) | |
4286 (with-current-buffer buffer | |
4287 (setq active gnus-newsgroup-active) | |
4288 (gnus-activate-group group) | |
4289 (when gnus-newsgroup-prepared | |
4290 (when (and gnus-newsgroup-auto-expire | |
4291 (memq mark gnus-auto-expirable-marks)) | |
4292 (setq mark gnus-expirable-mark)) | |
4293 (setq mark (gnus-request-update-mark | |
4294 group article mark)) | |
4295 (gnus-mark-article-as-read article mark) | |
4296 (setq gnus-newsgroup-active (gnus-active group)) | |
4297 (when active | |
4298 (setq n (1+ (cdr active))) | |
4299 (while (<= n (cdr gnus-newsgroup-active)) | |
4300 (unless (eq n article) | |
4301 (push n gnus-newsgroup-unselected)) | |
4302 (setq n (1+ n))) | |
4303 (setq gnus-newsgroup-unselected | |
4304 (nreverse gnus-newsgroup-unselected))))) | |
4305 (gnus-activate-group group) | |
4306 (gnus-group-make-articles-read group (list article)) | |
4307 (when (gnus-group-auto-expirable-p group) | |
4308 (gnus-add-marked-articles | |
4309 group 'expire (list article)))))) | |
4310 | |
3824 (provide 'gnus-group) | 4311 (provide 'gnus-group) |
3825 | 4312 |
4313 ;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 | |
3826 ;;; gnus-group.el ends here | 4314 ;;; gnus-group.el ends here |