X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-thread.el;h=5ac6e9d8398171be663ca7fe88c76ff3a11d3994;hb=0dcb53ebdc57513ab012f9ee6c8e8d5e20bad437;hp=386581ea5636cf1c2f0a5a838f91bf02e92595c1;hpb=4cbe786da1ca7523eab32913e22168b431943452;p=elisp%2Fwanderlust.git diff --git a/wl/wl-thread.el b/wl/wl-thread.el index 386581e..5ac6e9d 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -100,7 +100,7 @@ msgs-stack children) (while msgs (setq wl-summary-buffer-number-list (cons (car entity) - wl-summary-buffer-number-list)) + wl-summary-buffer-number-list)) (setq msgs (cdr msgs)) (setq children (wl-thread-entity-get-children entity)) (if children @@ -119,30 +119,22 @@ (defun wl-thread-save-top-list (dir) (let ((top-file (expand-file-name wl-thread-entity-list-file dir)) (entity wl-thread-entity-list) - (tmp-buffer (get-buffer-create " *wl-thread-save-top-list*")) print-length) - (save-excursion - (set-buffer tmp-buffer) - (erase-buffer) + (with-temp-buffer (when (file-writable-p top-file) - (prin1 entity tmp-buffer) - (princ "\n" tmp-buffer) - (write-region (point-min) (point-max) top-file nil 'no-msg) - (kill-buffer tmp-buffer))))) + (prin1 entity (current-buffer)) + (princ "\n" (current-buffer)) + (write-region (point-min) (point-max) top-file nil 'no-msg))))) (defun wl-thread-save-entities (dir) (let ((top-file (expand-file-name wl-thread-entity-file dir)) (entities wl-thread-entities) - (tmp-buffer (get-buffer-create " *wl-thread-save-entities*")) print-length print-level) - (save-excursion - (set-buffer tmp-buffer) - (erase-buffer) + (with-temp-buffer (when (file-writable-p top-file) - (prin1 entities tmp-buffer) - (princ "\n" tmp-buffer) - (write-region (point-min) (point-max) top-file nil 'no-msg) - (kill-buffer tmp-buffer))))) + (prin1 entities (current-buffer)) + (princ "\n" (current-buffer)) + (write-region (point-min) (point-max) top-file nil 'no-msg))))) (defsubst wl-thread-entity-get-number (entity) (nth 0 entity)) @@ -206,8 +198,7 @@ (nth (- (length curc) 1) curc)))) (wl-thread-entity-get-number curp))) - (setcar (cddr to) (wl-append children - (list (car entity)))) + (wl-thread-entity-set-children to (wl-append children (list (car entity)))) (setq wl-thread-entities (cons entity wl-thread-entities)) (elmo-set-hash-val (format "#%d" (car entity)) entity wl-thread-entity-hashtb))) @@ -231,7 +222,7 @@ (setq entity (wl-thread-get-entity (car msgs)))) ret-val)) -(defsubst wl-thread-entity-get-descendant (entity) +(defun wl-thread-entity-get-descendant (entity) (let (children ret-val msgs-stack (msgs (list (car entity)))) @@ -241,7 +232,7 @@ (if (null children) (while (and (null msgs) msgs-stack) (setq msgs (wl-pop msgs-stack))) - (setq ret-val (append ret-val (copy-sequence children))) + (setq ret-val (nconc ret-val (copy-sequence children))) (wl-push msgs msgs-stack) (setq msgs children)) (setq entity (wl-thread-get-entity (car msgs)))) @@ -277,12 +268,11 @@ ENTITY is returned." (car (last brothers))))) (defun wl-thread-entity-get-older-brothers (entity &optional parent) - (let* ((parent (or parent - (wl-thread-entity-get-parent-entity entity))) - (brothers (wl-thread-entity-get-children parent)) - ret-val) + (let ((parent (or parent + (wl-thread-entity-get-parent-entity entity))) + brothers ret-val) (if parent - brothers + (setq brothers (wl-thread-entity-get-children parent)) (setq brothers wl-thread-entity-list)) (while (and brothers (not (eq (wl-thread-entity-get-number entity) @@ -302,6 +292,7 @@ ENTITY is returned." (cdr (memq (car entity) wl-thread-entity-list))))) (defun wl-thread-jump-to-msg (&optional number) + "Jump to the message with specified number in the current summary." (interactive) (let ((num (or number (string-to-int @@ -312,62 +303,39 @@ ENTITY is returned." (defun wl-thread-close-all () "Close all top threads." (interactive) - (message "Closing all threads...") - (save-excursion - (let ((entities wl-thread-entity-list) - (cur 0) - (len (length wl-thread-entity-list))) - (while entities + (elmo-with-progress-display + (wl-thread-close-all (length wl-thread-entity-list)) + "Closing all threads" + (save-excursion + (dolist (entity wl-thread-entity-list) (when (and (wl-thread-entity-get-opened (wl-thread-get-entity - (car entities))) + entity)) (wl-thread-entity-get-children (wl-thread-get-entity - (car entities)))) - (wl-summary-jump-to-msg (car entities)) + entity))) + (wl-summary-jump-to-msg entity) (wl-thread-open-close)) - (when (> len elmo-display-progress-threshold) - (setq cur (1+ cur)) - (if (or (zerop (% cur 5)) (= cur len)) - (elmo-display-progress - 'wl-thread-close-all "Closing all threads..." - (/ (* cur 100) len)))) - (setq entities (cdr entities))))) - (message "Closing all threads...done")) + (elmo-progress-notify 'wl-thread-close-all))))) (defun wl-thread-open-all () "Open all threads." (interactive) - (message "Opening all threads...") - (save-excursion - (goto-char (point-min)) - (let ((len (count-lines (point-min) (point-max))) - (cur 0) - entity) + (elmo-with-progress-display + (wl-thread-open-all (count-lines (point-min) (point-max))) + "Opening all threads" + (save-excursion + (goto-char (point-min)) (while (not (eobp)) (if (wl-thread-entity-get-opened - (setq entity (wl-thread-get-entity - (wl-summary-message-number)))) + (wl-thread-get-entity (wl-summary-message-number))) (forward-line 1) (wl-thread-force-open) (wl-thread-goto-bottom-of-sub-thread)) - (when (> len elmo-display-progress-threshold) - (setq cur (1+ cur)) - (elmo-display-progress - 'wl-thread-open-all "Opening all threads..." - (/ (* cur 100) len))))) - ;; Make sure to be 100%. - (elmo-display-progress - 'wl-thread-open-all "Opening all threads..." - 100)) - (message "Opening all threads...done")) + (elmo-progress-notify 'wl-thread-open-all))))) (defun wl-thread-open-all-unread () (interactive) - (dolist (number (elmo-folder-list-messages-mark-match - wl-summary-buffer-elmo-folder - (wl-regexp-opt (list wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark - wl-summary-new-mark - wl-summary-important-mark)))) + (dolist (number (elmo-folder-list-flagged wl-summary-buffer-elmo-folder + 'digest 'in-msgdb)) (wl-thread-entity-force-open (wl-thread-get-entity number)))) (defsubst wl-thread-maybe-get-children-num (msg) @@ -378,49 +346,41 @@ ENTITY is returned." (defsubst wl-thread-update-line-on-buffer-sub (entity msg &optional parent-msg) (let* ((entity (or entity (wl-thread-get-entity msg))) (parent-msg (or parent-msg (wl-thread-entity-get-parent entity))) - (overview (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))) (buffer-read-only nil) (inhibit-read-only t) - overview-entity temp-mark summary-line invisible-top dest-pair) + message-entity temp-mark summary-line invisible-top) (if (wl-thread-delete-line-from-buffer msg) (progn (cond - ((memq msg wl-summary-buffer-delete-list) - (setq temp-mark "D")) ((memq msg wl-summary-buffer-target-mark-list) (setq temp-mark "*")) - ((setq dest-pair (assq msg wl-summary-buffer-refile-list)) - (setq temp-mark "o")) - ((setq dest-pair (assq msg wl-summary-buffer-copy-list)) - (setq temp-mark "O")) + ((setq temp-mark (wl-summary-registered-temp-mark msg)) + (setq temp-mark (nth 1 temp-mark))) (t (setq temp-mark (wl-summary-get-score-mark msg)))) - (when (setq overview-entity - (elmo-msgdb-overview-get-entity - msg (wl-summary-buffer-msgdb))) - (wl-summary-insert-line + (when (setq message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + msg)) + (wl-summary-insert-line (wl-summary-create-line - overview-entity - (elmo-msgdb-overview-get-entity - parent-msg (wl-summary-buffer-msgdb)) + message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + parent-msg) temp-mark - (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg) + (elmo-message-status wl-summary-buffer-elmo-folder msg) (if wl-thread-insert-force-opened nil (wl-thread-maybe-get-children-num msg)) (wl-thread-make-indent-string entity) - (wl-thread-entity-get-linked entity))) - (if dest-pair - (wl-summary-print-destination (car dest-pair) - (cdr dest-pair))))) + (wl-thread-entity-get-linked entity))))) ;; insert thread (moving thread) (if (not (setq invisible-top (wl-thread-entity-parent-invisible-p entity))) (wl-summary-update-thread - (elmo-msgdb-overview-get-entity msg (wl-summary-buffer-msgdb)) + (elmo-message-entity wl-summary-buffer-elmo-folder msg) entity (and parent-msg - (elmo-msgdb-overview-get-entity - parent-msg (wl-summary-buffer-msgdb)))) + (elmo-message-entity wl-summary-buffer-elmo-folder + parent-msg))) ;; currently invisible.. update closed line. (wl-thread-update-children-number invisible-top))))) @@ -451,28 +411,11 @@ ENTITY is returned." (wl-thread-get-entity (car msgs))))))))) updates)) -(defun wl-thread-update-line-msgs (msgs &optional no-msg) +(defun wl-thread-update-line-msgs (msgs) (wl-delete-all-overlays) - (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 - (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))))))) + (dolist (message msgs) + (wl-thread-update-line-on-buffer-sub nil message) + (elmo-progress-notify 'wl-thread-update-line))) (defun wl-thread-delete-line-from-buffer (msg) "Simply delete msg line." @@ -503,8 +446,7 @@ ENTITY is returned." (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)) + (when (elmo-message-entity wl-summary-buffer-elmo-folder (car msgs)) (wl-append ret-val (list (car msgs))) (setq children nil)) (setq msgs (cdr msgs)) @@ -519,80 +461,80 @@ ENTITY is returned." (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 ;;grandchildren - top-entity parent update-msgs beg invisible-top) + (let ((entity (wl-thread-get-entity msg)) + top-child top-entity update-msgs invisible-top) + (setq wl-summary-buffer-number-list + (delq msg wl-summary-buffer-number-list)) (when entity - (setq parent (wl-thread-entity-get-parent-entity entity)) - (if parent - (progn -;;; has parent. -;;; (setq brothers (wl-thread-entity-get-children parent)) - (setq older-brothers (wl-thread-entity-get-older-brothers - entity parent)) - (setq younger-brothers (wl-thread-entity-get-younger-brothers - entity parent)) - ;; - (unless deep - (setq children (wl-thread-entity-get-children entity)) - (wl-thread-reparent-children - children (wl-thread-entity-get-number parent)) - (setq update-msgs - (apply (function nconc) - update-msgs - (mapcar - (function - (lambda (message) - (wl-thread-get-children-msgs message t))) - children)))) - (wl-thread-entity-set-children - parent (append older-brothers children younger-brothers)) - ;; If chidren and younger-brothers not exists, - ;; update nearly older brother. - (when (and older-brothers - (not younger-brothers) - (not children)) - (wl-append - update-msgs - (wl-thread-get-children-msgs (car (last older-brothers)))))) - - ;; top...oldest child becomes top. - (unless deep - (setq children (wl-thread-entity-get-children entity)) - (when children - (setq top-child (car children) - children (cdr children)) - (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-append update-msgs - (wl-thread-get-children-msgs top-child t))) - (when children - (wl-thread-entity-set-children - top-entity - (append - (wl-thread-entity-get-children top-entity) - children)) - (wl-thread-reparent-children children top-child) - (wl-append update-msgs children))) - ;; delete myself from top list. + (when deep (setq wl-summary-buffer-number-list - (delq msg wl-summary-buffer-number-list)) - (setq older-brothers (wl-thread-entity-get-older-brothers - entity nil)) - (setq younger-brothers (wl-thread-entity-get-younger-brothers - entity nil)) - (setq wl-thread-entity-list - (append (append older-brothers - (and top-child (list top-child))) - younger-brothers)))) - + (elmo-list-delete + (wl-thread-entity-get-descendant entity) + wl-summary-buffer-number-list + #'delq))) + (let ((parent (wl-thread-entity-get-parent-entity entity))) + (if parent + ;; has parent. + (let (children + (older-brothers (wl-thread-entity-get-older-brothers + entity parent)) + (younger-brothers (wl-thread-entity-get-younger-brothers + entity parent))) + (unless deep + (setq children (wl-thread-entity-get-children entity)) + (wl-thread-reparent-children + children (wl-thread-entity-get-number parent)) + (setq update-msgs + (apply (function nconc) + update-msgs + (mapcar + (function + (lambda (message) + (wl-thread-get-children-msgs message t))) + children)))) + (wl-thread-entity-set-children + parent (append older-brothers children younger-brothers)) + ;; If chidren and younger-brothers do not exist, + ;; update nearly older brother. + (when (and older-brothers + (not younger-brothers) + (not children)) + (wl-append + update-msgs + (wl-thread-get-children-msgs (car (last older-brothers)))))) + ;; top...oldest child becomes top. + (unless deep + (let ((children (wl-thread-entity-get-children entity))) + (when children + (setq top-child (car children) + children (cdr children)) + (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-append update-msgs + (wl-thread-get-children-msgs top-child t))) + (when children + (wl-thread-entity-set-children + top-entity + (append + (wl-thread-entity-get-children top-entity) + children)) + (wl-thread-reparent-children children top-child) + (wl-append update-msgs children)))) + ;; delete myself from top list. + (let ((match (memq msg wl-thread-entity-list))) + (when match + (if top-child + (setcar match top-child) + (setq wl-thread-entity-list + (delq msg wl-thread-entity-list)))))))) + ;; (if deep ;; delete thread on buffer (when (wl-summary-jump-to-msg msg) - (setq beg (point)) - (wl-thread-goto-bottom-of-sub-thread) - (delete-region beg (point))) + (let ((beg (point))) + (wl-thread-goto-bottom-of-sub-thread) + (delete-region beg (point)))) ;; delete myself from buffer. (unless (wl-thread-delete-line-from-buffer msg) ;; jump to suitable point. @@ -608,7 +550,7 @@ ENTITY is returned." ;; 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) + (let (next-top insert-msgs ent grandchildren) (if top-child (progn (setq insert-msgs (wl-thread-get-exist-children @@ -646,31 +588,33 @@ ENTITY is returned." ;; don't update buffer update-msgs)))) ; return value -(defun wl-thread-insert-message (overview-entity +(defun wl-thread-insert-message (message-entity msg parent-msg &optional update linked) "Insert MSG to the entity. When optional argument UPDATE is non-nil, Message is inserted to the summary buffer." (let ((parent (wl-thread-get-entity parent-msg)) - (depth 0) cur child-entity invisible-top) ;;; Update the thread view...not implemented yet. ;;; (when force-insert ;;; (if parent ;;; (wl-thread-entity-force-open parent)) (when (and wl-summary-max-thread-depth parent) - (setq cur parent) - (while cur - (incf depth) - (setq cur (wl-thread-entity-get-parent-entity cur))) - (when (> depth wl-summary-max-thread-depth) - (setq parent nil))) + (let ((cur parent) + (depth 0)) + (while cur + (incf depth) + (setq cur (wl-thread-entity-get-parent-entity cur))) + (when (> depth wl-summary-max-thread-depth) + (setq parent nil + parent-msg nil)))) (if parent ;; insert as children. (wl-thread-entity-insert-as-children parent - (setq child-entity (wl-thread-create-entity - msg (nth 0 parent) nil linked))) + (setq child-entity + (wl-thread-create-entity + msg (wl-thread-entity-get-number parent) nil linked))) ;; insert as top message. (wl-thread-entity-insert-as-top (wl-thread-create-entity msg nil))) @@ -680,10 +624,10 @@ Message is inserted to the summary buffer." ;; visible. (progn (wl-summary-update-thread - overview-entity + message-entity child-entity - (elmo-msgdb-overview-get-entity - parent-msg (wl-summary-buffer-msgdb))) + (elmo-message-entity wl-summary-buffer-elmo-folder + parent-msg)) (when parent ;; use thread structure. ;;(wl-thread-entity-get-nearly-older-brother @@ -696,29 +640,46 @@ Message is inserted to the summary buffer." (wl-thread-update-children-number invisible-top) nil)))) +;(defun wl-thread-get-parent-list (msgs) +; ;; return ancestors +; (let* ((msgs2 msgs) +; myself) +; (while msgs2 +; (setq myself (car msgs2) +; msgs2 (cdr msgs2)) +; (while (not (eq myself (car msgs2))) +; (if (wl-thread-descendant-p myself (car msgs2)) +; (setq msgs (delq (car msgs2) msgs))) +; (setq msgs2 (or (cdr msgs2) msgs))) +; (setq msgs2 (cdr msgs2))) +; msgs)) + (defun wl-thread-get-parent-list (msgs) - (let* ((msgs2 msgs) - myself) - (while msgs2 - (setq myself (car msgs2) - msgs2 (cdr msgs2)) - (while (not (eq myself (car msgs2))) - (if (wl-thread-descendant-p myself (car msgs2)) - (setq msgs (delq (car msgs2) msgs))) - (setq msgs2 (or (cdr msgs2) msgs))) - (setq msgs2 (cdr msgs2))) - msgs)) + ;; return connected ancestors + (let ((ptr msgs) + parent ret) + (while (car ptr) + (setq parent (wl-thread-entity-get-parent (wl-thread-get-entity (car ptr)))) + (when (or (not parent) + (not (memq parent msgs))) + (setq ret (append ret (list (car ptr))))) + (setq ptr (cdr ptr))) + ret)) (defun wl-thread-update-indent-string-thread (top-list) (let ((top-list (wl-thread-get-parent-list top-list)) beg) - (while top-list - (when (car top-list) - (wl-summary-jump-to-msg (car top-list)) - (setq beg (point)) - (wl-thread-goto-bottom-of-sub-thread) - (wl-thread-update-indent-string-region beg (point))) - (setq top-list (cdr top-list))))) + (elmo-with-progress-display + (wl-thread-update-indent-string-thread (length top-list)) + "Updating thread indent" + (while top-list + (when (car top-list) + (wl-summary-jump-to-msg (car top-list)) + (setq beg (point)) + (wl-thread-goto-bottom-of-sub-thread) + (wl-thread-update-indent-string-region beg (point))) + (elmo-progress-notify 'wl-thread-update-indent-string-thread) + (setq top-list (cdr top-list)))))) (defun wl-thread-update-children-number (entity) "Update the children number." @@ -740,18 +701,6 @@ Message is inserted to the summary buffer." (interactive "P") (wl-thread-call-region-func 'wl-summary-prefetch-region arg)) -(defun wl-thread-msg-mark-as-important (msg) - "Set mark as important for invisible MSG. Modeline is not changed." - (let ((msgdb (wl-summary-buffer-msgdb)) - cur-mark) - (setq cur-mark (elmo-msgdb-get-mark msgdb msg)) - (elmo-msgdb-set-mark msgdb - msg - (if (string= cur-mark wl-summary-important-mark) - nil - wl-summary-important-mark)) - (wl-summary-set-mark-modified))) - (defun wl-thread-mark-as-read (&optional arg) (interactive "P") (wl-thread-call-region-func 'wl-summary-mark-as-read-region arg)) @@ -764,36 +713,18 @@ Message is inserted to the summary buffer." (interactive "P") (wl-thread-call-region-func 'wl-summary-mark-as-important-region arg)) -(defun wl-thread-copy (&optional arg) +(defun wl-thread-set-flags (&optional arg) (interactive "P") - (wl-thread-call-region-func 'wl-summary-copy-region arg)) + (wl-thread-call-region-func 'wl-summary-set-flags-region arg)) -(defun wl-thread-refile (&optional arg) +(defun wl-thread-mark-as-answered (&optional arg) (interactive "P") - (condition-case err - (progn - (wl-thread-call-region-func 'wl-summary-refile-region arg) - (if arg - (wl-summary-goto-top-of-current-thread)) - (wl-thread-goto-bottom-of-sub-thread)) - (error - (elmo-display-error err t) - nil))) - -(defun wl-thread-delete (&optional arg) - (interactive "P") - (wl-thread-call-region-func 'wl-summary-delete-region arg) - (if arg - (wl-summary-goto-top-of-current-thread)) - (if (not wl-summary-move-direction-downward) - (wl-summary-prev) - (wl-thread-goto-bottom-of-sub-thread) - (if wl-summary-buffer-disp-msg - (wl-summary-redisplay)))) + (wl-thread-call-region-func 'wl-summary-mark-as-answered-region arg)) -(defun wl-thread-target-mark (&optional arg) +(defun wl-thread-recover-messages (&optional arg) + "Recover killed messages which are contained current thread." (interactive "P") - (wl-thread-call-region-func 'wl-summary-target-mark-region arg)) + (wl-thread-call-region-func 'wl-summary-recover-messages-region arg)) (defun wl-thread-unmark (&optional arg) (interactive "P") @@ -809,10 +740,9 @@ Message is inserted to the summary buffer." (defun wl-thread-force-open (&optional msg-num) "force open current folder" - (if msg-num - (wl-summary-jump-to-msg msg-num)) - (let ((wl-thread-insert-force-opened t)) - (wl-thread-open-close))) + (when msg-num + (wl-summary-jump-to-msg msg-num)) + (wl-thread-open-close 'force-open)) (defun wl-thread-entity-force-open (entity) (let ((wl-thread-insert-force-opened t) @@ -827,52 +757,45 @@ Message is inserted to the summary buffer." (defun wl-thread-insert-top () (let ((elist wl-thread-entity-list) - (len (length wl-thread-entity-list)) - (cur 0)) - (wl-delete-all-overlays) - (while elist - (wl-thread-insert-entity - 0 - (wl-thread-get-entity (car elist)) - nil - len) - (setq elist (cdr elist)) - (when (> len elmo-display-progress-threshold) - (setq cur (1+ cur)) - (if (or (zerop (% cur 2)) (= cur len)) - (elmo-display-progress - 'wl-thread-insert-top "Inserting thread..." - (/ (* cur 100) len))))))) + (len (length wl-thread-entity-list))) + (elmo-with-progress-display + (wl-thread-insert-entity (length wl-thread-entity-list)) + "Inserting message" + (wl-delete-all-overlays) + (while elist + (wl-thread-insert-entity + 0 + (wl-thread-get-entity (car elist)) + nil + len) + (elmo-progress-notify 'wl-thread-insert-entity) + (setq elist (cdr elist)))))) (defsubst wl-thread-insert-entity-sub (indent entity parent-entity all) (let (msg-num - overview-entity + message-entity temp-mark summary-line) (when (setq msg-num (wl-thread-entity-get-number entity)) (unless all ; all...means no temp-mark. - (cond ((memq msg-num wl-summary-buffer-delete-list) - (setq temp-mark "D")) - ((memq msg-num wl-summary-buffer-target-mark-list) + (cond ((memq msg-num wl-summary-buffer-target-mark-list) (setq temp-mark "*")) - ((assq msg-num wl-summary-buffer-refile-list) - (setq temp-mark "o")) - ((assq msg-num wl-summary-buffer-copy-list) - (setq temp-mark "O")))) + ((setq temp-mark (wl-summary-registered-temp-mark msg-num)) + (setq temp-mark (nth 1 temp-mark))))) (unless temp-mark (setq temp-mark (wl-summary-get-score-mark msg-num))) - (setq overview-entity - (elmo-msgdb-overview-get-entity - (nth 0 entity) (wl-summary-buffer-msgdb))) + (setq message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + msg-num)) ;;; (wl-delete-all-overlays) - (when overview-entity + (when message-entity (wl-summary-insert-line (wl-summary-create-line - overview-entity - (elmo-msgdb-overview-get-entity - (nth 0 parent-entity) (wl-summary-buffer-msgdb)) + message-entity + (elmo-message-entity wl-summary-buffer-elmo-folder + (wl-thread-entity-get-number parent-entity)) temp-mark - (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg-num) + (elmo-message-status wl-summary-buffer-elmo-folder msg-num) (if wl-thread-insert-force-opened nil (wl-thread-maybe-get-children-num msg-num)) @@ -886,7 +809,7 @@ Message is inserted to the summary buffer." (while msgs (wl-thread-insert-entity-sub indent entity parent-entity all) (setq msgs (cdr msgs)) - (setq children (nth 2 entity)) + (setq children (wl-thread-entity-get-children entity)) (if children ;; insert children (when (or wl-thread-insert-force-opened @@ -936,30 +859,29 @@ Message is inserted to the summary buffer." (forward-line 1)) (beginning-of-line))) -(defun wl-thread-remove-destination-region (beg end) +(defun wl-thread-remove-argument-region (beg end) (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (while (not (eobp)) - (let ((num (wl-summary-message-number))) - (if (assq num wl-summary-buffer-refile-list) - (wl-summary-remove-destination))) + (wl-summary-remove-argument) (forward-line 1))))) -(defun wl-thread-print-destination-region (beg end) - (if (or wl-summary-buffer-refile-list - wl-summary-buffer-copy-list) +(defun wl-thread-print-argument-region (beg end) + (if wl-summary-buffer-temp-mark-list (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (while (not (eobp)) (let ((num (wl-summary-message-number)) - pair) - (if (or (setq pair (assq num wl-summary-buffer-refile-list)) - (setq pair (assq num wl-summary-buffer-copy-list))) - (wl-summary-print-destination (car pair) (cdr pair)))) + temp-mark pair) + (when (and (setq temp-mark + (wl-summary-registered-temp-mark num)) + (nth 2 temp-mark) + (setq pair (cons (nth 0 temp-mark)(nth 2 temp-mark)))) + (wl-summary-print-argument (car pair) (cdr pair)))) (forward-line 1)))))) (defsubst wl-thread-get-children-msgs (msg &optional visible-only) @@ -983,14 +905,12 @@ Message is inserted to the summary buffer." (defun wl-thread-get-children-msgs-uncached (msg &optional uncached-marks) (let ((children-msgs (wl-thread-get-children-msgs msg)) - (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) - mark - uncached-list) + mark uncached-list) (while children-msgs (if (and (not (eq msg (car children-msgs))) ; except itself (or (and uncached-marks - (setq mark (elmo-msgdb-get-mark - (wl-summary-buffer-msgdb) + (setq mark (wl-summary-message-mark + wl-summary-buffer-elmo-folder (car children-msgs))) (member mark uncached-marks)) (and (not uncached-marks) @@ -1027,17 +947,27 @@ Message is inserted to the summary buffer." (beginning-of-line) (setq beg (point)) (wl-thread-goto-bottom-of-sub-thread) - (wl-thread-remove-destination-region beg - (point)) + (wl-thread-remove-argument-region beg + (point)) (forward-char -1) ;; needed for mouse-face. (delete-region beg (point)) (wl-thread-insert-entity (- depth 1) entity (wl-thread-get-entity - (nth 3 entity)) + (wl-thread-entity-get-parent entity)) nil) (delete-char 1) ; delete '\n' - (wl-thread-print-destination-region beg (point)))) + (wl-thread-print-argument-region beg (point)))) + +(defun wl-thread-close-children (&optional number) + (interactive) + (when (eq wl-summary-buffer-view 'thread) + (setq number (or number (wl-summary-message-number))) + (save-excursion + (let ((inhibit-read-only t) + (entity (wl-thread-get-entity number))) + (when (wl-thread-entity-get-opened entity) + (wl-thread-close entity)))))) (defun wl-thread-open (entity) (let (depth beg) @@ -1050,9 +980,20 @@ Message is inserted to the summary buffer." (wl-thread-insert-entity depth ;(- depth 1) entity (wl-thread-get-entity - (nth 3 entity)) nil) + (wl-thread-entity-get-parent entity)) + nil) (delete-char 1) ; delete '\n' - (wl-thread-print-destination-region beg (point)))) + (wl-thread-print-argument-region beg (point)))) + +(defun wl-thread-open-children (&optional number) + (interactive) + (when (eq wl-summary-buffer-view 'thread) + (setq number (or number (wl-summary-message-number))) + (save-excursion + (let ((inhibit-read-only t) + (entity (wl-thread-get-entity number))) + (unless (wl-thread-entity-get-opened entity) + (wl-thread-open entity)))))) (defun wl-thread-open-close (&optional force-open) (interactive "P") @@ -1101,7 +1042,7 @@ Message is inserted to the summary buffer." (incf depth) (setq entity (wl-thread-get-entity number))) depth)) - + (defun wl-thread-update-indent-string-region (beg end) (interactive "r") (save-excursion @@ -1172,7 +1113,15 @@ Message is inserted to the summary buffer." (wl-thread-entity-set-children dst-parent-entity (append children (list number))) - (wl-thread-entity-set-linked entity t)) + (wl-thread-entity-set-linked + entity + (let ((parent (elmo-message-entity-parent + wl-summary-buffer-elmo-folder + (elmo-message-entity + wl-summary-buffer-elmo-folder + number)))) + (or (null parent) + (/= parent-number (elmo-message-entity-number parent)))))) ;; insert as top (wl-append wl-thread-entity-list (list number)) (wl-thread-entity-set-linked entity nil)) @@ -1183,7 +1132,7 @@ Message is inserted to the summary buffer." (wl-thread-entity-set-parent entity dst-parent) ;; update thread on buffer (wl-thread-make-number-list) - (wl-thread-update-line-msgs update-msgs t)))) + (wl-thread-update-line-msgs update-msgs)))) (require 'product) (product-provide (provide 'wl-thread) (require 'wl-version))