X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-topic.el;h=292f6c1e5765c4058ab8ef6ac810edc837acb1f0;hp=85cbd2440efeb7ac7eb6ccd52b1937a4db3d6e21;hb=3e2287c43a3bfcad1353b6a2b6fc98b01ebbd6e1;hpb=f34aa4cca7eb80ea0383b0c6958f0593ff249c29 diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 85cbd2440..292f6c1e5 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -1,5 +1,5 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Ilja Weis @@ -61,8 +61,8 @@ 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) @@ -104,16 +104,16 @@ See (gnus)Formatting Variables." (defun gnus-group-topic-name () "The name of the topic on the current line." - (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) + (let ((topic (get-text-property (point-at-bol) 'gnus-topic))) (and topic (symbol-name topic)))) (defun gnus-group-topic-level () "The level of the topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) + (get-text-property (point-at-bol) 'gnus-topic-level)) (defun gnus-group-topic-unread () "The number of unread articles in topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) + (get-text-property (point-at-bol) 'gnus-topic-unread)) (defun gnus-topic-unread (topic) "Return the number of unread articles in TOPIC." @@ -126,7 +126,7 @@ See (gnus)Formatting Variables." (defun gnus-topic-visible-p () "Return non-nil if the current topic is visible." - (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) + (get-text-property (point-at-bol) 'gnus-topic-visible)) (defun gnus-topic-articles-in-topic (entries) (let ((total 0) @@ -380,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." @@ -427,6 +435,8 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (and gnus-group-listed-groups (copy-sequence gnus-group-listed-groups)))) + (gnus-update-format-specifications nil 'topic) + (when (or (not gnus-topic-alist) (not gnus-topology-checked-p)) (gnus-topic-check-topology)) @@ -453,7 +463,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) (gnus-group-prepare-flat-list-dead - (gnus-delete-if (lambda (group) + (gnus-remove-if (lambda (group) (or (gnus-gethash group gnus-newsrc-hashtb) (gnus-gethash group gnus-killed-hashtb))) not-in-list) @@ -688,7 +698,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) @@ -700,20 +711,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) @@ -907,8 +929,8 @@ articles in the topic and its subtopics." ? )) (yanked (list group)) alist talist end) - ;; Then we enter the yanked groups into the topics they belong - ;; to. + ;; Then we enter the yanked groups into the topics + ;; they belong to. (when (setq alist (assoc (save-excursion (forward-line -1) (or @@ -1079,18 +1101,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] - ["Move matching" gnus-topic-move-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] @@ -1114,7 +1136,7 @@ articles in the topic and its subtopics." (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) - (gnus-add-minor-mode 'gnus-topic-mode " Topic" + (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map nil (lambda (&rest junk) (interactive) (gnus-topic-mode nil t))) @@ -1133,8 +1155,8 @@ articles in the topic and its subtopics." 'gnus-group-sort-topic) (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 + (gnus-make-local-hook 'gnus-check-bogus-groups-hook) + (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist nil 'local) (setq gnus-topology-checked-p nil) ;; We check the topology. @@ -1160,6 +1182,8 @@ If ALL is a number, fetch this number of articles. If performed over a topic line, toggle folding the topic." (interactive "P") + (when (and (eobp) (not (gnus-group-group-name))) + (forward-line -1)) (if (gnus-group-topic-p) (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) @@ -1182,7 +1206,8 @@ If performed over a topic line, toggle folding the topic." (gnus-message 5 "Expiring groups in %s..." topic) (let ((gnus-group-marked (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t)))) + (gnus-topic-find-groups topic gnus-level-killed t + nil t)))) (gnus-group-expire-articles nil)) (gnus-message 5 "Expiring groups in %s...done" topic)))) @@ -1193,10 +1218,14 @@ 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 + nil 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. @@ -1254,7 +1283,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)) @@ -1400,9 +1430,9 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (setcar (cdr (cadr topic)) 'visible) (gnus-group-list-groups))))) -(defun gnus-topic-mark-topic (topic &optional unmark recursive) +(defun gnus-topic-mark-topic (topic &optional unmark non-recursive) "Mark all groups in the TOPIC with the process mark. -If RECURSIVE is t, mark its subtopics too." +If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." (interactive (list (gnus-group-topic-name) nil (and current-prefix-arg t))) @@ -1410,20 +1440,20 @@ If RECURSIVE is t, mark its subtopics too." (call-interactively 'gnus-group-mark-group) (save-excursion (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil - recursive))) + (not non-recursive)))) (while groups (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) (gnus-info-group (nth 2 (pop groups))))))))) -(defun gnus-topic-unmark-topic (topic &optional dummy recursive) +(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive) "Remove the process mark from all groups in the TOPIC. -If RECURSIVE is t, unmark its subtopics too." +If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (interactive (list (gnus-group-topic-name) nil (and current-prefix-arg t))) (if (not topic) (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t recursive))) + (gnus-topic-mark-topic topic t non-recursive))) (defun gnus-topic-get-new-news-this-topic (&optional n) "Check for new news in the current topic." @@ -1517,7 +1547,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)))))) @@ -1536,7 +1566,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)))) @@ -1672,7 +1702,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