1 |
;;; gnus-topic.el --- a folding minor mode for Gnus group buffers |
;;; gnus-topic.el --- a folding minor mode for Gnus group buffers |
2 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Ilja Weis <kult@uni-paderborn.de> |
;; Author: Ilja Weis <kult@uni-paderborn.de> |
46 |
:type 'hook |
:type 'hook |
47 |
:group 'gnus-topic) |
:group 'gnus-topic) |
48 |
|
|
49 |
|
(when (featurep 'xemacs) |
50 |
|
(add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add)) |
51 |
|
|
52 |
(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" |
(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" |
53 |
"Format of topic lines. |
"Format of topic lines. |
54 |
It works along the same lines as a normal formatting string, |
It works along the same lines as a normal formatting string, |
60 |
%g Number of groups in the topic. |
%g Number of groups in the topic. |
61 |
%a Number of unread articles in the groups in the topic. |
%a Number of unread articles in the groups in the topic. |
62 |
%A Number of unread articles in the groups in the topic and its subtopics. |
%A Number of unread articles in the groups in the topic and its subtopics. |
63 |
" |
|
64 |
|
General format specifiers can also be used. |
65 |
|
See Info node `(gnus)Formatting Variables'." |
66 |
|
:link '(custom-manual "(gnus)Formatting Variables") |
67 |
:type 'string |
:type 'string |
68 |
:group 'gnus-topic) |
:group 'gnus-topic) |
69 |
|
|
167 |
(mapcar 'list (gnus-topic-list)) |
(mapcar 'list (gnus-topic-list)) |
168 |
nil t))) |
nil t))) |
169 |
(dolist (topic (gnus-current-topics topic)) |
(dolist (topic (gnus-current-topics topic)) |
170 |
|
(gnus-topic-goto-topic topic) |
171 |
(gnus-topic-fold t)) |
(gnus-topic-fold t)) |
172 |
(gnus-topic-goto-topic topic)) |
(gnus-topic-goto-topic topic)) |
173 |
|
|
203 |
"Return entries for all visible groups in TOPIC. |
"Return entries for all visible groups in TOPIC. |
204 |
If RECURSIVE is t, return groups in its subtopics too." |
If RECURSIVE is t, return groups in its subtopics too." |
205 |
(let ((groups (cdr (assoc topic gnus-topic-alist))) |
(let ((groups (cdr (assoc topic gnus-topic-alist))) |
206 |
info clevel unread group params visible-groups entry active) |
info clevel unread group params visible-groups entry active) |
207 |
(setq lowest (or lowest 1)) |
(setq lowest (or lowest 1)) |
208 |
(setq level (or level gnus-level-unsubscribed)) |
(setq level (or level gnus-level-unsubscribed)) |
209 |
;; We go through the newsrc to look for matches. |
;; We go through the newsrc to look for matches. |
252 |
(cdr recursive))) |
(cdr recursive))) |
253 |
visible-groups)) |
visible-groups)) |
254 |
|
|
255 |
|
(defun gnus-topic-goto-previous-topic (n) |
256 |
|
"Go to the N'th previous topic." |
257 |
|
(interactive "p") |
258 |
|
(gnus-topic-goto-next-topic (- n))) |
259 |
|
|
260 |
|
(defun gnus-topic-goto-next-topic (n) |
261 |
|
"Go to the N'th next topic." |
262 |
|
(interactive "p") |
263 |
|
(let ((backward (< n 0)) |
264 |
|
(n (abs n)) |
265 |
|
(topic (gnus-current-topic))) |
266 |
|
(while (and (> n 0) |
267 |
|
(setq topic |
268 |
|
(if backward |
269 |
|
(gnus-topic-previous-topic topic) |
270 |
|
(gnus-topic-next-topic topic)))) |
271 |
|
(gnus-topic-goto-topic topic) |
272 |
|
(setq n (1- n))) |
273 |
|
(when (/= 0 n) |
274 |
|
(gnus-message 7 "No more topics")) |
275 |
|
n)) |
276 |
|
|
277 |
(defun gnus-topic-previous-topic (topic) |
(defun gnus-topic-previous-topic (topic) |
278 |
"Return the previous topic on the same level as TOPIC." |
"Return the previous topic on the same level as TOPIC." |
279 |
(let ((top (cddr (gnus-topic-find-topology |
(let ((top (cddr (gnus-topic-find-topology |
380 |
"Compute the group parameters for GROUP taking into account inheritance from topics." |
"Compute the group parameters for GROUP taking into account inheritance from topics." |
381 |
(let ((params-list (copy-sequence (gnus-group-get-parameter group)))) |
(let ((params-list (copy-sequence (gnus-group-get-parameter group)))) |
382 |
(save-excursion |
(save-excursion |
|
(gnus-group-goto-group group) |
|
383 |
(nconc params-list |
(nconc params-list |
384 |
(gnus-topic-hierarchical-parameters (gnus-current-topic)))))) |
(gnus-topic-hierarchical-parameters |
385 |
|
;; First we try to go to the group within the group |
386 |
|
;; buffer and find the topic for the group that way. |
387 |
|
;; This hopefully copes well with groups that are in |
388 |
|
;; more than one topic. Failing that (i.e. when the |
389 |
|
;; group isn't visible in the group buffer) we find a |
390 |
|
;; topic for the group via gnus-group-topic. |
391 |
|
(or (and (gnus-group-goto-group group) |
392 |
|
(gnus-current-topic)) |
393 |
|
(gnus-group-topic group))))))) |
394 |
|
|
395 |
(defun gnus-topic-hierarchical-parameters (topic) |
(defun gnus-topic-hierarchical-parameters (topic) |
396 |
"Return a topic list computed for TOPIC." |
"Return a topic list computed for TOPIC." |
421 |
|
|
422 |
;;; Generating group buffers |
;;; Generating group buffers |
423 |
|
|
424 |
(defun gnus-group-prepare-topics (level &optional all lowest |
(defun gnus-group-prepare-topics (level &optional predicate lowest |
425 |
regexp list-topic topic-level) |
regexp list-topic topic-level) |
426 |
"List all newsgroups with unread articles of level LEVEL or lower. |
"List all newsgroups with unread articles of level LEVEL or lower. |
427 |
Use the `gnus-group-topics' to sort the groups. |
Use the `gnus-group-topics' to sort the groups. |
428 |
If ALL is non-nil, list groups that have no unread articles. |
If PREDICTE is a function, list groups that the function returns non-nil; |
429 |
|
if it is t, list groups that have no unread articles. |
430 |
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." |
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." |
431 |
(set-buffer gnus-group-buffer) |
(set-buffer gnus-group-buffer) |
432 |
(let ((buffer-read-only nil) |
(let ((buffer-read-only nil) |
433 |
(lowest (or lowest 1))) |
(lowest (or lowest 1)) |
434 |
|
(not-in-list |
435 |
|
(and gnus-group-listed-groups |
436 |
|
(copy-sequence gnus-group-listed-groups)))) |
437 |
|
|
438 |
|
(gnus-update-format-specifications nil 'topic) |
439 |
|
|
440 |
(when (or (not gnus-topic-alist) |
(when (or (not gnus-topic-alist) |
441 |
(not gnus-topology-checked-p)) |
(not gnus-topology-checked-p)) |
442 |
(gnus-topic-check-topology)) |
(gnus-topic-check-topology)) |
445 |
(erase-buffer)) |
(erase-buffer)) |
446 |
|
|
447 |
;; List dead groups? |
;; List dead groups? |
448 |
(when (and (>= level gnus-level-zombie) |
(when (or gnus-group-listed-groups |
449 |
(<= lowest gnus-level-zombie)) |
(and (>= level gnus-level-zombie) |
450 |
|
(<= lowest gnus-level-zombie))) |
451 |
(gnus-group-prepare-flat-list-dead |
(gnus-group-prepare-flat-list-dead |
452 |
(setq gnus-zombie-list (sort gnus-zombie-list 'string<)) |
(setq gnus-zombie-list (sort gnus-zombie-list 'string<)) |
453 |
gnus-level-zombie ?Z |
gnus-level-zombie ?Z |
454 |
regexp)) |
regexp)) |
455 |
|
|
456 |
(when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)) |
(when (or gnus-group-listed-groups |
457 |
|
(and (>= level gnus-level-killed) |
458 |
|
(<= lowest gnus-level-killed))) |
459 |
(gnus-group-prepare-flat-list-dead |
(gnus-group-prepare-flat-list-dead |
460 |
(setq gnus-killed-list (sort gnus-killed-list 'string<)) |
(setq gnus-killed-list (sort gnus-killed-list 'string<)) |
461 |
gnus-level-killed ?K |
gnus-level-killed ?K regexp) |
462 |
regexp)) |
(when not-in-list |
463 |
|
(unless gnus-killed-hashtb |
464 |
|
(gnus-make-hashtable-from-killed)) |
465 |
|
(gnus-group-prepare-flat-list-dead |
466 |
|
(gnus-remove-if (lambda (group) |
467 |
|
(or (gnus-gethash group gnus-newsrc-hashtb) |
468 |
|
(gnus-gethash group gnus-killed-hashtb))) |
469 |
|
not-in-list) |
470 |
|
gnus-level-killed ?K regexp))) |
471 |
|
|
472 |
;; Use topics. |
;; Use topics. |
473 |
(prog1 |
(prog1 |
474 |
(when (< lowest gnus-level-zombie) |
(when (or (< lowest gnus-level-zombie) |
475 |
|
gnus-group-listed-groups) |
476 |
(if list-topic |
(if list-topic |
477 |
(let ((top (gnus-topic-find-topology list-topic))) |
(let ((top (gnus-topic-find-topology list-topic))) |
478 |
(gnus-topic-prepare-topic (cdr top) (car top) |
(gnus-topic-prepare-topic (cdr top) (car top) |
479 |
(or topic-level level) all |
(or topic-level level) predicate |
480 |
nil lowest)) |
nil lowest regexp)) |
481 |
(gnus-topic-prepare-topic gnus-topic-topology 0 |
(gnus-topic-prepare-topic gnus-topic-topology 0 |
482 |
(or topic-level level) all |
(or topic-level level) predicate |
483 |
nil lowest))) |
nil lowest regexp))) |
|
|
|
484 |
(gnus-group-set-mode-line) |
(gnus-group-set-mode-line) |
485 |
(setq gnus-group-list-mode (cons level all)) |
(setq gnus-group-list-mode (cons level predicate)) |
486 |
(gnus-run-hooks 'gnus-group-prepare-hook)))) |
(gnus-run-hooks 'gnus-group-prepare-hook)))) |
487 |
|
|
488 |
(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent |
(defun gnus-topic-prepare-topic (topicl level &optional list-level |
489 |
lowest) |
predicate silent |
490 |
|
lowest regexp) |
491 |
"Insert TOPIC into the group buffer. |
"Insert TOPIC into the group buffer. |
492 |
If SILENT, don't insert anything. Return the number of unread |
If SILENT, don't insert anything. Return the number of unread |
493 |
articles in the topic and its subtopics." |
articles in the topic and its subtopics." |
494 |
(let* ((type (pop topicl)) |
(let* ((type (pop topicl)) |
495 |
(entries (gnus-topic-find-groups |
(entries (gnus-topic-find-groups |
496 |
(car type) list-level |
(car type) |
497 |
(or all |
(if gnus-group-listed-groups |
498 |
|
gnus-level-killed |
499 |
|
list-level) |
500 |
|
(or predicate gnus-group-listed-groups |
501 |
(cdr (assq 'visible |
(cdr (assq 'visible |
502 |
(gnus-topic-hierarchical-parameters |
(gnus-topic-hierarchical-parameters |
503 |
(car type))))) |
(car type))))) |
504 |
lowest)) |
(if gnus-group-listed-groups 0 lowest))) |
505 |
(visiblep (and (eq (nth 1 type) 'visible) (not silent))) |
(visiblep (and (eq (nth 1 type) 'visible) (not silent))) |
506 |
(gnus-group-indentation |
(gnus-group-indentation |
507 |
(make-string (* gnus-topic-indent-level level) ? )) |
(make-string (* gnus-topic-indent-level level) ? )) |
516 |
(while topicl |
(while topicl |
517 |
(incf unread |
(incf unread |
518 |
(gnus-topic-prepare-topic |
(gnus-topic-prepare-topic |
519 |
(pop topicl) (1+ level) list-level all |
(pop topicl) (1+ level) list-level predicate |
520 |
(not visiblep) lowest))) |
(not visiblep) lowest regexp))) |
521 |
(setq end (point)) |
(setq end (point)) |
522 |
(goto-char beg) |
(goto-char beg) |
523 |
;; Insert all the groups that belong in this topic. |
;; Insert all the groups that belong in this topic. |
524 |
(while (setq entry (pop entries)) |
(while (setq entry (pop entries)) |
525 |
(when visiblep |
(when (if (stringp entry) |
526 |
(if (stringp entry) |
(gnus-group-prepare-logic |
527 |
;; Dead groups. |
entry |
528 |
(gnus-group-insert-group-line |
(and |
529 |
entry (if (member entry gnus-zombie-list) |
(or (not gnus-group-listed-groups) |
530 |
gnus-level-zombie gnus-level-killed) |
(if (< list-level gnus-level-zombie) nil |
531 |
nil (- (1+ (cdr (setq active (gnus-active entry)))) |
(let ((entry-level |
532 |
(car active)) |
(if (member entry gnus-zombie-list) |
533 |
nil) |
gnus-level-zombie gnus-level-killed))) |
534 |
;; Living groups. |
(and (<= entry-level list-level) |
535 |
(when (setq info (nth 2 entry)) |
(>= entry-level lowest))))) |
536 |
(gnus-group-insert-group-line |
(cond |
537 |
(gnus-info-group info) |
((stringp regexp) |
538 |
(gnus-info-level info) (gnus-info-marks info) |
(string-match regexp entry)) |
539 |
(car entry) (gnus-info-method info))))) |
((functionp regexp) |
540 |
(when (and (listp entry) |
(funcall regexp entry)) |
541 |
(numberp (car entry))) |
((null regexp) t) |
542 |
(incf unread (car entry))) |
(t nil)))) |
543 |
(when (listp entry) |
(setq info (nth 2 entry)) |
544 |
(setq tick t))) |
(gnus-group-prepare-logic |
545 |
|
(gnus-info-group info) |
546 |
|
(and (or (not gnus-group-listed-groups) |
547 |
|
(let ((entry-level (gnus-info-level info))) |
548 |
|
(and (<= entry-level list-level) |
549 |
|
(>= entry-level lowest)))) |
550 |
|
(or (not (functionp predicate)) |
551 |
|
(funcall predicate info)) |
552 |
|
(or (not (stringp regexp)) |
553 |
|
(string-match regexp (gnus-info-group info)))))) |
554 |
|
(when visiblep |
555 |
|
(if (stringp entry) |
556 |
|
;; Dead groups. |
557 |
|
(gnus-group-insert-group-line |
558 |
|
entry (if (member entry gnus-zombie-list) |
559 |
|
gnus-level-zombie gnus-level-killed) |
560 |
|
nil (- (1+ (cdr (setq active (gnus-active entry)))) |
561 |
|
(car active)) |
562 |
|
nil) |
563 |
|
;; Living groups. |
564 |
|
(when (setq info (nth 2 entry)) |
565 |
|
(gnus-group-insert-group-line |
566 |
|
(gnus-info-group info) |
567 |
|
(gnus-info-level info) (gnus-info-marks info) |
568 |
|
(car entry) (gnus-info-method info))))) |
569 |
|
(when (and (listp entry) |
570 |
|
(numberp (car entry))) |
571 |
|
(incf unread (car entry))) |
572 |
|
(when (listp entry) |
573 |
|
(setq tick t)))) |
574 |
(goto-char beg) |
(goto-char beg) |
575 |
;; Insert the topic line. |
;; Insert the topic line. |
576 |
(when (and (not silent) |
(when (and (not silent) |
680 |
(when (and (eq major-mode 'gnus-group-mode) |
(when (and (eq major-mode 'gnus-group-mode) |
681 |
gnus-topic-mode) |
gnus-topic-mode) |
682 |
(let ((group (gnus-group-group-name)) |
(let ((group (gnus-group-group-name)) |
683 |
(m (point-marker)) |
(m (point-marker)) |
684 |
(buffer-read-only nil)) |
(buffer-read-only nil)) |
685 |
(when (and group |
(when (and group |
686 |
(gnus-get-info group) |
(gnus-get-info group) |
698 |
(unfound t) |
(unfound t) |
699 |
entry) |
entry) |
700 |
;; Try to jump to a visible group. |
;; Try to jump to a visible group. |
701 |
(while (and g (not (gnus-group-goto-group (car g) t))) |
(while (and g |
702 |
|
(not (gnus-group-goto-group (car g) t))) |
703 |
(pop g)) |
(pop g)) |
704 |
;; It wasn't visible, so we try to see where to insert it. |
;; It wasn't visible, so we try to see where to insert it. |
705 |
(when (not g) |
(when (not g) |
711 |
(when (and unfound |
(when (and unfound |
712 |
topic |
topic |
713 |
(not (gnus-topic-goto-missing-topic topic))) |
(not (gnus-topic-goto-missing-topic topic))) |
714 |
(let* ((top (gnus-topic-find-topology topic)) |
(gnus-topic-display-missing-topic topic))))) |
715 |
(children (cddr top)) |
|
716 |
(type (cadr top)) |
(defun gnus-topic-display-missing-topic (topic) |
717 |
(unread 0) |
"Insert topic lines recursively for missing topics." |
718 |
(entries (gnus-topic-find-groups |
(let ((parent (gnus-topic-find-topology |
719 |
(car type) (car gnus-group-list-mode) |
(gnus-topic-parent-topic topic)))) |
720 |
(cdr gnus-group-list-mode)))) |
(when (and parent |
721 |
(while children |
(not (gnus-topic-goto-missing-topic (caadr parent)))) |
722 |
(incf unread (gnus-topic-unread (caar (pop children))))) |
(gnus-topic-display-missing-topic (caadr parent)))) |
723 |
(while (setq entry (pop entries)) |
(gnus-topic-goto-missing-topic topic) |
724 |
(when (numberp (car entry)) |
(let* ((top (gnus-topic-find-topology topic)) |
725 |
(incf unread (car entry)))) |
(children (cddr top)) |
726 |
(gnus-topic-insert-topic-line |
(type (cadr top)) |
727 |
topic t t (car (gnus-topic-find-topology topic)) nil unread)))))) |
(unread 0) |
728 |
|
(entries (gnus-topic-find-groups |
729 |
|
(car type) (car gnus-group-list-mode) |
730 |
|
(cdr gnus-group-list-mode))) |
731 |
|
entry) |
732 |
|
(while children |
733 |
|
(incf unread (gnus-topic-unread (caar (pop children))))) |
734 |
|
(while (setq entry (pop entries)) |
735 |
|
(when (numberp (car entry)) |
736 |
|
(incf unread (car entry)))) |
737 |
|
(gnus-topic-insert-topic-line |
738 |
|
topic t t (car (gnus-topic-find-topology topic)) nil unread))) |
739 |
|
|
740 |
(defun gnus-topic-goto-missing-topic (topic) |
(defun gnus-topic-goto-missing-topic (topic) |
741 |
(if (gnus-topic-goto-topic topic) |
(if (gnus-topic-goto-topic topic) |
929 |
? )) |
? )) |
930 |
(yanked (list group)) |
(yanked (list group)) |
931 |
alist talist end) |
alist talist end) |
932 |
;; Then we enter the yanked groups into the topics they belong |
;; Then we enter the yanked groups into the topics |
933 |
;; to. |
;; they belong to. |
934 |
(when (setq alist (assoc (save-excursion |
(when (setq alist (assoc (save-excursion |
935 |
(forward-line -1) |
(forward-line -1) |
936 |
(or |
(or |
1048 |
"\r" gnus-topic-select-group |
"\r" gnus-topic-select-group |
1049 |
" " gnus-topic-read-group |
" " gnus-topic-read-group |
1050 |
"\C-c\C-x" gnus-topic-expire-articles |
"\C-c\C-x" gnus-topic-expire-articles |
1051 |
|
"c" gnus-topic-catchup-articles |
1052 |
"\C-k" gnus-topic-kill-group |
"\C-k" gnus-topic-kill-group |
1053 |
"\C-y" gnus-topic-yank-group |
"\C-y" gnus-topic-yank-group |
1054 |
"\M-g" gnus-topic-get-new-news-this-topic |
"\M-g" gnus-topic-get-new-news-this-topic |
1075 |
"j" gnus-topic-jump-to-topic |
"j" gnus-topic-jump-to-topic |
1076 |
"M" gnus-topic-move-matching |
"M" gnus-topic-move-matching |
1077 |
"C" gnus-topic-copy-matching |
"C" gnus-topic-copy-matching |
1078 |
|
"\M-p" gnus-topic-goto-previous-topic |
1079 |
|
"\M-n" gnus-topic-goto-next-topic |
1080 |
"\C-i" gnus-topic-indent |
"\C-i" gnus-topic-indent |
1081 |
[tab] gnus-topic-indent |
[tab] gnus-topic-indent |
1082 |
"r" gnus-topic-rename |
"r" gnus-topic-rename |
1089 |
"a" gnus-topic-sort-groups-by-alphabet |
"a" gnus-topic-sort-groups-by-alphabet |
1090 |
"u" gnus-topic-sort-groups-by-unread |
"u" gnus-topic-sort-groups-by-unread |
1091 |
"l" gnus-topic-sort-groups-by-level |
"l" gnus-topic-sort-groups-by-level |
1092 |
|
"e" gnus-topic-sort-groups-by-server |
1093 |
"v" gnus-topic-sort-groups-by-score |
"v" gnus-topic-sort-groups-by-score |
1094 |
"r" gnus-topic-sort-groups-by-rank |
"r" gnus-topic-sort-groups-by-rank |
1095 |
"m" gnus-topic-sort-groups-by-method)) |
"m" gnus-topic-sort-groups-by-method)) |
1101 |
'("Topics" |
'("Topics" |
1102 |
["Toggle topics" gnus-topic-mode t] |
["Toggle topics" gnus-topic-mode t] |
1103 |
("Groups" |
("Groups" |
1104 |
["Copy" gnus-topic-copy-group t] |
["Copy..." gnus-topic-copy-group t] |
1105 |
["Move" gnus-topic-move-group t] |
["Move..." gnus-topic-move-group t] |
1106 |
["Remove" gnus-topic-remove-group t] |
["Remove" gnus-topic-remove-group t] |
1107 |
["Copy matching" gnus-topic-copy-matching t] |
["Copy matching..." gnus-topic-copy-matching t] |
1108 |
["Move matching" gnus-topic-move-matching t]) |
["Move matching..." gnus-topic-move-matching t]) |
1109 |
("Topics" |
("Topics" |
1110 |
["Goto" gnus-topic-jump-to-topic t] |
["Goto..." gnus-topic-jump-to-topic t] |
1111 |
["Show" gnus-topic-show-topic t] |
["Show" gnus-topic-show-topic t] |
1112 |
["Hide" gnus-topic-hide-topic t] |
["Hide" gnus-topic-hide-topic t] |
1113 |
["Delete" gnus-topic-delete t] |
["Delete" gnus-topic-delete t] |
1114 |
["Rename" gnus-topic-rename t] |
["Rename..." gnus-topic-rename t] |
1115 |
["Create" gnus-topic-create-topic t] |
["Create..." gnus-topic-create-topic t] |
1116 |
["Mark" gnus-topic-mark-topic t] |
["Mark" gnus-topic-mark-topic t] |
1117 |
["Indent" gnus-topic-indent t] |
["Indent" gnus-topic-indent t] |
1118 |
["Sort" gnus-topic-sort-topics t] |
["Sort" gnus-topic-sort-topics t] |
1119 |
|
["Previous topic" gnus-topic-goto-previous-topic t] |
1120 |
|
["Next topic" gnus-topic-goto-next-topic t] |
1121 |
["Toggle hide empty" gnus-topic-toggle-display-empty-topics t] |
["Toggle hide empty" gnus-topic-toggle-display-empty-topics t] |
1122 |
["Edit parameters" gnus-topic-edit-parameters t]) |
["Edit parameters" gnus-topic-edit-parameters t]) |
1123 |
["List active" gnus-topic-list-active t])))) |
["List active" gnus-topic-list-active t])))) |
1132 |
(> (prefix-numeric-value arg) 0))) |
(> (prefix-numeric-value arg) 0))) |
1133 |
;; Infest Gnus with topics. |
;; Infest Gnus with topics. |
1134 |
(if (not gnus-topic-mode) |
(if (not gnus-topic-mode) |
1135 |
(setq gnus-goto-missing-group-function nil) |
(setq gnus-goto-missing-group-function nil) |
1136 |
(when (gnus-visual-p 'topic-menu 'menu) |
(when (gnus-visual-p 'topic-menu 'menu) |
1137 |
(gnus-topic-make-menu-bar)) |
(gnus-topic-make-menu-bar)) |
1138 |
(gnus-set-format 'topic t) |
(gnus-set-format 'topic t) |
1155 |
'gnus-group-sort-topic) |
'gnus-group-sort-topic) |
1156 |
(setq gnus-group-change-level-function 'gnus-topic-change-level) |
(setq gnus-group-change-level-function 'gnus-topic-change-level) |
1157 |
(setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) |
(setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) |
1158 |
(make-local-hook 'gnus-check-bogus-groups-hook) |
(gnus-make-local-hook 'gnus-check-bogus-groups-hook) |
1159 |
(add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) |
(add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist |
1160 |
|
nil 'local) |
1161 |
(setq gnus-topology-checked-p nil) |
(setq gnus-topology-checked-p nil) |
1162 |
;; We check the topology. |
;; We check the topology. |
1163 |
(when gnus-newsrc-alist |
(when gnus-newsrc-alist |
1176 |
(defun gnus-topic-select-group (&optional all) |
(defun gnus-topic-select-group (&optional all) |
1177 |
"Select this newsgroup. |
"Select this newsgroup. |
1178 |
No article is selected automatically. |
No article is selected automatically. |
1179 |
|
If the group is opened, just switch the summary buffer. |
1180 |
If ALL is non-nil, already read articles become readable. |
If ALL is non-nil, already read articles become readable. |
1181 |
If ALL is a number, fetch this number of articles. |
If ALL is a number, fetch this number of articles. |
1182 |
|
|
1183 |
If performed over a topic line, toggle folding the topic." |
If performed over a topic line, toggle folding the topic." |
1184 |
(interactive "P") |
(interactive "P") |
1185 |
|
(when (and (eobp) (not (gnus-group-group-name))) |
1186 |
|
(forward-line -1)) |
1187 |
(if (gnus-group-topic-p) |
(if (gnus-group-topic-p) |
1188 |
(let ((gnus-group-list-mode |
(let ((gnus-group-list-mode |
1189 |
(if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) |
(if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) |
1206 |
(gnus-message 5 "Expiring groups in %s..." topic) |
(gnus-message 5 "Expiring groups in %s..." topic) |
1207 |
(let ((gnus-group-marked |
(let ((gnus-group-marked |
1208 |
(mapcar (lambda (entry) (car (nth 2 entry))) |
(mapcar (lambda (entry) (car (nth 2 entry))) |
1209 |
(gnus-topic-find-groups topic gnus-level-killed t)))) |
(gnus-topic-find-groups topic gnus-level-killed t |
1210 |
|
nil t)))) |
1211 |
(gnus-group-expire-articles nil)) |
(gnus-group-expire-articles nil)) |
1212 |
(gnus-message 5 "Expiring groups in %s...done" topic)))) |
(gnus-message 5 "Expiring groups in %s...done" topic)))) |
1213 |
|
|
1214 |
|
(defun gnus-topic-catchup-articles (topic) |
1215 |
|
"Catchup this topic or group. |
1216 |
|
Also see `gnus-group-catchup'." |
1217 |
|
(interactive (list (gnus-group-topic-name))) |
1218 |
|
(if (not topic) |
1219 |
|
(call-interactively 'gnus-group-catchup-current) |
1220 |
|
(save-excursion |
1221 |
|
(let* ((groups |
1222 |
|
(mapcar (lambda (entry) (car (nth 2 entry))) |
1223 |
|
(gnus-topic-find-groups topic gnus-level-killed t |
1224 |
|
nil t))) |
1225 |
|
(buffer-read-only nil) |
1226 |
|
(gnus-group-marked groups)) |
1227 |
|
(gnus-group-catchup-current) |
1228 |
|
(mapcar 'gnus-topic-update-topics-containing-group groups))))) |
1229 |
|
|
1230 |
(defun gnus-topic-read-group (&optional all no-article group) |
(defun gnus-topic-read-group (&optional all no-article group) |
1231 |
"Read news in this newsgroup. |
"Read news in this newsgroup. |
1232 |
If the prefix argument ALL is non-nil, already read articles become |
If the prefix argument ALL is non-nil, already read articles become |
1283 |
If COPYP, copy the groups instead." |
If COPYP, copy the groups instead." |
1284 |
(interactive |
(interactive |
1285 |
(list current-prefix-arg |
(list current-prefix-arg |
1286 |
(completing-read "Move to topic: " gnus-topic-alist nil t))) |
(gnus-completing-read "Move to topic" gnus-topic-alist nil t |
1287 |
|
'gnus-topic-history))) |
1288 |
(let ((use-marked (and (not n) (not (gnus-region-active-p)) |
(let ((use-marked (and (not n) (not (gnus-region-active-p)) |
1289 |
gnus-group-marked t)) |
gnus-group-marked t)) |
1290 |
(groups (gnus-group-process-prefix n)) |
(groups (gnus-group-process-prefix n)) |
1430 |
(setcar (cdr (cadr topic)) 'visible) |
(setcar (cdr (cadr topic)) 'visible) |
1431 |
(gnus-group-list-groups))))) |
(gnus-group-list-groups))))) |
1432 |
|
|
1433 |
(defun gnus-topic-mark-topic (topic &optional unmark recursive) |
(defun gnus-topic-mark-topic (topic &optional unmark non-recursive) |
1434 |
"Mark all groups in the TOPIC with the process mark. |
"Mark all groups in the TOPIC with the process mark. |
1435 |
If RECURSIVE is t, mark its subtopics too." |
If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." |
1436 |
(interactive (list (gnus-group-topic-name) |
(interactive (list (gnus-group-topic-name) |
1437 |
nil |
nil |
1438 |
(and current-prefix-arg t))) |
(and current-prefix-arg t))) |
1440 |
(call-interactively 'gnus-group-mark-group) |
(call-interactively 'gnus-group-mark-group) |
1441 |
(save-excursion |
(save-excursion |
1442 |
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil |
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil |
1443 |
recursive))) |
(not non-recursive)))) |
1444 |
(while groups |
(while groups |
1445 |
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) |
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) |
1446 |
(gnus-info-group (nth 2 (pop groups))))))))) |
(gnus-info-group (nth 2 (pop groups))))))))) |
1447 |
|
|
1448 |
(defun gnus-topic-unmark-topic (topic &optional dummy recursive) |
(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive) |
1449 |
"Remove the process mark from all groups in the TOPIC. |
"Remove the process mark from all groups in the TOPIC. |
1450 |
If RECURSIVE is t, unmark its subtopics too." |
If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." |
1451 |
(interactive (list (gnus-group-topic-name) |
(interactive (list (gnus-group-topic-name) |
1452 |
nil |
nil |
1453 |
(and current-prefix-arg t))) |
(and current-prefix-arg t))) |
1454 |
(if (not topic) |
(if (not topic) |
1455 |
(call-interactively 'gnus-group-unmark-group) |
(call-interactively 'gnus-group-unmark-group) |
1456 |
(gnus-topic-mark-topic topic t recursive))) |
(gnus-topic-mark-topic topic t non-recursive))) |
1457 |
|
|
1458 |
(defun gnus-topic-get-new-news-this-topic (&optional n) |
(defun gnus-topic-get-new-news-this-topic (&optional n) |
1459 |
"Check for new news in the current topic." |
"Check for new news in the current topic." |
1460 |
(interactive "P") |
(interactive "P") |
1461 |
(if (not (gnus-group-topic-p)) |
(if (not (gnus-group-topic-p)) |
1462 |
(gnus-group-get-new-news-this-group n) |
(gnus-group-get-new-news-this-group n) |
1463 |
(gnus-topic-mark-topic (gnus-group-topic-name) nil (and n t)) |
(let* ((topic (gnus-group-topic-name)) |
1464 |
(gnus-group-get-new-news-this-group))) |
(data (cadr (gnus-topic-find-topology topic)))) |
1465 |
|
(save-excursion |
1466 |
|
(gnus-topic-mark-topic topic nil (and n t)) |
1467 |
|
(gnus-group-get-new-news-this-group)) |
1468 |
|
(gnus-topic-remove-topic (eq 'visible (cadr data)))))) |
1469 |
|
|
1470 |
(defun gnus-topic-move-matching (regexp topic &optional copyp) |
(defun gnus-topic-move-matching (regexp topic &optional copyp) |
1471 |
"Move all groups that match REGEXP to some topic." |
"Move all groups that match REGEXP to some topic." |
1511 |
(interactive |
(interactive |
1512 |
(let ((topic (gnus-current-topic))) |
(let ((topic (gnus-current-topic))) |
1513 |
(list topic |
(list topic |
1514 |
(read-string (format "Rename %s to: " topic))))) |
(read-string (format "Rename %s to: " topic) topic)))) |
1515 |
;; Check whether the new name exists. |
;; Check whether the new name exists. |
1516 |
(when (gnus-topic-find-topology new-name) |
(when (gnus-topic-find-topology new-name) |
1517 |
(error "Topic '%s' already exists" new-name)) |
(error "Topic '%s' already exists" new-name)) |
1683 |
(interactive "P") |
(interactive "P") |
1684 |
(gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) |
(gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) |
1685 |
|
|
1686 |
|
(defun gnus-topic-sort-groups-by-server (&optional reverse) |
1687 |
|
"Sort the current topic alphabetically by server name. |
1688 |
|
If REVERSE, sort in reverse order." |
1689 |
|
(interactive "P") |
1690 |
|
(gnus-topic-sort-groups 'gnus-group-sort-by-server reverse)) |
1691 |
|
|
1692 |
(defun gnus-topic-sort-topics-1 (top reverse) |
(defun gnus-topic-sort-topics-1 (top reverse) |
1693 |
(if (cdr top) |
(if (cdr top) |
1694 |
(let ((subtop |
(let ((subtop |
1695 |
(mapcar `(lambda (top) |
(mapcar (gnus-byte-compile |
1696 |
(gnus-topic-sort-topics-1 top ,reverse)) |
`(lambda (top) |
1697 |
|
(gnus-topic-sort-topics-1 top ,reverse))) |
1698 |
(sort (cdr top) |
(sort (cdr top) |
1699 |
'(lambda (t1 t2) |
(lambda (t1 t2) |
1700 |
(string-lessp (caar t1) (caar t2))))))) |
(string-lessp (caar t1) (caar t2))))))) |
1701 |
(setcdr top (if reverse (reverse subtop) subtop)))) |
(setcdr top (if reverse (reverse subtop) subtop)))) |
1702 |
top) |
top) |
1703 |
|
|
1750 |
(gnus-subscribe-alphabetically newsgroup) |
(gnus-subscribe-alphabetically newsgroup) |
1751 |
;; Add the group to the topic. |
;; Add the group to the topic. |
1752 |
(nconc (assoc topic gnus-topic-alist) (list newsgroup)) |
(nconc (assoc topic gnus-topic-alist) (list newsgroup)) |
1753 |
(throw 'end t)))))) |
;; if this topic specifies a default level, use it |
1754 |
|
(let ((subscribe-level (cdr (assq 'subscribe-level |
1755 |
|
(gnus-topic-parameters topic))))) |
1756 |
|
(when subscribe-level |
1757 |
|
(gnus-group-change-level newsgroup subscribe-level |
1758 |
|
gnus-level-default-subscribed))) |
1759 |
|
(throw 'end t))) |
1760 |
|
nil))) |
1761 |
|
|
1762 |
(provide 'gnus-topic) |
(provide 'gnus-topic) |
1763 |
|
|