X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-thread.el;h=5e5bca3af242fbf28c177567f81b44d35709079f;hb=e21941a415f1b0c567b2635524853573ef3c3411;hp=1dda0725cdeffb49cdc55232baa56d9897713ee9;hpb=10a95fa561ec82f555499e359e703a69eaecbad5;p=elisp%2Fwanderlust.git diff --git a/wl/wl-thread.el b/wl/wl-thread.el index 1dda072..5e5bca3 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -1,10 +1,10 @@ -;;; wl-thread.el -- Thread display modules for Wanderlust. +;;; wl-thread.el --- Thread display modules for Wanderlust. -;; Copyright 1998,1999,2000 Yuuichi Teranishi -;; Masahiro MURATA +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Masahiro MURATA ;; Author: Yuuichi Teranishi -;; Masahiro MURATA +;; Masahiro MURATA ;; Keywords: mail, net news ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -26,86 +26,40 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'wl-summary) (require 'wl-highlight) +(eval-when-compile (require 'cl)) ;; buffer local variables. ;;(defvar wl-thread-top-entity '(nil t nil nil)) ; top entity -(defvar wl-thread-tops nil) ; top number list (number) +(defvar wl-thread-tops nil) ; top number list (number) (defvar wl-thread-entities nil) -(defvar wl-thread-entity-list nil) ; entity list -(defvar wl-thread-entity-hashtb nil) ; obarray -(defvar wl-thread-indent-regexp nil) +(defvar wl-thread-entity-list nil) ; entity list +(defvar wl-thread-entity-hashtb nil) ; obarray (make-variable-buffer-local 'wl-thread-entity-hashtb) (make-variable-buffer-local 'wl-thread-entities) ; ".wl-thread-entity" (make-variable-buffer-local 'wl-thread-entity-list) ; ".wl-thread-entity-list" -(make-variable-buffer-local 'wl-thread-entity-cur) -(make-variable-buffer-local 'wl-thread-indent-regexp) ;;; global flag (defvar wl-thread-insert-force-opened nil) ;;;;;; each entity is (number opened-or-not children parent) ;;;;;;; -(defun wl-meaning-of-mark (mark) - (if (not (elmo-folder-plugged-p wl-summary-buffer-folder-name)) - (cond - ((string= mark wl-summary-unread-cached-mark) - 'unread) - ((string= mark wl-summary-important-mark) - 'important)) - (cond - ((string= mark wl-summary-new-mark) - 'new) - ((or (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-unread-cached-mark)) - 'unread) - ((string= mark wl-summary-important-mark) - 'important)))) - -(defun wl-thread-next-mark-p (mark next) - (cond ((not (elmo-folder-plugged-p wl-summary-buffer-folder-name)) - (or (string= mark wl-summary-unread-cached-mark) - (string= mark wl-summary-important-mark))) - ((eq next 'new) - (string= mark wl-summary-new-mark)) - ((eq next 'unread) - (or (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-unread-cached-mark) - (string= mark wl-summary-new-mark))) - (t - (or (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-unread-cached-mark) - (string= mark wl-summary-new-mark) - (string= mark wl-summary-important-mark))))) - -(defun wl-thread-next-failure-mark-p (mark next) - (cond ((not (elmo-folder-plugged-p wl-summary-buffer-folder-name)) - (string= mark wl-summary-unread-cached-mark)) - ((or (eq next 'new) - (eq next 'unread)) - (or (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-unread-cached-mark) - (string= mark wl-summary-new-mark) - (string= mark wl-summary-important-mark))) - (t t))) - (defun wl-thread-resume-entity (fld) (let (entities top-list) (setq entities (wl-summary-load-file-object (expand-file-name wl-thread-entity-file - (elmo-msgdb-expand-path fld)))) + (elmo-folder-msgdb-path fld)))) (setq top-list (wl-summary-load-file-object (expand-file-name wl-thread-entity-list-file - (elmo-msgdb-expand-path fld)))) - (current-buffer) + (elmo-folder-msgdb-path fld)))) (message "Resuming thread structure...") ;; set obarray value. (setq wl-thread-entity-hashtb (elmo-make-hash (* (length entities) 2))) @@ -116,8 +70,48 @@ (elmo-set-hash-val (format "#%d" (car (car entities))) (car entities) wl-thread-entity-hashtb) (setq entities (cdr entities))) + (wl-thread-make-number-list) (message "Resuming thread structure...done"))) +(defun wl-thread-make-number-list () + "Make `wl-summary-buffer-number-list', a list of message numbers." + (let* ((node (wl-thread-get-entity (car wl-thread-entity-list))) + (children (wl-thread-entity-get-children node)) + parent sibling) + (setq wl-summary-buffer-number-list (list (car wl-thread-entity-list))) + (while children + (wl-thread-entity-make-number-list-from-children + (wl-thread-get-entity (car children))) + (setq children (cdr children))) + (while node + (setq parent (wl-thread-entity-get-parent-entity node) + sibling (wl-thread-entity-get-younger-brothers + node parent)) + (while sibling + (wl-thread-entity-make-number-list-from-children + (wl-thread-get-entity (car sibling))) + (setq sibling (cdr sibling))) + (setq node parent)) + (setq wl-summary-buffer-number-list (nreverse + wl-summary-buffer-number-list)))) + +(defun wl-thread-entity-make-number-list-from-children (entity) + (let ((msgs (list (car entity))) + msgs-stack children) + (while msgs + (setq wl-summary-buffer-number-list (cons (car entity) + wl-summary-buffer-number-list)) + (setq msgs (cdr msgs)) + (setq children (wl-thread-entity-get-children entity)) + (if children + (progn + (wl-push msgs msgs-stack) + (setq msgs children)) + (unless msgs + (while (and (null msgs) msgs-stack) + (setq msgs (wl-pop msgs-stack))))) + (setq entity (wl-thread-get-entity (car msgs)))))) + (defun wl-thread-save-entity (dir) (wl-thread-save-entities dir) (wl-thread-save-top-list dir)) @@ -192,11 +186,24 @@ (car entity)) (wl-append wl-thread-entity-list (list (car entity))) (setq wl-thread-entities (cons entity wl-thread-entities)) + (setq wl-summary-buffer-number-list + (nconc wl-summary-buffer-number-list (list (car entity)))) (elmo-set-hash-val (format "#%d" (car entity)) entity wl-thread-entity-hashtb))) (defsubst wl-thread-entity-insert-as-children (to entity) - (let ((children (nth 2 to))) + (let ((children (wl-thread-entity-get-children to)) + curp curc) + (setq curp to) + (elmo-list-insert wl-summary-buffer-number-list + (wl-thread-entity-get-number entity) + (progn + (while (setq curc + (wl-thread-entity-get-children curp)) + (setq curp (wl-thread-get-entity + (nth (- (length curc) 1) + curc)))) + (wl-thread-entity-get-number curp))) (setcar (cddr to) (wl-append children (list (car entity)))) (setq wl-thread-entities (cons entity wl-thread-entities)) @@ -252,96 +259,15 @@ "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)) - -(defun wl-thread-entity-get-mark (number) - (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - mark) - (setq mark (cadr (assq number mark-alist))) - (if (string= mark wl-summary-read-uncached-mark) - () - mark))) - -(defun wl-thread-meaning-alist-get-result (meaning-alist) - (let ((malist meaning-alist) - ret-val) - (catch 'done - (while malist - (if (setq ret-val (cdr (car malist))) - (throw 'done ret-val)) - (setq malist (cdr malist)))))) - -(defun wl-thread-entity-check-prev-mark (entity prev-marks) - "Check prev mark. Result is stored in PREV-MARK." - (let ((msgs (list (car entity))) - (succeed-list (car prev-marks)) - (failure-list (cdr prev-marks)) - msgs-stack children - mark meaning success failure parents) - (catch 'done - (while msgs - (if (and (not (memq (car msgs) parents)) - (setq children (reverse (wl-thread-entity-get-children entity)))) - (progn - (wl-append parents (list (car msgs))) - (wl-push msgs msgs-stack) - (setq msgs children)) - (if (setq mark (wl-thread-entity-get-mark (car entity))) - (if (setq meaning (wl-meaning-of-mark mark)) - (if (setq success (assq meaning succeed-list)) - (progn - (setcdr success entity) - (throw 'done nil)) - (setq failure (assq meaning failure-list)) - (unless (cdr failure) - (setcdr (assq meaning failure-list) entity))))) - (setq msgs (cdr msgs))) - (unless msgs - (while (and (null msgs) msgs-stack) - (setq msgs (wl-pop msgs-stack)))) - (setq entity (wl-thread-get-entity (car msgs))))))) - -(defun wl-thread-entity-check-next-mark (entity next-marks) - "Check next mark. Result is stored in NEXT-MARK." - (let ((msgs (list (car entity))) - (succeed-list (car next-marks)) - (failure-list (cdr next-marks)) - msgs-stack children - mark meaning success failure) - (catch 'done - (while msgs - (if (setq mark (wl-thread-entity-get-mark (car entity))) - (if (setq meaning (wl-meaning-of-mark mark)) - (if (setq success (assq meaning succeed-list)) - (progn - (setcdr success entity) - (throw 'done nil)) - (setq failure (assq meaning failure-list)) - (unless (cdr failure) - (setcdr (assq meaning failure-list) entity))))) - (setq msgs (cdr msgs)) - (setq children (wl-thread-entity-get-children entity)) - (if children - (progn - (wl-push msgs msgs-stack) - (setq msgs children)) - (unless msgs - (while (and (null msgs) msgs-stack) - (setq msgs (wl-pop msgs-stack))))) - (setq entity (wl-thread-get-entity (car msgs))))))) + (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))) @@ -373,282 +299,74 @@ ENTITY is returned." ;; top!! (cdr (memq (car entity) wl-thread-entity-list))))) -(defun wl-thread-entity-check-prev-mark-from-older-brother (entity prev-marks) - (let* (older-brother) - (catch 'done - (while entity - (setq older-brother - (reverse (wl-thread-entity-get-older-brothers entity))) - ;; check itself - (let ((succeed-list (car prev-marks)) - (failure-list (cdr prev-marks)) - mark meaning success failure) - (if (setq mark (wl-thread-entity-get-mark (car entity))) - (if (setq meaning (wl-meaning-of-mark mark)) - (if (setq success (assq meaning succeed-list)) - (progn - (setcdr success entity) - (throw 'done nil)) - (setq failure (assq meaning failure-list)) - (unless (cdr failure) - (setcdr (assq meaning failure-list) entity)))))) - ;; check older brothers - (while older-brother - (wl-thread-entity-check-prev-mark (wl-thread-get-entity - (car older-brother)) - prev-marks) - (if (wl-thread-meaning-alist-get-result - (car prev-marks)) - (throw 'done nil)) - (setq older-brother (cdr older-brother))) - (setq entity (wl-thread-entity-get-parent-entity entity)))))) - -(defun wl-thread-entity-get-prev-marked-entity (entity prev-marks) - (let ((older-brothers (reverse - (wl-thread-entity-get-older-brothers entity))) - marked) - (or (catch 'done - (while older-brothers - (wl-thread-entity-check-prev-mark - (wl-thread-get-entity (car older-brothers)) prev-marks) - (if (setq marked - (wl-thread-meaning-alist-get-result - (car prev-marks))) - (throw 'done marked)) - (setq older-brothers (cdr older-brothers)))) - (wl-thread-entity-check-prev-mark-from-older-brother - (wl-thread-entity-get-parent-entity entity) prev-marks) - (if (setq marked - (wl-thread-meaning-alist-get-result - (car prev-marks))) - marked - (if (setq marked - (wl-thread-meaning-alist-get-result - (cdr prev-marks))) - marked))))) - -(defun wl-thread-get-prev-unread (msg &optional hereto) - (let ((cur-entity (wl-thread-get-entity msg)) - (prev-marks (cond ((eq wl-summary-move-order 'new) - (cons (list (cons 'new nil)) - (list (cons 'unread nil) - (cons 'important nil)))) - ((eq wl-summary-move-order 'unread) - (cons (list (cons 'unread nil) - (cons 'new nil)) - (list (cons 'important nil)))) - (t - (cons (list (cons 'unread nil) - (cons 'new nil) - (cons 'important nil)) - nil)))) - mark ret-val) - (if hereto - (when (wl-thread-next-mark-p (setq mark - (wl-thread-entity-get-mark - (car cur-entity))) - (caaar prev-marks)) - ;;(setq mark (cons cur-entity - ;;(wl-thread-entity-get-mark cur-entity))) - (setq ret-val msg))) - (when (and (not ret-val) - (or (setq cur-entity - (wl-thread-entity-get-prev-marked-entity - cur-entity prev-marks)) - (and hereto mark))) - (if (and hereto - (catch 'done - (let ((success-list (car prev-marks))) - (while success-list - (if (cdr (car success-list)) - (throw 'done nil)) - (setq success-list (cdr success-list))) - t)) - (wl-thread-next-failure-mark-p mark (caaar prev-marks))) - (setq ret-val msg) - (when cur-entity - (setq ret-val (car cur-entity))))) - ret-val)) - -(defun wl-thread-jump-to-prev-unread (&optional hereto) - "If prev unread is a children of a closed message. -The closed parent will be opened." - (interactive "P") - (let ((msg (wl-thread-get-prev-unread - (wl-summary-message-number) hereto))) - (when msg - (wl-thread-entity-force-open (wl-thread-get-entity msg)) - (wl-summary-jump-to-msg msg) - t))) - (defun wl-thread-jump-to-msg (&optional number) (interactive) (let ((num (or number - (string-to-int - (read-from-minibuffer "Jump to Message(No.): "))))) + (string-to-int + (read-from-minibuffer "Jump to Message(No.): "))))) (wl-thread-entity-force-open (wl-thread-get-entity num)) (wl-summary-jump-to-msg num))) -(defun wl-thread-get-next-unread (msg &optional hereto) - (let ((cur-entity (wl-thread-get-entity msg)) - (next-marks (cond ((not (elmo-folder-plugged-p - wl-summary-buffer-folder-name)) - (cons (list (cons 'unread nil)) - (list (cons 'important nil)))) - ((eq wl-summary-move-order 'new) - (cons (list (cons 'new nil)) - (list (cons 'unread nil) - (cons 'important nil)))) - ((eq wl-summary-move-order 'unread) - (cons (list (cons 'unread nil) - (cons 'new nil)) - (list (cons 'important nil)))) - (t - (cons (list (cons 'unread nil) - (cons 'new nil) - (cons 'important nil)) - nil)))) - mark ret-val) - (if hereto - (when (wl-thread-next-mark-p (setq mark - (wl-thread-entity-get-mark - (car cur-entity))) - (caaar next-marks)) - (setq ret-val msg))) - (when (and (not ret-val) - (or (setq cur-entity - (wl-thread-entity-get-next-marked-entity - cur-entity next-marks)) - (and hereto mark))) - (if (and hereto - ;; all success-list is nil - (catch 'done - (let ((success-list (car next-marks))) - (while success-list - (if (cdr (car success-list)) - (throw 'done nil)) - (setq success-list (cdr success-list))) - t)) - (wl-thread-next-failure-mark-p mark (caaar next-marks))) - (setq ret-val msg) - (when cur-entity - (setq ret-val (car cur-entity))))) - ret-val)) - -(defun wl-thread-jump-to-next-unread (&optional hereto) - "If next unread is a children of a closed message. -The closed parent will be opened." - (interactive "P") - (let ((msg (wl-thread-get-next-unread - (wl-summary-message-number) hereto))) - (when msg - (wl-thread-entity-force-open (wl-thread-get-entity msg)) - (wl-summary-jump-to-msg msg) - t))) - (defun wl-thread-close-all () "Close all top threads." (interactive) (message "Closing all threads...") - (let ((entities wl-thread-entity-list) - (cur 0) - (len (length wl-thread-entity-list))) - (while entities - (when (and (wl-thread-entity-get-opened (wl-thread-get-entity - (car entities))) - (wl-thread-entity-get-children (wl-thread-get-entity - (car entities)))) - (wl-summary-jump-to-msg (car entities)) - (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") - (goto-char (point-max))) + (save-excursion + (let ((entities wl-thread-entity-list) + (cur 0) + (len (length wl-thread-entity-list))) + (while entities + (when (and (wl-thread-entity-get-opened (wl-thread-get-entity + (car entities))) + (wl-thread-entity-get-children (wl-thread-get-entity + (car entities)))) + (wl-summary-jump-to-msg (car entities)) + (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")) (defun wl-thread-open-all () "Open all threads." (interactive) (message "Opening all threads...") - (let ((entities wl-thread-entity-list) - (cur 0) - (len (length wl-thread-entity-list))) - (while entities - (if (not (wl-thread-entity-get-opened (wl-thread-get-entity - (car entities)))) - (wl-thread-entity-force-open (wl-thread-get-entity - (car entities)))) - (when (> len elmo-display-progress-threshold) - (setq cur (1+ cur)) - (if (or (zerop (% cur 5)) (= cur len)) - (elmo-display-progress - 'wl-thread-open-all "Opening all threads..." - (/ (* cur 100) len)))) - (setq entities (cdr entities)))) - (message "Opening all threads...done") - (goto-char (point-max))) + (save-excursion + (goto-char (point-min)) + (let ((len (count-lines (point-min) (point-max))) + (cur 0) + entity) + (while (not (eobp)) + (if (wl-thread-entity-get-opened + (setq entity (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")) (defun wl-thread-open-all-unread () (interactive) - (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - mark) - (while mark-alist - (if (setq mark (nth 1 (car mark-alist))) - (if (or (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-unread-cached-mark) - (string= mark wl-summary-new-mark) - (string= mark wl-summary-important-mark)) - (wl-thread-entity-force-open (wl-thread-get-entity - (nth 0 (car mark-alist)))))) - (setq mark-alist (cdr mark-alist))))) - -;;; a subroutine for wl-thread-entity-get-next-marked-entity. -(defun wl-thread-entity-check-next-mark-from-younger-brother - (entity next-marks) - (let* (parent younger-brother) - (catch 'done - (while entity - (setq parent (wl-thread-entity-get-parent-entity entity) - younger-brother - (wl-thread-entity-get-younger-brothers entity parent)) - ;; check my brother! - (while younger-brother - (wl-thread-entity-check-next-mark - (wl-thread-get-entity (car younger-brother)) - next-marks) - (if (wl-thread-meaning-alist-get-result - (car next-marks)) - (throw 'done nil)) - (setq younger-brother (cdr younger-brother))) - (setq entity parent))))) - -(defun wl-thread-entity-get-next-marked-entity (entity next-marks) - (let ((children (wl-thread-entity-get-children entity)) - marked) - (or (catch 'done - (while children - (wl-thread-entity-check-next-mark - (wl-thread-get-entity (car children)) next-marks) - (if (setq marked - (wl-thread-meaning-alist-get-result - (car next-marks))) - (throw 'done marked)) - (setq children (cdr children)))) - ;; check younger brother - (wl-thread-entity-check-next-mark-from-younger-brother - entity next-marks) - (if (setq marked - (wl-thread-meaning-alist-get-result - (car next-marks))) - marked - (if (setq marked - (wl-thread-meaning-alist-get-result - (cdr next-marks))) - marked))))) + (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)))) + (wl-thread-entity-force-open (wl-thread-get-entity number)))) (defsubst wl-thread-maybe-get-children-num (msg) (let ((entity (wl-thread-get-entity msg))) @@ -658,50 +376,49 @@ The closed parent will be opened." (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)) - (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) + (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) + overview-entity temp-mark summary-line invisible-top dest-pair) (if (wl-thread-delete-line-from-buffer msg) (progn - (if (memq msg wl-summary-buffer-delete-list) - (setq temp-mark "D")) - (if (memq msg wl-summary-buffer-target-mark-list) - (setq temp-mark "*")) - (if (assq msg wl-summary-buffer-refile-list) - (setq temp-mark "o")) - (if (assq msg wl-summary-buffer-copy-list) - (setq temp-mark "O")) - (unless temp-mark - (setq temp-mark (wl-summary-get-score-mark msg))) + (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")) + (t (setq temp-mark (wl-summary-get-score-mark msg)))) (when (setq overview-entity (elmo-msgdb-overview-get-entity - msg wl-summary-buffer-msgdb)) - (setq summary-line - (wl-summary-overview-create-summary-line - msg - overview-entity - (elmo-msgdb-overview-get-entity - parent-msg wl-summary-buffer-msgdb) - nil - mark-alist - (if wl-thread-insert-force-opened - nil - (wl-thread-maybe-get-children-num msg)) - temp-mark entity)) - (wl-summary-insert-line summary-line))) + msg (wl-summary-buffer-msgdb))) + (wl-summary-insert-line + (wl-summary-create-line + overview-entity + (elmo-msgdb-overview-get-entity + parent-msg (wl-summary-buffer-msgdb)) + temp-mark + (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) 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))))) ;; 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) - overview - mark-alist + (elmo-msgdb-overview-get-entity msg (wl-summary-buffer-msgdb)) entity (and parent-msg (elmo-msgdb-overview-get-entity - parent-msg wl-summary-buffer-msgdb))) + parent-msg (wl-summary-buffer-msgdb)))) ;; currently invisible.. update closed line. (wl-thread-update-children-number invisible-top))))) @@ -777,14 +494,15 @@ The closed parent will be opened." wl-thread-entity-hashtb)) (setq msgs (cdr msgs))))) -(defun wl-thread-get-exist-children (msg) +(defun wl-thread-get-exist-children (msg &optional include-self) (let ((msgs (list msg)) msgs-stack children entity ret-val) (while msgs (setq children (wl-thread-entity-get-children (setq entity (wl-thread-get-entity (car msgs))))) - (when (elmo-msgdb-overview-get-entity (car msgs) wl-summary-buffer-msgdb) + (when (elmo-msgdb-overview-get-entity (car msgs) + (wl-summary-buffer-msgdb)) (wl-append ret-val (list (car msgs))) (setq children nil)) (setq msgs (cdr msgs)) @@ -793,6 +511,7 @@ The closed parent will be opened." (setq msgs (wl-pop msgs-stack))) (wl-push msgs msgs-stack) (setq msgs children))) + (unless include-self (setq ret-val (delq msg ret-val))) ret-val)) (defun wl-thread-delete-message (msg &optional deep update) @@ -855,6 +574,8 @@ The closed parent will be opened." (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 @@ -888,7 +609,8 @@ The closed parent will be opened." (let* (next-top insert-msgs ent e grandchildren) (if top-child (progn - (setq insert-msgs (wl-thread-get-exist-children top-child)) + (setq insert-msgs (wl-thread-get-exist-children + top-child 'include-self)) (setq next-top (car insert-msgs)) (setq ent (wl-thread-get-entity next-top)) (when (and @@ -916,13 +638,13 @@ The closed parent will be opened." ent entity nil)) (setq insert-msgs (cdr insert-msgs)))))) (if update - ;; modify buffer. + ;; modify buffer. (while update-msgs (wl-thread-update-line-on-buffer-sub nil (pop update-msgs))) - ;; don't update buffer + ;; don't update buffer update-msgs)))) ; return value -(defun wl-thread-insert-message (overview-entity overview mark-alist +(defun wl-thread-insert-message (overview-entity msg parent-msg &optional update linked) "Insert MSG to the entity. When optional argument UPDATE is non-nil, @@ -937,7 +659,8 @@ Message is inserted to the summary buffer." ;; 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 (nth 0 parent) nil linked))) ;; insert as top message. (wl-thread-entity-insert-as-top (wl-thread-create-entity msg nil))) @@ -948,17 +671,14 @@ Message is inserted to the summary buffer." (progn (wl-summary-update-thread overview-entity - overview - mark-alist child-entity (elmo-msgdb-overview-get-entity - parent-msg wl-summary-buffer-msgdb)) + parent-msg (wl-summary-buffer-msgdb))) (when parent ;; use thread structure. - (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; + ;;(wl-thread-entity-get-nearly-older-brother + ;; child-entity parent))) ; return value + (wl-thread-entity-get-number parent))) ; return value ;;; (setq beg (point)) ;;; (wl-thread-goto-bottom-of-sub-thread) ;;; (wl-thread-update-indent-string-region beg (point))) @@ -992,50 +712,9 @@ Message is inserted to the summary buffer." (defun wl-thread-update-children-number (entity) "Update the children number." - (save-excursion - (wl-summary-jump-to-msg (wl-thread-entity-get-number entity)) - (beginning-of-line) - (let ((text-prop (get-text-property (point) 'face)) - from from-end beg str) - (cond - ((looking-at (concat "^" wl-summary-buffer-number-regexp - "..../..\(.*\)..:.. [" - wl-thread-indent-regexp - "]*[[<]\\+\\([0-9]+\\):")) - (delete-region (match-beginning 1)(match-end 1)) - (goto-char (match-beginning 1)) - (setq str (format "%s" (wl-thread-entity-get-children-num entity))) - (if wl-summary-highlight - (put-text-property 0 (length str) 'face text-prop str)) - (insert str)) - ((looking-at (concat "^" wl-summary-buffer-number-regexp - "..../..\(.*\)..:.. [" - wl-thread-indent-regexp - "]*[[<]")) - (goto-char (match-end 0)) - (setq beg (current-column)) - (setq from-end (save-excursion - (move-to-column (+ 1 beg wl-from-width)) - (point))) - (setq from (buffer-substring (match-end 0) from-end)) - (delete-region (match-end 0) from-end) - (setq str (wl-set-string-width - (1+ wl-from-width) - (format - "+%s:%s" - (wl-thread-entity-get-children-num - entity) - from))) - (if wl-summary-highlight - (put-text-property 0 (length str) 'face text-prop str)) - (insert str) - (condition-case nil ; it's dangerous, so ignore error. - (run-hooks 'wl-thread-update-children-number-hook) - (error - (ding) - (message "Error in wl-thread-update-children-number-hook.")))))))) - -;; + (wl-thread-update-line-on-buffer (wl-thread-entity-get-number entity))) + +;; ;; Thread oriented commands. ;; (defun wl-thread-call-region-func (func &optional arg) @@ -1053,17 +732,14 @@ Message is inserted to the summary buffer." (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) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - cur-mark) - (setq cur-mark (cadr (assq msg mark-alist))) - (setq mark-alist - (elmo-msgdb-mark-set mark-alist - msg - (if (string= cur-mark wl-summary-important-mark) - nil - wl-summary-important-mark))) - (elmo-msgdb-set-mark-alist msgdb mark-alist) + (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) @@ -1093,7 +769,7 @@ Message is inserted to the summary buffer." (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) @@ -1159,8 +835,7 @@ Message is inserted to the summary buffer." (/ (* cur 100) len))))))) (defsubst wl-thread-insert-entity-sub (indent entity parent-entity all) - (let ((mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - msg-num + (let (msg-num overview-entity temp-mark summary-line) @@ -1178,22 +853,21 @@ Message is inserted to the summary buffer." (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)) + (nth 0 entity) (wl-summary-buffer-msgdb))) ;;; (wl-delete-all-overlays) (when overview-entity - (setq summary-line - (wl-summary-overview-create-summary-line - msg-num - overview-entity - (elmo-msgdb-overview-get-entity - (nth 0 parent-entity) wl-summary-buffer-msgdb) - (1+ indent) - mark-alist - (if wl-thread-insert-force-opened - nil - (wl-thread-maybe-get-children-num msg-num)) - temp-mark entity)) - (wl-summary-insert-line summary-line))))) + (wl-summary-insert-line + (wl-summary-create-line + overview-entity + (elmo-msgdb-overview-get-entity + (nth 0 parent-entity) (wl-summary-buffer-msgdb)) + temp-mark + (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg-num) + (if wl-thread-insert-force-opened + nil + (wl-thread-maybe-get-children-num msg-num)) + (wl-thread-make-indent-string entity) + (wl-thread-entity-get-linked entity))))))) (defun wl-thread-insert-entity (indent entity parent-entity all) "Insert thread entity in current buffer." @@ -1299,20 +973,22 @@ 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)) - (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)) + (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) mark uncached-list) (while children-msgs (if (and (not (eq msg (car children-msgs))) ; except itself (or (and uncached-marks - (setq mark (cadr (assq (car children-msgs) - mark-alist))) + (setq mark (elmo-msgdb-get-mark + (wl-summary-buffer-msgdb) + (car children-msgs))) (member mark uncached-marks)) (and (not uncached-marks) - (null (elmo-cache-exists-p - (cdr (assq (car children-msgs) - number-alist))))))) + (null (elmo-file-cache-exists-p + (elmo-message-field + wl-summary-buffer-elmo-folder + (car children-msgs) + 'message-id)))))) (wl-append uncached-list (list (car children-msgs)))) (setq children-msgs (cdr children-msgs))) uncached-list)) @@ -1402,31 +1078,27 @@ Message is inserted to the summary buffer." (wl-summary-jump-to-msg msg) (wl-thread-close (wl-thread-get-entity (wl-summary-message-number))))))) + (when wl-summary-lazy-highlight + (wl-highlight-summary-window)) (wl-summary-set-message-modified) (set-buffer-modified-p nil)))) - (defun wl-thread-get-depth-of-current-line () - (interactive) - (save-excursion - (beginning-of-line) - (let ((depth 0)) - (if (re-search-forward (concat "^" wl-summary-buffer-number-regexp - "..../..\(.*\)..:.. ") - nil t) - (while (string-match wl-thread-indent-regexp - (char-to-string - (char-after (point)))) - (setq depth (1+ depth)) - (forward-char))) - (/ depth wl-thread-indent-level-internal)))) - + (let ((entity (wl-thread-get-entity (wl-summary-message-number))) + (depth 0) + number) + (while (setq number (wl-thread-entity-get-parent entity)) + (incf depth) + (setq entity (wl-thread-get-entity number))) + depth)) + (defun wl-thread-update-indent-string-region (beg end) (interactive "r") (save-excursion (goto-char beg) (while (< (point) end) - (wl-thread-update-indent-string) + (save-excursion + (wl-thread-update-line-on-buffer-sub nil (wl-summary-message-number))) (forward-line 1)))) (defsubst wl-thread-make-indent-string (entity) @@ -1457,35 +1129,6 @@ Message is inserted to the summary buffer." (setq cur (wl-thread-entity-get-parent-entity cur)))) ret-val)) -(defun wl-thread-update-indent-string () - "Update indent string of current line." - (interactive) - (save-excursion - (beginning-of-line) - (let ((inhibit-read-only t) - (buffer-read-only nil) - thr-str) - (when (looking-at (concat "^ *\\([0-9]+\\)" - "..../..\(.*\)..:.. \\(" - wl-highlight-thread-indent-string-regexp - "\\)[[<]")) - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) - (match-end 2)) - (setq thr-str - (wl-thread-make-indent-string - (wl-thread-get-entity (string-to-int (wl-match-buffer 1))))) - (if (and wl-summary-width - wl-summary-indent-length-limit - (< wl-summary-indent-length-limit - (string-width thr-str))) - (setq thr-str (wl-set-string-width - wl-summary-indent-length-limit - thr-str))) - (insert thr-str) - (if wl-summary-highlight - (wl-highlight-summary-current-line)))))) - (defun wl-thread-set-parent (&optional parent-number) "Set current message's parent interactively." (interactive)