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
(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*")))
+ (tmp-buffer (get-buffer-create " *wl-thread-save-top-list*"))
+ print-length)
(save-excursion
(set-buffer tmp-buffer)
(erase-buffer)
(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*")))
+ (tmp-buffer (get-buffer-create " *wl-thread-save-entities*"))
+ print-length print-level)
(save-excursion
(set-buffer tmp-buffer)
(erase-buffer)
"If parent of ENTITY is invisible, the top invisible ancestor entity of
ENTITY is returned."
(let ((cur-entity entity)
- ret-val)
+ top)
(catch 'done
(while (setq cur-entity (wl-thread-entity-get-parent-entity
cur-entity))
(if (null (wl-thread-entity-get-number cur-entity))
- ;; top!!
- (progn
- ;;(setq ret-val nil)
- (throw 'done nil))
+ (throw 'done nil)
(when (not (wl-thread-entity-get-opened cur-entity))
- ;; not opened!!
- (setq ret-val cur-entity)))))
- ;; top of closed entity in the path.
- ret-val))
+ (setq top cur-entity)))))
+ top))
(defun wl-thread-entity-get-nearly-older-brother (entity &optional parent)
(let ((brothers (wl-thread-entity-get-older-brothers entity parent)))
(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)
(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)
(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 dest-pair)
(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 dest-pair (cons (nth 0 temp-mark)(nth 2 temp-mark))
+ 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-flags wl-summary-buffer-elmo-folder
+ msg)
+ (elmo-message-cached-p 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-summary-print-argument (car dest-pair)
+ (cdr dest-pair)))))
;; 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)))))
(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))
(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.
- (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))))
-
+ (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.
;; 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
;; 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,
;;; (when force-insert
;;; (if parent
;;; (wl-thread-entity-force-open parent))
+ (when (and wl-summary-max-thread-depth parent)
+ (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
;; 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
(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))
(interactive "P")
(wl-thread-call-region-func 'wl-summary-mark-as-important-region arg))
-(defun wl-thread-copy (&optional arg)
- (interactive "P")
- (wl-thread-call-region-func 'wl-summary-copy-region arg))
-
-(defun wl-thread-refile (&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)
+(defun wl-thread-set-flags (&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-set-flags-region arg))
-(defun wl-thread-target-mark (&optional arg)
+(defun wl-thread-mark-as-answered (&optional arg)
(interactive "P")
- (wl-thread-call-region-func 'wl-summary-target-mark-region arg))
+ (wl-thread-call-region-func 'wl-summary-mark-as-answered-region arg))
(defun wl-thread-unmark (&optional arg)
(interactive "P")
(setq cur (1+ cur))
(if (or (zerop (% cur 2)) (= cur len))
(elmo-display-progress
- 'wl-thread-insert-top "Inserting thread..."
+ 'wl-thread-insert-top "Inserting message..."
(/ (* cur 100) len)))))))
(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
+ (nth 0 entity)))
;;; (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
+ (nth 0 parent-entity))
temp-mark
- (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg-num)
+ (elmo-message-flags wl-summary-buffer-elmo-folder
+ msg-num)
+ (elmo-message-cached-p wl-summary-buffer-elmo-folder
+ msg-num)
(if wl-thread-insert-force-opened
nil
(wl-thread-maybe-get-children-num msg-num))
(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)
(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)
(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)
(nth 3 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 (entity)
(let (depth beg)
(wl-thread-get-entity
(nth 3 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-close (&optional force-open)
(interactive "P")
(setq update-msgs (elmo-uniq-list update-msgs))
(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))))
(require 'product)
projects / elisp / wanderlust.git / blobdiff