From 2e52c74806f489bf71310adad05d919f7dadbcd7 Mon Sep 17 00:00:00 2001 From: murata Date: Sat, 20 May 2000 02:05:36 +0000 Subject: [PATCH] (wl-summary-insert-thread-entity): Changed delayed updating process. (wl-summary-rescan): Ditto. (wl-summary-sync-update3): Ditto. (wl-thread-set-parent): Renamed from `wl-summary-set-parent'. (wl-thread-insert-message): Updating buffer faster. (wl-thread-delete-message): Updating buffer faster. --- wl/wl-message.el | 11 +- wl/wl-summary.el | 268 +++++++++++++++++++----------------------- wl/wl-thread.el | 342 ++++++++++++++++++++++++++++++++---------------------- 3 files changed, 328 insertions(+), 293 deletions(-) diff --git a/wl/wl-message.el b/wl/wl-message.el index 37bb7ba..421966a 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -407,8 +407,8 @@ (message-id (cdr (assq number (elmo-msgdb-get-number-alist msgdb)))) (size (elmo-msgdb-overview-entity-get-size - (assoc message-id - (elmo-msgdb-get-overview msgdb)))) + (elmo-msgdb-overview-get-entity + (elmo-msgdb-get-overview msgdb) message-id))) (backend (wl-message-decide-backend folder number message-id size)) cur-entity ret-val header-end real-fld-num summary-win) (require 'mmelmo) @@ -497,10 +497,9 @@ (message-id (cdr (assq number (elmo-msgdb-get-number-alist msgdb)))) (size (elmo-msgdb-overview-entity-get-size - (assoc message-id - (elmo-msgdb-get-overview msgdb)))) - header-end ret-val summary-win - ) + (elmo-msgdb-overview-get-entity + (elmo-msgdb-get-overview msgdb) message-id))) + header-end ret-val summary-win) (wl-select-buffer view-message-buffer) (unwind-protect (progn diff --git a/wl/wl-summary.el b/wl/wl-summary.el index f649481..8c71417 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -108,7 +108,6 @@ (defvar wl-summary-alike-hashtb nil) (defvar wl-summary-search-buf-name " *wl-search-subject*") (defvar wl-summary-delayed-update nil) -(defvar wl-summary-last-delayed-update nil) (defvar wl-summary-message-regexp "^ *\\([0-9]+\\)") @@ -161,7 +160,8 @@ ;; internal functions (dummy) (unless (fboundp 'wl-summary-append-message-func-internal) (defun wl-summary-append-message-func-internal (entity overview - mark-alist update))) + mark-alist update + &optional force-insert))) (unless (fboundp 'wl-summary-from-func-internal) (defun wl-summary-from-func-internal (from) from)) @@ -443,7 +443,7 @@ (define-key wl-summary-mode-map "t!" 'wl-thread-mark-as-unread) (define-key wl-summary-mode-map "t$" 'wl-thread-mark-as-important) (define-key wl-summary-mode-map "ty" 'wl-thread-save) - (define-key wl-summary-mode-map "ts" 'wl-summary-set-parent) + (define-key wl-summary-mode-map "ts" 'wl-thread-set-parent) ;; target-mark commands (define-key wl-summary-mode-map "m" (make-sparse-keymap)) @@ -921,9 +921,8 @@ q Goto folder mode. (setq wl-summary-buffer-refile-list nil) (setq wl-summary-buffer-delete-list nil) (setq wl-summary-delayed-update nil) - (setq wl-summary-last-delayed-update nil) (elmo-kill-buffer wl-summary-search-buf-name) - (message "Constructing summary structure..." percent) + (message "Constructing summary structure...") (while curp (setq entity (car curp)) (wl-summary-append-message-func-internal entity overview mark-alist @@ -936,16 +935,16 @@ q Goto folder mode. 'wl-summary-rescan "Constructing summary structure..." (/ (* i 100) num))))) (when wl-summary-delayed-update - (message "Constructing summary structure (reversed)...") (while wl-summary-delayed-update - (if (equal (car wl-summary-delayed-update) - (car wl-summary-last-delayed-update)) - (error "Summary is broken, please rescan summary")) - (setq wl-summary-last-delayed-update wl-summary-delayed-update) + (message "Parent (%d) of message %d is no entity" + (caar wl-summary-delayed-update) + (elmo-msgdb-overview-entity-get-number + (cdar wl-summary-delayed-update))) (wl-summary-append-message-func-internal - (car wl-summary-delayed-update) - overview mark-alist nil))) - (message "Constructing summary structure...done." percent) + (cdar wl-summary-delayed-update) + overview mark-alist nil t) + (setq wl-summary-delayed-update (cdr wl-summary-delayed-update)))) + (message "Constructing summary structure...done.") (set-buffer cur-buf) (when (eq wl-summary-buffer-view 'thread) (message "Inserting thread...") @@ -1188,7 +1187,7 @@ q Goto folder mode. (setq wl-thread-entity-hashtb (elmo-make-hash (* (length (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) 2))) - (setq wl-summary-buffer-msgdb '(nil nil nil nil)) + (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil)) (setq wl-thread-entity-list nil) (setq wl-thread-entities nil) (setq wl-summary-buffer-target-mark-list nil) @@ -1903,7 +1902,6 @@ If optional argument is non-nil, checking is omitted." (defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info) (interactive) - (elmo-kill-buffer wl-summary-search-buf-name) (save-excursion (let ((inhibit-read-only t) (buffer-read-only nil) @@ -1911,6 +1909,7 @@ If optional argument is non-nil, checking is omitted." (len (length msgs)) (i 0) update-list) + (elmo-kill-buffer wl-summary-search-buf-name) (while msgs (if (eq wl-summary-buffer-view 'thread) (progn @@ -2162,7 +2161,7 @@ If optional argument is non-nil, checking is omitted." in-db curp overview-append entity ret-val crossed crossed2 sync-all - top-num update-top-list mark + update-thread update-top-list mark expunged msgs unreads importants) ;(setq seen-list nil) ;for debug. (fset 'wl-summary-append-message-func-internal @@ -2175,7 +2174,9 @@ If optional argument is non-nil, checking is omitted." (setq in-folder (elmo-list-folder folder)) (setq in-db (sort (mapcar 'car number-alist) '<)) (when (or (eq msgdb nil) ; trick for unplugged... - (equal msgdb '(nil nil nil nil))) + (and (null overview) + (null number-alist) + (null mark-alist))) (setq sync-all t) (wl-summary-set-message-modified) (wl-summary-set-mark-modified) @@ -2243,7 +2244,7 @@ If optional argument is non-nil, checking is omitted." (setq result (cdr crossed)) (setq crossed (car crossed))) (setq overview-append (car result)) - (setq msgdb (elmo-msgdb-append msgdb result)) + (setq msgdb (elmo-msgdb-append msgdb result t)) ;; set these value for append-message-func (setq overview (elmo-msgdb-get-overview msgdb)) (setq number-alist (elmo-msgdb-get-number-alist msgdb)) @@ -2252,16 +2253,14 @@ If optional argument is non-nil, checking is omitted." (setq curp overview-append) (setq num (length curp)) (setq wl-summary-delayed-update nil) - (setq wl-summary-last-delayed-update nil) (elmo-kill-buffer wl-summary-search-buf-name) (while curp (setq entity (car curp)) - (setq top-num - (wl-summary-append-message-func-internal - entity overview mark-alist - (not sync-all))) - (when top-num - (wl-append update-top-list (list top-num))) + (when (setq update-thread + (wl-summary-append-message-func-internal + entity overview mark-alist + (not sync-all))) + (wl-append update-top-list update-thread)) (if elmo-use-database (elmo-database-msgid-put (car entity) folder @@ -2274,24 +2273,23 @@ If optional argument is non-nil, checking is omitted." 'wl-summary-sync-update3 "Updating thread..." (/ (* i 100) num))))) (when wl-summary-delayed-update - (message "Updating thread (reversed)...") (while wl-summary-delayed-update - (if (equal (car wl-summary-delayed-update) - (car wl-summary-last-delayed-update)) - (error "Summary is broken, please rescan summary")) - (setq wl-summary-last-delayed-update wl-summary-delayed-update) - (when (setq top-num + (message "Parent (%d) of message %d is no entity" + (caar wl-summary-delayed-update) + (elmo-msgdb-overview-entity-get-number + (cdar wl-summary-delayed-update))) + (when (setq update-thread (wl-summary-append-message-func-internal - (car wl-summary-delayed-update) - overview mark-alist (not sync-all))) - (wl-append update-top-list (list top-num)))) - (message "Updating thread (reversed)...done.")) - (setq update-top-list - (elmo-uniq-list update-top-list)) + (cdar wl-summary-delayed-update) + overview mark-alist (not sync-all) t)) + (wl-append update-top-list update-thread)) + (setq wl-summary-delayed-update + (cdr wl-summary-delayed-update)))) (when (and (eq wl-summary-buffer-view 'thread) update-top-list) (message "Updating indent...") - (wl-thread-update-indent-string-thread update-top-list) + (wl-thread-update-indent-string-thread + (elmo-uniq-list update-top-list)) (message "Updating indent...done.")) (message "Updating thread...done.") ;;(set-buffer cur-buf) @@ -2597,7 +2595,8 @@ If optional argument is non-nil, checking is omitted." (buf (get-buffer-create buffer-name)) (folder wl-summary-buffer-folder-name) (copy-variables - (append '(wl-summary-buffer-view + (append '(elmo-msgdb-overview-hashtb + wl-summary-buffer-view wl-summary-buffer-refile-list wl-summary-buffer-delete-list wl-summary-buffer-copy-list @@ -2899,7 +2898,7 @@ If optional argument is non-nil, checking is omitted." (error (ding) (message "Error in wl-summary-line-inserted-hook")))) -(defun wl-summary-insert-summary (entity database mark-alist dummy) +(defun wl-summary-insert-summary (entity database mark-alist dummy &optional dummy) (let ((overview-entity entity) summary-line msg) (setq msg (elmo-msgdb-overview-entity-get-number entity)) @@ -2921,6 +2920,17 @@ If optional argument is non-nil, checking is omitted." (string= (wl-summary-subject-filter-func-internal subject1) (wl-summary-subject-filter-func-internal subject2))) +(defun wl-summary-subject-equal-by-number (msg1 msg2 &optional overview) + (let ((overview (or overview + (elmo-msgdb-get-overview wl-summary-buffer-msgdb)))) + (wl-summary-subject-equal + (or (elmo-msgdb-overview-entity-get-subject + (elmo-msgdb-overview-get-entity-by-number overview msg1)) + "") + (or (elmo-msgdb-overview-entity-get-subject + (elmo-msgdb-overview-get-entity-by-number overview msg2)) + "")))) + (defmacro wl-summary-put-alike (alike) (` (elmo-set-hash-val (format "#%d" (wl-count-lines)) (, alike) @@ -2985,57 +2995,73 @@ If optional argument is non-nil, checking is omitted." (when (and (eolp) (= (save-excursion (forward-line 0) (point)) (match-beginning 0))) - (setq founds (wl-summary-get-alike)))) - (if (and founds - (< (elmo-msgdb-overview-entity-get-number (car founds)) - (elmo-msgdb-overview-entity-get-number entity))) - ;; return first matching entity - (car founds)))))) - -(defun wl-summary-insert-thread-entity (entity overview mark-alist update) - (let* ((this-id (elmo-msgdb-overview-entity-get-id entity)) - (parent-entity - (elmo-msgdb-overview-get-parent-entity entity overview));; temp - ;;(parent-id (elmo-msgdb-overview-entity-get-id parent-entity)) - (parent-number (elmo-msgdb-overview-entity-get-number parent-entity)) - (case-fold-search t) - msg overview2 cur-entity linked) - (setq msg (elmo-msgdb-overview-entity-get-number entity)) - (if (and parent-number - (not (wl-thread-get-entity parent-number))) - ;; parent is exists in overview, but not exists in wl-thread-entities - (progn - (if (equal entity (car wl-summary-delayed-update)) - (setq wl-summary-delayed-update - (cdr wl-summary-delayed-update))) ;; delete first - (wl-append wl-summary-delayed-update (list entity)) - nil) - ;; Search parent by subject. - (setq wl-summary-delayed-update - (delete entity wl-summary-delayed-update)) - (when (and (null parent-number) - wl-summary-search-parent-by-subject-regexp - (string-match wl-summary-search-parent-by-subject-regexp - (elmo-msgdb-overview-entity-get-subject entity))) - (let ((found (wl-summary-search-by-subject entity overview))) - (when (and found - (not (member found wl-summary-delayed-update))) - (setq parent-entity found) - (setq parent-number - (elmo-msgdb-overview-entity-get-number parent-entity)) - (setq linked t)))) - ;; If subject is change, divide thread. - (if (and parent-number - wl-summary-divide-thread-when-subject-changed - (not (wl-summary-subject-equal - (or (elmo-msgdb-overview-entity-get-subject - entity) "") - (or (elmo-msgdb-overview-entity-get-subject - parent-entity) "")))) - (setq parent-number nil)) - ;; - (wl-thread-insert-message entity overview mark-alist - msg parent-number update linked)))) + (setq founds (wl-summary-get-alike)))))) + (if (and founds + ;; Is founded entity myself or children? + (not (eq entity (car founds))) + (not (wl-thread-descendant-p + (elmo-msgdb-overview-entity-get-number entity) + (elmo-msgdb-overview-entity-get-number (car founds))))) + ;; return first matching entity + (car founds)))) + +(defun wl-summary-insert-thread-entity (entity overview mark-alist update + &optional force-insert) + (let (update-list entity-stack) + (while entity + (let* ((this-id (elmo-msgdb-overview-entity-get-id entity)) + (parent-entity + (elmo-msgdb-overview-get-parent-entity entity overview));; temp + ;;(parent-id (elmo-msgdb-overview-entity-get-id parent-entity)) + (parent-number (elmo-msgdb-overview-entity-get-number parent-entity)) + (case-fold-search t) + msg overview2 cur-entity linked retval delayed-entity) + (setq msg (elmo-msgdb-overview-entity-get-number entity)) + (if (and parent-number + (not (wl-thread-get-entity parent-number)) + (not force-insert)) + ;; parent is exists in overview, but not exists in wl-thread-entities + (progn + (wl-append wl-summary-delayed-update + (list (cons parent-number entity))) + (setq entity nil)) ;; exit loop + ;; Search parent by subject. + (when (and (null parent-number) + wl-summary-search-parent-by-subject-regexp + (string-match wl-summary-search-parent-by-subject-regexp + (elmo-msgdb-overview-entity-get-subject entity))) + (let ((found (wl-summary-search-by-subject entity overview))) + (when (and found + (not (member found wl-summary-delayed-update))) + (setq parent-entity found) + (setq parent-number + (elmo-msgdb-overview-entity-get-number parent-entity)) + (setq linked t)))) + ;; If subject is change, divide thread. + (if (and parent-number + wl-summary-divide-thread-when-subject-changed + (not (wl-summary-subject-equal + (or (elmo-msgdb-overview-entity-get-subject + entity) "") + (or (elmo-msgdb-overview-entity-get-subject + parent-entity) "")))) + (setq parent-number nil)) + ;; + (setq retval + (wl-thread-insert-message entity overview mark-alist + msg parent-number update linked)) + (and retval + (wl-append update-list (list retval))) + (setq entity nil) ; exit loop + (while (setq delayed-entity (assq msg wl-summary-delayed-update)) + (setq wl-summary-delayed-update + (delete delayed-entity wl-summary-delayed-update)) + ;; update delayed message + (wl-append entity-stack (list (cdr delayed-entity))))) + (if (and (not entity) + entity-stack) + (setq entity (pop entity-stack))))) + update-list)) (defun wl-summary-update-thread (entity overview @@ -5853,7 +5879,8 @@ Reply to author if invoked with argument." (setq wl-summary-buffer-msgdb (elmo-pack-number wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg)) - (wl-summary-rescan)) + (let (wl-use-scoring) + (wl-summary-rescan))) (defun wl-summary-target-mark-uudecode () (interactive) @@ -6039,61 +6066,6 @@ Reply to author if invoked with argument." (if wl-cache-prefetch-debug (message "Reading %d... done" msg)))))))))) -(defun wl-summary-set-parent (&optional parent-number) - "Set current message's parent interactively." - (interactive) - (let ((number (wl-summary-message-number)) - (dst-parent (if (interactive-p) - (read-from-minibuffer "Parent Message (No.): "))) - (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) - entity dst-parent-entity src-parent - buffer-read-only) - (if (string= dst-parent "") - (setq dst-parent nil) - (if (interactive-p) - (setq dst-parent (string-to-int dst-parent)) - (setq dst-parent parent-number))) - (if (and dst-parent - (memq dst-parent (wl-thread-get-children-msgs number))) - (error "Parent is children or myself")) - (setq entity (wl-thread-get-entity number)) - (when (and number entity) - (let* (older-brothers younger-brothers parent-entity beg) - ;; delete from old parent - (setq parent-entity (wl-thread-entity-get-parent-entity entity)) - (if parent-entity - (progn - (setq older-brothers (wl-thread-entity-get-older-brothers - entity parent-entity)) - (setq younger-brothers (wl-thread-entity-get-younger-brothers - entity parent-entity)) - (wl-thread-entity-set-children - parent-entity (append older-brothers younger-brothers)) - (setq src-parent (wl-thread-entity-get-number parent-entity))) - (setq wl-thread-entity-list - (delq number wl-thread-entity-list))) - ;; delete thread on buffer - (when (wl-summary-jump-to-msg number) - (setq beg (point)) - (wl-thread-goto-bottom-of-sub-thread) - (delete-region beg (point)))) - ;; insert as child at new parent - (setq dst-parent-entity (wl-thread-get-entity dst-parent)) - (if dst-parent-entity - (wl-thread-entity-set-children - dst-parent-entity - (append - (wl-thread-entity-get-children dst-parent-entity) - (list number))) - ;; insert as top - (wl-append wl-thread-entity-list (list number))) - (wl-thread-entity-set-parent entity dst-parent) - (wl-thread-entity-set-linked entity t) - ;; update thread on buffer - (wl-thread-update-line-msgs - (append (and src-parent (list src-parent)) - (list (or dst-parent number))))))) - (defun wl-summary-save-current-message () "Save current message for `wl-summary-yank-saved-message'." (interactive) @@ -6110,7 +6082,7 @@ Reply to author if invoked with argument." (message "Cannot set itself as a parent.") (save-excursion (wl-thread-jump-to-msg wl-summary-buffer-saved-message) - (wl-summary-set-parent number)) + (wl-thread-set-parent number)) (setq wl-summary-buffer-saved-message nil))) (message "There's no saved message."))) diff --git a/wl/wl-thread.el b/wl/wl-thread.el index f8bc082..2da6be9 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -167,7 +167,6 @@ (defsubst wl-thread-get-entity (num) (and num - (boundp (intern (format "#%d" num) wl-thread-entity-hashtb)) (elmo-get-hash-val (format "#%d" num) wl-thread-entity-hashtb))) (defsubst wl-thread-entity-set-parent (entity parent) @@ -339,6 +338,11 @@ ENTITY is returned." (setq msgs (wl-pop msgs-stack))))) (setq entity (wl-thread-get-entity (car msgs))))))) +(defun wl-thread-entity-get-nearly-older-brother (entity &optional parent) + (let ((brothers (wl-thread-entity-get-older-brothers entity parent))) + (when brothers + (car (last brothers))))) + (defun wl-thread-entity-get-older-brothers (entity &optional parent) (let* ((parent (or parent (wl-thread-entity-get-parent-entity entity))) @@ -347,13 +351,12 @@ ENTITY is returned." (if parent brothers (setq brothers wl-thread-entity-list)) - (catch 'done - (while brothers - (if (not (eq (wl-thread-entity-get-number entity) - (car brothers))) - (wl-append ret-val (list (car brothers))) - (throw 'done ret-val)) - (setq brothers (cdr brothers)))))) + (while (and brothers + (not (eq (wl-thread-entity-get-number entity) + (car brothers)))) + (wl-append ret-val (list (car brothers))) + (setq brothers (cdr brothers))) + ret-val)) (defun wl-thread-entity-get-younger-brothers (entity &optional parent) (let* ((parent (or parent @@ -652,6 +655,7 @@ the closed parent will be opened." (parent-msg (or parent-msg (wl-thread-entity-get-parent entity))) (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) + (overviewht (elmo-msgdb-get-overviewht wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) (buffer-read-only nil) (inhibit-read-only t) @@ -669,16 +673,18 @@ the closed parent will be opened." (unless temp-mark (setq temp-mark (wl-summary-get-score-mark msg))) (setq overview-entity - (elmo-msgdb-search-overview-entity msg - number-alist overview)) + (elmo-msgdb-search-overview-entity + msg number-alist overview overviewht)) (when overview-entity (setq summary-line (wl-summary-overview-create-summary-line msg overview-entity - (assoc ; parent-entity - (cdr (assq parent-msg - number-alist)) overview) + (elmo-msgdb-search-overview-entity + parent-msg number-alist overview overviewht) +;; (assoc ; parent-entity +;; (cdr (assq parent-msg +;; number-alist)) overview) nil mark-alist (if wl-thread-insert-force-opened @@ -695,7 +701,8 @@ the closed parent will be opened." mark-alist entity (and parent-msg - (elmo-msgdb-overview-get-entity-by-number overview parent-msg))) + (elmo-msgdb-overview-get-entity-by-number + overview parent-msg))) ;; currently invisible.. update closed line. (wl-thread-update-children-number invisible-top))))) @@ -729,12 +736,13 @@ the closed parent will be opened." (defun wl-thread-update-line-msgs (msgs &optional no-msg) (wl-delete-all-overlays) (let ((i 0) - len updates) - (while msgs - (wl-append updates - (wl-thread-get-children-msgs (car msgs))) - (setq msgs (cdr msgs))) - (setq updates (elmo-uniq-list updates)) + (updates msgs) + len) +;; (while msgs +;; (wl-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)) @@ -762,25 +770,23 @@ the closed parent will be opened." (let (sym) (while msgs ;; free symbol. - (when (boundp (setq sym (intern (format "#%d" (car msgs)) - wl-thread-entity-hashtb))) - ;; delete entity. - (setq wl-thread-entities - (delq (wl-thread-get-entity (car msgs)) - wl-thread-entities)) - (makunbound sym)) + (elmo-clear-hash-val (format "#%d" (car msgs)) + wl-thread-entity-hashtb) + ;; delete entity. + (setq wl-thread-entities + (delq (wl-thread-get-entity (car msgs)) + wl-thread-entities)) (setq msgs (cdr msgs))))) -(defun wl-thread-delete-message (msg &optional update) +(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 children2 top-children - older-brothers younger-brothers ;;brothers - parent num update-msgs move-threads beg) + children older-brothers younger-brothers top-child + top-entity parent update-msgs ent beg) (when entity (setq parent (wl-thread-entity-get-parent-entity entity)) - (if parent + (if parent (progn ;; has parent. ;;(setq brothers (wl-thread-entity-get-children parent)) @@ -789,117 +795,109 @@ the closed parent will be opened." (setq younger-brothers (wl-thread-entity-get-younger-brothers entity parent)) ;; - (setq children (wl-thread-entity-get-children entity)) - (mapcar '(lambda (x) - (wl-thread-entity-set-parent - (wl-thread-get-entity x) - (wl-thread-entity-get-number parent)) - (wl-thread-entity-set-linked - (wl-thread-get-entity x) - t)) - children) + (unless deep + (setq children (wl-thread-entity-get-children entity)) + (mapcar '(lambda (x) + (wl-thread-entity-set-parent + (wl-thread-get-entity x) + (wl-thread-entity-get-number parent)) + (wl-thread-entity-set-linked + (wl-thread-get-entity x) + t) + (wl-append update-msgs + (wl-thread-get-children-msgs x t))) + children)) (wl-thread-entity-set-children parent (append (append older-brothers children) - younger-brothers))) - ;; top...children becomes top. - (let ((overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) - ov found parent-entity parent-number linked) - (mapcar '(lambda (x) - ;; Search parent by subject. - (if (and - wl-summary-search-parent-by-subject-regexp - (setq ov (elmo-msgdb-overview-get-entity-by-number - overview x)) - (setq found (wl-summary-search-by-subject - ov overview)) - (setq parent-number - (elmo-msgdb-overview-entity-get-number found)) - (not (memq parent-number - (wl-thread-get-children-msgs x)))) - (progn - (setq parent-entity - (wl-thread-get-entity parent-number)) - (setq linked t) - (wl-thread-entity-set-children - parent-entity - (append - (wl-thread-entity-get-children parent-entity) - (list x))) - (wl-append update-msgs (list parent-number)) - (wl-append move-threads (list x))) - (setq parent-number nil - linked nil) - (wl-append top-children (list x))) - (wl-thread-entity-set-parent (wl-thread-get-entity x) - parent-number) - (wl-thread-entity-set-linked (wl-thread-get-entity x) - linked)) - (setq children (wl-thread-entity-get-children entity)))) + 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)) t)))) + + ;; 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)) + (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)) + (when children + (wl-thread-entity-set-children + top-entity + (append + (wl-thread-entity-get-children top-entity) + children)) + (mapcar + '(lambda (x) + (wl-thread-entity-set-parent (wl-thread-get-entity x) + top-child) + (wl-thread-entity-set-linked (wl-thread-get-entity x) + t)) + children) + (wl-append update-msgs children))) ;; delete myself from top 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 top-children) - younger-brothers)))) - - ;; delete myself from buffer. - (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)) - (setq children2 children) - (while children2 - (wl-thread-insert-entity 0 ; no mean now... - (wl-thread-get-entity - (car children2)) - entity nil) - (setq children2 (cdr children2)))) - ;; delete moving threads - (while (setq num (pop move-threads)) - (when (wl-summary-jump-to-msg num) - (setq beg (point)) - (wl-thread-goto-bottom-of-sub-thread) - (delete-region beg (point)))) + (and top-child + (setq wl-thread-entity-list + (append (append older-brothers (list top-child)) + younger-brothers))))) + + (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))) + ;; delete myself from buffer. + (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 + (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))))) + (if update ;; modify buffer. - (progn - (if parent - ;; update parent on buffer. - (progn - (setq num (wl-thread-entity-get-number parent)) - (when num - (wl-thread-update-line-on-buffer num))) - ;; update children lines on buffer. - (mapcar '(lambda (x) - (wl-thread-update-line-on-buffer - x - (wl-thread-entity-get-number parent))) - (append update-msgs children)))) + (mapcar '(lambda (x) + (wl-thread-update-line-on-buffer-sub nil x)) + update-msgs) ;; don't update buffer - (if parent - ;; return parent number - (list (wl-thread-entity-get-number parent)) - (append update-msgs children))) - ;; update the indent string -; (wl-summary-goto-top-of-current-thread) -; (setq beg (point)) -; (wl-thread-goto-bottom-of-sub-thread) -; (wl-thread-update-indent-string-region beg (point))) - ))) + update-msgs)))) ; return value (defun wl-thread-insert-message (overview-entity overview mark-alist msg parent-msg &optional update linked) @@ -933,8 +931,10 @@ Message is inserted to the summary buffer." (elmo-msgdb-overview-get-entity-by-number overview parent-msg)) (when parent ;; use thread structure. - (wl-thread-entity-get-number - (wl-thread-entity-get-top-entity parent)))) ; return value; + (wl-thread-entity-get-nearly-older-brother + child-entity parent))) ; return value +;; (wl-thread-entity-get-number +;; (wl-thread-entity-get-top-entity parent)))) ; return value; ;; (setq beg (point)) ;; (wl-thread-goto-bottom-of-sub-thread) ;; (wl-thread-update-indent-string-region beg (point))) @@ -942,8 +942,22 @@ Message is inserted to the summary buffer." (wl-thread-update-children-number invisible-top) nil)))) +(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)) + (defun wl-thread-update-indent-string-thread (top-list) - (let (beg) + (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)) @@ -1168,6 +1182,7 @@ Message is inserted to the summary buffer." (defsubst wl-thread-insert-entity-sub (indent entity parent-entity all) (let ((number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb)) + (overviewht (elmo-msgdb-get-overviewht wl-summary-buffer-msgdb)) (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) msg-num overview-entity @@ -1187,16 +1202,18 @@ Message is inserted to the summary buffer." (setq temp-mark (wl-summary-get-score-mark msg-num))) (setq overview-entity (elmo-msgdb-search-overview-entity - (nth 0 entity) number-alist overview)) + (nth 0 entity) number-alist overview overviewht)) ;;(wl-delete-all-overlays) (when overview-entity (setq summary-line (wl-summary-overview-create-summary-line msg-num overview-entity - (assoc ; parent-entity - (cdr (assq (nth 0 parent-entity) - number-alist)) overview) + (elmo-msgdb-search-overview-entity + (nth 0 parent-entity) number-alist overview overviewht) +;; (assoc ; parent-entity +;; (cdr (assq (nth 0 parent-entity) +;; number-alist)) overview) (1+ indent) mark-alist (if wl-thread-insert-force-opened @@ -1288,14 +1305,17 @@ Message is inserted to the summary buffer." (wl-summary-print-destination (car pair) (cdr pair)))) (forward-line 1)))))) -(defsubst wl-thread-get-children-msgs (msg) +(defsubst wl-thread-get-children-msgs (msg &optional visible-only) (let ((msgs (list msg)) msgs-stack children - ret-val) + entity ret-val) (while msgs (wl-append ret-val (list (car msgs))) (setq children (wl-thread-entity-get-children - (wl-thread-get-entity (car msgs)))) + (setq entity (wl-thread-get-entity (car msgs))))) + (if (and visible-only + (not (wl-thread-entity-get-opened entity))) + (setq children nil)) (setq msgs (cdr msgs)) (if (null children) (while (and (null msgs) msgs-stack) @@ -1493,6 +1513,50 @@ Message is inserted to the summary buffer." (if wl-summary-highlight (wl-highlight-summary-current-line)))))) +(defun wl-thread-set-parent (&optional parent-number) + "Set current message's parent interactively." + (interactive) + (let ((number (wl-summary-message-number)) + (dst-parent (if (interactive-p) + (read-from-minibuffer "Parent Message (No.): "))) + entity dst-parent-entity src-parent children + update-msgs + buffer-read-only) + (if (string= dst-parent "") + (setq dst-parent nil) + (if (interactive-p) + (setq dst-parent (string-to-int dst-parent)) + (setq dst-parent parent-number))) + (if (and dst-parent + (memq dst-parent (wl-thread-get-children-msgs number))) + (error "Parent is children or myself")) + (setq entity (wl-thread-get-entity number)) + (when (and number entity) + ;; delete thread + (setq update-msgs (wl-thread-delete-message number 'deep)) + ;; insert as child at new parent + (setq dst-parent-entity (wl-thread-get-entity dst-parent)) + (if dst-parent-entity + (progn + (if (setq children + (wl-thread-entity-get-children dst-parent-entity)) + (wl-append update-msgs + (wl-thread-get-children-msgs + (car (last children)) t))) + (wl-thread-entity-set-children + dst-parent-entity + (append children (list number)))) + ;; insert as top + (wl-append wl-thread-entity-list (list number))) + + ;; update my thread + (wl-append update-msgs (wl-thread-get-children-msgs number t)) + (setq update-msgs (elmo-uniq-list update-msgs)) + (wl-thread-entity-set-parent entity dst-parent) + (wl-thread-entity-set-linked entity t) + ;; update thread on buffer + (wl-thread-update-line-msgs update-msgs t)))) + (provide 'wl-thread) ;;; wl-thread.el ends here -- 1.7.10.4