(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]+\\)")
;; 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))
(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))
(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
'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...")
(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)
(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)
(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
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
(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)
(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))
(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
'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)
(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
(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))
(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)
(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
(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)
(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)
(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.")))
(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)
(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)))
(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
(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)
(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
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)))))
(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))
(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))
(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)
(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)))
(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))
(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
(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
(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)
(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
projects / elisp / wanderlust.git / commitdiff