--- gnus-move.el	08 Sep 2003 17:56:52 +0200	1.6
+++ gnus-move.el	21 Mar 2005 06:19:06 +0100	
@@ -63,7 +63,7 @@
   "Move group INFO from FROM-SERVER to TO-SERVER."
   (let ((group (gnus-info-group info))
 	to-active hashtb type mark marks
-	to-article to-reads to-marks article
+	to-article to-reads
 	act-articles)
     (gnus-message 7 "Translating %s..." group)
     (when (gnus-request-group group nil to-server)
@@ -98,17 +98,31 @@
 			       (gnus-uncompress-range
 				(gnus-active group))
 			       group from-server)))
-	  ;; Make it easier to map marks.
+	  ;; Make it easier to map marks.  Ok, this was basically an
+	  ;; inefficient piece of crapola.  What we do here is to map
+	  ;; article numbers and marks.  Marks are specified as
+	  ;; ranges.  It would be foolish to uncompress the ranges.
+	  ;; What we do instead is sorting the cars of the ranges and
+	  ;; the article numbers in sequence.  Then we work off the
+	  ;; sorted list.  Whenever we encounter a range, it is pushed
+	  ;; onto the active mark stack.  Whenever we encounter an
+	  ;; article, we go through the active mark stack, remove all
+	  ;; entries ending before the article itself, and mark the
+	  ;; article with all remaining marks.
 	  (let ((mark-lists (gnus-info-marks info))
 		ms type m)
 	    (while mark-lists
 	      (setq type (caar mark-lists)
-		    ms (gnus-uncompress-range (cdr (pop mark-lists))))
-	      (while ms
-		(if (setq m (assq (car ms) marks))
-		    (setcdr m (cons type (cdr m)))
-		  (push (list (car ms) type) marks))
-		(pop ms))))
+		    ms (cdr (pop mark-lists)))
+	      ;; ok, ms now is a range or range list.  We want to make
+	      ;; it a list.  gnus-range-normalize will not listify a
+	      ;; single number, so we do this by hand.
+	      (when (integerp (or (cdr-safe ms) ms))
+		(setq ms (list ms)))
+	      (while (setq m (pop ms))
+		(if (consp m)
+		    (push (cons (car m) (cons (cdr m) type)) marks)
+		  (push (cons m (cons m type)) marks)))))
 	  ;; Convert.
 	  (when (eq type 'headers)
 	    (nnvirtual-convert-headers))
@@ -123,40 +137,40 @@
 			 hashtb))
 	      ;; Add this article to the list of read articles.
 	      (push to-article to-reads)
-	      ;; See if there are any marks and then add them.
-	      (when (setq mark (assq (read (current-buffer)) marks))
-		(setq marks (delq mark marks))
-		(setcar mark to-article)
-		(push mark to-marks))
-	      (forward-line 1)))
+	      (push (cons (read (current-buffer)) to-article) marks))
+	    (forward-line 1))
 	  ;; Now we know what the read articles are and what the
-	  ;; article marks are.  We transform the information
-	  ;; into the Gnus info format.
+	  ;; article marks are.  We transform the information into the
+	  ;; Gnus info format.  Everything before the first
+	  ;; correspondence is marked read.
 	  (setq to-reads
-		(gnus-range-add
-		 (gnus-compress-sequence
-		  (and (setq to-reads (delq nil to-reads))
-		       (sort to-reads '<))
-		  t)
-		 (cons 1 (1- (car to-active)))))
+		(gnus-compress-sequence
+		 (sort to-reads '<)
+		 t))
+	  (if (consp (car to-reads))
+	      (setcar (car to-reads) 1)
+	    (setcar to-reads (cons 1 (car to-reads))))
 	  (gnus-info-set-read info to-reads)
 	  ;; Do the marks.  I'm sure y'all understand what's
 	  ;; going on down below, so I won't bother with any
 	  ;; further comments.  <duck>
+	  (setq marks (sort (nreverse marks) #'car-less-than-car))
 	  (let ((mlists gnus-article-mark-lists)
-		lists ms a)
+		lists a ma b)
 	    (while mlists
 	      (push (list (cdr (pop mlists))) lists))
-	    (while (setq ms (pop marks))
-	      (setq article (pop ms))
-	      (while ms
-		(setcdr (setq a (assq (pop ms) lists))
-			(cons article (cdr a)))))
+	    (while (setq mark (pop marks))
+	      (if (consp (cdr mark))
+		  (push (cons (cadr mark) (assq (cddr mark) lists)) a)
+		(while (setq ma (pop a))
+		  (unless (> (car mark) (car ma))
+		    (setcdr (cdr ma) (cons (cdr mark) (cddr ma)))
+		    (push ma b)))
+		(setq a b b nil)))
 	    (setq a lists)
-	    (while a
-	      (setcdr (car a) (gnus-compress-sequence
-			       (and (cdar a) (sort (cdar a) '<))))
-	      (pop a))
+	    (while (setq b (pop a))
+	      (setcdr b (gnus-compress-sequence
+			 (sort (cdr b) '<) t)))
 	    (gnus-info-set-marks info lists t)))))
     (gnus-message 7 "Translating %s...done" group)))