/[emacs]/emacs/lisp/gnus/gnus-topic.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-topic.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8.18.2 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.8.18.3 by miles, Thu Sep 16 00:12:16 2004 UTC
# Line 1  Line 1 
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>
# Line 46  Line 46 
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,
# Line 57  with some simple extensions. Line 60  with some simple extensions.
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    
# Line 161  with some simple extensions. Line 167  with some simple extensions.
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    
# Line 196  If TOPIC, start with that topic." Line 203  If TOPIC, start with that topic."
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.
# Line 245  If RECURSIVE is t, return groups in its Line 252  If RECURSIVE is t, return groups in its
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
# Line 351  If RECURSIVE is t, return groups in its Line 380  If RECURSIVE is t, return groups in its
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."
# Line 384  If RECURSIVE is t, return groups in its Line 421  If RECURSIVE is t, return groups in its
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))
# Line 402  If LOWEST is non-nil, list all newsgroup Line 445  If LOWEST is non-nil, list all newsgroup
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) ? ))
# Line 458  articles in the topic and its subtopics. Line 516  articles in the topic and its subtopics.
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)
# Line 593  articles in the topic and its subtopics. Line 680  articles in the topic and its subtopics.
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)
# Line 611  articles in the topic and its subtopics. Line 698  articles in the topic and its subtopics.
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)
# Line 623  articles in the topic and its subtopics. Line 711  articles in the topic and its subtopics.
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)
# Line 830  articles in the topic and its subtopics. Line 929  articles in the topic and its subtopics.
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
# Line 949  articles in the topic and its subtopics. Line 1048  articles in the topic and its subtopics.
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
# Line 975  articles in the topic and its subtopics. Line 1075  articles in the topic and its subtopics.
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
# Line 987  articles in the topic and its subtopics. Line 1089  articles in the topic and its subtopics.
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))
# Line 998  articles in the topic and its subtopics. Line 1101  articles in the topic and its subtopics.
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]))))
# Line 1027  articles in the topic and its subtopics. Line 1132  articles in the topic and its subtopics.
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)
# Line 1050  articles in the topic and its subtopics. Line 1155  articles in the topic and its subtopics.
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
# Line 1070  articles in the topic and its subtopics. Line 1176  articles in the topic and its subtopics.
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)))
# Line 1097  If performed over a topic line, toggle f Line 1206  If performed over a topic line, toggle f
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
# Line 1157  When used interactively, PARENT will be Line 1283  When used interactively, PARENT will be
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))
# Line 1303  If PERMANENT, make it stay shown in subs Line 1430  If PERMANENT, make it stay shown in subs
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)))
# Line 1313  If RECURSIVE is t, mark its subtopics to Line 1440  If RECURSIVE is t, mark its subtopics to
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."
# Line 1380  If RECURSIVE is t, unmark its subtopics Line 1511  If RECURSIVE is t, unmark its subtopics
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))
# Line 1552  If REVERSE, sort in reverse order." Line 1683  If REVERSE, sort in reverse order."
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    
# Line 1612  If REVERSE, reverse the sorting order." Line 1750  If REVERSE, reverse the sorting order."
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    

Legend:
Removed from v.1.8.18.2  
changed lines
  Added in v.1.8.18.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26