From ac18c23c913af08650ffbe27c9928d6ee913ab9d Mon Sep 17 00:00:00 2001 From: teranisi Date: Thu, 22 Feb 2001 06:39:09 +0000 Subject: [PATCH] * 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-update3): Ditto. (wl-summary-rescan): Ditto. (wl-summary-make-number-list): New function. * wl-draft.el: "FCC" -> "Fcc". * elmo-version.el (elmo-version): Up to 2.5.8. * elmo2.el (elmo-msgdb-list-messages-mark-match): New function. * elmo-util.el (elmo-list-insert): New function. --- doc/wl-ja.texi | 2 +- doc/wl.texi | 2 +- elmo/ChangeLog | 10 +- elmo/elmo-util.el | 14 ++ elmo/elmo-version.el | 2 +- elmo/elmo2.el | 10 ++ wl/ChangeLog | 49 +++++++ wl/wl-draft.el | 10 +- wl/wl-summary.el | 206 +++++++++++---------------- wl/wl-thread.el | 387 ++++++++------------------------------------------ 10 files changed, 229 insertions(+), 463 deletions(-) diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index 94ed4ea..ab594ef 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 d06f7f3..4fa13ff 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,8 +1,16 @@ +2001-02-22 Yuuichi Teranishi + + * elmo-version.el (elmo-version): Up to 2.5.8. + + * elmo2.el (elmo-msgdb-list-messages-mark-match): New function. + + * elmo-util.el (elmo-list-insert): New function. + 2001-02-21 OKAZAKI Tetsurou * elmo-util.el (elmo-display-progress): Prefer `progress-feedback-with-label' to `lprogress-display'. - + 2000-02-20 Kenichi OKADA * elmo-imap4.el (elmo-network-authenticate-session): Fix. diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 80b1a71..3cd1ac3 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -682,6 +682,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/elmo2.el b/elmo/elmo2.el index 07a9384..f99ffeb 100644 --- a/elmo/elmo2.el +++ b/elmo/elmo2.el @@ -921,6 +921,16 @@ message list in msgdb. Otherwise, number-list is load from msgdb." (fld (nth (- (/ number elmo-multi-divide-number) 1) flds))) (elmo-folder-number-get-spec fld number))) +(defun elmo-msgdb-list-messages-mark-match (msgdb 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 msgdb)) + (if (string-match mark-regexp (cadr elem)) + (setq matched (cons (car elem) matched))))) + matched)) + ;; autoloads (autoload 'elmo-nntp-make-groups-hashtb "elmo-nntp") (autoload 'elmo-nntp-post "elmo-nntp") diff --git a/wl/ChangeLog b/wl/ChangeLog index 2e2d738..3f1bea6 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,52 @@ +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-update3): 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): diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 5696228..3ff553d 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -690,11 +690,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 @@ -1200,7 +1200,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) @@ -1339,7 +1339,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-summary.el b/wl/wl-summary.el index 376947b..a8254cb 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -97,6 +97,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) @@ -163,6 +165,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) @@ -864,6 +867,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) @@ -893,10 +897,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 @@ -1141,6 +1147,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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-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) @@ -2294,6 +2301,8 @@ If ARG is non-nil, checking is omitted." (message "Updating thread...done") ;;; (set-buffer cur-buf) )) + (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)) @@ -2606,7 +2615,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 @@ -2682,6 +2692,12 @@ If ARG, without confirm." (delete-window mes-win) (run-hooks 'wl-summary-toggle-disp-off-hook)))) +(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 folder scan-type other-window sticky interactive scoring) "Display target folder on summary." @@ -2728,8 +2744,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 @@ -2739,7 +2754,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 fld)))) + (wl-thread-resume-entity fld) + (wl-summary-make-number-list)))) ;; Load msgdb (setq wl-summary-buffer-msgdb nil) ; new msgdb (setq wl-summary-buffer-msgdb @@ -2781,10 +2797,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) @@ -4467,107 +4482,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-folder-name) - (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-msgdb-list-messages-mark-match + wl-summary-buffer-msgdb + (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 @@ -5947,22 +5917,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)) (defsubst wl-cache-prefetch-p (fld &optional num) (cond ((and num wl-cache-prefetch-folder-type-list) diff --git a/wl/wl-thread.el b/wl/wl-thread.el index e153785..da99f95 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-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 @@ -105,7 +63,6 @@ (wl-summary-load-file-object (expand-file-name wl-thread-entity-list-file (elmo-msgdb-expand-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-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) @@ -610,50 +379,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)) @@ -863,6 +588,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 -- 1.7.10.4