[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-topic.el,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     07/10/28 09:18:40

Index: lisp/gnus/gnus-topic.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/gnus-topic.el,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- lisp/gnus/gnus-topic.el     26 Jul 2007 05:26:59 -0000      1.20
+++ lisp/gnus/gnus-topic.el     28 Oct 2007 09:18:26 -0000      1.21
@@ -105,16 +105,16 @@
 
 (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."
@@ -127,7 +127,7 @@
 
 (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)
@@ -167,9 +167,11 @@
    (list (completing-read "Go to topic: "
                          (mapcar 'list (gnus-topic-list))
                          nil t)))
+  (let ((buffer-read-only nil))
   (dolist (topic (gnus-current-topics topic))
-    (gnus-topic-goto-topic topic)
-    (gnus-topic-fold t))
+      (unless (gnus-topic-goto-topic topic)
+       (gnus-topic-goto-missing-topic topic)
+       (gnus-topic-display-missing-topic topic))))
   (gnus-topic-goto-topic topic))
 
 (defun gnus-current-topic ()
@@ -196,9 +198,7 @@
 
 (defun gnus-group-active-topic-p ()
   "Say whether the current topic comes from the active topics."
-  (save-excursion
-    (beginning-of-line)
-    (get-text-property (point) 'gnus-active)))
+  (get-text-property (point-at-bol) 'gnus-active))
 
 (defun gnus-topic-find-groups (topic &optional level all lowest recursive)
   "Return entries for all visible groups in TOPIC.
@@ -210,7 +210,7 @@
     ;; We go through the newsrc to look for matches.
     (while groups
       (when (setq group (pop groups))
-       (setq entry (gnus-gethash group gnus-newsrc-hashtb)
+       (setq entry (gnus-group-entry group)
              info (nth 2 entry)
              params (gnus-info-params info)
              active (gnus-active group)
@@ -244,13 +244,12 @@
     (when recursive
       (if (eq recursive t)
          (setq recursive (cdr (gnus-topic-find-topology topic))))
-      (mapcar (lambda (topic-topology)
+      (dolist (topic-topology (cdr recursive))
                (setq visible-groups
                      (nconc visible-groups
                             (gnus-topic-find-groups
                              (caar topic-topology)
-                             level all lowest topic-topology))))
-             (cdr recursive)))
+                     level all lowest topic-topology)))))
     visible-groups))
 
 (defun gnus-topic-goto-previous-topic (n)
@@ -351,7 +350,7 @@
     (setq topology gnus-topic-topology
          gnus-tmp-topics nil))
   (push (caar topology) gnus-tmp-topics)
-  (mapcar 'gnus-topic-list (cdr topology))
+  (mapc 'gnus-topic-list (cdr topology))
   gnus-tmp-topics)
 
 ;;; Topic parameter jazz
@@ -378,39 +377,50 @@
      (format "(gnus-topic-set-parameters %S '%S)" topic parameters))))
 
 (defun gnus-group-topic-parameters (group)
-  "Compute the group parameters for GROUP taking into account inheritance from 
topics."
+  "Compute the group parameters for GROUP in topic mode.
+Possibly inherit parameters from topics above GROUP."
   (let ((params-list (copy-sequence (gnus-group-get-parameter group))))
     (save-excursion
-      (nconc params-list
             (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.
+       ;; 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)))))))
+          (gnus-group-topic group))
+       params-list))))
 
