* 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.
@c %**end of header
@documentlanguage ja
@documentencoding iso-2022-jp
-@set VERSION 2.5.7
+@set VERSION 2.5.8
@synindex pg cp
@finalout
@c %**end of header
@documentlanguage en
@documentencoding us-ascii
-@set VERSION 2.5.7
+@set VERSION 2.5.8
@synindex pg cp
@finalout
+2001-02-22 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <okazaki@be.to>
* elmo-util.el (elmo-display-progress): Prefer
`progress-feedback-with-label' to `lprogress-display'.
-
+
2000-02-20 Kenichi OKADA <okada@opaopa.org>
* elmo-imap4.el (elmo-network-authenticate-session): Fix.
(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)))
;; 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)
(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")
+2001-02-22 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
* wl-highlight.el (wl-highlight-summary-window):
(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
(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)
(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
(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)
(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)
(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)
(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
(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)
(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))
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
(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."
(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
(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
(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)
(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
(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)
(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
;;;;;; 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
(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)))
(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))
(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))
;; 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
;; 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
(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)
(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))
(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
projects / elisp / wanderlust.git / commitdiff