From: murata Date: Sat, 17 Jun 2000 08:01:57 +0000 (+0000) Subject: (wl-thread-delete-msgs): Fixed problem when closed thread is deleted. X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=793043ff97eaa7328d3e53d6fb4b850193cfb33c;p=elisp%2Fwanderlust.git (wl-thread-delete-msgs): Fixed problem when closed thread is deleted. (wl-thread-delete-line-from-buffer): Ditto. (wl-thread-get-exist-children): New function. --- diff --git a/wl/wl-thread.el b/wl/wl-thread.el index e088cb4..9effecb 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -732,26 +732,23 @@ the closed parent will be opened." (let ((i 0) (updates msgs) len) - (while msgs - (setq updates - (append updates - (wl-thread-get-children-msgs (car msgs)))) - (setq msgs (cdr msgs))) - (setq updates (elmo-uniq-list updates)) - (setq len (length updates)) - (while updates - (if (wl-thread-entity-parent-invisible-p (wl-thread-get-entity - (car updates))) - (wl-thread-delete-line-from-buffer (car updates)) - (wl-thread-update-line-on-buffer-sub nil (car updates))) - (setq updates (cdr updates)) - (when (and (not no-msg) - (> len elmo-display-progress-threshold)) - (setq i (1+ i)) - (if (or (zerop (% i 5)) (= i len)) - (elmo-display-progress - 'wl-thread-update-line-msgs "Updating deleted thread..." - (/ (* i 100) len))))))) +;; (while msgs +;; (setq updates +;; (append updates +;; (wl-thread-get-children-msgs (car msgs)))) +;; (setq msgs (cdr msgs))) +;; (setq updates (elmo-uniq-list updates)) + (setq len (length updates)) + (while updates + (wl-thread-update-line-on-buffer-sub nil (car updates)) + (setq updates (cdr updates)) + (when (and (not no-msg) + (> len elmo-display-progress-threshold)) + (setq i (1+ i)) + (if (or (zerop (% i 5)) (= i len)) + (elmo-display-progress + 'wl-thread-update-line-msgs "Updating deleted thread..." + (/ (* i 100) len))))))) (defun wl-thread-delete-line-from-buffer (msg) "Simply delete msg line." @@ -775,12 +772,30 @@ the closed parent will be opened." wl-thread-entity-hashtb)) (setq msgs (cdr msgs))))) +(defun wl-thread-get-exist-children (msg) + (let ((msgs (list msg)) + msgs-stack children + entity ret-val) + (while msgs + (setq children (wl-thread-entity-get-children + (setq entity (wl-thread-get-entity (car msgs))))) + (when (elmo-msgdb-overview-get-entity (car msgs) wl-summary-buffer-msgdb) + (wl-append ret-val (list (car msgs))) + (setq children nil)) + (setq msgs (cdr msgs)) + (if (null children) + (while (and (null msgs) msgs-stack) + (setq msgs (wl-pop msgs-stack))) + (wl-push msgs msgs-stack) + (setq msgs children))) + ret-val)) + (defun wl-thread-delete-message (msg &optional deep update) "Delete MSG from entity and buffer." (save-excursion (let* ((entity (wl-thread-get-entity msg)) - children older-brothers younger-brothers top-child - top-entity parent update-msgs ent beg) + children older-brothers younger-brothers top-child ;;grandchildren + top-entity parent update-msgs beg invisible-top) (when entity (setq parent (wl-thread-entity-get-parent-entity entity)) (if parent @@ -818,7 +833,7 @@ the closed parent will be opened." (not children)) (wl-append update-msgs - (wl-thread-get-children-msgs (car (last older-brothers)) t)))) + (wl-thread-get-children-msgs (car (last older-brothers)))))) ;; top...oldest child becomes top. (unless deep @@ -826,11 +841,11 @@ the closed parent will be opened." (when children (setq top-child (car children) children (cdr children)) - (wl-append update-msgs - (wl-thread-get-children-msgs top-child t)) (setq top-entity (wl-thread-get-entity top-child)) (wl-thread-entity-set-parent top-entity nil) - (wl-thread-entity-set-linked top-entity nil)) + (wl-thread-entity-set-linked top-entity nil) + (wl-append update-msgs + (wl-thread-get-children-msgs top-child t))) (when children (wl-thread-entity-set-children top-entity @@ -865,28 +880,47 @@ the closed parent will be opened." (unless (wl-thread-delete-line-from-buffer msg) ;; jump to suitable point. ;; just upon the oldest younger-brother of my top. - (let ((younger-bros (wl-thread-entity-get-younger-brothers - (wl-thread-entity-get-top-entity entity) - nil))) - (if younger-bros - (wl-summary-jump-to-msg (car younger-bros)) - (goto-char (point-max))))) ; no younger brothers. - ;; insert children if thread is closed. - (when (not (wl-thread-entity-get-opened entity)) - (if top-child + (setq invisible-top + (car (wl-thread-entity-parent-invisible-p entity))) + (if invisible-top (progn - (setq ent (wl-thread-get-entity top-child)) - (if (wl-thread-entity-get-children ent) - (wl-thread-entity-set-opened ent nil)) - (wl-thread-insert-entity 0 ent nil nil)) - (if (not (wl-thread-entity-parent-invisible-p entity)) - (mapcar '(lambda (x) - (setq ent (wl-thread-get-entity x)) - (if (wl-thread-entity-get-children ent) - (wl-thread-entity-set-opened ent nil)) - (wl-thread-insert-entity 0 ; no mean now... - ent entity nil)) - children))))) + (wl-append update-msgs (list invisible-top)) + (wl-summary-jump-to-msg invisible-top)) + (goto-char (point-max)))) + + ;; insert children if thread is closed or delete top. + (when (or top-child + (not (wl-thread-entity-get-opened entity))) + (let* (next-top insert-msgs ent e grandchildren) + (if top-child + (progn + (setq insert-msgs (wl-thread-get-exist-children top-child)) + (setq next-top (car insert-msgs)) + (setq ent (wl-thread-get-entity next-top)) + (when (and + (wl-thread-entity-get-opened entity) ;; open + (not (wl-thread-entity-get-opened ent)) ;; close + (setq grandchildren + (wl-thread-entity-get-children ent)) + (wl-summary-jump-to-msg next-top)) + (forward-line 1) + (setq insert-msgs (append (cdr insert-msgs) grandchildren))) + (when top-entity (wl-thread-entity-set-opened top-entity t)) + (when ent (wl-thread-entity-set-opened ent t))) + (when (not invisible-top) + (setq insert-msgs (wl-thread-get-exist-children msg)) + ;; First msg always opened, because first msg maybe becomes top. + (if (setq ent (wl-thread-get-entity (car insert-msgs))) + (wl-thread-entity-set-opened ent t)))) + ;; insert children + (mapcar + '(lambda (x) + ;; if no exists in summary, insert entity. + (when (and x (not (wl-summary-jump-to-msg x))) + (setq ent (wl-thread-get-entity x)) + (wl-thread-insert-entity 0 ; no mean now... + ent entity nil))) + insert-msgs)))) (if update ;; modify buffer. @@ -895,7 +929,7 @@ the closed parent will be opened." update-msgs) ;; don't update buffer update-msgs)))) ; return value - + (defun wl-thread-insert-message (overview-entity overview mark-alist msg parent-msg &optional update linked) "Insert MSG to the entity.