-(defun gnus-topic-hierarchical-parameters (topic)
-  "Return a topic list computed for TOPIC."
-  (let ((topics (gnus-current-topics topic))
-       params-list param out params)
-    (while topics
-      (push (gnus-topic-parameters (pop topics)) params-list))
-    ;; We probably have lots of nil elements here, so
-    ;; we remove them.  Probably faster than doing this "properly".
-    (setq params-list (delq nil params-list))
+(defun gnus-topic-hierarchical-parameters (topic &optional group-params-list)
+  "Compute the topic parameters for TOPIC.
+Possibly inherit parameters from topics above TOPIC.
+If optional argument GROUP-PARAMS-LIST is non-nil, use it as the basis for
+inheritance."
+  (let ((params-list
+        ;; We probably have lots of nil elements here, so we remove them.
+        ;; Probably faster than doing this "properly".
+        (delq nil (cons group-params-list
+                        (mapcar 'gnus-topic-parameters
+                                (gnus-current-topics topic)))))
+       param out params)
     ;; Now we have all the parameters, so we go through them
     ;; and do inheritance in the obvious way.
+    (let (posting-style)
     (while (setq params (pop params-list))
       (while (setq param (pop params))
        (when (atom param)
          (setq param (cons param t)))
-       ;; Override any old versions of this param.
-       (gnus-pull (car param) out)
-       (push param out)))
+         (cond ((eq (car param) 'posting-style)
+                (let ((param (cdr param))
+                      elt)
+                  (while (setq elt (pop param))
+                    (unless (assoc (car elt) posting-style)
+                      (push elt posting-style)))))
+               (t
+                (unless (assq (car param) out)
+                  (push param out))))))
+      (and posting-style (push (cons 'posting-style posting-style) out)))
     ;; Return the resulting parameter list.
     out))
 
@@ -465,7 +475,7 @@
          (gnus-make-hashtable-from-killed))
        (gnus-group-prepare-flat-list-dead
         (gnus-remove-if (lambda (group)
-                          (or (gnus-gethash group gnus-newsrc-hashtb)
+                          (or (gnus-group-entry group)
                               (gnus-gethash group gnus-killed-hashtb)))
                         not-in-list)
         gnus-level-killed ?K regexp)))
@@ -727,6 +737,9 @@
               (not (gnus-topic-goto-missing-topic (caadr parent))))
       (gnus-topic-display-missing-topic (caadr parent))))
   (gnus-topic-goto-missing-topic topic)
+  ;; Skip past all groups in the topic we're in.
+  (while (gnus-group-group-name)
+    (forward-line 1))
   (let* ((top (gnus-topic-find-topology topic))
         (children (cddr top))
         (type (cadr top))
@@ -848,8 +861,7 @@
       (pop topics)))
   ;; Go through all living groups and make sure that
   ;; they belong to some topic.
-  (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
-                                        gnus-topic-alist)))
+  (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist)))
         (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
         (newsrc (cdr gnus-newsrc-alist))
         group)
@@ -863,7 +875,7 @@
     (while (setq topic (pop alist))
       (while (cdr topic)
        (if (and (cadr topic)
-                (gnus-gethash (cadr topic) gnus-newsrc-hashtb))
+                (gnus-group-entry (cadr topic)))
            (setq topic (cdr topic))
          (setcdr topic (cddr topic)))))))
 
@@ -893,7 +905,7 @@
       (let ((topic-name (pop topic))
            group filtered-topic)
        (while (setq group (pop topic))
-         (when (and (or (gnus-gethash group gnus-active-hashtb)
+         (when (and (or (gnus-active group)
                         (gnus-info-method (gnus-get-info group)))
                     (not (gnus-gethash group gnus-killed-hashtb)))
            (push group filtered-topic)))
@@ -1142,7 +1154,7 @@
       (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" gnus-topic-mode-map)
+      (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
       (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
       (set (make-local-variable 'gnus-group-prepare-function)
           'gnus-group-prepare-topics)
@@ -1297,15 +1309,13 @@
        entry)
     (if (and (not groups) (not copyp) start-topic)
        (gnus-topic-move start-topic topic)
-      (mapcar
-       (lambda (g)
+      (dolist (g groups)
         (gnus-group-remove-mark g use-marked)
         (when (and
                (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
                (not copyp))
           (setcdr entry (gnus-delete-first g (cdr entry))))
         (nconc topicl (list g)))
-       groups)
       (gnus-topic-enter-dribble)
       (if start-group
          (gnus-group-goto-group start-group)
@@ -1318,7 +1328,7 @@
   (let ((use-marked (and (not n) (not (gnus-region-active-p))
                         gnus-group-marked t))
        (groups (gnus-group-process-prefix n)))
-    (mapcar
+    (mapc
      (lambda (group)
        (gnus-group-remove-mark group use-marked)
        (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
@@ -1735,9 +1745,7 @@
     (if (gnus-topic-find-topology to current-top 0);; Don't care the level
        (error "Can't move `%s' to its sub-level" current))
     (gnus-topic-find-topology current nil nil 'delete)
-    (while (cdr to-top)
-      (setq to-top (cdr to-top)))
-    (setcdr to-top (list current-top))
+    (setcdr (last to-top) (list current-top))
     (gnus-topic-enter-dribble)
     (gnus-group-list-groups)
     (gnus-topic-goto-topic current)))