X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-thread.el;h=067b10cf813357220e9276e7040a125d7ccec7f1;hb=709366cf00291239e4287abb0b2105ad47fdbf59;hp=26f4eab5d7b2d3f41f77f56250ede1c0505931ae;hpb=0fbd8fa3e611a5f03687ff7e11f98083d67bc1ce;p=elisp%2Fwanderlust.git diff --git a/wl/wl-thread.el b/wl/wl-thread.el index 26f4eab..067b10c 100644 --- a/wl/wl-thread.el +++ b/wl/wl-thread.el @@ -41,13 +41,10 @@ (defvar wl-thread-entities nil) (defvar wl-thread-entity-list nil) ; entity list (defvar wl-thread-entity-hashtb nil) ; obarray -(defvar wl-thread-indent-regexp nil) (make-variable-buffer-local 'wl-thread-entity-hashtb) (make-variable-buffer-local 'wl-thread-entities) ; ".wl-thread-entity" (make-variable-buffer-local 'wl-thread-entity-list) ; ".wl-thread-entity-list" -(make-variable-buffer-local 'wl-thread-entity-cur) -(make-variable-buffer-local 'wl-thread-indent-regexp) ;;; global flag (defvar wl-thread-insert-force-opened nil) @@ -103,7 +100,7 @@ msgs-stack children) (while msgs (setq wl-summary-buffer-number-list (cons (car entity) - wl-summary-buffer-number-list)) + wl-summary-buffer-number-list)) (setq msgs (cdr msgs)) (setq children (wl-thread-entity-get-children entity)) (if children @@ -199,14 +196,14 @@ 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))) + (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)) @@ -368,17 +365,13 @@ ENTITY is returned." (defun wl-thread-open-all-unread () (interactive) - (let ((mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) - mark) - (while mark-alist - (if (setq mark (nth 1 (car mark-alist))) - (if (or (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-unread-cached-mark) - (string= mark wl-summary-new-mark) - (string= mark wl-summary-important-mark)) - (wl-thread-entity-force-open (wl-thread-get-entity - (nth 0 (car mark-alist)))))) - (setq mark-alist (cdr mark-alist))))) + (dolist (number (elmo-folder-list-messages-mark-match + wl-summary-buffer-elmo-folder + (wl-regexp-opt (list elmo-msgdb-unread-uncached-mark + elmo-msgdb-unread-cached-mark + elmo-msgdb-new-mark + elmo-msgdb-important-mark)))) + (wl-thread-entity-force-open (wl-thread-get-entity number)))) (defsubst wl-thread-maybe-get-children-num (msg) (let ((entity (wl-thread-get-entity msg))) @@ -389,7 +382,6 @@ ENTITY is returned." (let* ((entity (or entity (wl-thread-get-entity msg))) (parent-msg (or parent-msg (wl-thread-entity-get-parent entity))) (overview (elmo-msgdb-get-overview (wl-summary-buffer-msgdb))) - (mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (buffer-read-only nil) (inhibit-read-only t) overview-entity temp-mark summary-line invisible-top dest-pair) @@ -408,20 +400,18 @@ ENTITY is returned." (when (setq overview-entity (elmo-msgdb-overview-get-entity msg (wl-summary-buffer-msgdb))) - (setq summary-line - (wl-summary-overview-create-summary-line - msg - overview-entity - (elmo-msgdb-overview-get-entity - parent-msg (wl-summary-buffer-msgdb)) - nil - mark-alist - (if wl-thread-insert-force-opened - nil - (wl-thread-maybe-get-children-num msg)) - temp-mark entity)) - (save-excursion - (wl-summary-insert-line summary-line)) + (wl-summary-insert-line + (wl-summary-create-line + overview-entity + (elmo-msgdb-overview-get-entity + parent-msg (wl-summary-buffer-msgdb)) + temp-mark + (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg) + (if wl-thread-insert-force-opened + nil + (wl-thread-maybe-get-children-num msg)) + (wl-thread-make-indent-string entity) + (wl-thread-entity-get-linked entity))) (if dest-pair (wl-summary-print-destination (car dest-pair) (cdr dest-pair))))) @@ -430,8 +420,6 @@ ENTITY is returned." (wl-thread-entity-parent-invisible-p entity))) (wl-summary-update-thread (elmo-msgdb-overview-get-entity msg (wl-summary-buffer-msgdb)) - overview - mark-alist entity (and parent-msg (elmo-msgdb-overview-get-entity @@ -511,14 +499,15 @@ ENTITY is returned." wl-thread-entity-hashtb)) (setq msgs (cdr msgs))))) -(defun wl-thread-get-exist-children (msg) +(defun wl-thread-get-exist-children (msg &optional include-self) (let ((msgs (list msg)) msgs-stack children entity ret-val) (while msgs (setq children (wl-thread-entity-get-children (setq entity (wl-thread-get-entity (car msgs))))) - (when (elmo-msgdb-overview-get-entity (car msgs) (wl-summary-buffer-msgdb)) + (when (elmo-msgdb-overview-get-entity (car msgs) + (wl-summary-buffer-msgdb)) (wl-append ret-val (list (car msgs))) (setq children nil)) (setq msgs (cdr msgs)) @@ -527,6 +516,7 @@ ENTITY is returned." (setq msgs (wl-pop msgs-stack))) (wl-push msgs msgs-stack) (setq msgs children))) + (unless include-self (setq ret-val (delq msg ret-val))) ret-val)) (defun wl-thread-delete-message (msg &optional deep update) @@ -624,7 +614,8 @@ ENTITY is returned." (let* (next-top insert-msgs ent e grandchildren) (if top-child (progn - (setq insert-msgs (wl-thread-get-exist-children top-child)) + (setq insert-msgs (wl-thread-get-exist-children + top-child 'include-self)) (setq next-top (car insert-msgs)) (setq ent (wl-thread-get-entity next-top)) (when (and @@ -658,7 +649,7 @@ ENTITY is returned." ;; don't update buffer update-msgs)))) ; return value -(defun wl-thread-insert-message (overview-entity overview mark-alist +(defun wl-thread-insert-message (overview-entity msg parent-msg &optional update linked) "Insert MSG to the entity. When optional argument UPDATE is non-nil, @@ -673,7 +664,8 @@ Message is inserted to the summary buffer." ;; insert as children. (wl-thread-entity-insert-as-children parent - (setq child-entity (wl-thread-create-entity msg (nth 0 parent) nil linked))) + (setq child-entity (wl-thread-create-entity + msg (nth 0 parent) nil linked))) ;; insert as top message. (wl-thread-entity-insert-as-top (wl-thread-create-entity msg nil))) @@ -684,17 +676,14 @@ Message is inserted to the summary buffer." (progn (wl-summary-update-thread overview-entity - overview - mark-alist child-entity (elmo-msgdb-overview-get-entity parent-msg (wl-summary-buffer-msgdb))) (when parent ;; use thread structure. - (wl-thread-entity-get-nearly-older-brother - child-entity parent))) ; return value -;;; (wl-thread-entity-get-number -;;; (wl-thread-entity-get-top-entity parent)))) ; return value; + ;;(wl-thread-entity-get-nearly-older-brother + ;; child-entity parent))) ; return value + (wl-thread-entity-get-number parent))) ; return value ;;; (setq beg (point)) ;;; (wl-thread-goto-bottom-of-sub-thread) ;;; (wl-thread-update-indent-string-region beg (point))) @@ -728,48 +717,7 @@ Message is inserted to the summary buffer." (defun wl-thread-update-children-number (entity) "Update the children number." - (save-excursion - (wl-summary-jump-to-msg (wl-thread-entity-get-number entity)) - (beginning-of-line) - (let ((text-prop (get-text-property (point) 'face)) - from from-end beg str) - (cond - ((looking-at (concat "^" wl-summary-buffer-number-regexp - "..../..\(.*\)..:.. [" - wl-thread-indent-regexp - "]*[[<]\\+\\([0-9]+\\):")) - (delete-region (match-beginning 1)(match-end 1)) - (goto-char (match-beginning 1)) - (setq str (format "%s" (wl-thread-entity-get-children-num entity))) - (if wl-summary-highlight - (put-text-property 0 (length str) 'face text-prop str)) - (insert str)) - ((looking-at (concat "^" wl-summary-buffer-number-regexp - "..../..\(.*\)..:.. [" - wl-thread-indent-regexp - "]*[[<]")) - (goto-char (match-end 0)) - (setq beg (current-column)) - (setq from-end (save-excursion - (move-to-column (+ 1 beg wl-from-width)) - (point))) - (setq from (buffer-substring (match-end 0) from-end)) - (delete-region (match-end 0) from-end) - (setq str (wl-set-string-width - (1+ wl-from-width) - (format - "+%s:%s" - (wl-thread-entity-get-children-num - entity) - from))) - (if wl-summary-highlight - (put-text-property 0 (length str) 'face text-prop str)) - (insert str) - (condition-case nil ; it's dangerous, so ignore error. - (run-hooks 'wl-thread-update-children-number-hook) - (error - (ding) - (message "Error in wl-thread-update-children-number-hook.")))))))) + (wl-thread-update-line-on-buffer (wl-thread-entity-get-number entity))) ;; ;; Thread oriented commands. @@ -789,17 +737,14 @@ Message is inserted to the summary buffer." (defun wl-thread-msg-mark-as-important (msg) "Set mark as important for invisible MSG. Modeline is not changed." - (let* ((msgdb (wl-summary-buffer-msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - cur-mark) - (setq cur-mark (cadr (assq msg mark-alist))) - (setq mark-alist - (elmo-msgdb-mark-set mark-alist - msg - (if (string= cur-mark wl-summary-important-mark) - nil - wl-summary-important-mark))) - (elmo-msgdb-set-mark-alist msgdb mark-alist) + (let ((msgdb (wl-summary-buffer-msgdb)) + cur-mark) + (setq cur-mark (elmo-msgdb-get-mark msgdb msg)) + (elmo-msgdb-set-mark msgdb + msg + (if (string= cur-mark elmo-msgdb-important-mark) + nil + elmo-msgdb-important-mark)) (wl-summary-set-mark-modified))) (defun wl-thread-mark-as-read (&optional arg) @@ -891,12 +836,11 @@ Message is inserted to the summary buffer." (setq cur (1+ cur)) (if (or (zerop (% cur 2)) (= cur len)) (elmo-display-progress - 'wl-thread-insert-top "Inserting thread..." + 'wl-thread-insert-top "Inserting message..." (/ (* cur 100) len))))))) (defsubst wl-thread-insert-entity-sub (indent entity parent-entity all) - (let ((mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) - msg-num + (let (msg-num overview-entity temp-mark summary-line) @@ -917,19 +861,18 @@ Message is inserted to the summary buffer." (nth 0 entity) (wl-summary-buffer-msgdb))) ;;; (wl-delete-all-overlays) (when overview-entity - (setq summary-line - (wl-summary-overview-create-summary-line - msg-num - overview-entity - (elmo-msgdb-overview-get-entity - (nth 0 parent-entity) (wl-summary-buffer-msgdb)) - (1+ indent) - mark-alist - (if wl-thread-insert-force-opened - nil - (wl-thread-maybe-get-children-num msg-num)) - temp-mark entity)) - (wl-summary-insert-line summary-line))))) + (wl-summary-insert-line + (wl-summary-create-line + overview-entity + (elmo-msgdb-overview-get-entity + (nth 0 parent-entity) (wl-summary-buffer-msgdb)) + temp-mark + (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg-num) + (if wl-thread-insert-force-opened + nil + (wl-thread-maybe-get-children-num msg-num)) + (wl-thread-make-indent-string entity) + (wl-thread-entity-get-linked entity))))))) (defun wl-thread-insert-entity (indent entity parent-entity all) "Insert thread entity in current buffer." @@ -1035,15 +978,15 @@ Message is inserted to the summary buffer." (defun wl-thread-get-children-msgs-uncached (msg &optional uncached-marks) (let ((children-msgs (wl-thread-get-children-msgs msg)) - (mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))) (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) mark uncached-list) (while children-msgs (if (and (not (eq msg (car children-msgs))) ; except itself (or (and uncached-marks - (setq mark (cadr (assq (car children-msgs) - mark-alist))) + (setq mark (elmo-msgdb-get-mark + (wl-summary-buffer-msgdb) + (car children-msgs))) (member mark uncached-marks)) (and (not uncached-marks) (null (elmo-file-cache-exists-p @@ -1140,31 +1083,27 @@ Message is inserted to the summary buffer." (wl-summary-jump-to-msg msg) (wl-thread-close (wl-thread-get-entity (wl-summary-message-number))))))) + (when wl-summary-lazy-highlight + (wl-highlight-summary-window)) (wl-summary-set-message-modified) (set-buffer-modified-p nil)))) - (defun wl-thread-get-depth-of-current-line () - (interactive) - (save-excursion - (beginning-of-line) - (let ((depth 0)) - (if (re-search-forward (concat "^" wl-summary-buffer-number-regexp - "..../..\(.*\)..:.. ") - nil t) - (while (string-match wl-thread-indent-regexp - (char-to-string - (char-after (point)))) - (setq depth (1+ depth)) - (forward-char))) - (/ depth wl-thread-indent-level-internal)))) - + (let ((entity (wl-thread-get-entity (wl-summary-message-number))) + (depth 0) + number) + (while (setq number (wl-thread-entity-get-parent entity)) + (incf depth) + (setq entity (wl-thread-get-entity number))) + depth)) + (defun wl-thread-update-indent-string-region (beg end) (interactive "r") (save-excursion (goto-char beg) (while (< (point) end) - (wl-thread-update-indent-string) + (save-excursion + (wl-thread-update-line-on-buffer-sub nil (wl-summary-message-number))) (forward-line 1)))) (defsubst wl-thread-make-indent-string (entity) @@ -1195,35 +1134,6 @@ Message is inserted to the summary buffer." (setq cur (wl-thread-entity-get-parent-entity cur)))) ret-val)) -(defun wl-thread-update-indent-string () - "Update indent string of current line." - (interactive) - (save-excursion - (beginning-of-line) - (let ((inhibit-read-only t) - (buffer-read-only nil) - thr-str) - (when (looking-at (concat "^ *\\([0-9]+\\)" - "..../..\(.*\)..:.. \\(" - wl-highlight-thread-indent-string-regexp - "\\)[[<]")) - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) - (match-end 2)) - (setq thr-str - (wl-thread-make-indent-string - (wl-thread-get-entity (string-to-int (wl-match-buffer 1))))) - (if (and wl-summary-width - wl-summary-indent-length-limit - (< wl-summary-indent-length-limit - (string-width thr-str))) - (setq thr-str (wl-set-string-width - wl-summary-indent-length-limit - thr-str))) - (insert thr-str) - (if wl-summary-highlight - (wl-highlight-summary-current-line)))))) - (defun wl-thread-set-parent (&optional parent-number) "Set current message's parent interactively." (interactive)