Mercurial > hg > xemacs-beta
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))