diff lisp/vm/vm-thread.el @ 54:05472e90ae02 r19-16-pre2

Import from CVS: tag r19-16-pre2
author cvs
date Mon, 13 Aug 2007 08:57:55 +0200
parents c53a95d3c46d
children 131b0175ea99
line wrap: on
line diff
--- a/lisp/vm/vm-thread.el	Mon Aug 13 08:57:25 2007 +0200
+++ b/lisp/vm/vm-thread.el	Mon Aug 13 08:57:55 2007 +0200
@@ -42,13 +42,14 @@
 	;; no need to schedule reindents of reparented messages
 	;; unless there were already messages present.
 	(schedule-reindents message-list)
-	parent parent-sym id id-sym date refs old-parent-sym)
+	m parent parent-sym id id-sym date refs old-parent-sym)
     (while mp
-      (setq parent (vm-th-parent (car mp))
-	    id (vm-su-message-id (car mp))
+      (setq m (car mp)
+	    parent (vm-th-parent m)
+	    id (vm-su-message-id m)
 	    id-sym (intern id vm-thread-obarray)
-	    date (vm-so-sortable-datestring (car mp)))
-      (put id-sym 'messages (cons (car mp) (get id-sym 'messages)))
+	    date (vm-so-sortable-datestring m))
+      (put id-sym 'messages (cons m (get id-sym 'messages)))
       (if (and (null (cdr (get id-sym 'messages)))
 	       schedule-reindents)
 	  (vm-thread-mark-for-summary-update (get id-sym 'children)))
@@ -65,7 +66,7 @@
 			(let ((kids (get old-parent-sym 'children))
 			      (msgs (get id-sym 'messages)))
 			  (while msgs
-			    (setq kids (delq (car msgs) kids)
+			    (setq kids (delq m kids)
 				  msgs (cdr msgs)))
 			  kids ))
 		   (set id-sym parent-sym)
@@ -73,13 +74,13 @@
 		       (vm-thread-mark-for-summary-update
 			(get id-sym 'messages)))))
 	    (put parent-sym 'children
-		 (cons (car mp) (get parent-sym 'children))))
+		 (cons m (get parent-sym 'children))))
 	(if (not (boundp id-sym))
 	    (set id-sym nil)))
       ;; use the references header to set parenting information
       ;; for ancestors of this message.  This does not override
       ;; a parent pointer for a message if it already exists.
-      (if (cdr (setq refs (vm-th-references (car mp))))
+      (if (cdr (setq refs (vm-th-references m)))
 	  (let (parent-sym id-sym msgs)
 	    (setq parent-sym (intern (car refs) vm-thread-obarray)
 		  refs (cdr refs))
@@ -99,17 +100,17 @@
 	  ;; inhibit-quit because we need to make sure the asets
 	  ;; below are an atomic group.
 	  (let* ((inhibit-quit t)
-		 (subject (vm-so-sortable-subject (car mp)))
+		 (subject (vm-so-sortable-subject m))
 		 (subject-sym (intern subject vm-thread-subject-obarray)))
 	    ;; if this subject never seen before create the
 	    ;; information vector.
 	    (if (not (boundp subject-sym))
 		(set subject-sym
-		     (vector id-sym (vm-so-sortable-datestring (car mp))
-			     nil (list (car mp))))
+		     (vector id-sym (vm-so-sortable-datestring m)
+			     nil (list m)))
 	      ;; this subject seen before 
 	      (aset (symbol-value subject-sym) 3
-		    (cons (car mp) (aref (symbol-value subject-sym) 3)))
+		    (cons m (aref (symbol-value subject-sym) 3)))
 	      (if (string< date (aref (symbol-value subject-sym) 1))
 		  (let* ((vect (symbol-value subject-sym))
 			 (i-sym (aref vect 0)))
@@ -139,8 +140,7 @@
 		;; using the parent information.
 		(if (null parent)
 		    (aset (symbol-value subject-sym) 2
-			  (cons (car mp)
-				(aref (symbol-value subject-sym) 2))))))))
+			  (cons m (aref (symbol-value subject-sym) 2))))))))
       (setq mp (cdr mp) n (1+ n))
       (if (zerop (% n modulus))
 	  (message "Building threads... %d" n)))
@@ -148,15 +148,20 @@
 	(message "Building threads... done"))))
 
 (defun vm-thread-mark-for-summary-update (message-list)
-  (while message-list
-    (vm-mark-for-summary-update (car message-list) t)
-    (vm-set-thread-list-of (car message-list) nil)
-    (vm-set-thread-indentation-of (car message-list) nil)
-    (vm-thread-mark-for-summary-update
-     (get (intern (vm-su-message-id (car message-list))
-		  vm-thread-obarray)
-	  'children))
-    (setq message-list (cdr message-list))))
+  (let (m)
+    (while message-list
+      (setq m (car message-list))
+      ;; if thread-list is null then we've already marked this
+      ;; message, or it doesn't need marking.
+      (if (null (vm-thread-list-of m))
+	  nil
+	(vm-mark-for-summary-update m t)
+	(vm-set-thread-list-of m nil)
+	(vm-set-thread-indentation-of m nil)
+	(vm-thread-mark-for-summary-update
+	 (get (intern (vm-su-message-id m) vm-thread-obarray)
+	      'children)))
+      (setq message-list (cdr message-list)))))
 
 (defun vm-thread-list (message)
   (let ((done nil)
@@ -207,27 +212,28 @@
 (defun vm-unthread-message (message &optional message-changing)
   (save-excursion
     (let ((mp (cons message (vm-virtual-messages-of message)))
-	  id-sym subject-sym vect p-sym)
+	  m id-sym subject-sym vect p-sym)
       (while mp
+	(setq m (car mp))
 	(let ((inhibit-quit t))
-	  (vm-set-thread-list-of (car mp) nil)
-	  (vm-set-thread-indentation-of (car mp) nil)
-	  (set-buffer (vm-buffer-of (car mp)))
-	  (setq id-sym (intern (vm-su-message-id (car mp)) vm-thread-obarray)
-		subject-sym (intern (vm-so-sortable-subject (car mp))
+	  (vm-set-thread-list-of m nil)
+	  (vm-set-thread-indentation-of m nil)
+	  (set-buffer (vm-buffer-of m))
+	  (setq id-sym (intern (vm-su-message-id m) vm-thread-obarray)
+		subject-sym (intern (vm-so-sortable-subject m)
 				    vm-thread-subject-obarray))
 	  (if (boundp id-sym)
 	      (progn
-		(put id-sym 'messages (delq (car mp) (get id-sym 'messages)))
+		(put id-sym 'messages (delq m (get id-sym 'messages)))
 		(vm-thread-mark-for-summary-update (get id-sym 'children))
 		(setq p-sym (symbol-value id-sym))
 		(and p-sym (put p-sym 'children
-				(delq (car mp) (get p-sym 'children))))
+				(delq m (get p-sym 'children))))
 		(if message-changing
 		    (set id-sym nil))))
 	  (if (and (boundp subject-sym) (setq vect (symbol-value subject-sym)))
 	      (if (not (eq id-sym (aref vect 0)))
-		  (aset vect 2 (delq (car mp) (aref vect 2)))
+		  (aset vect 2 (delq m (aref vect 2)))
 		(if message-changing
 		    (if (null (cdr (aref vect 3)))
 			(makunbound subject-sym)
@@ -239,7 +245,7 @@
 			(while p
 			  (if (and (string-lessp (vm-so-sortable-datestring (car p))
 						 oldest-date)
-				   (not (eq (car mp) (car p))))
+				   (not (eq m (car p))))
 			      (setq oldest-msg (car p)
 				    oldest-date (vm-so-sortable-datestring (car p))))
 			  (setq p (cdr p)))
@@ -248,7 +254,7 @@
 			(aset vect 1 oldest-date)
 			(setq children (delq oldest-msg (aref vect 2)))
 			(aset vect 2 children)
-			(aset vect 3 (delq (car mp) (aref vect 3)))
+			(aset vect 3 (delq m (aref vect 3)))
 			;; I'm not sure there aren't situations
 			;; where this might loop forever.
 			(let ((inhibit-quit nil))