From: teranisi Date: Thu, 22 Feb 2001 06:43:25 +0000 (+0000) Subject: Synch up with main trunk. X-Git-Tag: wl-2_8-root^2~27 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2dc9710be02a0fe09d354dda7ca8df6ad2f32c50;p=elisp%2Fwanderlust.git Synch up with main trunk. --- diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index a1d391e..0d06ecf 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -5,7 +5,7 @@ @c %**end of header @documentlanguage ja @documentencoding iso-2022-jp -@set VERSION 2.5.7 +@set VERSION 2.5.8 @synindex pg cp @finalout diff --git a/doc/wl.texi b/doc/wl.texi index 5f123b7..ab5a1da 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -5,7 +5,7 @@ @c %**end of header @documentlanguage en @documentencoding us-ascii -@set VERSION 2.5.7 +@set VERSION 2.5.8 @synindex pg cp @finalout diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 995cac7..f79f2c4 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,11 @@ +2001-02-22 Yuuichi Teranishi + + * elmo-version.el (elmo-version): Up to 2.5.8. + + * elmo.el (elmo-folder-list-messages-mark-match): New function. + + * elmo-util.el (elmo-list-insert): New function. + 2001-02-21 Yuuichi Teranishi * elmo.el (elmo-init): New function. diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 05d7477..a3d97c4 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -339,6 +339,20 @@ Return value is a cons cell of (STRUCTURE . REST)" (cdr tmp))))))) lst) +(defun elmo-list-insert (list element after) + "Insert an ELEMENT to the LIST, just after AFTER." + (let ((li list) + (curn 0) + p pn) + (while li + (if (eq (car li) after) + (setq p li pn curn li nil) + (incf curn)) + (setq li (cdr li))) + (if pn + (setcdr (nthcdr pn list) (cons element (cdr p))) + (nconc list (list element))))) + (defun elmo-string-partial-p (string) (and (stringp string) (string-match "message/partial" string))) diff --git a/elmo/elmo-version.el b/elmo/elmo-version.el index 9c6e3ed..0836ef1 100644 --- a/elmo/elmo-version.el +++ b/elmo/elmo-version.el @@ -39,7 +39,7 @@ ;; product-define in the first place (product-provide 'elmo-version - (product-define "ELMO" nil '(2 5 7))) + (product-define "ELMO" nil '(2 5 8))) ;; For APEL 10.2 or earlier. (defun-maybe product-version-as-string (product) diff --git a/elmo/elmo.el b/elmo/elmo.el index 72eefde..168f8e9 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -900,7 +900,17 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") "Get mark of the message. FOLDER is the ELMO folder structure. NUMBER is a number of the message." - (cdr (assq number (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))) + (cadr (assq number (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))) + +(defun elmo-folder-list-messages-mark-match (folder mark-regexp) + "List messages in the FOLDER which have a mark that matches MARK-REGEXP" + (let ((case-fold-search nil) + matched) + (if mark-regexp + (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) + (if (string-match mark-regexp (cadr elem)) + (setq matched (cons (car elem) matched))))) + matched)) (defun elmo-message-field (folder number field) "Get message field value in the msgdb. diff --git a/wl/ChangeLog b/wl/ChangeLog index 8aad2b6..9af4767 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,57 @@ +2001-02-22 Yuuichi Teranishi + + * Version number is increased to 2.5.8. + + * wl-thread.el (toplevel): require 'cl. + (wl-thread-resume-entity): Call wl-thread-make-number-list. + (wl-thread-make-number-list): New function. + (wl-thread-entity-make-number-list-from-children): Ditt. + (wl-thread-entity-insert-as-top): Update wl-summary-buffer-number-list. + (wl-thread-entity-insert-as-children): Likewise. + (wl-thread-delete-message): Likewise. + (wl-meaning-of-mark): Eliminated. + (wl-thread-next-failure-mark-p): Ditto. + (wl-thread-entity-get-mark): Ditto. + (wl-thread-meaning-alist-get-result): Ditto. + (wl-thread-entity-check-prev-mark): Ditto. + (wl-thread-entity-check-next-mark): Ditto. + (wl-thread-entity-check-prev-mark-from-older-brother): Ditto. + (wl-thread-entity-get-prev-marked-entity): Ditto. + (wl-thread-get-prev-unread): Ditto. + (wl-thread-jump-to-prev-unread): Ditto. + (wl-thread-get-next-unread): Ditto. + (wl-thread-jump-to-next-unread): Ditto. + (wl-thread-entity-check-next-mark-from-younger-brother): Ditto. + (wl-thread-entity-get-next-marked-entity): Ditto. + + * wl-summary.el (wl-summary-buffer-number-list): + New bufer-local variable. + (wl-summary-switch-to-clone-buffer): Clone + `wl-summary-buffer-number-list'. + (wl-summary-goto-folder-subr): Use `wl-summary-next-message'. + (wl-summary-cursor-move-regex): Eliminated. + (wl-summary-cursor-up): Rewrite. + (wl-summary-cursor-down): Ditto. + (wl-summary-mode-spec-alist): New variable. + (wl-summary-next-message): New inline function. + (wl-summary-cursor-move): New function. + (wl-summary-default-get-next-msg): Rewrite. + (wl-summary-sync-all-init): Setup `wl-summary-number-list'. + (wl-summary-rescan): Ditto. + (wl-summary-sync-all-init): Ditto. + (wl-summary-goto-folder-subr): Call `wl-summary-make-number-list' if + summary is not thread view. + (wl-summary-sync-update): Ditto. + (wl-summary-rescan): Ditto. + (wl-summary-make-number-list): New function. + + * wl-draft.el: "FCC" -> "Fcc". + 2001-02-21 Yuuichi Teranishi + * wl-highlight.el (wl-highlight-summary-window): + Call `set-buffer-modified-p'. + * wl.el (wl-init): Don't call `elmo-crosspost-message-alist-load'. (wl): Call `elmo-init' and fix. diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 65acdd6..6674de4 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -694,11 +694,11 @@ Reply to author if WITH-ARG is non-nil." (message ""))) (defun wl-draft-fcc () - "Add a new FCC field, with file name completion." + "Add a new Fcc field, with file name completion." (interactive) - (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. + (or (mail-position-on-field "fcc" t) ;Put new field after exiting Fcc. (mail-position-on-field "to")) - (insert "\nFCC: ")) + (insert "\nFcc: ")) ;; function for wl-sent-message-via @@ -1204,7 +1204,7 @@ If optional argument is non-nil, current draft buffer is killed" (or (markerp header-end) (error "header-end must be a marker")) (save-excursion (goto-char (point-min)) - (while (re-search-forward "^FCC:[ \t]*" header-end t) + (while (re-search-forward "^Fcc:[ \t]*" header-end t) (setq fcc-list (cons (buffer-substring-no-properties (point) @@ -1347,7 +1347,7 @@ If optional argument is non-nil, current draft buffer is killed" (insert "Reply-To: " mail-default-reply-to "\n")) (wl-draft-insert-ccs "Bcc: " (or wl-bcc (and mail-self-blind (user-login-name)))) - (wl-draft-insert-ccs "FCC: " wl-fcc) + (wl-draft-insert-ccs "Fcc: " wl-fcc) (if wl-organization (insert "Organization: " wl-organization "\n")) (and wl-auto-insert-x-face diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index e73a998..ec8b5a1 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -1023,7 +1023,8 @@ This function is defined for `window-scroll-functions'" (save-excursion (goto-char (window-start win)) (forward-line (frame-height)) - (point)))))) + (point))) + (set-buffer-modified-p nil)))) (defun wl-highlight-headers (&optional for-draft) (let ((beg (point-min)) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 86a322b..3541815 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -108,6 +108,8 @@ (defvar wl-summary-buffer-prev-folder-func nil) (defvar wl-summary-buffer-next-folder-func nil) (defvar wl-summary-buffer-exit-func nil) +(defvar wl-summary-buffer-number-list nil) + (defvar wl-thread-indent-level-internal nil) (defvar wl-thread-have-younger-brother-str-internal nil) (defvar wl-thread-youngest-child-str-internal nil) @@ -174,6 +176,7 @@ (make-variable-buffer-local 'wl-summary-buffer-prev-folder-func) (make-variable-buffer-local 'wl-summary-buffer-next-folder-func) (make-variable-buffer-local 'wl-summary-buffer-exit-func) +(make-variable-buffer-local 'wl-summary-buffer-number-list) ;; internal functions (dummy) (unless (fboundp 'wl-summary-append-message-func-internal) @@ -846,6 +849,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2))) (setq wl-thread-entity-list nil) (setq wl-thread-entities nil) + (setq wl-summary-buffer-number-list nil) (setq wl-summary-buffer-target-mark-list nil) (setq wl-summary-buffer-refile-list nil) (setq wl-summary-buffer-delete-list nil) @@ -875,10 +879,12 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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...") - (wl-thread-insert-top) - (message "Inserting thread...done")) + (if (eq wl-summary-buffer-view 'thread) + (progn + (message "Inserting thread...") + (wl-thread-insert-top) + (message "Inserting thread...done")) + (wl-summary-make-number-list)) (when wl-use-scoring (setq wl-summary-scored nil) (wl-summary-score-headers nil msgdb @@ -1064,6 +1070,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (wl-summary-buffer-msgdb))) 2))) (setq wl-thread-entity-list nil) (setq wl-thread-entities nil) + (setq wl-summary-buffer-number-list nil) (setq wl-summary-buffer-target-mark-list nil) (setq wl-summary-buffer-refile-list nil) (setq wl-summary-buffer-copy-list nil) @@ -2132,6 +2139,8 @@ If ARG is non-nil, checking is omitted." (wl-thread-update-indent-string-thread (elmo-uniq-list update-top-list))) (message "Updating thread...done")) + (unless (eq wl-summary-buffer-view 'thread) + (wl-summary-make-number-list)) (wl-summary-set-message-modified) (wl-summary-set-mark-modified) (when (and sync-all (eq wl-summary-buffer-view 'thread)) @@ -2449,7 +2458,8 @@ If ARG, without confirm." wl-summary-buffer-number-regexp wl-summary-buffer-message-modified wl-summary-buffer-mark-modified - wl-summary-buffer-thread-modified) + wl-summary-buffer-thread-modified + wl-summary-buffer-number-list) (and (eq wl-summary-buffer-view 'thread) '(wl-thread-entity-hashtb wl-thread-entities @@ -2500,6 +2510,12 @@ If ARG, without confirm." (or (get-buffer (wl-summary-sticky-buffer-name name)) (get-buffer-create wl-summary-buffer-name)))) +(defun wl-summary-make-number-list () + (setq wl-summary-buffer-number-list + (mapcar + (lambda (x) (elmo-msgdb-overview-entity-get-number x)) + (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))))) + (defun wl-summary-goto-folder-subr (&optional name scan-type other-window sticky interactive scoring) "Display target folder on summary." @@ -2553,8 +2569,7 @@ If ARG, without confirm." (cache (expand-file-name wl-summary-cache-file dir)) (view (expand-file-name wl-summary-view-file dir))) (when (file-exists-p cache) - (as-binary-input-file - (insert-file-contents cache)) + (insert-file-contents-as-binary cache) (elmo-set-buffer-multibyte default-enable-multibyte-characters) (decode-mime-charset-region @@ -2564,7 +2579,8 @@ If ARG, without confirm." (setq wl-summary-buffer-view (wl-summary-load-file-object view))) (if (eq wl-summary-buffer-view 'thread) - (wl-thread-resume-entity folder)))) + (wl-thread-resume-entity folder) + (wl-summary-make-number-list)))) ;; Select folder (elmo-folder-open folder) (wl-summary-count-unread @@ -2601,10 +2617,9 @@ If ARG, without confirm." (set-buffer-modified-p nil) (goto-char (point-min)) (if (wl-summary-cursor-down t) - (let ((unreadp (wl-thread-next-mark-p - (wl-thread-entity-get-mark - (wl-summary-message-number)) - wl-summary-move-order))) + (let ((unreadp (wl-summary-next-message + (wl-summary-message-number) + 'down nil))) (cond ((and wl-auto-select-first unreadp) (setq retval 'disp-msg)) ((not unreadp) @@ -4279,107 +4294,62 @@ If ARG, exit virtual folder." (wl-match-string 1 wday-str) (elmo-date-get-week year month mday)))) -(defmacro wl-summary-cursor-move-regex () - (` (let ((mark-alist - (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder) - (cond ((eq wl-summary-move-order 'new) - (list - (list - wl-summary-new-mark) - (list - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark - wl-summary-important-mark))) - ((eq wl-summary-move-order 'unread) - (list - (list - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark - wl-summary-new-mark) - (list - wl-summary-important-mark))) - (t - (list - (list - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark - wl-summary-new-mark - wl-summary-important-mark)))) - (cond ((eq wl-summary-move-order 'unread) - (list - (list - wl-summary-unread-cached-mark) - (list - wl-summary-important-mark))) - (t - (list - (list - wl-summary-unread-cached-mark - wl-summary-important-mark))))))) - (mapcar - (function - (lambda (mark-list) - (concat wl-summary-message-regexp - ".\\(" - (mapconcat 'regexp-quote - mark-list - "\\|") - "\\)\\|" - wl-summary-message-regexp "\\*"))) - mark-alist)))) - -;; -;; Goto unread or important -;; -(defun wl-summary-cursor-up (&optional hereto) - (interactive "P") - (if (and (not wl-summary-buffer-target-mark-list) - (eq wl-summary-buffer-view 'thread)) - (progn - (if (eobp) - (forward-line -1)) - (wl-thread-jump-to-prev-unread hereto)) - (if hereto - (end-of-line) - (beginning-of-line)) - (let ((case-fold-search nil) - regex-list) - (setq regex-list (wl-summary-cursor-move-regex)) - (catch 'done - (while regex-list - (when (re-search-backward - (car regex-list) - nil t nil) - (beginning-of-line) - (throw 'done t)) - (setq regex-list (cdr regex-list))) - (beginning-of-line) - (throw 'done nil))))) - +(defvar wl-summary-move-spec-alist + '((new . ((p . "\\(N\\|\\$\\)") + (p . "\\(U\\|!\\)") + (t . nil))) + (unread . ((p . "\\(N\\|\\$\\|U\\|!\\)") + (t . nil))))) + +(defsubst wl-summary-next-message (num direction hereto) + (let ((cur-spec (cdr (assq wl-summary-move-order + wl-summary-move-spec-alist))) + (nums (memq num (if (eq direction 'up) + (reverse wl-summary-buffer-number-list) + wl-summary-buffer-number-list))) + marked-list nums2) + (unless hereto (setq nums (cdr nums))) + (setq nums2 nums) + (catch 'done + (while cur-spec + (setq nums nums2) + (cond ((eq (car (car cur-spec)) 'p) + (if (setq marked-list (elmo-folder-list-messages-mark-match + wl-summary-buffer-elmo-folder + (cdr (car cur-spec)))) + (while nums + (if (memq (car nums) marked-list) + (throw 'done (car nums))) + (setq nums (cdr nums))))) + ((eq (car (car cur-spec)) 't) + (while nums + (if (and wl-summary-buffer-target-mark-list + (memq (car nums) + wl-summary-buffer-target-mark-list)) + (throw 'done (car nums))) + (setq nums (cdr nums))))) + (setq cur-spec (cdr cur-spec)))))) + +(defsubst wl-summary-cursor-move (direction hereto) + (when (and (eq direction 'up) + (eobp)) + (forward-line -1) + (setq hereto t)) + (let (num) + (when (setq num (wl-summary-next-message (wl-summary-message-number) + direction hereto)) + (wl-thread-jump-to-msg num) + t))) ;; ;; Goto unread or important ;; returns t if next message exists in this folder. (defun wl-summary-cursor-down (&optional hereto) (interactive "P") - (if (and (null wl-summary-buffer-target-mark-list) - (eq wl-summary-buffer-view 'thread)) - (wl-thread-jump-to-next-unread hereto) - (if hereto - (beginning-of-line) - (end-of-line)) - (let ((case-fold-search nil) - regex-list) - (setq regex-list (wl-summary-cursor-move-regex)) - (catch 'done - (while regex-list - (when (re-search-forward - (car regex-list) - nil t nil) - (beginning-of-line) - (throw 'done t)) - (setq regex-list (cdr regex-list))) - (beginning-of-line) - (throw 'done nil))))) + (wl-summary-cursor-move 'down hereto)) + +(defun wl-summary-cursor-up (&optional hereto) + (interactive "P") + (wl-summary-cursor-move 'up hereto)) (defun wl-summary-save-view-cache () (save-excursion @@ -5625,22 +5595,10 @@ Use function list is `wl-summary-write-current-folder-functions'." ;; (message "Dropping...done")))) (defun wl-summary-default-get-next-msg (msg) - (let (next) - (if (and (not wl-summary-buffer-target-mark-list) - (eq wl-summary-buffer-view 'thread) - (if (eq wl-summary-move-direction-downward nil) - (setq next (wl-thread-get-prev-unread msg)) - (setq next (wl-thread-get-next-unread msg)))) - next - (save-excursion - (wl-summary-jump-to-msg msg) - (let (wl-summary-buffer-disp-msg) - (if (eq wl-summary-move-direction-downward nil) - (unless (wl-summary-cursor-up) - (wl-summary-prev)) - (unless (wl-summary-cursor-down) - (wl-summary-next))) - (wl-summary-message-number)))))) + (wl-summary-next-message msg + (if wl-summary-move-direction-downward 'down + 'up) + nil)) (defun wl-summary-save-current-message () "Save current message for `wl-summary-yank-saved-message'." diff --git a/wl/wl-thread.el b/wl/wl-thread.el index 81db491..eb52fd9 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -33,6 +33,7 @@ (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 @@ -53,49 +54,6 @@ ;;;;;; each entity is (number opened-or-not children parent) ;;;;;;; -(defun wl-meaning-of-mark (mark) - (if (not (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)) - (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-elmo-folder)) - (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-elmo-folder)) - (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 @@ -105,7 +63,6 @@ (wl-summary-load-file-object (expand-file-name wl-thread-entity-list-file (elmo-folder-msgdb-path fld)))) - (current-buffer) (message "Resuming thread structure...") ;; set obarray value. (setq wl-thread-entity-hashtb (elmo-make-hash (* (length entities) 2))) @@ -116,8 +73,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 +189,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)) @@ -267,82 +277,6 @@ ENTITY is returned." ;; 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))))))) - (defun wl-thread-entity-get-nearly-older-brother (entity &optional parent) (let ((brothers (wl-thread-entity-get-older-brothers entity parent))) (when brothers @@ -373,114 +307,6 @@ 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 @@ -489,63 +315,6 @@ The closed parent will be opened." (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-elmo-folder)) - (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) @@ -611,50 +380,6 @@ The closed parent will be opened." (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))))) - (defsubst wl-thread-maybe-get-children-num (msg) (let ((entity (wl-thread-get-entity msg))) (if (not (wl-thread-entity-get-opened entity)) @@ -864,6 +589,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