X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-topic.el;h=338afb5d107298fe060b5e4e5d4e26a404cd9e07;hb=5c35cfa4c620de42c00e0f43c478f9c096663d94;hp=215ca755ff4379c6c6938ceb218408a49b77ee59;hpb=52823b7763f961c511d12b0ae72bcad39c5c6acb;p=gnus diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 215ca755f..338afb5d1 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -61,8 +61,9 @@ with some simple extensions. %a Number of unread articles in the groups in the topic. %A Number of unread articles in the groups in the topic and its subtopics. -General format specifiers can also be used. See -(gnus)Formatting Variables." +General format specifiers can also be used. +See Info node `(gnus)Formatting Variables'." + :link '(custom-manual "(gnus)Formatting Variables") :type 'string :group 'gnus-topic) @@ -379,9 +380,17 @@ If RECURSIVE is t, return groups in its subtopics too." "Compute the group parameters for GROUP taking into account inheritance from topics." (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) (save-excursion - (gnus-group-goto-group group) (nconc params-list - (gnus-topic-hierarchical-parameters (gnus-current-topic)))))) + (gnus-topic-hierarchical-parameters + ;; First we try to go to the group within the group + ;; buffer and find the topic for the group that way. + ;; This hopefully copes well with groups that are in + ;; more than one topic. Failing that (i.e. when the + ;; group isn't visible in the group buffer) we find a + ;; topic for the group via gnus-group-topic. + (or (and (gnus-group-goto-group group) + (gnus-current-topic)) + (gnus-group-topic group))))))) (defun gnus-topic-hierarchical-parameters (topic) "Return a topic list computed for TOPIC." @@ -687,7 +696,8 @@ articles in the topic and its subtopics." (unfound t) entry) ;; Try to jump to a visible group. - (while (and g (not (gnus-group-goto-group (car g) t))) + (while (and g + (not (gnus-group-goto-group (car g) t))) (pop g)) ;; It wasn't visible, so we try to see where to insert it. (when (not g) @@ -699,20 +709,31 @@ articles in the topic and its subtopics." (when (and unfound topic (not (gnus-topic-goto-missing-topic topic))) - (let* ((top (gnus-topic-find-topology topic)) - (children (cddr top)) - (type (cadr top)) - (unread 0) - (entries (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode)))) - (while children - (incf unread (gnus-topic-unread (caar (pop children))))) - (while (setq entry (pop entries)) - (when (numberp (car entry)) - (incf unread (car entry)))) - (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil unread)))))) + (gnus-topic-display-missing-topic topic))))) + +(defun gnus-topic-display-missing-topic (topic) + "Insert topic lines recursively for missing topics." + (let ((parent (gnus-topic-find-topology + (gnus-topic-parent-topic topic)))) + (when (and parent + (not (gnus-topic-goto-missing-topic (caadr parent)))) + (gnus-topic-display-missing-topic (caadr parent)))) + (gnus-topic-goto-missing-topic topic) + (let* ((top (gnus-topic-find-topology topic)) + (children (cddr top)) + (type (cadr top)) + (unread 0) + (entries (gnus-topic-find-groups + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode))) + entry) + (while children + (incf unread (gnus-topic-unread (caar (pop children))))) + (while (setq entry (pop entries)) + (when (numberp (car entry)) + (incf unread (car entry)))) + (gnus-topic-insert-topic-line + topic t t (car (gnus-topic-find-topology topic)) nil unread))) (defun gnus-topic-goto-missing-topic (topic) (if (gnus-topic-goto-topic topic) @@ -1078,18 +1099,18 @@ articles in the topic and its subtopics." '("Topics" ["Toggle topics" gnus-topic-mode t] ("Groups" - ["Copy" gnus-topic-copy-group t] - ["Move" gnus-topic-move-group t] + ["Copy..." gnus-topic-copy-group t] + ["Move..." gnus-topic-move-group t] ["Remove" gnus-topic-remove-group t] - ["Copy matching" gnus-topic-copy-matching t] + ["Copy matching..." gnus-topic-copy-matching t] ["Move matching" gnus-topic-move-matching t]) ("Topics" - ["Goto" gnus-topic-jump-to-topic t] + ["Goto..." gnus-topic-jump-to-topic t] ["Show" gnus-topic-show-topic t] ["Hide" gnus-topic-hide-topic t] ["Delete" gnus-topic-delete t] - ["Rename" gnus-topic-rename t] - ["Create" gnus-topic-create-topic t] + ["Rename..." gnus-topic-rename t] + ["Create..." gnus-topic-create-topic t] ["Mark" gnus-topic-mark-topic t] ["Indent" gnus-topic-indent t] ["Sort" gnus-topic-sort-topics t] @@ -1133,7 +1154,7 @@ articles in the topic and its subtopics." (setq gnus-group-change-level-function 'gnus-topic-change-level) (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) (make-local-hook 'gnus-check-bogus-groups-hook) - (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist + (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist nil 'local) (setq gnus-topology-checked-p nil) ;; We check the topology. @@ -1192,10 +1213,13 @@ Also see `gnus-group-catchup'." (if (not topic) (call-interactively 'gnus-group-catchup-current) (save-excursion - (let ((gnus-group-marked + (let* ((groups (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t)))) - (gnus-group-catchup-current))))) + (gnus-topic-find-groups topic gnus-level-killed t))) + (buffer-read-only nil) + (gnus-group-marked groups)) + (gnus-group-catchup-current) + (mapcar 'gnus-topic-update-topics-containing-group groups))))) (defun gnus-topic-read-group (&optional all no-article group) "Read news in this newsgroup. @@ -1253,7 +1277,8 @@ When used interactively, PARENT will be the topic under point." If COPYP, copy the groups instead." (interactive (list current-prefix-arg - (completing-read "Move to topic: " gnus-topic-alist nil t))) + (gnus-completing-read "Move to topic" gnus-topic-alist nil t + 'gnus-topic-history))) (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) (groups (gnus-group-process-prefix n)) @@ -1516,7 +1541,7 @@ If UNINDENT, remove an indentation." (gnus-topic-kill-group) (push (cdar gnus-topic-killed-topics) gnus-topic-alist) (gnus-topic-create-topic - topic parent nil (cdaar gnus-topic-killed-topics)) + topic parent nil (cdar (car gnus-topic-killed-topics))) (pop gnus-topic-killed-topics) (or (gnus-topic-goto-topic topic) (gnus-topic-goto-topic parent)))))) @@ -1535,7 +1560,7 @@ If UNINDENT, remove an indentation." (push (cdar gnus-topic-killed-topics) gnus-topic-alist) (gnus-topic-create-topic topic grandparent (gnus-topic-next-topic parent) - (cdaar gnus-topic-killed-topics)) + (cdar (car gnus-topic-killed-topics))) (pop gnus-topic-killed-topics) (gnus-topic-goto-topic topic)))) @@ -1671,7 +1696,7 @@ If REVERSE, sort in reverse order." top) (defun gnus-topic-sort-topics (&optional topic reverse) - "Sort topics in TOPIC alphabeticaly by topic name. + "Sort topics in TOPIC alphabetically by topic name. If REVERSE, reverse the sorting order." (interactive (list (completing-read "Sort topics in : " gnus-topic-alist nil t