Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-topic.el @ 2:ac2d302a0011 r19-15b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
376 gnus-topic-active-alist nil 376 gnus-topic-active-alist nil
377 gnus-topic-killed-topics nil 377 gnus-topic-killed-topics nil
378 gnus-topic-tallied-groups nil 378 gnus-topic-tallied-groups nil
379 gnus-topology-checked-p nil)) 379 gnus-topology-checked-p nil))
380 380
381
381 (defun gnus-topic-check-topology () 382 (defun gnus-topic-check-topology ()
382 ;; The first time we set the topology to whatever we have 383 ;; The first time we set the topology to whatever we have
383 ;; gotten here, which can be rather random. 384 ;; gotten here, which can be rather random.
384 (unless gnus-topic-alist 385 (unless gnus-topic-alist
385 (gnus-topic-init-alist)) 386 (gnus-topic-init-alist))
386 387
387 (setq gnus-topology-checked-p t) 388 (setq gnus-topology-checked-p t)
389 ;; Go through the topic alist and make sure that all topics
390 ;; are in the topic topology.
388 (let ((topics (gnus-topic-list)) 391 (let ((topics (gnus-topic-list))
389 (alist gnus-topic-alist) 392 (alist gnus-topic-alist)
390 changed) 393 changed)
391 (while alist 394 (while alist
392 (unless (member (caar alist) topics) 395 (unless (member (caar alist) topics)
393 (nconc gnus-topic-topology 396 (nconc gnus-topic-topology
394 (list (list (list (caar alist) 'visible)))) 397 (list (list (list (caar alist) 'visible))))
395 (setq changed t)) 398 (setq changed t))
396 (setq alist (cdr alist))) 399 (setq alist (cdr alist)))
397 (when changed 400 (when changed
398 (gnus-topic-enter-dribble))) 401 (gnus-topic-enter-dribble))
402 ;; Conversely, go through the topology and make sure that all
403 ;; topologies have alists.
404 (while topics
405 (unless (assoc (car topics) gnus-topic-alist)
406 (push (list (car topics)) gnus-topic-alist))
407 (pop topics)))
408 ;; Go through all living groups and make sure that
409 ;; they belong to some topic.
399 (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) 410 (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
400 gnus-topic-alist))) 411 gnus-topic-alist)))
401 (entry (assoc (caar gnus-topic-topology) gnus-topic-alist)) 412 (entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
402 (newsrc gnus-newsrc-alist) 413 (newsrc gnus-newsrc-alist)
403 group) 414 group)
404 (while newsrc 415 (while newsrc
405 (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) 416 (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
406 (setcdr entry (cons group (cdr entry))))))) 417 (setcdr entry (cons group (cdr entry))))))
418 ;; Go through all topics and make sure they contain only living groups.
419 (let ((alist gnus-topic-alist)
420 topic)
421 (while (setq topic (pop alist))
422 (while (cdr topic)
423 (if (gnus-gethash (cadr topic) gnus-newsrc-hashtb)
424 (setq topic (cdr topic))
425 (setcdr topic (cddr topic)))))))
407 426
408 (defvar gnus-tmp-topics nil) 427 (defvar gnus-tmp-topics nil)
409 (defun gnus-topic-list (&optional topology) 428 (defun gnus-topic-list (&optional topology)
410 (unless topology 429 (unless topology
411 (setq topology gnus-topic-topology 430 (setq topology gnus-topic-topology
668 (setq gnus-group-change-level-function 'gnus-topic-change-level) 687 (setq gnus-group-change-level-function 'gnus-topic-change-level)
669 (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) 688 (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
670 (make-local-variable 'gnus-group-indentation-function) 689 (make-local-variable 'gnus-group-indentation-function)
671 (setq gnus-group-indentation-function 690 (setq gnus-group-indentation-function
672 'gnus-topic-group-indentation) 691 'gnus-topic-group-indentation)
692 (gnus-make-local-hook 'gnus-check-bogus-groups-hook)
693 (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
673 (setq gnus-topology-checked-p nil) 694 (setq gnus-topology-checked-p nil)
674 ;; We check the topology. 695 ;; We check the topology.
675 (when gnus-newsrc-alist 696 (when gnus-newsrc-alist
676 (gnus-topic-check-topology)) 697 (gnus-topic-check-topology))
677 (run-hooks 'gnus-topic-mode-hook)) 698 (run-hooks 'gnus-topic-mode-hook))
678 ;; Remove topic infestation. 699 ;; Remove topic infestation.
679 (unless gnus-topic-mode 700 (unless gnus-topic-mode
680 (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) 701 (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
681 (remove-hook 'gnus-group-change-level-function 702 (remove-hook 'gnus-group-change-level-function
682 'gnus-topic-change-level) 703 'gnus-topic-change-level)
704 (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
683 (setq gnus-group-prepare-function 'gnus-group-prepare-flat)) 705 (setq gnus-group-prepare-function 'gnus-group-prepare-flat))
684 (when redisplay 706 (when redisplay
685 (gnus-group-list-groups)))) 707 (gnus-group-list-groups))))
686 708
687 (defun gnus-topic-select-group (&optional all) 709 (defun gnus-topic-select-group (&optional all)
688 "Select this newsgroup. 710 "Select this newsgroup.
689 No article is selected automatically. 711 No article is selected automatically.
690 If ALL is non-nil, already read articles become readable. 712 If ALL is non-nil, already read articles become readable.
691 If ALL is a number, fetch this number of articles." 713 If ALL is a number, fetch this number of articles.
714
715 If performed over a topic line, toggle folding the topic."
692 (interactive "P") 716 (interactive "P")
693 (if (gnus-group-topic-p) 717 (if (gnus-group-topic-p)
694 (let ((gnus-group-list-mode 718 (let ((gnus-group-list-mode
695 (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) 719 (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
696 (gnus-topic-fold all)) 720 (gnus-topic-fold all))
706 "Read news in this newsgroup. 730 "Read news in this newsgroup.
707 If the prefix argument ALL is non-nil, already read articles become 731 If the prefix argument ALL is non-nil, already read articles become
708 readable. IF ALL is a number, fetch this number of articles. If the 732 readable. IF ALL is a number, fetch this number of articles. If the
709 optional argument NO-ARTICLE is non-nil, no article will be 733 optional argument NO-ARTICLE is non-nil, no article will be
710 auto-selected upon group entry. If GROUP is non-nil, fetch that 734 auto-selected upon group entry. If GROUP is non-nil, fetch that
711 group." 735 group.
736
737 If performed over a topic line, toggle folding the topic."
712 (interactive "P") 738 (interactive "P")
713 (if (gnus-group-topic-p) 739 (if (gnus-group-topic-p)
714 (let ((gnus-group-list-mode 740 (let ((gnus-group-list-mode
715 (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) 741 (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
716 (gnus-topic-fold all)) 742 (gnus-topic-fold all))
787 (make-string 813 (make-string
788 (* gnus-topic-indent-level 814 (* gnus-topic-indent-level
789 (or (save-excursion 815 (or (save-excursion
790 (gnus-topic-goto-topic (gnus-group-parent-topic)) 816 (gnus-topic-goto-topic (gnus-group-parent-topic))
791 (gnus-group-topic-level)) 0)) ? )) 817 (gnus-group-topic-level)) 0)) ? ))
818
819 (defun gnus-topic-clean-alist ()
820 "Remove bogus groups from the topic alist."
821 (let ((topic-alist gnus-topic-alist)
822 result topic)
823 (unless gnus-killed-hashtb
824 (gnus-make-hashtable-from-killed))
825 (while (setq topic (pop topic-alist))
826 (let ((topic-name (pop topic))
827 group filtered-topic)
828 (while (setq group (pop topic))
829 (if (and (gnus-gethash group gnus-active-hashtb)
830 (not (gnus-gethash group gnus-killed-hashtb)))
831 (push group filtered-topic)))
832 (push (cons topic-name (nreverse filtered-topic)) result)))
833 (setq gnus-topic-alist (nreverse result))))
792 834
793 (defun gnus-topic-change-level (group level oldlevel) 835 (defun gnus-topic-change-level (group level oldlevel)
794 "Run when changing levels to enter/remove groups from topics." 836 "Run when changing levels to enter/remove groups from topics."
795 (save-excursion 837 (save-excursion
796 (set-buffer gnus-group-buffer) 838 (set-buffer gnus-group-buffer)
918 (setq alist nil)) 960 (setq alist nil))
919 (setq alist (cdr alist)))))) 961 (setq alist (cdr alist))))))
920 (gnus-topic-update-topic))) 962 (gnus-topic-update-topic)))
921 963
922 (defun gnus-topic-hide-topic () 964 (defun gnus-topic-hide-topic ()
923 "Hide all subtopics under the current topic." 965 "Hide the current topic."
924 (interactive) 966 (interactive)
925 (when (gnus-group-parent-topic) 967 (when (gnus-group-parent-topic)
926 (gnus-topic-goto-topic (gnus-group-parent-topic)) 968 (gnus-topic-goto-topic (gnus-group-parent-topic))
927 (gnus-topic-remove-topic nil nil 'hidden))) 969 (gnus-topic-remove-topic nil nil 'hidden)))
928 970
1002 (entry (assoc old-name gnus-topic-alist))) 1044 (entry (assoc old-name gnus-topic-alist)))
1003 (when top 1045 (when top
1004 (setcar (cadr top) new-name)) 1046 (setcar (cadr top) new-name))
1005 (when entry 1047 (when entry
1006 (setcar entry new-name)) 1048 (setcar entry new-name))
1049 (forward-line -1)
1007 (gnus-group-list-groups))) 1050 (gnus-group-list-groups)))
1008 1051
1009 (defun gnus-topic-indent (&optional unindent) 1052 (defun gnus-topic-indent (&optional unindent)
1010 "Indent a topic -- make it a sub-topic of the previous topic. 1053 "Indent a topic -- make it a sub-topic of the previous topic.
1011 If UNINDENT, remove an indentation." 1054 If UNINDENT, remove an indentation."