Move or remove the right group.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5fd238a..076d972 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2000-05-17 02:25:11  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-group.el (gnus-group-mark-line-p): New function.
+       (gnus-group-goto-group): New parameter.
+       (gnus-group-remove-mark): Use it.
+       * gnus-topic.el (gnus-topic-move-group): Ditto.
+       (gnus-topic-remove-group): Ditto.
+
 2000-05-17 00:49:09  Shenghuo ZHU  <zsh@cs.rochester.edu>
 
        * gnus-group.el (gnus-group-list-dormant): New function.

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 120c97c..8ab0489 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -1421,6 +1421,12 @@ If FIRST-TOO, the current line is also eligible as a target."
 
 ;; Group marking.
 
+(defun gnus-group-mark-line-p ()
+  (save-excursion
+    (beginning-of-line)
+    (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
+    (eq (char-after) gnus-process-mark)))
+
 (defun gnus-group-mark-group (n &optional unmark no-advance)
   "Mark the current group."
   (interactive "p")
@@ -1487,10 +1493,10 @@ If UNMARK, remove the mark instead."
        (gnus-group-set-mark group))))
   (gnus-group-position-point))
 
-(defun gnus-group-remove-mark (group)
+(defun gnus-group-remove-mark (group &optional test-marked)
   "Remove the process mark from GROUP and move point there.
 Return nil if the group isn't displayed."
-  (if (gnus-group-goto-group group)
+  (if (gnus-group-goto-group group nil test-marked)
       (save-excursion
        (gnus-group-mark-group 1 'unmark t)
        t)
@@ -1569,7 +1575,7 @@ Take into consideration N (the prefix) and the list of marked groups."
     (eval
      `(defun gnus-group-iterate (arg ,function)
        "Iterate FUNCTION over all process/prefixed groups.
-FUNCTION will be called with the group name as the paremeter
+FUNCTION will be called with the group name as the parameter
 and with point over the group in question."
        (let ((,groups (gnus-group-process-prefix arg))
              (,window (selected-window))
@@ -1758,41 +1764,56 @@ Return the name of the group if selection was successful."
   ;; Adjust cursor point.
   (gnus-group-position-point))
 
-(defun gnus-group-goto-group (group &optional far)
+(defun gnus-group-goto-group (group &optional far test-marked)
   "Goto to newsgroup GROUP.
-If FAR, it is likely that the group is not on the current line."
+If FAR, it is likely that the group is not on the current line.
+If TEST-MARKED, the line must be marked."
   (when group
-    (if far
-       (gnus-goto-char
-        (text-property-any
-         (point-min) (point-max)
-         'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
-      (beginning-of-line)
-      (cond
-       ;; It's quite likely that we are on the right line, so
-       ;; we check the current line first.
-       ((eq (get-text-property (point) 'gnus-group)
-           (gnus-intern-safe group gnus-active-hashtb))
-       (point))
-       ;; Previous and next line are also likely, so we check them as well.
-       ((save-excursion
-         (forward-line -1)
-         (eq (get-text-property (point) 'gnus-group)
-             (gnus-intern-safe group gnus-active-hashtb)))
-       (forward-line -1)
-       (point))
-       ((save-excursion
-         (forward-line 1)
-         (eq (get-text-property (point) 'gnus-group)
-             (gnus-intern-safe group gnus-active-hashtb)))
-       (forward-line 1)
-       (point))
-       (t
-       ;; Search through the entire buffer.
-       (gnus-goto-char
-        (text-property-any
-         (point-min) (point-max)
-         'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
+    (beginning-of-line)
+    (cond
+     ;; It's quite likely that we are on the right line, so
+     ;; we check the current line first.
+     ((and (not far)
+          (eq (get-text-property (point) 'gnus-group)
+              (gnus-intern-safe group gnus-active-hashtb))
+          (or (not test-marked) (gnus-group-mark-line-p)))
+      (point))
+     ;; Previous and next line are also likely, so we check them as well.
+     ((and (not far)
+          (save-excursion
+            (forward-line -1)
+            (and (eq (get-text-property (point) 'gnus-group)
+                     (gnus-intern-safe group gnus-active-hashtb))
+                 (or (not test-marked) (gnus-group-mark-line-p)))))
+      (forward-line -1)
+      (point))
+     ((and (not far)
+          (save-excursion
+            (forward-line 1)
+            (and (eq (get-text-property (point) 'gnus-group)
+                     (gnus-intern-safe group gnus-active-hashtb))
+                 (or (not test-marked) (gnus-group-mark-line-p)))))
+      (forward-line 1)
+      (point))
+     (test-marked
+      (goto-char (point-min))
+      (let (found)
+       (while (and (not found) 
+                   (gnus-goto-char
+                    (text-property-any
+                     (point) (point-max)
+                     'gnus-group 
+                     (gnus-intern-safe group gnus-active-hashtb))))
+         (if (gnus-group-mark-line-p)
+             (setq found t)
+           (forward-line 1)))
+       found))
+     (t
+      ;; Search through the entire buffer.
+      (gnus-goto-char
+       (text-property-any
+       (point-min) (point-max)
+       'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
 
 (defun gnus-group-next-group (n &optional silent)
   "Go to next N'th newsgroup.

diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el
index 631251e..f53c7c1 100644 (file)
--- a/lisp/gnus-topic.el
+++ b/lisp/gnus-topic.el
@@ -1130,13 +1130,21 @@ When used interactively, PARENT will be the topic under point."
   (gnus-group-list-groups)
   (gnus-topic-goto-topic topic))
 
+;; FIXME: 
+;;  1. When the marked groups are overlapped with the process 
+;;     region, the behavior of move or remove is not right.
+;;  2. Can't process on several marked groups with a same name, 
+;;     because gnus-group-marked only keeps one copy.
+
 (defun gnus-topic-move-group (n topic &optional copyp)
   "Move the next N groups to TOPIC.
 If COPYP, copy the groups instead."
   (interactive
    (list current-prefix-arg
         (completing-read "Move to topic: " gnus-topic-alist nil t)))
-  (let ((groups (gnus-group-process-prefix n))
+  (let ((use-marked (and (not n) (not (gnus-region-active-p)) 
+                        gnus-group-marked t))
+       (groups (gnus-group-process-prefix n))
        (topicl (assoc topic gnus-topic-alist))
        (start-topic (gnus-group-topic-name))
        (start-group (progn (forward-line 1) (gnus-group-group-name)))
@@ -1145,7 +1153,7 @@ If COPYP, copy the groups instead."
        (gnus-topic-move start-topic topic)
       (mapcar
        (lambda (g)
-        (gnus-group-remove-mark g)
+        (gnus-group-remove-mark g use-marked)
         (when (and
                (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
                (not copyp))
@@ -1158,18 +1166,24 @@ If COPYP, copy the groups instead."
        (gnus-topic-goto-topic start-topic))
       (gnus-group-list-groups))))
 
-(defun gnus-topic-remove-group (&optional arg)
+(defun gnus-topic-remove-group (&optional n)
   "Remove the current group from the topic."
   (interactive "P")
-  (gnus-group-iterate arg
-    (lambda (group)
-      (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
-           (buffer-read-only nil))
-       (when (and topicl group)
-         (gnus-delete-line)
-         (gnus-delete-first group topicl))
-       (gnus-topic-update-topic)
-       (gnus-group-position-point)))))
+  (let ((use-marked (and (not n) (not (gnus-region-active-p)) 
+                        gnus-group-marked t))
+       (groups (gnus-group-process-prefix n)))
+    (mapcar
+     (lambda (group)
+       (gnus-group-remove-mark group use-marked)
+       (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
+            (buffer-read-only nil))
+        (when (and topicl group)
+          (gnus-delete-line)
+          (gnus-delete-first group topicl))
+        (gnus-topic-update-topic)))
+     groups)
+    (gnus-topic-enter-dribble)
+    (gnus-group-position-point)))
 
 (defun gnus-topic-copy-group (n topic)
   "Copy the current group to a topic."