X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-summary.el;h=d1c6670479661eb424f84fbfdba66ebf949d2397;hb=641767eeab1fe2d715ebe4e836b5e24068145966;hp=4ba9febade7e52c7c2862c3d1f57ec1bcb0a5bee;hpb=be25aa06a6b036f01a0f02ee327b401085ad2a04;p=elisp%2Fwanderlust.git diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 4ba9feb..d1c6670 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -37,6 +37,7 @@ (require 'elmo) (require 'elmo-multi) +(eval-when-compile (require 'elmo-filter)) (require 'wl-message) (require 'wl-vars) (require 'wl-highlight) @@ -60,6 +61,7 @@ (defvar dragdrop-drop-functions) (defvar scrollbar-height) (defvar mail-reply-buffer) +(defvar elmo-global-flags) (defvar wl-summary-buffer-name "Summary") (defvar wl-summary-mode-map nil) @@ -68,46 +70,48 @@ (defvar wl-summary-buffer-elmo-folder nil) (defmacro wl-summary-buffer-folder-name () - (` (and wl-summary-buffer-elmo-folder - (elmo-folder-name-internal wl-summary-buffer-elmo-folder)))) + `(and wl-summary-buffer-elmo-folder + (elmo-folder-name-internal wl-summary-buffer-elmo-folder))) -(defmacro wl-summary-buffer-msgdb () - (` (and wl-summary-buffer-elmo-folder - (elmo-folder-msgdb wl-summary-buffer-elmo-folder)))) - -(defvar wl-summary-buffer-folder-indicator nil) (defvar wl-summary-buffer-disp-msg nil) (defvar wl-summary-buffer-disp-folder nil) -(defvar wl-summary-buffer-refile-list nil) -(defvar wl-summary-buffer-delete-list nil) -(defvar wl-summary-buffer-last-displayed-msg nil) +(defvar wl-summary-buffer-temp-mark-list nil) +(defvar wl-summary-buffer-message-ring nil) (defvar wl-summary-buffer-current-msg nil) -(defvar wl-summary-buffer-unread-status " (0 new/0 unread)") (defvar wl-summary-buffer-unread-count 0) (defvar wl-summary-buffer-new-count 0) +(defvar wl-summary-buffer-answered-count 0) (defvar wl-summary-buffer-mime-charset nil) (defvar wl-summary-buffer-weekday-name-lang nil) (defvar wl-summary-buffer-thread-indent-set-alist nil) -(defvar wl-summary-buffer-view 'thread) +(defvar wl-summary-buffer-view nil) (defvar wl-summary-buffer-message-modified nil) -(defvar wl-summary-buffer-mark-modified nil) (defvar wl-summary-buffer-thread-modified nil) + (defvar wl-summary-buffer-number-column nil) +(defvar wl-summary-buffer-temp-mark-column nil) +(defvar wl-summary-buffer-persistent-mark-column nil) + +(defvar wl-summary-buffer-persistent-mark-version 0) + (defvar wl-summary-buffer-persistent nil) (defvar wl-summary-buffer-thread-nodes nil) (defvar wl-summary-buffer-target-mark-list nil) -(defvar wl-summary-buffer-copy-list nil) (defvar wl-summary-buffer-prev-refile-destination nil) -(defvar wl-summary-buffer-prev-copy-destination nil) (defvar wl-summary-buffer-saved-message nil) (defvar wl-summary-buffer-prev-folder-function nil) (defvar wl-summary-buffer-next-folder-function nil) (defvar wl-summary-buffer-exit-function nil) (defvar wl-summary-buffer-next-message-function nil) +(defvar wl-summary-buffer-window-scroll-functions nil) (defvar wl-summary-buffer-number-list nil) -(defvar wl-summary-buffer-msgdb nil) (defvar wl-summary-buffer-folder-name nil) (defvar wl-summary-buffer-line-formatter nil) +(defvar wl-summary-buffer-line-format nil) +(defvar wl-summary-buffer-mode-line-formatter nil) +(defvar wl-summary-buffer-mode-line nil) +(defvar wl-summary-buffer-display-mime-mode 'mime) +(defvar wl-summary-buffer-display-header-mode 'partial) (defvar wl-thread-indent-level-internal nil) (defvar wl-thread-have-younger-brother-str-internal nil) @@ -116,7 +120,7 @@ (defvar wl-thread-horizontal-str-internal nil) (defvar wl-thread-space-str-internal nil) (defvar wl-summary-last-visited-folder nil) -(defvar wl-read-folder-hist nil) +(defvar wl-read-folder-history nil) (defvar wl-summary-scored nil) (defvar wl-crosspost-alist-modified nil) (defvar wl-summary-alike-hashtb nil) @@ -126,35 +130,33 @@ (defvar wl-summary-get-petname-function 'wl-address-get-petname-1) -(defconst wl-summary-message-regexp "^ *-?[0-9]+" - "Regexp for the message.") - (defvar wl-summary-shell-command-last "") (defvar wl-ps-preprint-hook nil) (defvar wl-ps-print-hook nil) +(defvar wl-thread-saved-entity-hashtb-internal nil) + (make-variable-buffer-local 'wl-summary-buffer-elmo-folder) (make-variable-buffer-local 'wl-summary-search-buf-folder-name) (make-variable-buffer-local 'wl-summary-buffer-disp-msg) (make-variable-buffer-local 'wl-summary-buffer-disp-folder) -(make-variable-buffer-local 'wl-summary-buffer-refile-list) -(make-variable-buffer-local 'wl-summary-buffer-copy-list) (make-variable-buffer-local 'wl-summary-buffer-target-mark-list) -(make-variable-buffer-local 'wl-summary-buffer-delete-list) -(make-variable-buffer-local 'wl-summary-buffer-folder-indicator) -(make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg) -(make-variable-buffer-local 'wl-summary-buffer-unread-status) +(make-variable-buffer-local 'wl-summary-buffer-temp-mark-list) +(make-variable-buffer-local 'wl-summary-buffer-message-ring) (make-variable-buffer-local 'wl-summary-buffer-unread-count) (make-variable-buffer-local 'wl-summary-buffer-new-count) +(make-variable-buffer-local 'wl-summary-buffer-answered-count) (make-variable-buffer-local 'wl-summary-buffer-mime-charset) (make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang) (make-variable-buffer-local 'wl-summary-buffer-thread-indent-set) (make-variable-buffer-local 'wl-summary-buffer-view) (make-variable-buffer-local 'wl-summary-buffer-message-modified) -(make-variable-buffer-local 'wl-summary-buffer-mark-modified) (make-variable-buffer-local 'wl-summary-buffer-thread-modified) (make-variable-buffer-local 'wl-summary-buffer-number-column) +(make-variable-buffer-local 'wl-summary-buffer-temp-mark-column) +(make-variable-buffer-local 'wl-summary-buffer-persistent-mark-column) +(make-variable-buffer-local 'wl-summary-buffer-persistent-mark-version) (make-variable-buffer-local 'wl-summary-buffer-persistent) (make-variable-buffer-local 'wl-summary-buffer-thread-nodes) (make-variable-buffer-local 'wl-summary-buffer-prev-refile-destination) @@ -176,10 +178,15 @@ (make-variable-buffer-local 'wl-summary-buffer-next-folder-function) (make-variable-buffer-local 'wl-summary-buffer-exit-function) (make-variable-buffer-local 'wl-summary-buffer-next-message-function) +(make-variable-buffer-local 'wl-summary-buffer-window-scroll-functions) (make-variable-buffer-local 'wl-summary-buffer-number-list) -(make-variable-buffer-local 'wl-summary-buffer-msgdb) (make-variable-buffer-local 'wl-summary-buffer-folder-name) (make-variable-buffer-local 'wl-summary-buffer-line-formatter) +(make-variable-buffer-local 'wl-summary-buffer-line-format) +(make-variable-buffer-local 'wl-summary-buffer-mode-line-formatter) +(make-variable-buffer-local 'wl-summary-buffer-mode-line) +(make-variable-buffer-local 'wl-summary-buffer-display-mime-mode) +(make-variable-buffer-local 'wl-summary-buffer-display-header-mode) (defvar wl-datevec) (defvar wl-thr-indent-string) @@ -187,14 +194,11 @@ (defvar wl-thr-linked) (defvar wl-message-entity) (defvar wl-parent-message-entity) - -;; internal functions (dummy) -(unless (fboundp 'wl-summary-append-message-func-internal) - (defun wl-summary-append-message-func-internal (entity msgdb update - &optional force-insert))) +(defvar wl-temp-mark) +(defvar wl-persistent-mark) (defmacro wl-summary-sticky-buffer-name (name) - (` (concat wl-summary-buffer-name ":" (, name)))) + `(concat wl-summary-buffer-name ":" ,name)) (defun wl-summary-default-subject (subject-string) (if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string) @@ -202,41 +206,31 @@ subject-string)) (defun wl-summary-default-from (from) - (let (retval tos ng) - (unless - (and (eq major-mode 'wl-summary-mode) + "Instance of `wl-summary-from-function'. +Ordinarily returns the sender name. Returns recipient names if (1) +summary's folder name matches with `wl-summary-showto-folder-regexp' +and (2) sender address is yours. + +See also variable `wl-use-petname'." + (let ((translator (if wl-use-petname + (lambda (string) + (or (funcall wl-summary-get-petname-function string) + (car (std11-extract-address-components string)) + string)) + #'identity)) + to ng) + (or (and (eq major-mode 'wl-summary-mode) (stringp wl-summary-showto-folder-regexp) (string-match wl-summary-showto-folder-regexp (wl-summary-buffer-folder-name)) (wl-address-user-mail-address-p from) (cond - ((and (setq tos (elmo-msgdb-overview-entity-get-to - wl-message-entity)) - (not (string= "" tos))) - (setq retval - (concat "To:" - (mapconcat - (function - (lambda (to) - (eword-decode-string - (if wl-use-petname - (or - (funcall wl-summary-get-petname-function to) - (car - (std11-extract-address-components to)) - to) - to)))) - (wl-parse-addresses tos) - ",")))) - ((setq ng (elmo-msgdb-overview-entity-get-extra-field - wl-message-entity "newsgroups")) - (setq retval (concat "Ng:" ng))))) - (if wl-use-petname - (setq retval (or (funcall wl-summary-get-petname-function from) - (car (std11-extract-address-components from)) - from)) - (setq retval from))) - retval)) + ((setq to (elmo-message-entity-field wl-message-entity 'to)) + (concat "To:" (mapconcat translator to ","))) + ((setq ng (elmo-message-entity-field wl-message-entity + 'newsgroups)) + (concat "Ng:" ng)))) + (funcall translator from)))) (defun wl-summary-simple-from (string) (if wl-use-petname @@ -245,6 +239,9 @@ string) string)) +(defvar wl-summary-sort-specs '(number date subject from list-info size)) +(defvar wl-summary-default-sort-spec 'date) + (defvar wl-summary-mode-menu-spec '("Summary" ["Read" wl-summary-read t] @@ -270,35 +267,40 @@ ["Stick" wl-summary-stick t] ("Sort" ["By Number" wl-summary-sort-by-number t] + ["By Size" wl-summary-sort-by-size t] ["By Date" wl-summary-sort-by-date t] ["By From" wl-summary-sort-by-from t] - ["By Subject" wl-summary-sort-by-subject t]) + ["By Subject" wl-summary-sort-by-subject t] + ["By List Info" wl-summary-sort-by-list-info t]) "----" ("Message Operation" ["Mark as read" wl-summary-mark-as-read t] - ["Mark as important" wl-summary-mark-as-important t] + ["Set flags" wl-summary-set-flags t] ["Mark as unread" wl-summary-mark-as-unread t] - ["Set delete mark" wl-summary-delete t] + ["Mark as answered" wl-summary-mark-as-answered t] + ["Set dispose mark" wl-summary-dispose t] ["Set refile mark" wl-summary-refile t] ["Set copy mark" wl-summary-copy t] - ["Prefetch" wl-summary-prefetch t] + ["Set resend mark" wl-summary-resend t] + ["Prefetch" wl-summary-prefetch t] ["Set target mark" wl-summary-target-mark t] - ["Unmark" wl-summary-unmark t] + ["Unmark" wl-summary-unmark t] ["Save" wl-summary-save t] ["Cancel posted news" wl-summary-cancel-message t] ["Supersedes message" wl-summary-supersedes-message t] ["Resend bounced mail" wl-summary-resend-bounced-mail t] - ["Resend message" wl-summary-resend-message t] ["Enter the message" wl-summary-jump-to-current-message t] ["Pipe message" wl-summary-pipe-message t] - ["Print message" wl-summary-print-message t]) + ["Print message" wl-summary-print-message t] + ["View raw message" wl-summary-display-raw t]) ("Thread Operation" ["Open or Close" wl-thread-open-close (eq wl-summary-buffer-view 'thread)] ["Open all" wl-thread-open-all (eq wl-summary-buffer-view 'thread)] ["Close all" wl-thread-close-all (eq wl-summary-buffer-view 'thread)] ["Mark as read" wl-thread-mark-as-read (eq wl-summary-buffer-view 'thread)] - ["Mark as important" wl-thread-mark-as-important (eq wl-summary-buffer-view 'thread)] + ["Set flags" wl-thread-set-flags (eq wl-summary-buffer-view 'thread)] ["Mark as unread" wl-thread-mark-as-unread (eq wl-summary-buffer-view 'thread)] + ["Mark as answered" wl-thread-mark-as-answered (eq wl-summary-buffer-view 'thread)] ["Set delete mark" wl-thread-delete (eq wl-summary-buffer-view 'thread)] ["Set refile mark" wl-thread-refile (eq wl-summary-buffer-view 'thread)] ["Set copy mark" wl-thread-copy (eq wl-summary-buffer-view 'thread)] @@ -309,9 +311,10 @@ ["Execute" wl-thread-exec (eq wl-summary-buffer-view 'thread)]) ("Region Operation" ["Mark as read" wl-summary-mark-as-read-region t] - ["Mark as important" wl-summary-mark-as-important-region t] + ["Set flags" wl-summary-set-flags-region t] ["Mark as unread" wl-summary-mark-as-unread-region t] - ["Set delete mark" wl-summary-delete-region t] + ["Mark as answered" wl-summary-mark-as-answered-region t] + ["Set dispose mark" wl-summary-dispose-region t] ["Set refile mark" wl-summary-refile-region t] ["Set copy mark" wl-summary-copy-region t] ["Prefetch" wl-summary-prefetch-region t] @@ -321,7 +324,7 @@ ["Execute" wl-summary-exec-region t]) ("Mark Operation" ["Mark as read" wl-summary-target-mark-mark-as-read t] - ["Mark as important" wl-summary-target-mark-mark-as-important t] + ["Set flags" wl-summary-target-mark-set-flags t] ["Mark as unread" wl-summary-target-mark-mark-as-unread t] ["Set delete mark" wl-summary-target-mark-delete t] ["Set refile mark" wl-summary-target-mark-refile t] @@ -367,19 +370,31 @@ (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next) (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up) (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down) + ;; For Meadow2 + (define-key wl-summary-mode-map [mouse-wheel1] + 'wl-summary-wheel-dispatcher) + (define-key wl-summary-mode-map [S-mouse-wheel1] + 'wl-summary-wheel-dispatcher) (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click))) (if wl-summary-mode-map () - (setq wl-summary-mode-map (make-sparse-keymap)) + (setq wl-summary-mode-map (make-keymap)) + (suppress-keymap wl-summary-mode-map) + (substitute-key-definition 'kill-buffer + 'wl-summary-mimic-kill-buffer + wl-summary-mode-map + global-map) + ;; basic commands (define-key wl-summary-mode-map " " 'wl-summary-read) (define-key wl-summary-mode-map "." 'wl-summary-redisplay) + (define-key wl-summary-mode-map "," 'wl-summary-display-raw) (define-key wl-summary-mode-map "<" 'wl-summary-display-top) (define-key wl-summary-mode-map ">" 'wl-summary-display-bottom) (define-key wl-summary-mode-map "\177" 'wl-summary-prev-page) (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page) - (define-key wl-summary-mode-map "\r" 'wl-summary-next-line-content) - (define-key wl-summary-mode-map "\C-m" 'wl-summary-next-line-content) + (define-key wl-summary-mode-map "\r" 'wl-summary-enter-handler) + (define-key wl-summary-mode-map "\C-m" 'wl-summary-enter-handler) (define-key wl-summary-mode-map "/" 'wl-thread-open-close) (define-key wl-summary-mode-map "[" 'wl-thread-open-all) (define-key wl-summary-mode-map "]" 'wl-thread-close-all) @@ -388,7 +403,6 @@ (define-key wl-summary-mode-map "g" 'wl-summary-goto-folder) (define-key wl-summary-mode-map "G" 'wl-summary-goto-folder-sticky) (define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all) -; (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync) (define-key wl-summary-mode-map "a" 'wl-summary-reply) (define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation) @@ -397,6 +411,9 @@ (define-key wl-summary-mode-map "\eE" 'wl-summary-resend-bounced-mail) (define-key wl-summary-mode-map "f" 'wl-summary-forward) (define-key wl-summary-mode-map "$" 'wl-summary-mark-as-important) + (define-key wl-summary-mode-map "F" 'wl-summary-set-flags) + (define-key wl-summary-mode-map "\M-k" 'wl-summary-toggle-persistent-mark) + (define-key wl-summary-mode-map "&" 'wl-summary-mark-as-answered) (define-key wl-summary-mode-map "@" 'wl-summary-edit-addresses) (define-key wl-summary-mode-map "y" 'wl-summary-save) @@ -404,17 +421,15 @@ (define-key wl-summary-mode-map "p" 'wl-summary-prev) (define-key wl-summary-mode-map "N" 'wl-summary-down) (define-key wl-summary-mode-map "P" 'wl-summary-up) -;;;(define-key wl-summary-mode-map "w" 'wl-draft) (define-key wl-summary-mode-map "w" 'wl-summary-write) (define-key wl-summary-mode-map "W" 'wl-summary-write-current-folder) -;;;(define-key wl-summary-mode-map "e" 'wl-draft-open-file) (define-key wl-summary-mode-map "e" 'wl-summary-save) (define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer) (define-key wl-summary-mode-map "\C-c\C-a" 'wl-addrmgr) (define-key wl-summary-mode-map "\C-c\C-p" 'wl-summary-previous-buffer) (define-key wl-summary-mode-map "\C-c\C-n" 'wl-summary-next-buffer) - (define-key wl-summary-mode-map "H" 'wl-summary-redisplay-all-header) - (define-key wl-summary-mode-map "M" 'wl-summary-redisplay-no-mime) + (define-key wl-summary-mode-map "H" 'wl-summary-toggle-all-header) + (define-key wl-summary-mode-map "M" 'wl-summary-toggle-mime) (define-key wl-summary-mode-map "B" 'wl-summary-burst) (define-key wl-summary-mode-map "Z" 'wl-status-update) (define-key wl-summary-mode-map "#" 'wl-summary-print-message) @@ -455,11 +470,12 @@ (define-key wl-summary-mode-map "o" 'wl-summary-refile) (define-key wl-summary-mode-map "O" 'wl-summary-copy) (define-key wl-summary-mode-map "\M-o" 'wl-summary-refile-prev-destination) -; (define-key wl-summary-mode-map "\M-O" 'wl-summary-copy-prev-destination) (define-key wl-summary-mode-map "\C-o" 'wl-summary-auto-refile) - (define-key wl-summary-mode-map "d" 'wl-summary-delete) + (define-key wl-summary-mode-map "d" 'wl-summary-dispose) (define-key wl-summary-mode-map "u" 'wl-summary-unmark) (define-key wl-summary-mode-map "U" 'wl-summary-unmark-all) + (define-key wl-summary-mode-map "D" 'wl-summary-delete) + (define-key wl-summary-mode-map "~" 'wl-summary-resend) ;; thread commands (define-key wl-summary-mode-map "t" (make-sparse-keymap)) @@ -469,24 +485,36 @@ (define-key wl-summary-mode-map "t*" 'wl-thread-target-mark) (define-key wl-summary-mode-map "to" 'wl-thread-refile) (define-key wl-summary-mode-map "tO" 'wl-thread-copy) - (define-key wl-summary-mode-map "td" 'wl-thread-delete) + (define-key wl-summary-mode-map "t\M-o" 'wl-thread-refile-prev-destination) + (define-key wl-summary-mode-map "td" 'wl-thread-dispose) + (define-key wl-summary-mode-map "tD" 'wl-thread-delete) + (define-key wl-summary-mode-map "t~" 'wl-thread-resend) (define-key wl-summary-mode-map "tu" 'wl-thread-unmark) (define-key wl-summary-mode-map "t!" 'wl-thread-mark-as-unread) (define-key wl-summary-mode-map "t$" 'wl-thread-mark-as-important) + (define-key wl-summary-mode-map "tF" 'wl-thread-set-flags) + (define-key wl-summary-mode-map "t&" 'wl-thread-mark-as-answered) (define-key wl-summary-mode-map "ty" 'wl-thread-save) (define-key wl-summary-mode-map "ts" 'wl-thread-set-parent) ;; target-mark commands (define-key wl-summary-mode-map "m" (make-sparse-keymap)) (define-key wl-summary-mode-map "mi" 'wl-summary-target-mark-prefetch) - (define-key wl-summary-mode-map "mR" 'wl-summary-target-mark-mark-as-read) (define-key wl-summary-mode-map "mo" 'wl-summary-target-mark-refile) (define-key wl-summary-mode-map "mO" 'wl-summary-target-mark-copy) - (define-key wl-summary-mode-map "md" 'wl-summary-target-mark-delete) + (define-key wl-summary-mode-map "m\M-o" 'wl-summary-target-mark-refile-prev-destination) + (define-key wl-summary-mode-map "md" 'wl-summary-target-mark-dispose) + (define-key wl-summary-mode-map "mD" 'wl-summary-target-mark-delete) + (define-key wl-summary-mode-map "m~" 'wl-summary-target-mark-resend) + + (define-key wl-summary-mode-map "mu" 'wl-summary-delete-all-temp-marks) + (define-key wl-summary-mode-map "my" 'wl-summary-target-mark-save) + (define-key wl-summary-mode-map "mR" 'wl-summary-target-mark-mark-as-read) (define-key wl-summary-mode-map "m!" 'wl-summary-target-mark-mark-as-unread) + (define-key wl-summary-mode-map "m&" 'wl-summary-target-mark-mark-as-answered) (define-key wl-summary-mode-map "m$" 'wl-summary-target-mark-mark-as-important) - (define-key wl-summary-mode-map "mu" 'wl-summary-delete-all-temp-marks) + (define-key wl-summary-mode-map "mF" 'wl-summary-target-mark-set-flags) (define-key wl-summary-mode-map "mU" 'wl-summary-target-mark-uudecode) (define-key wl-summary-mode-map "ma" 'wl-summary-target-mark-all) (define-key wl-summary-mode-map "mt" 'wl-summary-target-mark-thread) @@ -505,10 +533,15 @@ (define-key wl-summary-mode-map "r*" 'wl-summary-target-mark-region) (define-key wl-summary-mode-map "ro" 'wl-summary-refile-region) (define-key wl-summary-mode-map "rO" 'wl-summary-copy-region) - (define-key wl-summary-mode-map "rd" 'wl-summary-delete-region) + (define-key wl-summary-mode-map "r\M-o" 'wl-summary-refile-prev-destination-region) + (define-key wl-summary-mode-map "rd" 'wl-summary-dispose-region) + (define-key wl-summary-mode-map "rD" 'wl-summary-delete-region) + (define-key wl-summary-mode-map "r~" 'wl-summary-resend-region) (define-key wl-summary-mode-map "ru" 'wl-summary-unmark-region) (define-key wl-summary-mode-map "r!" 'wl-summary-mark-as-unread-region) (define-key wl-summary-mode-map "r$" 'wl-summary-mark-as-important-region) + (define-key wl-summary-mode-map "rF" 'wl-summary-set-flags-region) + (define-key wl-summary-mode-map "r&" 'wl-summary-mark-as-answered-region) (define-key wl-summary-mode-map "ry" 'wl-summary-save-region) ;; score commands @@ -523,6 +556,8 @@ (define-key wl-summary-mode-map "hm" 'wl-score-set-mark-below) (define-key wl-summary-mode-map "hx" 'wl-score-set-expunge-below) + ;; misc + (define-key wl-summary-mode-map "\C-c\C-f" 'wl-summary-toggle-header-narrowing) (define-key wl-summary-mode-map "\M-t" 'wl-toggle-plugged) (define-key wl-summary-mode-map "\C-t" 'wl-plugged-change) ;; @@ -534,6 +569,147 @@ "Menu used in Summary mode." wl-summary-mode-menu-spec)) +(defun wl-summary-mimic-kill-buffer (buffer) + "Kill the current (Summary) buffer with query." + (interactive "bKill buffer: ") + (if (or (not buffer) + (string-equal buffer "") + (string-equal buffer (buffer-name))) + (wl-summary-exit 'force-exit) + (kill-buffer buffer))) + +(defsubst wl-summary-message-visible-p (number) + "Return non-nil if the message with NUMBER is visible." + (or (eq wl-summary-buffer-view 'sequence) + (not (wl-thread-entity-parent-invisible-p + (wl-thread-get-entity number))))) + +(defun wl-summary-push-message (number) + (when (and number + (not (equal number (car wl-summary-buffer-message-ring)))) + (setq wl-summary-buffer-message-ring + (cons number wl-summary-buffer-message-ring)) + (when (> (length wl-summary-buffer-message-ring) + wl-summary-message-ring-max) + (setcdr (nthcdr (1- wl-summary-message-ring-max) + wl-summary-buffer-message-ring) + nil)))) + +(defun wl-summary-pop-message (&optional current-number) + (when wl-summary-buffer-message-ring + (when current-number + (setq wl-summary-buffer-message-ring + (nconc wl-summary-buffer-message-ring (list current-number)))) + (prog1 + (car wl-summary-buffer-message-ring) + (setq wl-summary-buffer-message-ring + (cdr wl-summary-buffer-message-ring))))) + +(defmacro wl-summary-message-status (&optional number) + `(elmo-message-status wl-summary-buffer-elmo-folder + (or ,number (wl-summary-message-number)))) + +(defun wl-summary-update-mark-and-highlight-window (&optional win beg) + "A function to be called as window-scroll-functions." + (with-current-buffer (window-buffer win) + (when (eq major-mode 'wl-summary-mode) + (let ((beg (or beg (window-start win))) + (end (condition-case nil + (window-end win t) ; old emacsen doesn't support 2nd arg. + (error (window-end win))))) + (save-excursion + (goto-char beg) + (while (and (< (point) end) (not (eobp))) + (when (or (null (get-text-property (point) 'face)) + (wl-summary-persistent-mark-invalid-p)) + (wl-summary-update-persistent-mark (wl-summary-message-number))) + (forward-line 1))))) + (set-buffer-modified-p nil))) + +(defun wl-summary-window-scroll-functions () + (cond ((and wl-summary-highlight + wl-summary-lazy-highlight + wl-summary-lazy-update-mark) + (list 'wl-summary-update-mark-and-highlight-window)) + ((and wl-summary-highlight + wl-summary-lazy-highlight) + (list 'wl-highlight-summary-window)) + (wl-summary-lazy-update-mark + (list 'wl-summary-update-mark-window)))) + +(defun wl-summary-after-resize-function (frame) + "Called from `window-size-change-functions'." + (save-excursion + (save-selected-window + (select-frame frame) + (walk-windows + (lambda (window) + (set-buffer (window-buffer window)) + (when (eq major-mode 'wl-summary-mode) + (run-hook-with-args 'wl-summary-buffer-window-scroll-functions + window))) + 'nomini frame)))) + +;; Handler of event from elmo-folder +(defun wl-summary-update-persistent-mark-on-event (buffer numbers) + (save-excursion + (set-buffer buffer) + (if wl-summary-lazy-update-mark + (let ((window-list (get-buffer-window-list (current-buffer) 'nomini t)) + invalidate) + (dolist (number numbers) + (when (wl-summary-message-visible-p number) + (if (catch 'visible + (let ((window-list window-list) + win) + (while (setq win (car window-list)) + (when (wl-summary-jump-to-msg number + (window-start win) + (window-end win)) + (throw 'visible t)) + (setq window-list (cdr window-list))))) + (wl-summary-update-persistent-mark number) + (setq invalidate t)))) + (when invalidate + (wl-summary-invalidate-persistent-mark) + (dolist (win window-list) + (wl-summary-validate-persistent-mark + (window-start win) + (window-end win))))) + (dolist (number numbers) + (when (and (wl-summary-message-visible-p number) + (wl-summary-jump-to-msg number)) + (wl-summary-update-persistent-mark number)))))) + +(defun wl-summary-buffer-attach () + (when wl-summary-buffer-elmo-folder + (elmo-connect-signal + wl-summary-buffer-elmo-folder + 'flag-changed + (current-buffer) + (elmo-define-signal-handler (buffer folder numbers) + (wl-summary-update-persistent-mark-on-event buffer numbers))) + (elmo-connect-signal + wl-summary-buffer-elmo-folder + 'status-changed + (current-buffer) + (elmo-define-signal-handler (buffer folder numbers) + (wl-summary-update-persistent-mark-on-event buffer numbers))) + (elmo-connect-signal + wl-summary-buffer-elmo-folder + 'update-overview + (current-buffer) + (elmo-define-signal-handler (buffer folder number) + (with-current-buffer buffer + (wl-summary-rescan-message number)))))) + +(defun wl-summary-buffer-detach () + (when (and (eq major-mode 'wl-summary-mode) + wl-summary-buffer-elmo-folder) + (elmo-disconnect-signal 'flag-changed (current-buffer)) + (elmo-disconnect-signal 'status-changed (current-buffer)) + (elmo-disconnect-signal 'update-overview (current-buffer)))) + (defun wl-status-update () (interactive) (wl-address-init)) @@ -541,6 +717,7 @@ (defun wl-summary-display-top () (interactive) (goto-char (point-min)) + (run-hooks 'wl-summary-buffer-window-scroll-functions) (if wl-summary-buffer-disp-msg (wl-summary-redisplay))) @@ -548,19 +725,19 @@ (interactive) (goto-char (point-max)) (forward-line -1) + (run-hooks 'wl-summary-buffer-window-scroll-functions) (if wl-summary-buffer-disp-msg (wl-summary-redisplay))) (defun wl-summary-count-unread () - (let ((pair - (elmo-msgdb-count-marks (wl-summary-buffer-msgdb) - wl-summary-new-mark - (list wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark)))) - (if (eq major-mode 'wl-summary-mode) - (setq wl-summary-buffer-new-count (car pair) - wl-summary-buffer-unread-count (cdr pair))) - pair)) + (let ((flag-count (elmo-folder-count-flags wl-summary-buffer-elmo-folder))) + (setq wl-summary-buffer-new-count + (or (cdr (assq 'new flag-count)) 0) + wl-summary-buffer-unread-count + (or (cdr (assq 'unread flag-count)) 0) + wl-summary-buffer-answered-count + (or (cdr (assq 'answered flag-count)) 0)) + flag-count)) (defun wl-summary-message-string (&optional use-cache) "Return full body string of current message. @@ -569,37 +746,36 @@ If optional USE-CACHE is non-nil, use cache if exists." (folder wl-summary-buffer-elmo-folder)) (if (null number) (message "No message.") - (elmo-set-work-buf - (elmo-message-fetch folder - number - (elmo-make-fetch-strategy - 'entire - use-cache ; use cache - nil ; save cache (should `t'?) - (and - use-cache - (elmo-file-cache-get-path - (elmo-message-field folder number 'message-id)))) - nil - (current-buffer) - 'unread) - (buffer-string))))) + (elmo-message-fetch-string folder + number + (elmo-make-fetch-strategy + 'entire + use-cache ; use cache + nil ; save cache (should `t'?) + (and + use-cache + (elmo-file-cache-get-path + (elmo-message-field folder number + 'message-id)))) + 'unread)))) (defun wl-summary-reedit (&optional arg) "Re-edit current message. If ARG is non-nil, Supersedes message" (interactive "P") - (if arg - (wl-summary-supersedes-message) - (if (string= (wl-summary-buffer-folder-name) wl-draft-folder) - (if (wl-summary-message-number) - (progn - (wl-draft-reedit (wl-summary-message-number)) - (if (wl-message-news-p) - (mail-position-on-field "Newsgroups") - (mail-position-on-field "To")) - (delete-other-windows))) - (wl-draft-edit-string (wl-summary-message-string))))) + (wl-summary-toggle-disp-msg 'off) + (cond + ((null (wl-summary-message-number)) + (message "No message.")) + (arg + (wl-summary-supersedes-message)) + ((string= (wl-summary-buffer-folder-name) wl-draft-folder) + (wl-draft-reedit (wl-summary-message-number)) + (if (wl-message-news-p) + (mail-position-on-field "Newsgroups") + (mail-position-on-field "To"))) + (t + (wl-draft-edit-string (wl-summary-message-string 'maybe))))) (defun wl-summary-resend-bounced-mail () "Re-mail the current message. @@ -607,6 +783,7 @@ This only makes sense if the current message is a bounce message which contains some mail you have written but has been bounced back to you." (interactive) + (wl-summary-toggle-disp-msg 'off) (save-excursion (wl-summary-set-message-buffer-or-redisplay) (set-buffer (wl-message-get-original-buffer)) @@ -625,7 +802,7 @@ you." (concat "^--" boundary "\n" "\\([Cc]ontent-[Dd]escription:.*\n\\)?" "[Cc]ontent-[Tt]ype:[ \t]+" - "\\(message/rfc822\\|text/rfc822-headers\\)\n" + "\\(message/rfc822\\|text/rfc822-headers\\).*\n" "\\(.+\n\\)*\n") nil t)) (re-search-forward (concat "\n\\(--" boundary "\\)--\n") nil t)) @@ -639,68 +816,55 @@ you." (t (message "Does not appear to be a rejected letter.")))))) -(defun wl-summary-resend-message (address) - "Resend the current message to ADDRESS." - (interactive "sResend message to: ") - (if (or (null address) (string-match "^[ \t]*$" address)) - (message "No address specified.") - (message "Resending message to %s..." address) - (save-excursion - (let ((original (wl-summary-get-original-buffer))) - ;; We first set up a normal mail buffer. - (set-buffer (get-buffer-create " *wl-draft-resend*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (setq wl-sent-message-via nil) - ;; Insert our usual headers. - (wl-draft-insert-from-field) - (wl-draft-insert-date-field) - (insert "to: " address "\n") - (goto-char (point-min)) - ;; Rename them all to "Resent-*". - (while (re-search-forward "^[A-Za-z]" nil t) - (forward-char -1) - (insert "Resent-")) - (widen) - (forward-line) - (delete-region (point) (point-max)) - (let ((beg (point))) - ;; Insert the message to be resent. - (insert-buffer-substring original) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (save-restriction - (narrow-to-region beg (point)) - (wl-draft-delete-fields wl-ignored-resent-headers) - (goto-char (point-max))) - (insert mail-header-separator) - ;; Rename all old ("Previous-")Resent headers. - (while (re-search-backward "^\\(Previous-\\)*Resent-" beg t) - (beginning-of-line) - (insert "Previous-")) - ;; Quote any "From " lines at the beginning. - (goto-char beg) - (when (looking-at "From ") - (replace-match "X-From-Line: "))) - ;; Send it. - (wl-draft-dispatch-message) - (kill-buffer (current-buffer))) - (message "Resending message to %s...done" address)))) +(defun wl-summary-detect-mark-position () + (let ((column wl-summary-buffer-number-column) + (formatter wl-summary-buffer-line-formatter) + (lang wl-summary-buffer-weekday-name-lang) + (dummy-number 10000) + (dummy-temp (char-to-string 200)) + ;; bind only for the check. + (wl-summary-new-uncached-mark (char-to-string 201)) + (wl-summary-persistent-mark-priority-list '(new)) ; ditto. + wl-summary-highlight + temp persistent) + (with-temp-buffer + (set-buffer-multibyte t) + (setq wl-summary-buffer-number-column column + wl-summary-buffer-line-formatter formatter + wl-summary-buffer-weekday-name-lang lang) + (insert + (wl-summary-create-line + (elmo-msgdb-make-message-entity + (luna-make-entity 'modb-entity-handler) + :number dummy-number + :from "foo" + :subject "bar" + :size 100) + nil + dummy-temp + (let ((status (elmo-message-status nil dummy-number))) + (elmo-message-status-set-flags status '(new)) + (elmo-message-status-set-killed status nil) + status))) + (goto-char (point-min)) + (setq temp (save-excursion + (when (search-forward dummy-temp nil t) + (current-column))) + persistent + (save-excursion + (when (search-forward wl-summary-new-uncached-mark nil t) + (current-column))))) + (setq wl-summary-buffer-temp-mark-column temp + wl-summary-buffer-persistent-mark-column persistent))) (defun wl-summary-buffer-set-folder (folder) + (wl-summary-buffer-detach) (if (stringp folder) (setq folder (wl-folder-get-elmo-folder folder))) (setq wl-summary-buffer-elmo-folder folder) - (setq wl-summary-buffer-folder-indicator - (if (memq 'modeline wl-use-folder-petname) - (wl-folder-get-petname (elmo-folder-name-internal folder)) - (elmo-folder-name-internal folder))) (make-local-variable 'wl-message-buffer) - (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value - wl-folder-mime-charset-alist - (elmo-folder-name-internal folder)) - wl-mime-charset)) + (setq wl-summary-buffer-mime-charset (wl-folder-mime-charset + (elmo-folder-name-internal folder))) (setq wl-summary-buffer-weekday-name-lang (or (wl-get-assoc-list-value wl-folder-weekday-name-lang-alist @@ -716,14 +880,20 @@ you." wl-summary-default-number-column)) (wl-line-formatter-setup wl-summary-buffer-line-formatter - (or (wl-get-assoc-list-value - wl-folder-summary-line-format-alist - (elmo-folder-name-internal folder)) - wl-summary-line-format) + (setq wl-summary-buffer-line-format + (or (wl-get-assoc-list-value + wl-folder-summary-line-format-alist + (elmo-folder-name-internal folder)) + wl-summary-line-format)) wl-summary-line-format-spec-alist) + (wl-line-formatter-setup + wl-summary-buffer-mode-line-formatter + wl-summary-mode-line-format + wl-summary-mode-line-format-spec-alist) (setq wl-summary-buffer-persistent (wl-folder-persistent-p (elmo-folder-name-internal folder))) (elmo-folder-set-persistent-internal folder wl-summary-buffer-persistent) + (wl-summary-buffer-attach) ;; process duplicates. (elmo-folder-set-process-duplicates-internal folder (cdr (elmo-string-matched-assoc @@ -748,13 +918,6 @@ you." wl-thread-space-str-internal (or (nth 5 wl-summary-buffer-thread-indent-set) wl-thread-space-str)) - (setq wl-thread-indent-regexp - (concat - (regexp-quote wl-thread-have-younger-brother-str-internal) "\\|" - (regexp-quote wl-thread-youngest-child-str-internal) "\\|" - (regexp-quote wl-thread-vertical-str-internal) "\\|" - (regexp-quote wl-thread-horizontal-str-internal) "\\|" - (regexp-quote wl-thread-space-str-internal))) (run-hooks 'wl-summary-buffer-set-folder-hook)) (defun wl-summary-mode () @@ -773,136 +936,196 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." ;;;(setq default-directory (or wl-tmp-dir (expand-file-name "~/"))) (setq buffer-read-only t) (setq truncate-lines t) + (when (boundp 'show-trailing-whitespace) + (setq show-trailing-whitespace nil)) ;;;(make-local-variable 'tab-width) ;;;(setq tab-width 1) (buffer-disable-undo (current-buffer)) - (wl-mode-line-buffer-identification '("Wanderlust: " - wl-summary-buffer-folder-indicator - wl-summary-buffer-unread-status)) + (setq selective-display t + selective-display-ellipses nil) + (wl-mode-line-buffer-identification '(wl-summary-buffer-mode-line)) (easy-menu-add wl-summary-mode-menu) - (when wl-summary-lazy-highlight - (make-local-variable 'window-scroll-functions) - (add-hook 'window-scroll-functions 'wl-highlight-summary-window)) + (setq wl-summary-buffer-window-scroll-functions + (wl-summary-window-scroll-functions)) + (when wl-summary-buffer-window-scroll-functions + (let ((hook (if wl-on-xemacs 'pre-idle-hook 'window-scroll-functions))) + (make-local-hook hook) + (dolist (function wl-summary-buffer-window-scroll-functions) + (add-hook hook function nil t))) + (add-hook 'window-size-change-functions + #'wl-summary-after-resize-function)) + (dolist (hook '(change-major-mode-hook kill-buffer-hook)) + (make-local-hook hook) + (add-hook hook #'wl-summary-buffer-detach nil t)) ;; This hook may contain the function `wl-setup-summary' for reasons ;; of system internal to accord facilities for the Emacs variants. (run-hooks 'wl-summary-mode-hook)) +;;; +(defun wl-summary-overview-entity-compare-by-size (x y) + "Compare entity X and Y by size." + (< (elmo-message-entity-field x 'size) + (elmo-message-entity-field y 'size))) + + (defun wl-summary-overview-entity-compare-by-date (x y) "Compare entity X and Y by date." (condition-case nil - (string< - (timezone-make-date-sortable - (elmo-msgdb-overview-entity-get-date x)) - (timezone-make-date-sortable - (elmo-msgdb-overview-entity-get-date y))) + (elmo-time< + (elmo-message-entity-field x 'date) + (elmo-message-entity-field y 'date)) (error))) ;; ignore error. (defun wl-summary-overview-entity-compare-by-number (x y) "Compare entity X and Y by number." (< - (elmo-msgdb-overview-entity-get-number x) - (elmo-msgdb-overview-entity-get-number y))) + (elmo-message-entity-number x) + (elmo-message-entity-number y))) (defun wl-summary-overview-entity-compare-by-from (x y) "Compare entity X and Y by from." (string< - (wl-address-header-extract-address - (or (elmo-msgdb-overview-entity-get-from-no-decode x) - wl-summary-no-from-message)) - (wl-address-header-extract-address - (or (elmo-msgdb-overview-entity-get-from-no-decode y) - wl-summary-no-from-message)))) + (or (elmo-message-entity-field x 'from) + wl-summary-no-from-message) + (or (elmo-message-entity-field y 'from) + wl-summary-no-from-message))) (defun wl-summary-overview-entity-compare-by-subject (x y) "Compare entity X and Y by subject." - (string< (elmo-msgdb-overview-entity-get-subject-no-decode x) - (elmo-msgdb-overview-entity-get-subject-no-decode y))) - -(defun wl-summary-sort-by-date () - (interactive) - (wl-summary-rescan "date")) -(defun wl-summary-sort-by-number () + (string< (elmo-message-entity-field x 'subject) + (elmo-message-entity-field y 'subject))) + +(defun wl-summary-get-list-info (entity) + "Returns (\"ML-name\" . ML-count) of ENTITY." + (or (elmo-message-entity-field entity 'ml-info) + (lexical-let ((entity entity)) + (let* ((getter (lambda (field) + (elmo-message-entity-field entity field))) + (name (elmo-find-list-match-value + elmo-mailing-list-name-spec-list + getter)) + (count (elmo-find-list-match-value + elmo-mailing-list-count-spec-list + getter))) + (cons name (and count (string-to-number count))))))) + +(defun wl-summary-overview-entity-compare-by-list-info (x y) + "Compare entity X and Y by mailing-list info." + (let* ((list-info-x (wl-summary-get-list-info x)) + (list-info-y (wl-summary-get-list-info y))) + (if (equal (car list-info-x) (car list-info-y)) + (if (equal (cdr list-info-x) (cdr list-info-y)) + (wl-summary-overview-entity-compare-by-date x y) + (< (or (cdr list-info-x) 0) + (or (cdr list-info-y) 0))) + (string< (or (car list-info-x) "") + (or (car list-info-y) ""))))) + +(defun wl-summary-define-sort-command () + "Define functions to sort summary lines by `wl-summary-sort-specs'." (interactive) - (wl-summary-rescan "number")) -(defun wl-summary-sort-by-subject () - (interactive) - (wl-summary-rescan "subject")) -(defun wl-summary-sort-by-from () - (interactive) - (wl-summary-rescan "from")) - -(defun wl-summary-rescan (&optional sort-by) + (dolist (sort-by wl-summary-sort-specs) + (fset (intern (format "wl-summary-sort-by-%s" sort-by)) + `(lambda (&optional reverse) + ,(format "\ +Sort summary lines into the order by %s. +If optional argument REVERSE is non-nil, sort into descending order. + +This function is defined by `wl-summary-define-sort-command'." sort-by) + (interactive "P") + (wl-summary-rescan ,(symbol-name sort-by) reverse))))) + +(defun wl-summary-sort-function-from-spec (spec reverse) + (let (function) + (when (string-match "^!\\(.+\\)$" spec) + (setq spec (match-string 1 spec) + reverse (not reverse))) + (setq function + (intern (format "wl-summary-overview-entity-compare-by-%s" spec))) + (if reverse + `(lambda (x y) (not (,function x y))) + function))) + +(defun wl-summary-sort-messages (numbers sort-by reverse) + (let* ((functions (mapcar + (lambda (spec) + (wl-summary-sort-function-from-spec spec reverse)) + (if (listp sort-by) sort-by (list sort-by)))) + (predicate (if (= (length functions) 1) + (car functions) + (lambda (x y) + (let ((functions functions)) + (catch 'done + (dolist (function functions) + (when (funcall function x y) + (throw 'done t)) + (when (funcall function y x) + (throw 'done nil))))))))) + (mapcar #'elmo-message-entity-number + (sort (mapcar (lambda (number) + (elmo-message-entity + wl-summary-buffer-elmo-folder + number)) + numbers) + predicate)))) + +(defun wl-summary-rescan (&optional sort-by reverse disable-killed disable-thread) "Rescan current folder without updating." (interactive) - (let* ((cur-buf (current-buffer)) - (msgdb (wl-summary-buffer-msgdb)) - (overview (elmo-msgdb-get-overview msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (elmo-mime-charset wl-summary-buffer-mime-charset) - i percent num - gc-message entity - curp - (inhibit-read-only t) - (buffer-read-only nil) - expunged) - (fset 'wl-summary-append-message-func-internal - (wl-summary-get-append-message-func)) + (let ((elmo-mime-charset wl-summary-buffer-mime-charset) + gc-message ; for XEmacs + (inhibit-read-only t) + (buffer-read-only nil) + (numbers (elmo-folder-list-messages wl-summary-buffer-elmo-folder + (not disable-killed) t)) ; in-msgdb + (wl-thread-saved-entity-hashtb-internal (and (not disable-thread) + wl-thread-entity-hashtb)) + (wl-summary-search-parent-by-subject-regexp + (and disable-thread wl-summary-search-parent-by-subject-regexp)) + (wl-summary-divide-thread-when-subject-changed + (and disable-thread wl-summary-divide-thread-when-subject-changed)) + num + expunged) (erase-buffer) (message "Re-scanning...") - (setq i 0) - (setq num (length overview)) - (when sort-by - (message "Sorting by %s..." sort-by) - (setq overview - (sort overview - (intern (format "wl-summary-overview-entity-compare-by-%s" - sort-by)))) - (message "Sorting by %s...done" sort-by) - (elmo-msgdb-set-overview (wl-summary-buffer-msgdb) - overview)) - (setq curp overview) - (set-buffer cur-buf) - (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 nil) + (when (and sort-by numbers) + (let ((action (if reverse "Reverse sorting" "Sorting"))) + (message "%s by %s..." action sort-by) + (setq numbers (wl-summary-sort-messages numbers sort-by reverse)) + (message "%s by %s...done" action sort-by))) + (setq num (length numbers)) + (setq wl-thread-entity-hashtb (elmo-make-hash (* num 2)) + wl-thread-entity-list nil + wl-thread-entities nil + wl-summary-scored nil + wl-summary-buffer-number-list nil + wl-summary-buffer-persistent-mark-version 0 + wl-summary-buffer-target-mark-list nil + wl-summary-buffer-temp-mark-list nil + wl-summary-delayed-update nil) (elmo-kill-buffer wl-summary-search-buf-name) - (message "Constructing summary structure...") - (while curp - (setq entity (car curp)) - (wl-summary-append-message-func-internal entity msgdb nil) - (setq curp (cdr curp)) - (when (> num elmo-display-progress-threshold) - (setq i (+ i 1)) - (if (or (zerop (% i 5)) (= i num)) - (elmo-display-progress - 'wl-summary-rescan "Constructing summary structure..." - (/ (* i 100) num))))) - (when wl-summary-delayed-update + (elmo-with-progress-display (wl-summary-insert-line num) + "Constructing summary structure" + (dolist (number numbers) + (wl-summary-insert-message (elmo-message-entity + wl-summary-buffer-elmo-folder + number) + wl-summary-buffer-elmo-folder + nil)) (while wl-summary-delayed-update (message "Parent (%d) of message %d is no entity" (caar wl-summary-delayed-update) - (elmo-msgdb-overview-entity-get-number + (elmo-message-entity-number (cdar wl-summary-delayed-update))) - (wl-summary-append-message-func-internal - (cdar wl-summary-delayed-update) msgdb nil t) + (wl-summary-insert-message + (cdar wl-summary-delayed-update) + wl-summary-buffer-elmo-folder nil t) (setq wl-summary-delayed-update (cdr wl-summary-delayed-update)))) - (message "Constructing summary structure...done") - (set-buffer cur-buf) - (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 (eq wl-summary-buffer-view 'thread) + (wl-thread-insert-top)) (when wl-use-scoring - (setq wl-summary-scored nil) - (wl-summary-score-headers nil msgdb - (wl-summary-rescore-msgs number-alist) + (wl-summary-score-headers (wl-summary-rescore-msgs + wl-summary-buffer-number-list) t) (when (and wl-summary-scored (setq expunged (wl-summary-score-update-all-lines))) @@ -914,6 +1137,56 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (forward-line -1) (set-buffer-modified-p nil))) +(defun wl-summary-rescan-message (number &optional reparent) + "Rescan current message without updating." + (interactive (list (wl-summary-message-number) current-prefix-arg)) + (let ((start-number (wl-summary-message-number)) + (start-column (current-column))) + (when (wl-summary-jump-to-msg number) + (let* ((folder wl-summary-buffer-elmo-folder) + (entity (elmo-message-entity folder number)) + (inhibit-read-only t)) + (if (eq wl-summary-buffer-view 'thread) + (let* ((thread-entity (wl-thread-get-entity number)) + (thread-parent (wl-thread-entity-get-parent thread-entity)) + (entity-parent (elmo-message-entity-number + (elmo-message-entity-parent folder entity))) + update-top-list) + (if (and (not reparent) + (eq thread-parent entity-parent)) + (progn + (wl-thread-entity-set-linked thread-entity nil) + (wl-thread-update-line-on-buffer-sub nil number)) + (let ((replacements + (cons number + (wl-thread-entity-get-descendant thread-entity)))) + (wl-thread-delete-message number 'deep 'update) + (wl-thread-cleanup-symbols replacements) + (dolist (number replacements) + (setq update-top-list + (nconc + update-top-list + (wl-summary-insert-thread + (elmo-message-entity folder number) + folder + 'update)))) + (when update-top-list + (wl-thread-update-indent-string-thread + (elmo-uniq-list update-top-list)))))) + (delete-region (point-at-bol) (1+ (point-at-eol))) + (wl-summary-insert-line + (wl-summary-create-line entity nil + (wl-summary-temp-mark number) + (elmo-message-status folder number))))) + (when (and wl-summary-buffer-disp-msg + wl-summary-buffer-current-msg) + (save-excursion + (when (wl-summary-jump-to-msg wl-summary-buffer-current-msg) + (wl-highlight-summary-displaying)))) + (wl-summary-set-message-modified) + (wl-summary-jump-to-msg start-number) + (move-to-column start-column)))) + (defun wl-summary-next-folder-or-exit (&optional next-entity upward) (if (and next-entity wl-auto-select-next) @@ -943,11 +1216,9 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-entity-info-msg (entity finfo) (or (and entity (concat - (elmo-replace-in-string - (if (memq 'ask-folder wl-use-folder-petname) - (wl-folder-get-petname entity) - entity) - "%" "%%") + (if (memq 'ask-folder wl-use-folder-petname) + (wl-folder-get-petname entity) + entity) (if (null (car finfo)) " (? new/? unread)" (format @@ -958,43 +1229,32 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." "folder mode")) (defun wl-summary-set-message-modified () - (elmo-folder-set-message-modified-internal - wl-summary-buffer-elmo-folder t) (setq wl-summary-buffer-message-modified t)) (defun wl-summary-message-modified-p () wl-summary-buffer-message-modified) -(defun wl-summary-set-mark-modified () - (elmo-folder-set-mark-modified-internal - wl-summary-buffer-elmo-folder t) - (setq wl-summary-buffer-mark-modified t)) -(defun wl-summary-mark-modified-p () - wl-summary-buffer-mark-modified) (defun wl-summary-set-thread-modified () (setq wl-summary-buffer-thread-modified t)) (defun wl-summary-thread-modified-p () wl-summary-buffer-thread-modified) -(defsubst wl-summary-cleanup-temp-marks (&optional sticky) - (if (or wl-summary-buffer-refile-list - wl-summary-buffer-copy-list - wl-summary-buffer-delete-list) - (if (y-or-n-p "Marks remain to be executed. Execute them? ") - (progn - (wl-summary-exec) - (if (or wl-summary-buffer-refile-list - wl-summary-buffer-copy-list - wl-summary-buffer-delete-list) - (error "Some execution was failed"))) - ;; delete temp-marks - (message "") - (wl-summary-delete-all-refile-marks) - (wl-summary-delete-all-copy-marks) - (wl-summary-delete-all-delete-marks))) - (if wl-summary-buffer-target-mark-list - (progn - (wl-summary-delete-all-target-marks) - (setq wl-summary-buffer-target-mark-list nil))) - (wl-summary-delete-all-temp-marks-on-buffer sticky) +(defun wl-summary-exec-with-confirmation (&optional message) + (when wl-summary-buffer-temp-mark-list + (if (y-or-n-p (or message + (format "Execute marks in %s? " + (wl-summary-buffer-folder-name)))) + (progn + (wl-summary-exec) + (if wl-summary-buffer-temp-mark-list + (error "Some execution was failed"))) + ;; temp-mark-list is remained. + (message "")))) + +(defun wl-summary-cleanup-temp-marks () + (when wl-summary-buffer-temp-mark-list + (wl-summary-exec-with-confirmation + (format "Execute marks in %s? (answer \"n\" to discard them) " + (wl-summary-buffer-folder-name)))) + (wl-summary-delete-all-temp-marks 'no-msg) (setq wl-summary-scored nil)) ;; a subroutine for wl-summary-exit/wl-save-status @@ -1005,7 +1265,6 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." ;; save the current summary buffer view. (if (and wl-summary-cache-use (or (wl-summary-message-modified-p) - (wl-summary-mark-modified-p) (wl-summary-thread-modified-p))) (wl-summary-save-view-cache)))) @@ -1017,7 +1276,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (elmo-folder-commit wl-summary-buffer-elmo-folder) (elmo-folder-check wl-summary-buffer-elmo-folder) (if wl-use-scoring (wl-score-save)) - (if (interactive-p) (message "Saving summary status...done."))) + (if (interactive-p) (message "Saving summary status...done"))) (defun wl-summary-force-exit () "Exit current summary. Buffer is deleted even the buffer is sticky." @@ -1036,7 +1295,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (if wl-summary-buffer-exit-function (funcall wl-summary-buffer-exit-function) (if (or force-exit (not sticky)) - (wl-summary-cleanup-temp-marks sticky)) + (wl-summary-cleanup-temp-marks)) (unwind-protect ;; save summary status (progn @@ -1078,6 +1337,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." wl-folder-buffer-cur-point (goto-char wl-folder-buffer-cur-point)) (setq wl-folder-buffer-cur-path nil) + (setq wl-folder-buffer-last-visited-entity-id wl-folder-buffer-cur-entity-id) (setq wl-folder-buffer-cur-entity-id nil) (wl-delete-all-overlays) (if wl-summary-exit-next-move @@ -1099,23 +1359,21 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-sync-force-update (&optional unset-cursor no-check) (interactive) - (wl-summary-sync-update unset-cursor nil no-check)) + (wl-summary-sync-update unset-cursor nil nil no-check)) (defsubst wl-summary-sync-all-init () (wl-summary-cleanup-temp-marks) (erase-buffer) (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) (setq wl-thread-entity-hashtb (elmo-make-hash - (* (length (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb))) 2))) + (* (elmo-folder-length + wl-summary-buffer-elmo-folder) + 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) - (setq wl-summary-buffer-delete-list nil)) + (setq wl-summary-buffer-temp-mark-list nil)) (defun wl-summary-sync (&optional unset-cursor force-range) (interactive) @@ -1125,30 +1383,37 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (msgdb-dir (elmo-folder-msgdb-path folder)) (range (or force-range (wl-summary-input-range (elmo-folder-name-internal folder))))) - (cond ((string= range "rescan") - (let ((msg (wl-summary-message-number))) - (wl-summary-rescan) - (and msg (wl-summary-jump-to-msg msg)))) - ((string= range "rescan-noscore") + (when (symbolp range) + (setq range (symbol-name range))) + (cond ((string-match "rescan" range) (let ((msg (wl-summary-message-number)) - wl-use-scoring) - (wl-summary-rescan) + (wl-use-scoring (if (string-match "noscore" range) + nil + wl-use-scoring))) + (wl-summary-rescan nil + nil + (string-match "noscore" range) + (string-match "thread" range)) + (and msg (wl-summary-jump-to-msg msg)))) + ((string= range "mark") + (let ((msg (wl-summary-message-number))) + (call-interactively 'wl-summary-sync-marks) (and msg (wl-summary-jump-to-msg msg)))) ((string= range "cache-status") (let ((msg (wl-summary-message-number))) (wl-summary-resume-cache-status) (and msg (wl-summary-jump-to-msg msg)))) - ((or (string-match "last:" range) - (string-match "first:" range)) + ((string= range "no-sync")) + ((or (string-match "^last:" range) + (string-match "^first:" range)) (wl-summary-goto-folder-subr (concat "/" range "/" (elmo-folder-name-internal folder)) - 'force-update nil nil t)) + 'force-update nil nil t)) (t (wl-summary-sync-update unset-cursor - (cond ((string= range "all") 'all) - ((string= range "all-visible") - 'visible-only))))))) + (string-match "entirely" range) + (string-match "all" range)))))) (defvar wl-summary-edit-addresses-candidate-fields ;; First element becomes default. @@ -1165,18 +1430,17 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (if body (setq candidates (append candidates body))) (setq fields (cdr fields))) (setq candidates (elmo-uniq-list candidates)) - (elmo-set-work-buf - (elmo-set-buffer-multibyte default-enable-multibyte-characters) - (mapcar (function - (lambda (x) - (setq components (std11-extract-address-components x)) - (cons (nth 1 components) - (and (car components) - (eword-decode-string - (decode-mime-charset-string - (car components) - mime-charset)))))) - candidates)))) + (elmo-with-enable-multibyte + (mapcar (function + (lambda (x) + (setq components (std11-extract-address-components x)) + (cons (nth 1 components) + (and (car components) + (eword-decode-string + (decode-mime-charset-string + (car components) + mime-charset)))))) + candidates)))) (defun wl-summary-edit-addresses-subr (the-email name-in-addr) ;; returns nil if there's no change. @@ -1273,89 +1537,104 @@ If ARG is non-nil, checking is omitted." (unless arg (save-excursion (wl-summary-sync-force-update))) - (wl-summary-prefetch-region (point-min) (point-max) - wl-summary-incorporate-marks)) + (wl-summary-prefetch-region-no-mark (point-min) (point-max) + wl-summary-incorporate-marks)) + +(defun wl-summary-force-prefetch () + "All uncached messages are cached." + (interactive) + (unless (elmo-folder-local-p wl-summary-buffer-elmo-folder) + (let* ((targets (elmo-folder-list-flagged wl-summary-buffer-elmo-folder + 'uncached 'in-msgdb)) + (count 0) + wl-prefetch-confirm + wl-prefetch-threshold + (length (length targets)) + msg) + (save-excursion + (elmo-with-progress-display (wl-summary-prefetch-message length) + "Retrieving" + (goto-char (point-min)) + (dolist (target targets) + (when (if (not (wl-thread-entity-parent-invisible-p + (wl-thread-get-entity target))) + (progn + (wl-summary-jump-to-msg target) + (wl-summary-prefetch-msg + (wl-summary-message-number))) + (wl-summary-prefetch-msg target)) + (incf count)) + (elmo-progress-notify 'wl-summary-prefetch-message))) + (message "Retrieved %d/%d message(s)" count length))))) (defun wl-summary-prefetch-msg (number &optional arg) - "Returns status-mark. if skipped, returns nil." + "Prefetch message and return non-nil value. If skipped, return nil." ;; prefetching procedure. (save-excursion - (let* ((msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (message-id (cdr (assq number number-alist))) - (ov (elmo-msgdb-overview-get-entity message-id msgdb)) - (entity ov) - (size (elmo-msgdb-overview-entity-get-size ov)) - (inhibit-read-only t) - (buffer-read-only nil) - (file-cached (elmo-file-cache-exists-p message-id)) + (let* ((size (elmo-message-field wl-summary-buffer-elmo-folder + number 'size)) + (file-cached (elmo-file-cache-exists-p + (elmo-message-field wl-summary-buffer-elmo-folder + number 'message-id))) (force-read (and size - (or (null wl-prefetch-threshold) + (or file-cached + (and (null wl-prefetch-confirm) arg) + (null wl-prefetch-threshold) (< size wl-prefetch-threshold)))) mark new-mark) - (unwind-protect - (progn - (when (and (or arg (not file-cached)) - size (not force-read) wl-prefetch-confirm) - (setq force-read - (save-restriction - (widen) - (y-or-n-p - (format - "Message from %s has %d bytes. Prefetch it? " - (concat - "[ " - (save-match-data - (wl-set-string-width - 17 - (funcall wl-summary-from-function - (eword-decode-string - (elmo-delete-char - ?\" - (or - (elmo-msgdb-overview-entity-get-from ov) - "??")))))) " ]") - size)))) - (message "")) ; flush. - (setq mark (elmo-msgdb-get-mark msgdb number)) - (if force-read - (save-excursion - (save-match-data - ;; online - (if (or arg (not file-cached)) - (elmo-message-encache - wl-summary-buffer-elmo-folder - number)) - (setq new-mark - (cond - ((string= mark - wl-summary-unread-uncached-mark) - wl-summary-unread-cached-mark) - ((string= mark wl-summary-new-mark) - (setq wl-summary-buffer-new-count - (- wl-summary-buffer-new-count 1)) - (setq wl-summary-buffer-unread-count - (+ wl-summary-buffer-unread-count 1)) - wl-summary-unread-cached-mark) - ((string= mark wl-summary-read-uncached-mark) - nil) - (t mark))) - (elmo-msgdb-set-mark msgdb number new-mark) - (or new-mark (setq new-mark " ")) - (wl-summary-set-mark-modified) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count))) - new-mark))))))) - -;;(defvar wl-summary-message-uncached-marks -;; (list wl-summary-new-mark -;; wl-summary-unread-uncached-mark -;; wl-summary-read-uncached-mark)) - -(defun wl-summary-prefetch-region (beg end &optional prefetch-marks) + (ignore-errors + (when (and (or arg (not file-cached)) + size (not force-read) wl-prefetch-confirm) + (let ((wl-message-entity (elmo-message-entity + wl-summary-buffer-elmo-folder + number))) + (setq force-read + (save-restriction + (widen) + (y-or-n-p + (format + "Message from %s has %d bytes. Prefetch it? " + (concat + "[ " + (save-match-data + (wl-set-string-width + 17 + (funcall + wl-summary-from-function + (elmo-delete-char + ?\" + (or + (elmo-message-entity-field + wl-message-entity + 'from) + "??"))))) + " ]") + size)))) + (message ""))) ; flush. + (if force-read + (save-excursion + (save-match-data + ;; online + (when (or arg (not file-cached)) + (elmo-message-encache wl-summary-buffer-elmo-folder + number)) + (elmo-message-set-cached wl-summary-buffer-elmo-folder + number t)) + t) + nil))))) + +(defsubst wl-summary-narrow-to-region (beg end) + (narrow-to-region + (save-excursion + (goto-char beg) + (beginning-of-line) + (point)) + (save-excursion + (goto-char end) + (if (eq (current-column) 0) (beginning-of-line) (end-of-line)) + (point)))) + +(defun wl-summary-prefetch-region-no-mark (beg end &optional prefetch-marks) (interactive "r") (let ((count 0) targets @@ -1365,83 +1644,47 @@ If ARG is non-nil, checking is omitted." (save-excursion (setq start-pos (point)) (save-restriction - (narrow-to-region beg end) + (wl-summary-narrow-to-region beg end) ;; collect prefetch targets. (message "Collecting marks...") (goto-char (point-min)) (while (not (eobp)) - (beginning-of-line) - (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)") - (setq mark (wl-match-buffer 2)) - (setq msg (string-to-int (wl-match-buffer 1))) - (if (or (and (null prefetch-marks) - msg - (null (elmo-file-cache-exists-p - (cdr (assq msg - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb))))))) - (member mark prefetch-marks)) - (setq targets (nconc targets (list msg)))) - (setq entity (wl-thread-get-entity msg)) - (if (or (not (eq wl-summary-buffer-view 'thread)) - (wl-thread-entity-get-opened entity)) - (); opened. no hidden children. - ;; hidden children!! - (setq targets (nconc - targets - (wl-thread-get-children-msgs-uncached - msg prefetch-marks))))) + (setq msg (wl-summary-message-number)) + (setq mark (wl-summary-persistent-mark msg)) + (if (or (and (null prefetch-marks) + msg + (null (elmo-file-cache-exists-p + (elmo-message-field + wl-summary-buffer-elmo-folder + msg + 'message-id)))) + (member mark prefetch-marks)) + (setq targets (nconc targets (list msg)))) + (setq entity (wl-thread-get-entity msg)) + (if (or (not (eq wl-summary-buffer-view 'thread)) + (wl-thread-entity-get-opened entity)) + (); opened. no hidden children. + (setq targets (nconc + targets + (wl-thread-get-children-msgs-uncached + msg prefetch-marks)))) (forward-line 1)) (setq length (length targets)) (message "Prefetching...") (while targets - (setq mark (if (not (wl-thread-entity-parent-invisible-p - (wl-thread-get-entity (car targets)))) - (progn - (wl-summary-jump-to-msg (car targets)) - (wl-summary-prefetch)) - (wl-summary-prefetch-msg (car targets)))) - (if (if prefetch-marks - (string= mark wl-summary-unread-cached-mark) - (or (string= mark wl-summary-unread-cached-mark) - (string= mark " "))) - (message "Prefetching... %d/%d message(s)" - (setq count (+ 1 count)) length)) - ;; redisplay! - (save-excursion - (setq pos (point)) - (goto-char start-pos) - (if (pos-visible-in-window-p pos) - (save-restriction - (widen) - (sit-for 0)))) + (when (if (not (wl-thread-entity-parent-invisible-p + (wl-thread-get-entity (car targets)))) + (progn + (wl-summary-jump-to-msg (car targets)) + (wl-summary-prefetch-msg + (wl-summary-message-number))) + (wl-summary-prefetch-msg (car targets))) + (message "Prefetching... %d/%d message(s)" + (setq count (+ 1 count)) length)) (setq targets (cdr targets))) (message "Prefetched %d/%d message(s)" count length) (cons count length))))) -(defun wl-summary-prefetch (&optional arg) - "Prefetch current message." - (interactive "P") - (save-excursion - (save-match-data - (beginning-of-line) - (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)") - (goto-char (match-beginning 2)) - (let ((inhibit-read-only t) - (buffer-read-only nil) - (beg (match-beginning 2)) - (end (match-end 2)) - mark) - (setq mark (wl-summary-prefetch-msg - (string-to-int (wl-match-buffer 1)) arg)) - (when mark - (delete-region beg end) - (insert mark) - (if wl-summary-highlight - (wl-highlight-summary-current-line))) - (set-buffer-modified-p nil) - mark))))) - (defun wl-summary-delete-marks-on-buffer (marks) (while marks (wl-summary-unmark (pop marks)))) @@ -1449,276 +1692,148 @@ If ARG is non-nil, checking is omitted." (defun wl-summary-delete-copy-marks-on-buffer (copies) (wl-summary-delete-marks-on-buffer copies)) -(defun wl-summary-delete-all-refile-marks () - (let ((marks wl-summary-buffer-refile-list)) - (while marks - (wl-summary-unmark (car (pop marks)))))) - -(defun wl-summary-delete-all-copy-marks () - (let ((marks wl-summary-buffer-copy-list)) - (while marks - (wl-summary-unmark (car (pop marks)))))) - -(defun wl-summary-delete-all-delete-marks () - (wl-summary-delete-marks-on-buffer wl-summary-buffer-delete-list)) - +;;; (defun wl-summary-delete-all-target-marks () (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list)) -(defun wl-summary-delete-all-temp-marks-on-buffer (&optional sticky) - ;; for summary view cache saving. - (interactive) - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t) - (buffer-read-only nil) - (case-fold-search nil) - (regexp (concat wl-summary-message-regexp "\\([^ 0-9]\\)" ))) - (while (re-search-forward regexp nil t) - (delete-region (match-beginning 1) (match-end 1)) - (insert " ") - (if (and sticky wl-summary-highlight) - (wl-highlight-summary-current-line)))))) - -;; Does not work correctly... -(defun wl-summary-mark-as-read-region (beg end) - (interactive "r") +(defun wl-summary-number-list-from-region (beg end) (save-excursion (save-restriction - (narrow-to-region beg end) -;;; use narrowing. -;;; (save-excursion (goto-char end) -;;; (end-of-line) (point))) + (wl-summary-narrow-to-region beg end) (goto-char (point-min)) - (if (eq wl-summary-buffer-view 'thread) - (progn + (let (number-list) + (if (eq wl-summary-buffer-view 'thread) (while (not (eobp)) (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...mark line. - ;; Crossposts are not processed - (wl-summary-mark-as-read t) - ;; closed - (wl-summary-mark-as-read t) ; mark itself. - (setq children (wl-thread-get-children-msgs number)) - (while children - (wl-summary-mark-as-read t nil nil (car children)) - (setq children (cdr children)))) - (forward-line 1)))) - (while (not (eobp)) - (wl-summary-mark-as-read t) - (forward-line 1))))) - (wl-summary-count-unread) - (wl-summary-update-modeline)) + (entity (wl-thread-get-entity number))) + (setq number-list + (nconc number-list + (if (wl-thread-entity-get-opened entity) + (list number) + (wl-thread-get-children-msgs number)))) + (forward-line 1))) + (while (not (eobp)) + (setq number-list + (nconc number-list (list (wl-summary-message-number)))) + (forward-line 1))) + number-list)))) + +(defun wl-summary-mark-as-read-region (beg end) + (interactive "r") + (let ((number-list (wl-summary-number-list-from-region beg end))) + (if (null number-list) + (message "No message.") + (wl-summary-mark-as-read number-list)))) (defun wl-summary-mark-as-unread-region (beg end) (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region beg end) -;;; use narrowing. -;;; (save-excursion (goto-char end) -;;; (end-of-line) (point))) - (goto-char (point-min)) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...mark line. - ;; Crossposts are not processed - (wl-summary-mark-as-unread) - ;; closed - (wl-summary-mark-as-unread) ; mark itself. - (setq children - (delq number (wl-thread-get-children-msgs number))) - (while children - (wl-summary-mark-as-unread (car children)) - (setq children (cdr children)))) - (forward-line 1)))) - (while (not (eobp)) - (wl-summary-mark-as-unread) - (forward-line 1))))) - (wl-summary-count-unread) - (wl-summary-update-modeline)) + (let ((number-list (wl-summary-number-list-from-region beg end))) + (if (null number-list) + (message "No message.") + (wl-summary-mark-as-unread number-list)))) -(defun wl-summary-mark-as-important-region (beg end) +(defun wl-summary-set-flags-region (beg end &optional remove) + (interactive "r\nP") + (let ((number-list (wl-summary-number-list-from-region beg end))) + (if (null number-list) + (message "No message.") + (wl-summary-set-flags-internal number-list nil nil remove) + (wl-summary-count-unread) + (wl-summary-update-modeline)))) + +(defun wl-summary-mark-as-answered-region (beg end &optional remove) + (interactive "r\nP") + (let ((number-list (wl-summary-number-list-from-region beg end)) + (remove (or remove + (elmo-message-flagged-p wl-summary-buffer-elmo-folder + (save-excursion + (goto-char beg) + (wl-summary-message-number)) + 'answered)))) + (if (null number-list) + (message "No message.") + (wl-summary-set-persistent-mark-internal remove 'answered + number-list + nil nil (interactive-p)) + (wl-summary-count-unread) + (wl-summary-update-modeline)))) + +(defun wl-summary-mark-as-important-region (beg end &optional remove) + (interactive "r\nP") + (let ((number-list (wl-summary-number-list-from-region beg end)) + (remove (or remove + (elmo-message-flagged-p wl-summary-buffer-elmo-folder + (save-excursion + (goto-char beg) + (wl-summary-message-number)) + 'important)))) + (if (null number-list) + (message "No message.") + (wl-summary-set-persistent-mark-internal remove 'important number-list + nil nil (interactive-p)) + (wl-summary-count-unread) + (wl-summary-update-modeline)))) + +(defun wl-summary-recover-messages-region (beg end) + "Recover killed messages in region." (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region beg end);(save-excursion (goto-char end) - ; (end-of-line) (point))) - (goto-char (point-min)) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...mark line. - ;; Crossposts are not processed - (wl-summary-mark-as-important) - ;; closed - (wl-summary-mark-as-important) ; mark itself. - (setq children - (delq number (wl-thread-get-children-msgs number))) - (while children - (wl-thread-msg-mark-as-important (car children)) - (setq children (cdr children)))) - (forward-line 1)))) - (while (not (eobp)) - (wl-summary-mark-as-important) - (forward-line 1))))) - (wl-summary-count-unread) - (wl-summary-update-modeline)) + (let ((number-list (wl-summary-number-list-from-region beg end))) + (if (null number-list) + (message "No message.") + (elmo-folder-recover-messages wl-summary-buffer-elmo-folder + number-list)))) (defun wl-summary-mark-as-read-all () (interactive) (if (or (not (interactive-p)) (y-or-n-p "Mark all messages as read? ")) - (let* ((folder wl-summary-buffer-elmo-folder) - (cur-buf (current-buffer)) - (msgdb (wl-summary-buffer-msgdb)) - (inhibit-read-only t) - (buffer-read-only nil) - (case-fold-search nil) - msg mark) + (let ((folder wl-summary-buffer-elmo-folder) + (cur-buf (current-buffer))) (message "Setting all msgs as read...") - (elmo-folder-mark-as-read folder - (elmo-folder-list-unreads - folder - (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9 ]\\)" - nil t) - (setq msg (string-to-int (wl-match-buffer 1))) - (setq mark (wl-match-buffer 2)) - (when (and (not (string= mark wl-summary-important-mark)) - (not (string= mark wl-summary-read-uncached-mark))) - (delete-region (match-beginning 2) (match-end 2)) - (if (or (not (elmo-message-use-cache-p folder msg)) - (string= mark wl-summary-unread-cached-mark)) - (progn - (insert " ") - (elmo-msgdb-set-mark msgdb msg nil)) - ;; New mark and unread-uncached mark - (insert wl-summary-read-uncached-mark) - (elmo-msgdb-set-mark - msgdb msg wl-summary-read-uncached-mark)) - (if wl-summary-highlight - (wl-highlight-summary-current-line nil nil t))))) - (elmo-folder-replace-marks + (elmo-folder-unset-flag folder - (list (cons wl-summary-unread-cached-mark - nil) - (cons wl-summary-unread-uncached-mark - wl-summary-read-uncached-mark) - (cons wl-summary-new-mark - wl-summary-read-uncached-mark))) - (wl-summary-set-mark-modified) + (elmo-folder-list-flagged folder 'unread 'in-msgdb) + 'unread) (wl-folder-update-unread (wl-summary-buffer-folder-name) 0) (setq wl-summary-buffer-unread-count 0) (setq wl-summary-buffer-new-count 0) (wl-summary-update-modeline) - (message "Setting all msgs as read...done") - (set-buffer-modified-p nil)))) + (message "Setting all msgs as read...done")))) (defun wl-summary-delete-cache () "Delete cache of current message." (interactive) (save-excursion - (let* ((inhibit-read-only t) - (buffer-read-only nil) - (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (case-fold-search nil) - mark number unread new-mark) - (beginning-of-line) - (when (looking-at "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)") - (progn - (setq mark (wl-match-buffer 2)) - (cond - ((or (string= mark wl-summary-new-mark) - (string= mark wl-summary-unread-uncached-mark) - (string= mark wl-summary-important-mark)) - ;; noop - ) - ((string= mark wl-summary-unread-cached-mark) - (setq new-mark wl-summary-unread-uncached-mark)) - (t - (setq new-mark wl-summary-read-uncached-mark))) - (when new-mark - (setq number (string-to-int (wl-match-buffer 1))) - (delete-region (match-beginning 2) (match-end 2)) - (goto-char (match-beginning 2)) - (insert new-mark) - (elmo-file-cache-delete - (elmo-file-cache-get-path - (elmo-message-field wl-summary-buffer-elmo-folder - number - 'message-id))) - (elmo-msgdb-set-mark msgdb number new-mark) - (wl-summary-set-mark-modified) - (if wl-summary-highlight - (wl-highlight-summary-current-line nil nil t)) - (set-buffer-modified-p nil))))))) + (let* ((folder wl-summary-buffer-elmo-folder) + number) + (setq number (wl-summary-message-number)) + (elmo-message-set-cached folder number nil) + (ignore-errors + (elmo-file-cache-delete + (elmo-file-cache-get-path + (elmo-message-field wl-summary-buffer-elmo-folder + number + 'message-id))))))) (defun wl-summary-resume-cache-status () "Resume the cache status of all messages in the current folder." (interactive) - (let* ((folder wl-summary-buffer-elmo-folder) - (cur-buf (current-buffer)) - (msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (inhibit-read-only t) - (buffer-read-only nil) - (case-fold-search nil) - msg mark msgid set-mark) + (let ((folder wl-summary-buffer-elmo-folder) + number msgid) (message "Resuming cache status...") (save-excursion (goto-char (point-min)) - (while (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)" nil t) - (setq msg (string-to-int - (wl-match-buffer 1))) - (setq mark (wl-match-buffer 2)) - (setq msgid (elmo-msgdb-get-field msgdb msg 'message-id)) - (setq set-mark nil) - (if (elmo-file-cache-exists-p msgid) - (if (or - (string= mark wl-summary-unread-uncached-mark) ; U -> ! - (string= mark wl-summary-new-mark) ; N -> ! - ) - (setq set-mark wl-summary-unread-cached-mark) - (if (string= mark wl-summary-read-uncached-mark) ; u -> ' ' - (setq set-mark " "))) - (if (string= mark " ") - (setq set-mark wl-summary-read-uncached-mark) ;' ' -> u - (if (string= mark wl-summary-unread-cached-mark) - (setq set-mark wl-summary-unread-uncached-mark) ; ! -> U - ))) - (when set-mark - (delete-region (match-beginning 2) (match-end 2)) - (insert set-mark) - (elmo-msgdb-set-mark msgdb msg - (if (string= set-mark " ") nil set-mark)) - (if wl-summary-highlight - (wl-highlight-summary-current-line)))) - (wl-summary-set-mark-modified) + (while (not (eobp)) + (setq number (wl-summary-message-number)) + (setq msgid (elmo-message-field folder number 'message-id)) + (elmo-message-set-cached folder number + (elmo-file-cache-exists-p msgid)) + (forward-line 1)) (wl-summary-count-unread) (wl-summary-update-modeline) - (message "Resuming cache status...done") - (set-buffer-modified-p nil)))) + (message "Resuming cache status...done")))) -(defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info) +(defun wl-summary-delete-messages-on-buffer (msgs) (interactive) (save-excursion (let ((inhibit-read-only t) @@ -1737,258 +1852,190 @@ If ARG is non-nil, checking is omitted." (wl-thread-delete-message (car msgs)))) (setq update-list (delq (car msgs) update-list))) (goto-char (point-min)) - (if (re-search-forward (format "^ *%d[^0-9]\\([^0-9]\\).*$" - (car msgs)) nil t) + (if (wl-summary-jump-to-msg (car msgs)) (progn - (delete-region (match-beginning 0) (match-end 0)) + (delete-region (point-at-bol) (point-at-eol)) (delete-char 1) ; delete '\n' (setq wl-summary-buffer-number-list (delq (car msgs) wl-summary-buffer-number-list))))) - (when (and deleting-info - (> len elmo-display-progress-threshold)) - (setq i (1+ i)) - (if (or (zerop (% i 5)) (= i len)) - (elmo-display-progress - 'wl-summary-delete-messages-on-buffer deleting-info - (/ (* i 100) len)))) (setq msgs (cdr msgs))) (when (eq wl-summary-buffer-view 'thread) - (wl-thread-update-line-msgs (elmo-uniq-list update-list) - (unless deleting-info 'no-msg)) - (wl-thread-cleanup-symbols msgs2)) + (let ((updates (elmo-uniq-list update-list))) + (elmo-with-progress-display (wl-thread-update-line (length updates)) + "Updating deleted thread" + (wl-thread-update-line-msgs updates) + (wl-thread-cleanup-symbols msgs2)))) (wl-summary-count-unread) (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count))))) + (wl-summary-folder-info-update)))) -(defun wl-summary-replace-status-marks (before after) - "Replace the status marks on buffer." - (interactive) +(defun wl-summary-update-status-marks (beg end &optional check) + "Synchronize status marks on current buffer to the msgdb." + (interactive "r") (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t) - (buffer-read-only nil) - (regexp (concat wl-summary-message-regexp ".\\(\\%s\\)"))) - (while (re-search-forward - (format regexp (regexp-quote before)) nil t) - (delete-region (match-beginning 1) (match-end 1)) - (insert after) - (if wl-summary-highlight - (wl-highlight-summary-current-line)))))) - -(defun wl-summary-get-delete-folder (folder) - (if (string= folder wl-trash-folder) - 'null - (let* ((type (or (wl-get-assoc-list-value wl-delete-folder-alist folder) - 'trash))) - (cond ((stringp type) - type) - ((or (equal type 'remove) (equal type 'null)) - 'null) - (t;; (equal type 'trash) - (let ((trash-folder (wl-folder-get-elmo-folder wl-trash-folder))) - (unless (elmo-folder-exists-p trash-folder) - (if (y-or-n-p - (format "Trash Folder %s does not exist, create it? " - wl-trash-folder)) - (elmo-folder-create trash-folder) - (error "Trash Folder is not created")))) - wl-trash-folder))))) - -(defun wl-summary-get-append-message-func () + (goto-char beg) + (while (and (< (point) end) (not (eobp))) + (when (or (not check) + (wl-summary-persistent-mark-invalid-p)) + (wl-summary-update-persistent-mark)) + (forward-line 1)))) + +(defun wl-summary-update-mark-window (&optional win beg) + "Update persistent mark in visible summary window. +This function is defined for `window-scroll-functions'" + (with-current-buffer (window-buffer win) + (when (eq major-mode 'wl-summary-mode) + (let ((start (window-start win)) + (end (condition-case nil + (window-end win t) ; old emacsen doesn't support 2nd arg. + (error (window-end win))))) + (wl-summary-update-status-marks start end 'check))))) + +(defun wl-summary-insert-message (&rest args) (if (eq wl-summary-buffer-view 'thread) - 'wl-summary-insert-thread-entity - 'wl-summary-insert-sequential)) + (apply 'wl-summary-insert-thread args) + (apply 'wl-summary-insert-sequential args))) -(defun wl-summary-sort () - (interactive) - (let ((sort-by (let ((input-range-list '("number" "date" "subject" "from")) - (default "date") - in) - (setq in - (completing-read - (format "Sort by (%s): " default) - (mapcar - (function (lambda (x) (cons x x))) - input-range-list))) - (if (string= in "") - default - in)))) - (if (not (member sort-by '("number" "date" "subject" "from"))) - (error "Sort by %s is not implemented" sort-by)) - (wl-summary-rescan sort-by))) +(defun wl-summary-sort (reverse) + "Sort summary lines into the selected order; argument means descending order." + (interactive "P") + (let ((default-value (symbol-name wl-summary-default-sort-spec))) + (wl-summary-rescan + (wl-completing-read-multiple + (format "%s by (%s): " (if reverse "Reverse sort" "Sort") default-value) + (nconc + (mapcar (lambda (spec) (list (symbol-name spec))) + wl-summary-sort-specs) + (mapcar (lambda (spec) (list (concat "!" (symbol-name spec)))) + wl-summary-sort-specs)) + nil t nil nil + default-value) + reverse))) + +(defun wl-summary-get-available-flags (&optional include-specials) + (let ((flags (elmo-uniq-list + (append elmo-global-flags + (copy-sequence elmo-preserved-flags)) + #'delq))) + (if include-specials + flags + (delq 'new (delq 'cached flags))))) (defun wl-summary-sync-marks () - "Update marks in summary." + "Update persistent marks in summary." (interactive) - (let ((last-progress 0) - (i 0) - unread-marks importants unreads - importants-in-db unreads-in-db diff diffs - mes progress) - ;; synchronize marks. - (when (not (eq (elmo-folder-type-internal - wl-summary-buffer-elmo-folder) - 'internal)) - (message "Updating marks...") - (setq unread-marks (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark) - importants-in-db (elmo-folder-list-messages-mark-match - wl-summary-buffer-elmo-folder - (regexp-quote wl-summary-important-mark)) - unreads-in-db (elmo-folder-list-messages-mark-match - wl-summary-buffer-elmo-folder - (wl-regexp-opt unread-marks)) - importants (elmo-folder-list-importants - wl-summary-buffer-elmo-folder - wl-summary-important-mark) - unreads (elmo-folder-list-unreads - wl-summary-buffer-elmo-folder - unread-marks)) - (setq diff (elmo-list-diff importants importants-in-db)) - (setq diffs (cadr diff)) ; important-deletes - (setq mes (format "Updated (-%d" (length diffs))) - (while diffs - (wl-summary-mark-as-important (car diffs) - wl-summary-important-mark - 'no-server) - (setq diffs (cdr diffs))) - (setq diffs (car diff)) ; important-appends - (setq mes (concat mes (format "/+%d) important," (length diffs)))) - (while diffs - (wl-summary-mark-as-important (car diffs) " " 'no-server) - (setq diffs (cdr diffs))) - (setq diff (elmo-list-diff unreads unreads-in-db)) + (let ((mes "Updated ") + diff diffs) + (message "Updating marks...") + (dolist (flag (wl-summary-get-available-flags)) + (setq diff (elmo-list-diff (elmo-folder-list-flagged + wl-summary-buffer-elmo-folder + flag) + (elmo-folder-list-flagged + wl-summary-buffer-elmo-folder + flag 'in-msgdb))) (setq diffs (cadr diff)) - (setq mes (concat mes (format "(-%d" (length diffs)))) - (while diffs - (wl-summary-mark-as-read t 'no-server nil (car diffs)) - (setq diffs (cdr diffs))) - (setq diffs (car diff)) ; unread-appends - (setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs)))) - (while diffs - (wl-summary-mark-as-unread (car diffs) 'no-server 'no-modeline) - (setq diffs (cdr diffs))) - (if (interactive-p) (message mes))))) - -(defun wl-summary-sync-update (&optional unset-cursor sync-all no-check) + (setq mes (concat mes (format "-%d" (length diffs)))) + (when diffs + (wl-summary-unset-persistent-mark flag diffs 'no-modeline 'no-server)) + (setq diffs (car diff) + mes (concat mes (format "/+%d %s " (length diffs) flag))) + (when diffs + (wl-summary-set-persistent-mark flag diffs 'no-modeline 'no-server))) + (if (interactive-p) (message "%s" mes)))) + +(defun wl-summary-sync-update (&optional unset-cursor + disable-killed + sync-all + no-check) "Update the summary view to the newest folder status." (interactive) (let* ((folder wl-summary-buffer-elmo-folder) - (case-fold-search nil) (elmo-mime-charset wl-summary-buffer-mime-charset) (inhibit-read-only t) (buffer-read-only nil) - gc-message - overview number-alist - curp num i new-msgdb - append-list delete-list crossed - update-thread update-top-list - expunged mes sync-result entity) + gc-message ; for XEmacs + crossed expunged mes) (unwind-protect (progn (unless wl-summary-buffer-elmo-folder (error "(Internal error) Folder is not set:%s" (buffer-name (current-buffer)))) - (fset 'wl-summary-append-message-func-internal - (wl-summary-get-append-message-func)) ;; Flush pending append operations (disconnected operation). ;;(setq seen-list ;;(wl-summary-flush-pending-append-operations seen-list)) (goto-char (point-max)) (wl-folder-confirm-existence folder (elmo-folder-plugged-p folder)) - (setq sync-result (elmo-folder-synchronize - folder - wl-summary-new-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark - wl-summary-read-uncached-mark - wl-summary-important-mark - sync-all no-check)) - (setq new-msgdb (nth 0 sync-result)) - (setq delete-list (nth 1 sync-result)) - (setq crossed (nth 2 sync-result)) - (if sync-result - (progn + (setq crossed (elmo-folder-synchronize folder + disable-killed + sync-all + no-check)) + (if crossed + (let ((wl-summary-highlight + (and wl-summary-highlight + (not wl-summary-lazy-highlight))) + append-list delete-list + update-thread update-top-list + num diff entity) ;; Setup sync-all (if sync-all (wl-summary-sync-all-init)) -; (if (and has-nntp -; (elmo-nntp-max-number-precedes-list-active-p)) - ;; XXX this does not work correctly in rare case. -; (setq delete-list -; (wl-summary-delete-canceled-msgs-from-list -; delete-list -; (wl-summary-buffer-msgdb)))) + (setq diff (elmo-list-diff (elmo-folder-list-messages + folder + (not disable-killed) + 'in-msgdb) + wl-summary-buffer-number-list)) + (setq append-list (sort (car diff) #'<)) + (setq delete-list (cadr diff)) + (when delete-list - (wl-summary-delete-messages-on-buffer delete-list "Deleting...") - (message "Deleting...done")) - (when new-msgdb - (wl-summary-replace-status-marks - wl-summary-new-mark - wl-summary-unread-uncached-mark)) - (setq append-list (elmo-msgdb-get-overview new-msgdb)) - (setq curp append-list) - (setq num (length curp)) - (when append-list - (setq i 0) - - ;; set these value for append-message-func - (setq overview (elmo-msgdb-get-overview - (elmo-folder-msgdb folder))) - (setq number-alist (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder))) - - (setq wl-summary-delayed-update nil) - (elmo-kill-buffer wl-summary-search-buf-name) - (while curp - (setq entity (car curp)) + (wl-summary-delete-messages-on-buffer delete-list)) + (unless wl-summary-lazy-update-mark + (wl-summary-update-status-marks (point-min) (point-max))) + (when (and wl-summary-lazy-highlight + wl-summary-lazy-update-mark) + (let (buffer-read-only) + (put-text-property (point-min) (point-max) 'face nil))) + (setq num (length append-list)) + (setq wl-summary-delayed-update nil) + (elmo-kill-buffer wl-summary-search-buf-name) + (elmo-with-progress-display (wl-summary-insert-line num) + (if (eq wl-summary-buffer-view 'thread) + "Making thread" + "Inserting message") + (dolist (number append-list) + (setq entity (elmo-message-entity folder number)) (when (setq update-thread - (wl-summary-append-message-func-internal - entity (elmo-folder-msgdb folder) + (wl-summary-insert-message + entity folder (not sync-all))) (wl-append update-top-list update-thread)) (if elmo-use-database (elmo-database-msgid-put - (car entity) (elmo-folder-name-internal folder) - (elmo-msgdb-overview-entity-get-number entity))) - (setq curp (cdr curp)) - (when (> num elmo-display-progress-threshold) - (setq i (+ i 1)) - (if (or (zerop (% i 5)) (= i num)) - (elmo-display-progress - 'wl-summary-sync-update "Updating thread..." - (/ (* i 100) num))))) - (when wl-summary-delayed-update - (while wl-summary-delayed-update - (message "Parent (%d) of message %d is no entity" - (caar wl-summary-delayed-update) - (elmo-msgdb-overview-entity-get-number - (cdar wl-summary-delayed-update))) - (when (setq update-thread - (wl-summary-append-message-func-internal - (cdar wl-summary-delayed-update) - (elmo-folder-msgdb folder) - (not sync-all) t)) - (wl-append update-top-list update-thread)) - (setq wl-summary-delayed-update - (cdr wl-summary-delayed-update)))) - (when (and (eq wl-summary-buffer-view 'thread) - update-top-list) - (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) + (elmo-message-entity-field entity 'message-id) + (elmo-folder-name-internal folder) + (elmo-message-entity-number entity)))) + (while wl-summary-delayed-update + (message "Parent (%d) of message %d is no entity" + (caar wl-summary-delayed-update) + (elmo-message-entity-number + (cdar wl-summary-delayed-update))) + (when (setq update-thread + (wl-summary-insert-message + (cdar wl-summary-delayed-update) + wl-summary-buffer-elmo-folder + (not sync-all) t)) + (wl-append update-top-list update-thread)) + (setq wl-summary-delayed-update + (cdr wl-summary-delayed-update)))) + (when (and (eq wl-summary-buffer-view 'thread) + update-top-list) + (wl-thread-update-indent-string-thread + (elmo-uniq-list update-top-list))) + (when (or delete-list append-list) + (wl-summary-set-message-modified)) (when (and sync-all (eq wl-summary-buffer-view 'thread)) (elmo-kill-buffer wl-summary-search-buf-name) - (message "Inserting thread...") - (setq wl-thread-entity-cur 0) - (wl-thread-insert-top) - (message "Inserting thread...done")) + (wl-thread-insert-top)) (if elmo-use-database (elmo-database-close)) (run-hooks 'wl-summary-sync-updated-hook) @@ -2000,16 +2047,16 @@ If ARG is non-nil, checking is omitted." folder)) (format "Updated (-%d/+%d) message(s)" (length delete-list) num)))) - (setq mes "Quit updating."))) + (setq mes "Quit updating"))) ;; synchronize marks. - (if (and wl-summary-auto-sync-marks sync-result) + (if (and crossed wl-summary-auto-sync-marks) (wl-summary-sync-marks)) ;; scoring (when wl-use-scoring (setq wl-summary-scored nil) - (wl-summary-score-headers nil (wl-summary-buffer-msgdb) - (and sync-all - (wl-summary-rescore-msgs number-alist)) + (wl-summary-score-headers (and sync-all + (wl-summary-rescore-msgs + wl-summary-buffer-number-list)) sync-all) (when (and wl-summary-scored (setq expunged (wl-summary-score-update-all-lines))) @@ -2027,9 +2074,8 @@ If ARG is non-nil, checking is omitted." (wl-folder-set-folder-updated (elmo-folder-name-internal folder) (list 0 - (let ((pair (wl-summary-count-unread))) - (+ (car pair) (cdr pair))) - (elmo-folder-messages folder))) + (or (cdr (assq 'unread (wl-summary-count-unread))) 0) + (elmo-folder-length folder))) (wl-summary-update-modeline) ;; (unless unset-cursor @@ -2038,38 +2084,31 @@ If ARG is non-nil, checking is omitted." (progn (goto-char (point-max)) (forward-line -1)) - (if (and wl-summary-highlight - (not (get-text-property (point) 'face))) - (save-excursion - (forward-line (- 0 - (or - wl-summary-partial-highlight-above-lines - wl-summary-highlight-partial-threshold))) - (wl-highlight-summary (point) (point-max)))))) - (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder)) + (when (and wl-summary-highlight + (not wl-summary-lazy-highlight) + (not (get-text-property (point) 'face))) + (save-excursion + (forward-line (- 0 + (or + wl-summary-partial-highlight-above-lines + wl-summary-highlight-partial-threshold))) + (wl-highlight-summary (point) (point-max)))))) (wl-delete-all-overlays) + (run-hooks 'wl-summary-buffer-window-scroll-functions) (set-buffer-modified-p nil) (if mes (message "%s" mes))))) (defun wl-summary-set-score-mark (mark) (save-excursion (beginning-of-line) - (let ((inhibit-read-only t) - (buffer-read-only nil) - msg-num - cur-mark) - (when (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)") - (setq msg-num (string-to-int (wl-match-buffer 1))) - (setq cur-mark (wl-match-buffer 2)) - (when (member cur-mark (list " " - wl-summary-score-below-mark - wl-summary-score-over-mark)) - (goto-char (match-end 1)) - (delete-region (match-beginning 2) (match-end 2)) - (insert mark) - (if wl-summary-highlight - (wl-highlight-summary-current-line nil nil t)) - (set-buffer-modified-p nil)))))) + (let ((cur-mark (wl-summary-temp-mark))) + (when (member cur-mark (list " " + wl-summary-score-below-mark + wl-summary-score-over-mark)) + (wl-summary-put-temp-mark mark) + (if wl-summary-highlight + (wl-highlight-summary-current-line)) + (set-buffer-modified-p nil))))) (defun wl-summary-get-score-mark (msg-num) (let ((score (cdr (assq msg-num wl-summary-scored)))) @@ -2080,60 +2119,47 @@ If ARG is non-nil, checking is omitted." "+"))))) (defun wl-summary-update-modeline () - (setq wl-summary-buffer-unread-status - (format " {%s}(%d new/%d unread)" - (if (eq wl-summary-buffer-view 'thread) - "T" "S") - wl-summary-buffer-new-count - (+ wl-summary-buffer-new-count - wl-summary-buffer-unread-count)))) - -(defsubst wl-summary-jump-to-msg (&optional number) - (interactive) - (let ((num (or number - (string-to-int - (read-from-minibuffer "Jump to Message(No.): "))))) - (setq num (int-to-string num)) - (beginning-of-line) - (if (or (re-search-forward (concat "^[ \t]*" num "[^0-9]") nil t) - (re-search-backward (concat "^[ \t]*" num "[^0-9]") nil t)) - (progn (beginning-of-line) t) - nil))) + (setq wl-summary-buffer-mode-line + (funcall wl-summary-buffer-mode-line-formatter))) + +(defun wl-summary-jump-to-msg (&optional number beg end) + (interactive "NJump to Message (No.): ") + (when number + (let ((pos (point)) + regexp) + (setq regexp (concat "\r" (int-to-string number) "[^0-9]")) + (if (and beg end (or (< pos beg) (< end pos))) + (progn + (goto-char beg) + (if (re-search-forward regexp end t) + (progn (backward-char 1) (beginning-of-line) t) + (goto-char pos) + nil)) + (beginning-of-line) + (if (or (and (re-search-forward regexp end t) + (progn (backward-char 1) t)) + (re-search-backward regexp beg t)) + (progn (beginning-of-line) t) + nil))))) (defun wl-summary-highlight-msgs (msgs) (save-excursion - (let ((len (length msgs)) - i) - (message "Hilighting...") - (setq i 0) + (elmo-with-progress-display (wl-summary-highlight-line (length msgs)) + "Hilighting" (while msgs (if (wl-summary-jump-to-msg (car msgs)) (wl-highlight-summary-current-line)) (setq msgs (cdr msgs)) - (when (> len elmo-display-progress-threshold) - (setq i (+ i 1)) - (if (or (zerop (% i 5)) (= i len)) - (elmo-display-progress - 'wl-summary-highlight-msgs "Highlighting..." - (/ (* i 100) len))))) - (message "Highlighting...done")))) + (elmo-progress-notify 'wl-summary-highlight-line))))) (defun wl-summary-message-number () (save-excursion (beginning-of-line) - (if (looking-at "^ *\\(-?[0-9]+\\)") - (string-to-int (wl-match-buffer 1)) + (if (or (re-search-forward "\r\\(-?[0-9]+\\)" (point-at-eol) t) + (re-search-forward "^ *\\(-?[0-9]+\\)" (point-at-eol) t)) + (string-to-number (wl-match-buffer 1)) nil))) -(defun wl-summary-move (src dsts-msgs) - (let* ((dsts (car dsts-msgs)) ; (+foo +bar) -;;; (msgs (cdr dsts-msgs)) ; (1 2 3) -;;; (msgdb (wl-summary-buffer-msgdb)) -;;; result) - ) - (while dsts - (setq dsts (cdr dsts))))) - (defun wl-summary-delete-all-msgs () (interactive) (let ((cur-buf (current-buffer)) @@ -2146,13 +2172,9 @@ If ARG is non-nil, checking is omitted." (length dels))) (progn (message "Deleting...") - (elmo-folder-delete-messages - wl-summary-buffer-elmo-folder dels) - (elmo-msgdb-delete-msgs (wl-summary-buffer-msgdb) - dels) -;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil) + (elmo-folder-move-messages wl-summary-buffer-elmo-folder dels + 'null) (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) (list 0 0 0)) ;;; for thread. @@ -2182,25 +2204,20 @@ If ARG, without confirm." (setq wl-summary-buffer-view 'thread)) (wl-summary-update-modeline) (force-mode-line-update) - (wl-summary-rescan))) + (wl-summary-rescan nil nil nil t))) (defun wl-summary-load-file-object (filename) "Load lisp object from dir." - (save-excursion - (let ((tmp-buffer (get-buffer-create " *wl-summary-load-file-object*")) - insert-file-contents-pre-hook ; To avoid autoconv-xmas... + (with-temp-buffer + (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas... insert-file-contents-post-hook ret-val) (if (not (file-readable-p filename)) () - (set-buffer tmp-buffer) (as-binary-input-file (insert-file-contents filename)) - (setq ret-val - (condition-case nil - (read (current-buffer)) - (error (error "Reading failed"))))) - (kill-buffer tmp-buffer) - ret-val))) + (condition-case nil + (read (current-buffer)) + (error (error "Reading failed"))))))) (defun wl-summary-goto-folder (&optional arg) (interactive "P") @@ -2254,17 +2271,16 @@ If ARG, without confirm." (folder wl-summary-buffer-elmo-folder) (copy-variables (append '(wl-summary-buffer-view - wl-summary-buffer-refile-list - wl-summary-buffer-delete-list - wl-summary-buffer-copy-list + wl-summary-buffer-temp-mark-list wl-summary-buffer-target-mark-list wl-summary-buffer-elmo-folder wl-summary-buffer-number-column + wl-summary-buffer-temp-mark-column + wl-summary-buffer-persistent-mark-column wl-summary-buffer-message-modified - wl-summary-buffer-mark-modified wl-summary-buffer-thread-modified wl-summary-buffer-number-list - wl-summary-buffer-msgdb + wl-summary-buffer-persistent-mark-version wl-summary-buffer-folder-name wl-summary-buffer-line-formatter) (and (eq wl-summary-buffer-view 'thread) @@ -2285,7 +2301,7 @@ If ARG, without confirm." (wl-summary-mode) (wl-summary-buffer-set-folder folder) (let ((buffer-read-only nil)) - (insert-buffer cur-buf)) + (insert-buffer-substring cur-buf)) (set-buffer-modified-p nil) (while copy-variables (set (car copy-variables) @@ -2305,9 +2321,13 @@ If ARG, without confirm." (beginning-of-line)))) (defun wl-summary-get-buffer (folder) - (or (and folder - (get-buffer (wl-summary-sticky-buffer-name folder))) - (get-buffer wl-summary-buffer-name))) + (and folder + (or (get-buffer (wl-summary-sticky-buffer-name folder)) + (let ((buffer (get-buffer wl-summary-buffer-name))) + (and buffer + (with-current-buffer buffer + (string= (wl-summary-buffer-folder-name) folder)) + buffer))))) (defun wl-summary-get-buffer-create (name &optional force-sticky) (if force-sticky @@ -2317,18 +2337,21 @@ If ARG, without confirm." (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))))) + (save-excursion + (goto-char (point-min)) + (setq wl-summary-buffer-number-list nil) + (while (not (eobp)) + (setq wl-summary-buffer-number-list + (cons (wl-summary-message-number) + wl-summary-buffer-number-list)) + (forward-line 1)) + (setq wl-summary-buffer-number-list + (nreverse wl-summary-buffer-number-list)))) (defun wl-summary-auto-select-msg-p (unread-msg) (and unread-msg - (not (string= - (elmo-msgdb-get-mark - (wl-summary-buffer-msgdb) - unread-msg) - wl-summary-important-mark)))) + (not (elmo-message-has-global-flag-p + wl-summary-buffer-elmo-folder unread-msg)))) (defsubst wl-summary-open-folder (folder) ;; Select folder @@ -2336,7 +2359,6 @@ If ARG, without confirm." (unwind-protect (elmo-folder-open folder 'load-msgdb) ;; For compatibility - (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder)) (setq wl-summary-buffer-folder-name (elmo-folder-name-internal folder))))) @@ -2360,10 +2382,13 @@ If ARG, without confirm." (eq major-mode 'wl-summary-mode)) ; called in summary. (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name)) (run-hooks 'wl-summary-exit-pre-hook) - (if (or force-exit (not (wl-summary-sticky-p))) - (wl-summary-cleanup-temp-marks (wl-summary-sticky-p))) - (wl-summary-save-view) - (elmo-folder-commit wl-summary-buffer-elmo-folder) + (let ((discard-contents (or force-exit (not (wl-summary-sticky-p))))) + (when discard-contents + (wl-summary-cleanup-temp-marks)) + (wl-summary-save-view) + (if discard-contents + (elmo-folder-close wl-summary-buffer-elmo-folder) + (elmo-folder-commit wl-summary-buffer-elmo-folder))) (if (and (wl-summary-sticky-p) force-exit) (kill-buffer (current-buffer)))) (setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder) @@ -2384,11 +2409,15 @@ If ARG, without confirm." (unless (eq major-mode 'wl-summary-mode) (wl-summary-mode)) (wl-summary-buffer-set-folder folder) + (setq wl-summary-buffer-display-mime-mode + (if (wl-summary-no-mime-p wl-summary-buffer-elmo-folder) + 'as-is + 'mime)) (setq wl-summary-buffer-disp-msg nil) - (setq wl-summary-buffer-last-displayed-msg nil) + (setq wl-summary-buffer-message-ring nil) (setq wl-summary-buffer-current-msg nil) - (let ((case-fold-search nil) - (inhibit-read-only t) + (setq wl-summary-buffer-persistent-mark-version 0) + (let ((inhibit-read-only t) (buffer-read-only nil)) (erase-buffer) ;; Resume summary view @@ -2398,32 +2427,42 @@ If ARG, without confirm." (view (expand-file-name wl-summary-view-file dir))) (when (file-exists-p cache) (insert-file-contents-as-binary cache) - (elmo-set-buffer-multibyte + (set-buffer-multibyte default-enable-multibyte-characters) (decode-mime-charset-region (point-min)(point-max) - wl-summary-buffer-mime-charset)) - (when (file-exists-p view) + wl-summary-buffer-mime-charset 'LF)) + (if (file-exists-p view) + (setq wl-summary-buffer-view + (wl-summary-load-file-object view)) (setq wl-summary-buffer-view - (wl-summary-load-file-object view))) + (or (wl-get-assoc-list-value + wl-summary-default-view-alist + (elmo-folder-name-internal folder)) + wl-summary-default-view))) (wl-thread-resume-entity folder) - (wl-summary-open-folder folder)) + (wl-summary-open-folder folder) + (wl-summary-detect-mark-position)) (setq wl-summary-buffer-view (wl-summary-load-file-object (expand-file-name wl-summary-view-file (elmo-folder-msgdb-path folder)))) (wl-summary-open-folder folder) + (wl-summary-detect-mark-position) (wl-summary-rescan)) (wl-summary-count-unread) (wl-summary-update-modeline))) (unless (eq wl-summary-buffer-view 'thread) (wl-summary-make-number-list)) + (when (and wl-summary-cache-use + (or (and wl-summary-check-line-format + (wl-summary-line-format-changed-p)) + (wl-summary-view-old-p))) + (wl-summary-rescan)) (wl-summary-toggle-disp-msg (if wl-summary-buffer-disp-msg 'on 'off)) (unless (and reuse-buf keep-cursor) - ;(setq hilit wl-summary-highlight) (unwind-protect - (let ((wl-summary-highlight (if reuse-buf wl-summary-highlight)) - (wl-use-scoring + (let ((wl-use-scoring (if (or scoring interactive) wl-use-scoring))) (if (and (not scan-type) interactive @@ -2435,10 +2474,12 @@ If ARG, without confirm." ((eq scan-type 'all) (wl-summary-sync 'unset-cursor "all")) ((eq scan-type 'no-sync)) + ((eq scan-type 'rescan) + (wl-summary-rescan)) ((or (eq scan-type 'force-update) (eq scan-type 'update)) (setq mes (wl-summary-sync-force-update - 'unset-cursor 'no-check))))) + 'unset-cursor))))) (if interactive (switch-to-buffer buf) (set-buffer buf)) @@ -2455,22 +2496,21 @@ If ARG, without confirm." (cond ((and wl-auto-select-first (wl-summary-auto-select-msg-p unreadp)) ;; wl-auto-select-first is non-nil and - ;; unreadp is non-nil but not important + ;; unreadp is non-nil but not flagged (setq retval 'disp-msg)) ((and wl-auto-prefetch-first (wl-summary-auto-select-msg-p unreadp)) ;; wl-auto-select-first is non-nil and - ;; unreadp is non-nil but not important + ;; unreadp is non-nil but not flagged (setq retval 'prefetch-msg)) ((not (wl-summary-auto-select-msg-p unreadp)) - ;; unreadp is nil or important + ;; unreadp is nil or flagged (setq retval 'more-next)))) (goto-char (point-max)) (if (elmo-folder-plugged-p folder) (forward-line -1) (wl-summary-prev)) (setq retval 'more-next)) - ;(setq wl-summary-highlight hilit) (if (and wl-summary-highlight (not wl-summary-lazy-highlight) (not reuse-buf)) @@ -2491,22 +2531,31 @@ If ARG, without confirm." (wl-message-buffer-prefetch folder (wl-summary-message-number) - wl-message-buffer-prefetch-depth + (min (or wl-message-buffer-prefetch-depth 0) + (1- wl-message-buffer-cache-size)) (current-buffer) wl-summary-buffer-mime-charset)) (if mes (message "%s" mes)) (if (and interactive wl-summary-recenter) (recenter (/ (- (window-height) 2) 2)))))) ;; set current entity-id - (if (and (not folder) - (setq entity - (wl-folder-search-entity-by-name (elmo-folder-name-internal - folder) - wl-folder-entity - 'folder))) - ;; entity-id is unknown. - (wl-folder-set-current-entity-id - (wl-folder-get-entity-id entity))) + (when (and folder + (setq entity + (wl-folder-search-entity-by-name + (elmo-folder-name-internal folder) + wl-folder-entity + 'folder))) + ;; entity-id is unknown. + (wl-folder-set-current-entity-id + (wl-folder-get-entity-id entity))) + (when (and wl-summary-buffer-window-scroll-functions + wl-on-xemacs) + (sit-for 0)) + (when (or (eq t wl-summary-force-prefetch-folder-list) + (wl-string-match-member + (elmo-folder-name-internal wl-summary-buffer-elmo-folder) + wl-summary-force-prefetch-folder-list)) + (wl-summary-force-prefetch)) (unwind-protect (run-hooks 'wl-summary-prepared-hook) (set-buffer-modified-p nil)) @@ -2514,7 +2563,7 @@ If ARG, without confirm." (defun wl-summary-goto-previous-message-beginning () (end-of-line) - (re-search-backward wl-summary-message-regexp nil t) + (re-search-backward "\r\\(-?[0-9]+\\)" nil t) (beginning-of-line)) (defun wl-summary-goto-top-of-current-thread () @@ -2543,53 +2592,67 @@ If ARG, without confirm." (save-excursion (end-of-line)(point)) 'mouse-face nil)) (insert line "\n") + (save-excursion + (forward-line -1) + (let* ((number (wl-summary-message-number)) + (mark-info (wl-summary-registered-temp-mark number))) + (when (and mark-info (nth 2 mark-info)) + (wl-summary-print-argument number (nth 2 mark-info))))) (if wl-use-highlight-mouse-line ;; remove 'mouse-face of current line. (put-text-property (save-excursion (beginning-of-line)(point)) (save-excursion (end-of-line)(point)) 'mouse-face nil)) + (elmo-progress-notify 'wl-summary-insert-line) (ignore-errors (run-hooks 'wl-summary-line-inserted-hook))) -(defun wl-summary-insert-sequential (entity msgdb &rest args) - (let ((inhibit-read-only t) - buffer-read-only) - (goto-char (point-max)) - (wl-summary-insert-line - (wl-summary-create-line entity nil nil)))) +(defun wl-summary-insert-sequential (entity folder &rest args) + (when entity + (let ((inhibit-read-only t) + (number (elmo-message-entity-number entity)) + buffer-read-only) + (goto-char (point-max)) + (wl-summary-insert-line + (wl-summary-create-line entity nil nil + (elmo-message-status folder number))) + (setq wl-summary-buffer-number-list + (wl-append wl-summary-buffer-number-list + (list (elmo-message-entity-number entity)))) + nil))) (defun wl-summary-default-subject-filter (subject) - (let ((case-fold-search t)) - (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" "")) - (setq subject (elmo-replace-in-string subject "[ \t]" "")) - (elmo-replace-in-string subject "^\\[.*\\]" ""))) + (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" "")) + (setq subject (elmo-replace-in-string subject "[ \t]" "")) + (elmo-replace-in-string subject "^\\[[^]]*\\]" "")) (defun wl-summary-subject-equal (subject1 subject2) (string= (funcall wl-summary-subject-filter-function subject1) (funcall wl-summary-subject-filter-function subject2))) (defmacro wl-summary-put-alike (alike) - (` (elmo-set-hash-val (format "#%d" (wl-count-lines)) - (, alike) - wl-summary-alike-hashtb))) + `(elmo-set-hash-val (format "#%d" (wl-count-lines)) + ,alike + wl-summary-alike-hashtb)) (defmacro wl-summary-get-alike () - (` (elmo-get-hash-val (format "#%d" (wl-count-lines)) - wl-summary-alike-hashtb))) + `(elmo-get-hash-val (format "#%d" (wl-count-lines)) + wl-summary-alike-hashtb)) -(defun wl-summary-insert-headers (overview func mime-decode) - (let (ov this last alike) +(defun wl-summary-insert-headers (folder func &optional mime-decode) + (let ((numbers (elmo-folder-list-messages folder 'visible t)) + ov this last alike) (buffer-disable-undo (current-buffer)) (make-local-variable 'wl-summary-alike-hashtb) - (setq wl-summary-alike-hashtb (elmo-make-hash (* (length overview) 2))) + (setq wl-summary-alike-hashtb (elmo-make-hash (* (length numbers) 2))) (when mime-decode - (elmo-set-buffer-multibyte default-enable-multibyte-characters)) - (while (setq ov (pop overview)) + (set-buffer-multibyte default-enable-multibyte-characters)) + (while (setq ov (elmo-message-entity folder (pop numbers))) (setq this (funcall func ov)) (and this (setq this (std11-unfold-string this))) (if (equal last this) - (wl-append alike (list ov)) + (setq alike (cons ov alike)) (when last (wl-summary-put-alike alike) (insert last ?\n)) @@ -2605,76 +2668,90 @@ If ARG, without confirm." (eword-decode-region (point-min) (point-max)))) (run-hooks 'wl-summary-insert-headers-hook))) -(defun wl-summary-search-by-subject (entity overview) +(defun wl-summary-search-by-subject (entity folder) (let ((summary-buf (current-buffer)) (buf (get-buffer-create wl-summary-search-buf-name)) (folder-name (wl-summary-buffer-folder-name)) - match founds found-entity) + match founds result) (with-current-buffer buf (let ((case-fold-search t)) (when (or (not (string= wl-summary-search-buf-folder-name folder-name)) (zerop (buffer-size))) (setq wl-summary-search-buf-folder-name folder-name) + (message "Creating subject cache...") (wl-summary-insert-headers - overview + folder (function (lambda (x) (funcall wl-summary-subject-filter-function - (elmo-msgdb-overview-entity-get-subject-no-decode x)))) - t)) + (elmo-message-entity-field x 'subject))))) + (message "Creating subject cache...done")) (setq match (funcall wl-summary-subject-filter-function - (elmo-msgdb-overview-entity-get-subject entity))) + (elmo-message-entity-field entity 'subject))) (if (string= match "") (setq match "\n")) - (goto-char (point-min)) - (while (and (not founds) - (not (= (point) (point-max))) - (search-forward match nil t)) + (goto-char (point-max)) + (while (and (null result) + (not (= (point) (point-min))) + (search-backward match nil t)) ;; check exactly match - (when (and (eolp) - (= (point-at-bol) - (match-beginning 0))) - (setq found-entity (wl-summary-get-alike)) - (if (and found-entity - ;; Is founded entity myself or children? - (not (string= - (elmo-msgdb-overview-entity-get-id entity) - (elmo-msgdb-overview-entity-get-id - (car found-entity)))) - (with-current-buffer summary-buf + (when (and (bolp) (= (point-at-eol)(match-end 0))) + (setq founds (wl-summary-get-alike)) + (with-current-buffer summary-buf + (while founds + (when (and + ;; the first element of found-entity list exists on + ;; thread tree. + (wl-thread-get-entity + (elmo-message-entity-number (car founds))) + ;; message id is not same as myself. + (not (string= + (elmo-message-entity-field entity 'message-id) + (elmo-message-entity-field (car founds) + 'message-id))) + ;; not a descendant. (not (wl-thread-descendant-p - (elmo-msgdb-overview-entity-get-number entity) - (elmo-msgdb-overview-entity-get-number - (car found-entity)))))) - ;; return matching entity - (setq founds found-entity)))) - (if founds - (car founds)))))) - -(defun wl-summary-insert-thread-entity (entity msgdb update - &optional force-insert) - (let* ((overview (elmo-msgdb-get-overview msgdb)) - this-id - parent-entity - parent-number - (case-fold-search t) - cur number overview2 cur-entity linked retval delayed-entity - update-list entity-stack) + (elmo-message-entity-number entity) + (elmo-message-entity-number (car founds))))) + (setq result (car founds) + founds nil)) + (setq founds (cdr founds)))))) + result)))) + +(defun wl-summary-insert-thread (entity folder update + &optional force-insert) + (let ((depth 0) + this-id parent-entity parent-number + number cur-entity linked retval delayed-entity + update-list entity-stack thread-entity) (while entity - (setq this-id (elmo-msgdb-overview-entity-get-id entity) - parent-entity - (elmo-msgdb-get-parent-entity entity msgdb) - parent-number (elmo-msgdb-overview-entity-get-number - parent-entity)) - (setq number (elmo-msgdb-overview-entity-get-number entity)) + (setq this-id (elmo-message-entity-field entity 'message-id) + number (elmo-message-entity-number entity)) + (if (and wl-thread-saved-entity-hashtb-internal + (setq thread-entity + (elmo-get-hash-val + (format "#%d" (elmo-message-entity-number entity)) + wl-thread-saved-entity-hashtb-internal))) + (setq parent-entity + (elmo-message-entity + folder + (wl-thread-entity-get-parent thread-entity)) + linked (wl-thread-entity-get-linked thread-entity)) + (setq parent-entity (elmo-message-entity-parent folder entity) + linked nil)) + (setq parent-number (and parent-entity + (elmo-message-entity-number parent-entity))) ;; If thread loop detected, set parent as nil. - (setq cur entity) - (while cur - (if (eq number (elmo-msgdb-overview-entity-get-number - (setq cur - (elmo-msgdb-get-parent-entity cur msgdb)))) - (setq parent-number nil - cur nil))) + (let ((cur entity) + anumber relatives) + (while cur + (when (setq anumber + (elmo-message-entity-number + (setq cur (elmo-message-entity-parent folder cur)))) + (if (memq anumber relatives) + (setq parent-number nil + cur nil)) + (setq relatives (cons anumber relatives))))) (if (and parent-number (not (wl-thread-get-entity parent-number)) (not force-insert)) @@ -2688,22 +2765,21 @@ If ARG, without confirm." wl-summary-search-parent-by-subject-regexp (string-match wl-summary-search-parent-by-subject-regexp - (elmo-msgdb-overview-entity-get-subject entity))) - (let ((found (wl-summary-search-by-subject entity overview))) + (elmo-message-entity-field entity 'subject))) + (let ((found (wl-summary-search-by-subject entity folder))) (when (and found (not (member found wl-summary-delayed-update))) (setq parent-entity found) (setq parent-number - (elmo-msgdb-overview-entity-get-number parent-entity)) + (elmo-message-entity-number parent-entity)) (setq linked t)))) ;; If subject is change, divide thread. (if (and parent-number wl-summary-divide-thread-when-subject-changed (not (wl-summary-subject-equal - (or (elmo-msgdb-overview-entity-get-subject - entity) "") - (or (elmo-msgdb-overview-entity-get-subject - parent-entity) "")))) + (or (elmo-message-entity-field entity 'subject) "") + (or (elmo-message-entity-field parent-entity + 'subject) "")))) (setq parent-number nil)) (setq retval (wl-thread-insert-message entity @@ -2724,816 +2800,73 @@ If ARG, without confirm." (defun wl-summary-update-thread (entity thr-entity parent-entity) - (let* ((this-id (elmo-msgdb-overview-entity-get-id entity)) + (let* ((this-id (elmo-message-entity-field entity 'message-id)) (overview-entity entity) - (parent-id (elmo-msgdb-overview-entity-get-id parent-entity)) - (parent-number (elmo-msgdb-overview-entity-get-number parent-entity)) - summary-line msg subject-differ) + (parent-id (elmo-message-entity-field parent-entity 'message-id)) + (number (elmo-message-entity-number entity)) + (parent-number (elmo-message-entity-number parent-entity)) + insert-line) (cond ((or (not parent-id) (string= this-id parent-id)) (goto-char (point-max)) - (beginning-of-line)) + (beginning-of-line) + (setq insert-line t)) ;; parent already exists in buffer. ((wl-summary-jump-to-msg parent-number) - (wl-thread-goto-bottom-of-sub-thread))) - (let ((inhibit-read-only t) - (buffer-read-only nil)) - (wl-summary-insert-line - (wl-summary-create-line - entity - parent-entity - nil - (wl-thread-maybe-get-children-num msg) - (wl-thread-make-indent-string thr-entity) - (wl-thread-entity-get-linked thr-entity)))))) + (wl-thread-goto-bottom-of-sub-thread) + (setq insert-line t))) + (when insert-line + (let (buffer-read-only) + (wl-summary-insert-line + (wl-summary-create-line + entity + parent-entity + nil + (wl-summary-message-status number) + (wl-thread-maybe-get-children-num number) + (wl-thread-make-indent-string thr-entity) + (wl-thread-entity-get-linked thr-entity))))))) -(defun wl-summary-mark-as-unread (&optional number - no-server-update - no-modeline-update) - (interactive) - (save-excursion - (let* (eol - (inhibit-read-only t) - (buffer-read-only nil) - (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) -;;; (number-alist (elmo-msgdb-get-number-alist msgdb)) - new-mark visible mark) - (if number - (progn - (setq visible (wl-summary-jump-to-msg number)) - (unless (setq mark (elmo-msgdb-get-mark msgdb number)) - (setq mark " "))) - ;; interactive - (setq visible t)) - (when visible - (if (null (wl-summary-message-number)) - (message "No message.") - (end-of-line) - (setq eol (point)) - (wl-summary-goto-previous-message-beginning))) - (if (or (and (not visible) - ;; already exists in msgdb. - (assq number (elmo-msgdb-get-number-alist msgdb))) - (re-search-forward - (format (concat "^ *\\(" - (if number (int-to-string number) - "-?[0-9]+") - "\\)[^0-9]\\(%s\\|%s\\)") - wl-summary-read-uncached-mark - " ") eol t)) - (progn - (setq number (or number (string-to-int (wl-match-buffer 1)))) - (setq mark (or mark (elmo-match-buffer 2))) - (save-match-data - (setq new-mark (if (string= mark - wl-summary-read-uncached-mark) - wl-summary-unread-uncached-mark - (if (elmo-message-use-cache-p folder number) - wl-summary-unread-mark - wl-summary-unread-uncached-mark)))) - ;; server side mark - (unless no-server-update - (save-match-data - (unless (elmo-folder-unmark-read folder (list number)) - (error "Setting mark failed")))) - (when visible - (delete-region (match-beginning 2) (match-end 2)) - (insert new-mark)) - (elmo-msgdb-set-mark msgdb number new-mark) - (unless no-modeline-update - (setq wl-summary-buffer-unread-count - (+ 1 wl-summary-buffer-unread-count)) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count))) - (wl-summary-set-mark-modified) - (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line)))))) - (set-buffer-modified-p nil)) - -(defun wl-summary-delete (&optional number) - "Mark Delete mark 'D'. -If optional argument NUMBER is specified, mark message specified by NUMBER." - (interactive) - (let* ((buffer-num (wl-summary-message-number)) - (msg-num (or number buffer-num)) - mark) - (catch 'done - (when (null msg-num) - (if (interactive-p) - (message "No message.")) - (throw 'done nil)) - (when (setq mark (wl-summary-get-mark msg-num)) - (when (wl-summary-reserve-temp-mark-p mark) - (if (interactive-p) - (error "Already marked as `%s'" mark)) - (throw 'done nil)) - (wl-summary-unmark msg-num)) - (if (or (interactive-p) - (eq number buffer-num)) - (wl-summary-mark-line "D")) - (setq wl-summary-buffer-delete-list - (cons msg-num wl-summary-buffer-delete-list)) - (if (interactive-p) - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - msg-num))) - -(defun wl-summary-remove-destination () - (save-excursion - (let ((inhibit-read-only t) - (buffer-read-only nil) - (buf (current-buffer)) - sol eol rs re) - (beginning-of-line) - (setq sol (point)) - (end-of-line) - (setq eol (point)) - (setq rs (next-single-property-change sol 'wl-summary-destination - buf eol)) - (setq re (next-single-property-change rs 'wl-summary-destination - buf eol)) - (put-text-property rs re 'wl-summary-destination nil) - (put-text-property rs re 'invisible nil) - (goto-char re) - (delete-char (- eol re))))) - -(defun wl-summary-check-mark (msg mark) - (let ((check-func (cond ((string= mark "o") - 'wl-summary-msg-marked-as-refiled) - ((string= mark "O") - 'wl-summary-msg-marked-as-copied) - ((string= mark "D") - 'wl-summary-msg-marked-as-deleted) - ((string= mark "*") - 'wl-summary-msg-marked-as-target)))) - (if check-func - (funcall check-func msg)))) - -(defun wl-summary-mark-collect (mark &optional begin end) - (save-excursion - (save-restriction - (let (msglist) - (narrow-to-region (or begin (point-min)) - (or end (point-max))) - (goto-char (point-min)) - ;; for thread... - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - result) - ;; opened...only myself is checked. - (if (wl-summary-check-mark number mark) - (wl-append msglist (list number))) - (unless (wl-thread-entity-get-opened entity) - ;; closed...children is also checked. - (if (setq result (wl-thread-get-children-msgs-with-mark - number - mark)) - (wl-append msglist result))) - (forward-line 1))) - (elmo-uniq-list msglist)) - (let* ((case-fold-search nil) - (re (format (concat wl-summary-message-regexp "%s") - (regexp-quote mark)))) - (while (re-search-forward re nil t) - (setq msglist (cons (wl-summary-message-number) msglist))) - (nreverse msglist))))))) - -(defun wl-summary-exec () - (interactive) - (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list) - (reverse wl-summary-buffer-delete-list) - (mapcar 'car wl-summary-buffer-copy-list))) +(defun wl-summary-target-mark-msgs (msgs) + "Return the number of marked messages." + (let ((i 0)) + (dolist (number msgs) + (when (wl-summary-target-mark number) + (setq i (1+ i)))) + i)) -(defun wl-summary-exec-region (beg end) - (interactive "r") - (message "Collecting marks ...") +(defun wl-summary-pick (&optional from-list delete-marks) + (interactive "i\nP") (save-excursion - (goto-char beg) - (beginning-of-line) - (setq beg (point)) - (goto-char (1- end)) - (forward-line) - (setq end (point)) - (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end) - (wl-summary-mark-collect "D" beg end) - (wl-summary-mark-collect "O" beg end)))) - -(defun wl-summary-exec-subr (moves dels copies) - (if (not (or moves dels copies)) - (message "No marks") - (save-excursion - (let ((del-fld (wl-summary-get-delete-folder - (wl-summary-buffer-folder-name))) - (start (point)) - (unread-marks (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark)) - (refiles (append moves dels)) - (refile-failures 0) - (copy-failures 0) - (copy-len (length copies)) - refile-len - dst-msgs ; loop counter - result) - (message "Executing ...") - (while dels - (when (not (assq (car dels) wl-summary-buffer-refile-list)) - (wl-append wl-summary-buffer-refile-list - (list (cons (car dels) del-fld))) - (setq wl-summary-buffer-delete-list - (delete (car dels) wl-summary-buffer-delete-list))) - (setq dels (cdr dels))) - ;; begin refile... - (setq refile-len (length refiles)) - (setq dst-msgs - (wl-inverse-alist refiles wl-summary-buffer-refile-list)) - (goto-char start) ; avoid moving cursor to - ; the bottom line. - (when (> refile-len elmo-display-progress-threshold) - (elmo-progress-set 'elmo-folder-move-messages - refile-len "Moving messages...")) - (while dst-msgs - (setq result nil) - (condition-case nil - (setq result (elmo-folder-move-messages - wl-summary-buffer-elmo-folder - (cdr (car dst-msgs)) - (if (eq 'null (car (car dst-msgs))) - 'null - (wl-folder-get-elmo-folder - (car (car dst-msgs)))) - (wl-summary-buffer-msgdb) - (not (null (cdr dst-msgs))) - nil ; no-delete - nil ; same-number - unread-marks - t)) - (error nil)) - (if result ; succeeded. - (progn - ;; update buffer. - (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs))) - ;; update refile-alist. - (setq wl-summary-buffer-refile-list - (wl-delete-associations (cdr (car dst-msgs)) - wl-summary-buffer-refile-list))) - (setq refile-failures - (+ refile-failures (length (cdr (car dst-msgs)))))) - (setq dst-msgs (cdr dst-msgs))) - (elmo-progress-clear 'elmo-folder-move-messages) - ;; end refile - ;; begin cOpy... - (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list)) - (when (> copy-len elmo-display-progress-threshold) - (elmo-progress-set 'elmo-folder-move-messages - copy-len "Copying messages...")) - (while dst-msgs - (setq result nil) - (condition-case nil - (setq result (elmo-folder-move-messages - wl-summary-buffer-elmo-folder - (cdr (car dst-msgs)) - (wl-folder-get-elmo-folder - (car (car dst-msgs))) - (wl-summary-buffer-msgdb) - (not (null (cdr dst-msgs))) - t ; t is no-delete (copy) - nil ; same number - unread-marks - t)) - (error nil)) - (if result ; succeeded. - (progn - ;; update buffer. - (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs))) - ;; update copy-alist - (setq wl-summary-buffer-copy-list - (wl-delete-associations (cdr (car dst-msgs)) - wl-summary-buffer-copy-list))) - (setq copy-failures - (+ copy-failures (length (cdr (car dst-msgs)))))) - (setq dst-msgs (cdr dst-msgs))) - ;; Hide progress bar. - (elmo-progress-clear 'elmo-folder-move-messages) - ;; end cOpy - (wl-summary-folder-info-update) - (wl-summary-set-message-modified) - (wl-summary-set-mark-modified) - (run-hooks 'wl-summary-exec-hook) - (unless (and wl-message-buffer - (eq (wl-summary-message-number) - (with-current-buffer wl-message-buffer - wl-message-buffer-cur-number))) - (wl-summary-toggle-disp-msg 'off)) - (set-buffer-modified-p nil) - (message (concat "Executing ... done" - (if (> refile-failures 0) - (format " (%d refiling failed)" refile-failures) - "") - (if (> copy-failures 0) - (format " (%d copying failed)" copy-failures) - "") - ".")))))) - -(defun wl-summary-read-folder (default &optional purpose ignore-error - no-create init) - (let ((fld (completing-read - (format "Folder name %s(%s): " (or purpose "") - default) - (or wl-folder-completion-function - (if (memq 'read-folder wl-use-folder-petname) - (wl-folder-get-entity-with-petname) - wl-folder-entity-hashtb)) - nil nil (or init wl-default-spec) - 'wl-read-folder-hist))) - (if (or (string= fld wl-default-spec) - (string= fld "")) - (setq fld default)) - (setq fld (elmo-string (wl-folder-get-realname fld))) - (if (string-match "\n" fld) - (error "Not supported folder name: %s" fld)) - (unless no-create - (if ignore-error - (condition-case nil - (wl-folder-confirm-existence - (wl-folder-get-elmo-folder - fld)) - (error)) - (wl-folder-confirm-existence (wl-folder-get-elmo-folder - fld)))) - fld)) - -(defun wl-summary-print-destination (msg-num folder) - "Print refile destination on line." - (wl-summary-remove-destination) - (let ((inhibit-read-only t) - (folder (copy-sequence folder)) - (buffer-read-only nil) - len rs re c) - (setq len (string-width folder)) - (if (< len 1) () - (end-of-line) - (setq re (point)) - (setq c 0) - (while (< c len) - (forward-char -1) - (setq c (+ c (char-width (following-char))))) - (and (> c len) (setq folder (concat " " folder))) - (setq rs (point)) - (put-text-property rs re 'invisible t) - (put-text-property rs re 'wl-summary-destination t) - (goto-char re) - (wl-highlight-refile-destination-string folder) - (insert folder) - (set-buffer-modified-p nil)))) - -(defsubst wl-summary-get-mark (number) - "Return a temporal mark of message specified by NUMBER." - (or (and (memq number wl-summary-buffer-delete-list) "D") - (and (assq number wl-summary-buffer-copy-list) "O") - (and (assq number wl-summary-buffer-refile-list) "o") - (and (memq number wl-summary-buffer-target-mark-list) "*"))) - -(defsubst wl-summary-reserve-temp-mark-p (mark) - "Return t if temporal MARK should be reserved." - (member mark wl-summary-reserve-mark-list)) - -(defun wl-summary-refile (&optional dst number) - "Put refile mark on current line message. -If optional argument DST is specified, put mark without asking -destination folder. -If optional argument NUMBER is specified, mark message specified by NUMBER. - -If folder is read-only, message should be copied. -See `wl-refile-policy-alist' for more details." - (interactive) - (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist - (wl-summary-buffer-folder-name)))) - (cond ((eq policy 'copy) - (if (interactive-p) - (call-interactively 'wl-summary-copy) - (wl-summary-copy dst number))) - (t - (wl-summary-refile-subr 'refile (interactive-p) dst number))))) - -(defun wl-summary-copy (&optional dst number) - "Put copy mark on current line message. -If optional argument DST is specified, put mark without asking -destination folder. -If optional argument NUMBER is specified, mark message specified by NUMBER." - (interactive) - (wl-summary-refile-subr 'copy (interactive-p) dst number)) - -(defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number) - (let* ((buffer-num (wl-summary-message-number)) - (msg-num (or number buffer-num)) - (msgid (and msg-num - (elmo-message-field wl-summary-buffer-elmo-folder - msg-num 'message-id))) - (entity (and msg-num - (elmo-msgdb-overview-get-entity - msg-num (wl-summary-buffer-msgdb)))) - (variable - (intern (format "wl-summary-buffer-%s-list" copy-or-refile))) - folder mark already tmp-folder) - (catch 'done - (when (null entity) - ;; msgdb is empty? - (if interactive - (message "Cannot refile.")) - (throw 'done nil)) - (when (null msg-num) - (if interactive - (message "No message.")) - (throw 'done nil)) - (when (setq mark (wl-summary-get-mark msg-num)) - (when (wl-summary-reserve-temp-mark-p mark) - (if interactive - (error "Already marked as `%s'" mark)) - (throw 'done nil))) - (setq folder (and msg-num - (or dst (wl-summary-read-folder - (or (wl-refile-guess entity) wl-trash-folder) - (format "for %s" copy-or-refile))))) - ;; Cache folder hack by okada@opaopa.org - (if (and (eq (elmo-folder-type-internal - (wl-folder-get-elmo-folder - (wl-folder-get-realname folder))) 'cache) - (not (string= folder - (setq tmp-folder - (concat "'cache/" - (elmo-cache-get-path-subr - (elmo-msgid-to-cache msgid))))))) - (progn - (setq folder tmp-folder) - (message "Force refile to %s." folder))) - (if (string= folder (wl-summary-buffer-folder-name)) - (error "Same folder")) - (if (or (not (elmo-folder-writable-p (wl-folder-get-elmo-folder folder))) - (string= folder wl-queue-folder) - (string= folder wl-draft-folder)) - (error "Don't %s messages to %s" copy-or-refile folder)) - ;; learn for refile. - (if (eq copy-or-refile 'refile) - (wl-refile-learn entity folder)) - (wl-summary-unmark msg-num) - (set variable (append - (symbol-value variable) - (list (cons msg-num folder)))) - (when (or interactive - (eq number buffer-num)) - (wl-summary-mark-line (if (eq copy-or-refile 'refile) - "o" "O")) - ;; print refile destination - (wl-summary-print-destination msg-num folder)) - (if interactive - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile))) - (setq wl-summary-buffer-prev-refile-destination folder) - msg-num))) - -(defun wl-summary-refile-prev-destination () - "Refile message to previously refiled destination." - (interactive) - (wl-summary-refile wl-summary-buffer-prev-refile-destination - (wl-summary-message-number)) - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - -(defun wl-summary-copy-prev-destination () - "Refile message to previously refiled destination." - (interactive) - (wl-summary-copy wl-summary-buffer-prev-copy-destination - (wl-summary-message-number)) - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - -(defsubst wl-summary-no-auto-refile-message-p (msg) - (member (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg) - wl-summary-auto-refile-skip-marks)) - -(defun wl-summary-auto-refile (&optional open-all) - "Set refile mark automatically according to 'wl-refile-guess-by-rule'." - (interactive "P") - (message "Marking...") - (save-excursion - (if (and (eq wl-summary-buffer-view 'thread) - open-all) - (wl-thread-open-all)) - (let* ((spec (wl-summary-buffer-folder-name)) - checked-dsts - (count 0) - number dst thr-entity) - (goto-line 1) - (while (not (eobp)) - (setq number (wl-summary-message-number)) - (dolist (number (cons number - (and (eq wl-summary-buffer-view 'thread) - ;; process invisible children. - (not (wl-thread-entity-get-opened - (setq thr-entity - (wl-thread-get-entity number)))) - (wl-thread-entity-get-descendant - thr-entity)))) - (when (and (not (wl-summary-no-auto-refile-message-p - number)) - (setq dst - (wl-folder-get-realname - (wl-refile-guess-by-rule - (elmo-msgdb-overview-get-entity - number (wl-summary-buffer-msgdb))))) - (not (equal dst spec)) - (let ((pair (assoc dst checked-dsts)) - ret) - (if pair - (cdr pair) - (setq ret - (condition-case nil - (progn - (wl-folder-confirm-existence - (wl-folder-get-elmo-folder dst)) - t) - (error))) - (setq checked-dsts (cons (cons dst ret) checked-dsts)) - ret))) - (if (wl-summary-refile dst number) - (incf count)) - (message "Marking...%d message(s)." count))) - (forward-line)) - (if (eq count 0) - (message "No message was marked.") - (message "Marked %d message(s)." count))))) - -(defun wl-summary-unmark (&optional number) - "Unmark marks (temporary, refile, copy, delete)of current line. -If optional argument NUMBER is specified, unmark message specified by NUMBER." - (interactive) - (save-excursion - (beginning-of-line) - (let ((inhibit-read-only t) - (buffer-read-only nil) - visible - msg-num - cur-mark - score-mark) - (if number - (setq visible (wl-summary-jump-to-msg number)) - (setq visible t)) - ;; Delete mark on buffer. - (when (and visible - (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)")) - (goto-char (match-end 2)) - (or number - (setq number (string-to-int (wl-match-buffer 1)))) - (setq cur-mark (wl-match-buffer 2)) - (if (string= cur-mark " ") - () - (delete-region (match-beginning 2) (match-end 2)) - (if (setq score-mark (wl-summary-get-score-mark number)) - (insert score-mark) - (insert " "))) - (if (or (string= cur-mark "o") - (string= cur-mark "O")) - (wl-summary-remove-destination)) - (if wl-summary-highlight - (wl-highlight-summary-current-line nil nil score-mark)) - (set-buffer-modified-p nil)) - ;; Remove from temporary mark structure. - (and number - (wl-summary-delete-mark number))))) - -(defun wl-summary-msg-marked-as-target (msg) - (if (memq msg wl-summary-buffer-target-mark-list) - t)) - -(defun wl-summary-msg-marked-as-copied (msg) - (assq msg wl-summary-buffer-copy-list)) - -(defun wl-summary-msg-marked-as-deleted (msg) - (if (memq msg wl-summary-buffer-delete-list) - t)) - -(defun wl-summary-msg-marked-as-refiled (msg) - (assq msg wl-summary-buffer-refile-list)) - -(defun wl-summary-target-mark (&optional number) - "Put target mark '*' on current message. -If optional argument NUMBER is specified, mark message specified by NUMBER." - (interactive) - (let* ((buffer-num (wl-summary-message-number)) - (msg-num (or number buffer-num)) - mark) - (catch 'done - (when (null msg-num) - (if (interactive-p) - (message "No message.")) - (throw 'done nil)) - (when (setq mark (wl-summary-get-mark msg-num)) - (when (wl-summary-reserve-temp-mark-p mark) - (if (interactive-p) - (error "Already marked as `%s'" mark)) - (throw 'done nil)) - (wl-summary-unmark msg-num)) - (if (or (interactive-p) - (eq number buffer-num)) - (wl-summary-mark-line "*")) - (setq wl-summary-buffer-target-mark-list - (cons msg-num wl-summary-buffer-target-mark-list)) - (if (interactive-p) - (if (eq wl-summary-move-direction-downward nil) - (wl-summary-prev) - (wl-summary-next))) - msg-num))) - - -(defun wl-summary-refile-region (beg end) - "Put copy mark on messages in the region specified by BEG and END." - (interactive "r") - (wl-summary-refile-region-subr "refile" beg end)) - -(defun wl-summary-copy-region (beg end) - "Put copy mark on messages in the region specified by BEG and END." - (interactive "r") - (wl-summary-refile-region-subr "copy" beg end)) - -(defun wl-summary-refile-region-subr (copy-or-refile beg end) - (save-excursion - (save-restriction - (goto-char beg) - ;; guess by first msg - (let* ((msgid (cdr (assq (wl-summary-message-number) - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb))))) - (function (intern (format "wl-summary-%s" copy-or-refile))) - (entity (assoc msgid (elmo-msgdb-get-overview - (wl-summary-buffer-msgdb)))) - folder) - (if entity - (setq folder (wl-summary-read-folder (wl-refile-guess entity) - (format "for %s" - copy-or-refile)))) - (narrow-to-region beg end) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...refile line. - (funcall function folder number) - ;; closed - (setq children (wl-thread-get-children-msgs number)) - (while children - (funcall function folder (pop children)))) - (forward-line 1)))) - (while (not (eobp)) - (funcall function folder (wl-summary-message-number)) - (forward-line 1))))))) - -(defun wl-summary-unmark-region (beg end) - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number))) - (if (wl-thread-entity-get-opened entity) - ;; opened...unmark line. - (wl-summary-unmark) - ;; closed - (wl-summary-delete-marks-on-buffer - (wl-thread-get-children-msgs number)))) - (forward-line 1))) - (while (not (eobp)) - (wl-summary-unmark) - (forward-line 1)))))) - -(defun wl-summary-mark-region-subr (function beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (if (eq wl-summary-buffer-view 'thread) - (progn - (while (not (eobp)) - (let* ((number (wl-summary-message-number)) - (entity (wl-thread-get-entity number)) - (wl-summary-move-direction-downward t) - children) - (if (wl-thread-entity-get-opened entity) - ;; opened...delete line. - (funcall function number) - ;; closed - (setq children (wl-thread-get-children-msgs number)) - (while children - (funcall function (pop children)))) - (forward-line 1)))) - (while (not (eobp)) - (funcall function (wl-summary-message-number)) - (forward-line 1)))))) - -(defun wl-summary-delete-region (beg end) - (interactive "r") - (wl-summary-mark-region-subr 'wl-summary-delete beg end)) - -(defun wl-summary-target-mark-region (beg end) - (interactive "r") - (wl-summary-mark-region-subr 'wl-summary-target-mark beg end)) - -(defun wl-summary-target-mark-all () - (interactive) - (wl-summary-target-mark-region (point-min) (point-max)) - (setq wl-summary-buffer-target-mark-list - (mapcar 'car - (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))))) - -(defun wl-summary-delete-all-mark (mark) - (goto-char (point-min)) - (let ((case-fold-search nil)) - (while (re-search-forward (format "^ *-?[0-9]+%s" - (regexp-quote mark)) nil t) - (wl-summary-unmark)) - (cond ((string= mark "*") - (setq wl-summary-buffer-target-mark-list nil)) - ((string= mark "D") - (setq wl-summary-buffer-delete-list nil)) - ((string= mark "O") - (setq wl-summary-buffer-copy-list nil)) - ((string= mark "o") - (setq wl-summary-buffer-refile-list nil))))) - -(defun wl-summary-unmark-all () - "Unmark all according to what you input." - (interactive) - (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: "))) - cur-mark) - (save-excursion - (while unmarks - (setq cur-mark (char-to-string (car unmarks))) - (wl-summary-delete-all-mark cur-mark) - (setq unmarks (cdr unmarks)))))) - -(defun wl-summary-target-mark-thread () - (interactive) - (wl-thread-call-region-func 'wl-summary-target-mark-region t)) - -(defun wl-summary-target-mark-msgs (msgs) - "Return the number of marked messages." - (let ((i 0) num) - (while msgs - (if (eq wl-summary-buffer-view 'thread) - (wl-thread-jump-to-msg (car msgs)) - (wl-summary-jump-to-msg (car msgs))) - (setq num (wl-summary-message-number)) - (when (eq num (car msgs)) - (wl-summary-target-mark num) - (setq i (1+ i))) - (setq msgs (cdr msgs))) - i)) - -(defun wl-summary-pick (&optional from-list delete-marks) - (interactive) - (save-excursion - (let* ((condition (car (elmo-parse-search-condition - (elmo-read-search-condition - wl-summary-pick-field-default)))) - (result (elmo-folder-search wl-summary-buffer-elmo-folder - condition - from-list)) - num) - (if delete-marks - (let ((mlist wl-summary-buffer-target-mark-list)) - (while mlist - (when (wl-summary-jump-to-msg (car mlist)) - (wl-summary-unmark)) - (setq mlist (cdr mlist))) - (setq wl-summary-buffer-target-mark-list nil))) - (if (and result - (setq num (wl-summary-target-mark-msgs result)) - (> num 0)) - (if (= num (length result)) - (message "%d message(s) are picked." num) - (message "%d(%d) message(s) are picked." num - (- (length result) num))) - (message "No message was picked."))))) + (let* ((messages (or from-list + (elmo-folder-list-messages + wl-summary-buffer-elmo-folder + 'visible + 'in-msgdb) + (error "No messages"))) + (condition (car (elmo-parse-search-condition + (wl-read-search-condition + wl-summary-pick-field-default)))) + (result (elmo-folder-search wl-summary-buffer-elmo-folder + condition + messages)) + num) + (if delete-marks + (let ((mlist wl-summary-buffer-target-mark-list)) + (while mlist + (when (wl-summary-jump-to-msg (car mlist)) + (wl-summary-unmark)) + (setq mlist (cdr mlist))) + (setq wl-summary-buffer-target-mark-list nil))) + (if (and result + (setq num (wl-summary-target-mark-msgs result)) + (> num 0)) + (if (= num (length result)) + (message "%d message(s) are picked." num) + (message "%d(%d) message(s) are picked." num + (- (length result) num))) + (message "No message was picked."))))) (defun wl-summary-unvirtual () "Exit from current virtual folder." @@ -3554,168 +2887,133 @@ If ARG, exit virtual folder." (if arg (wl-summary-unvirtual) (wl-summary-goto-folder-subr (concat "/" - (elmo-read-search-condition + (wl-read-search-condition wl-summary-pick-field-default) "/" (wl-summary-buffer-folder-name)) - 'update nil nil t))) + 'update nil nil t) + (run-hooks 'wl-summary-virtual-hook))) -(defun wl-summary-delete-all-temp-marks (&optional no-msg) +(defun wl-summary-delete-all-temp-marks (&optional no-msg force) "Erase all temp marks from buffer." (interactive) (when (or wl-summary-buffer-target-mark-list - wl-summary-buffer-delete-list - wl-summary-buffer-refile-list - wl-summary-buffer-copy-list) + wl-summary-buffer-temp-mark-list + wl-summary-scored) (save-excursion (goto-char (point-min)) (unless no-msg (message "Unmarking...")) (while (not (eobp)) - (wl-summary-unmark) - (forward-line)) + (wl-summary-unset-mark nil nil force) + (forward-line 1)) (unless no-msg (message "Unmarking...done")) (setq wl-summary-buffer-target-mark-list nil) - (setq wl-summary-buffer-delete-list nil) - (setq wl-summary-buffer-refile-list nil) - (setq wl-summary-buffer-copy-list nil)))) - -(defun wl-summary-delete-mark (number) - "Delete temporary mark of the message specified by NUMBER." - (cond - ((memq number wl-summary-buffer-target-mark-list) - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))) - ((memq number wl-summary-buffer-delete-list) - (setq wl-summary-buffer-delete-list - (delq number wl-summary-buffer-delete-list))) - (t - (let (pair) - (cond - ((setq pair (assq number wl-summary-buffer-copy-list)) - (setq wl-summary-buffer-copy-list - (delq pair wl-summary-buffer-copy-list))) - ((setq pair (assq number wl-summary-buffer-refile-list)) - (setq wl-summary-buffer-refile-list - (delq pair wl-summary-buffer-refile-list)))))))) - -(defun wl-summary-mark-line (mark) - "Put MARK on current line. Return message number." - (save-excursion - (beginning-of-line) - (let ((inhibit-read-only t) - (buffer-read-only nil) - msg-num - cur-mark) - (when (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)") - (setq msg-num (string-to-int (wl-match-buffer 1))) - (setq cur-mark (wl-match-buffer 2)) - (goto-char (match-end 1)) - (delete-region (match-beginning 2) (match-end 2)) -;;; (wl-summary-delete-mark msg-num) - (insert mark) - (if wl-summary-highlight - (wl-highlight-summary-current-line nil nil t)) - (set-buffer-modified-p nil) - msg-num)))) - -(defun wl-summary-target-mark-delete () - (interactive) - (save-excursion - (goto-char (point-min)) - (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)")) - number mlist) - (while (re-search-forward regexp nil t) - (let (wl-summary-buffer-disp-msg) - (when (setq number (wl-summary-message-number)) - (wl-summary-delete number) - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))))) - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-append wl-summary-buffer-delete-list (list (car mlist))) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist)))))) - -(defun wl-summary-target-mark-prefetch (&optional ignore-cache) - (interactive "P") - (save-excursion - (let* ((mlist (nreverse wl-summary-buffer-target-mark-list)) - (inhibit-read-only t) - (buffer-read-only nil) - (count 0) - (length (length mlist)) - (pos (point)) - skipped - new-mark) - (while mlist - (setq new-mark (wl-summary-prefetch-msg (car mlist) ignore-cache)) - (if new-mark - (progn - (message "Prefetching... %d/%d message(s)" - (setq count (+ 1 count)) length) - (when (wl-summary-jump-to-msg (car mlist)) - (wl-summary-unmark) - (when new-mark - (when (looking-at "^ *-?[0-9]+[^0-9]\\([^0-9]\\)") - (delete-region (match-beginning 1) (match-end 1))) - (goto-char (match-beginning 1)) - (insert new-mark) - (if wl-summary-highlight - (wl-highlight-summary-current-line)) - (save-excursion - (goto-char pos) - (sit-for 0))))) - (setq skipped (cons (car mlist) skipped))) - (setq mlist (cdr mlist))) - (setq wl-summary-buffer-target-mark-list skipped) - (message "Prefetching... %d/%d message(s)." count length) - (set-buffer-modified-p nil)))) + (setq wl-summary-buffer-temp-mark-list nil)))) + +(defsubst wl-summary-temp-mark (&optional number) + "Return temp-mark string of current line." + (let ((number (or number (wl-summary-message-number))) + info) + (or (and (wl-summary-have-target-mark-p number) + "*") + (and (setq info (wl-summary-registered-temp-mark number)) + (nth 1 info)) + (wl-summary-get-score-mark number) + " "))) + +(defun wl-summary-persistent-mark-invalid-p () + (not + (equal + ;; mey be nil. + (get-text-property (point) 'wl-summary-persistent-mark-version) + wl-summary-buffer-persistent-mark-version))) + +(defun wl-summary-validate-persistent-mark (beg end) + (let ((inhibit-read-only t) + (buffer-read-only nil)) + (put-text-property beg end + 'wl-summary-persistent-mark-version + wl-summary-buffer-persistent-mark-version) + (set-buffer-modified-p nil))) -(defun wl-summary-target-mark-refile-subr (copy-or-refile) - (let ((variable - (intern (format "wl-summary-buffer-%s-list" copy-or-refile))) - (function - (intern (format "wl-summary-%s" copy-or-refile))) - regexp number msgid entity folder mlist) +(defun wl-summary-validate-persistent-mark-string (string) + (put-text-property 0 (length string) + 'wl-summary-persistent-mark-version + wl-summary-buffer-persistent-mark-version + string)) + +(defun wl-summary-invalidate-persistent-mark () + (setq wl-summary-buffer-persistent-mark-version + (1+ wl-summary-buffer-persistent-mark-version))) + +(defsubst wl-summary-persistent-mark-string (folder status) + "Return the persistent mark string. +The mark is decided according to the FOLDER and STATUS." + (let ((priorities wl-summary-persistent-mark-priority-list) + (flags (elmo-message-status-flags status)) + (cached (elmo-message-status-cached-p status)) + mark) + (while (and (null mark) priorities) + (let ((flag (car priorities))) + (cond + ((eq flag 'flag) + (let ((flags (elmo-get-global-flags flags 'ignore-preserved)) + (specs wl-summary-flag-alist) + spec) + (when flags + (while (setq spec (car specs)) + (if (memq (car spec) flags) + (setq mark (or (nth 2 spec) wl-summary-flag-mark) + specs nil) + (setq specs (cdr specs)))) + (unless mark + (setq mark wl-summary-flag-mark))))) + ((eq flag 'killed) + (when (elmo-message-status-killed-p status) + (setq mark wl-summary-killed-mark))) + ((memq flag flags) + (setq mark + (let ((var (intern-soft + (format + (if cached + "wl-summary-%s-cached-mark" + "wl-summary-%s-uncached-mark") + flag)))) + (or (and var (boundp var) (symbol-value var)) + (funcall (if cached #'downcase #'upcase) + (substring (symbol-name flag) 0 1))))))) + (setq priorities (cdr priorities)))) + (or mark + (if (or cached (elmo-folder-local-p folder)) + nil + wl-summary-uncached-mark)))) + +(defsubst wl-summary-message-mark (folder number &optional status) + "Return mark of the message." + (ignore-errors + (wl-summary-persistent-mark-string + folder + (or status (elmo-message-status folder number))))) + +(defsubst wl-summary-persistent-mark (&optional number status) + "Return persistent-mark string of current line." + (or (wl-summary-message-mark wl-summary-buffer-elmo-folder + (or number (wl-summary-message-number)) + status) + " ")) + +(defun wl-summary-put-temp-mark (mark) + "Put temp MARK on current line." + (when wl-summary-buffer-temp-mark-column (save-excursion - (goto-char (point-min)) - (setq regexp (concat wl-summary-message-regexp "\\(\\*\\)")) - ;; guess by first mark - (when (re-search-forward regexp nil t) - (setq msgid (cdr (assq (setq number (wl-summary-message-number)) - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))) - entity (assoc msgid - (elmo-msgdb-get-overview - (wl-summary-buffer-msgdb)))) - (if (null entity) - (error "Cannot %s" copy-or-refile)) - (funcall function - (setq folder (wl-summary-read-folder - (wl-refile-guess entity) - (format "for %s" copy-or-refile))) - number) - (if number - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))) - (while (re-search-forward regexp nil t) - (let (wl-summary-buffer-disp-msg) - (when (setq number (wl-summary-message-number)) - (funcall function folder number) - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))))) - ;; process invisible messages. - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (set variable - (append (symbol-value variable) - (list (cons (car mlist) folder)))) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))))))) + (beginning-of-line) + (let ((inhibit-read-only t) + (buffer-read-only nil)) + (move-to-column wl-summary-buffer-temp-mark-column) + (delete-backward-char 1) + (insert mark))))) (defun wl-summary-next-buffer () "Switch to next summary buffer." @@ -3739,290 +3037,431 @@ If ARG, exit virtual folder." (or (cadr (memq (current-buffer) buffers)) (car buffers))))) -(defun wl-summary-target-mark-copy () - (interactive) - (wl-summary-target-mark-refile-subr "copy")) - -(defun wl-summary-target-mark-refile () - (interactive) - (wl-summary-target-mark-refile-subr "refile")) +(defun wl-summary-check-target-mark () + (when (null wl-summary-buffer-target-mark-list) + (error "No marked message"))) (defun wl-summary-target-mark-mark-as-read () (interactive) + (wl-summary-check-target-mark) (save-excursion (goto-char (point-min)) - (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)")) - (inhibit-read-only t) + (let ((inhibit-read-only t) (buffer-read-only nil) - number mlist) - (while (re-search-forward regexp nil t) - (let (wl-summary-buffer-disp-msg) - ;; delete target-mark from buffer. - (delete-region (match-beginning 1) (match-end 1)) - (insert " ") - (setq number (wl-summary-mark-as-read t)) - (if wl-summary-highlight - (wl-highlight-summary-current-line)) - (if number - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))))) - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-summary-mark-as-read t nil nil (car mlist)) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))) - (wl-summary-count-unread) - (wl-summary-update-modeline)))) + wl-summary-buffer-disp-msg) + (wl-summary-mark-as-read wl-summary-buffer-target-mark-list) + (dolist (number wl-summary-buffer-target-mark-list) + (wl-summary-unset-mark number))))) (defun wl-summary-target-mark-mark-as-unread () (interactive) + (wl-summary-check-target-mark) (save-excursion (goto-char (point-min)) - (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)")) - (inhibit-read-only t) + (let ((inhibit-read-only t) (buffer-read-only nil) - number mlist) - (while (re-search-forward regexp nil t) - (let (wl-summary-buffer-disp-msg) - ;; delete target-mark from buffer. - (delete-region (match-beginning 1) (match-end 1)) - (insert " ") - (setq number (wl-summary-mark-as-unread)) - (if wl-summary-highlight - (wl-highlight-summary-current-line)) - (if number - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))))) - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-summary-mark-as-unread (car mlist)) -;;; (wl-thread-msg-mark-as-unread (car mlist)) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))) + wl-summary-buffer-disp-msg) + (wl-summary-mark-as-unread wl-summary-buffer-target-mark-list) + (dolist (number wl-summary-buffer-target-mark-list) + (wl-summary-unset-mark number))))) + +(defun wl-summary-target-mark-operation (flag &optional inverse) + (wl-summary-check-target-mark) + (save-excursion + (let ((inhibit-read-only t) + (buffer-read-only nil) + wl-summary-buffer-disp-msg) + (funcall + (intern (format "wl-summary-mark-as-%s-internal" flag)) + inverse + wl-summary-buffer-target-mark-list) + (wl-summary-delete-all-target-marks)))) + +(defun wl-summary-target-mark-mark-as-important (&optional remove) + (interactive "P") + (wl-summary-target-mark-operation 'important remove)) + +(defun wl-summary-target-mark-mark-as-answered (&optional remove) + (interactive "P") + (wl-summary-target-mark-operation 'answered remove)) + +(defun wl-summary-target-mark-set-flags (&optional remove) + (interactive "P") + (wl-summary-check-target-mark) + (save-excursion + (let ((inhibit-read-only t) + (buffer-read-only nil) + wl-summary-buffer-disp-msg) + (wl-summary-set-flags-internal wl-summary-buffer-target-mark-list + nil nil remove) + (wl-summary-delete-all-target-marks) (wl-summary-count-unread) (wl-summary-update-modeline)))) -(defun wl-summary-target-mark-mark-as-important () +(defun wl-summary-target-mark-recover () + "Recover killed messages which have target mark." (interactive) + (wl-summary-check-target-mark) (save-excursion - (goto-char (point-min)) - (let ((regexp (concat wl-summary-message-regexp "\\(\\*\\)")) - (inhibit-read-only t) + (let ((inhibit-read-only t) (buffer-read-only nil) - number mlist) - (while (re-search-forward regexp nil t) - (let (wl-summary-buffer-disp-msg) - ;; delete target-mark from buffer. - (delete-region (match-beginning 1) (match-end 1)) - (insert " ") - (setq number (wl-summary-mark-as-important)) - (if wl-summary-highlight - (wl-highlight-summary-current-line)) - (if number - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list))))) - (setq mlist wl-summary-buffer-target-mark-list) - (while mlist - (wl-summary-mark-as-important (car mlist)) - (wl-thread-msg-mark-as-important (car mlist)) - (setq wl-summary-buffer-target-mark-list - (delq (car mlist) wl-summary-buffer-target-mark-list)) - (setq mlist (cdr mlist))) - (wl-summary-count-unread) - (wl-summary-update-modeline)))) + wl-summary-buffer-disp-msg) + (elmo-folder-recover-messages wl-summary-buffer-elmo-folder + wl-summary-buffer-target-mark-list) + (dolist (number wl-summary-buffer-target-mark-list) + (wl-summary-unset-mark number))))) (defun wl-summary-target-mark-save () (interactive) - (save-excursion - (goto-char (point-min)) - (let ((wl-save-dir - (wl-read-directory-name "Save to directory: " - wl-temporary-file-directory)) - (regexp (concat wl-summary-message-regexp "\\(\\*\\)")) - number mlist) - (if (null (file-exists-p wl-save-dir)) - (make-directory wl-save-dir)) - (while (re-search-forward regexp nil t) - (let (wl-summary-buffer-disp-msg) - (setq number (wl-summary-save t wl-save-dir)) - (wl-summary-unmark) - (if number - (setq wl-summary-buffer-target-mark-list - (delq number wl-summary-buffer-target-mark-list)))))))) + (wl-summary-check-target-mark) + (let ((wl-save-dir + (wl-read-directory-name "Save to directory: " + wl-temporary-file-directory)) + number) + (if (null (file-exists-p wl-save-dir)) + (make-directory wl-save-dir)) + (while (setq number (car wl-summary-buffer-target-mark-list)) + (wl-thread-jump-to-msg number) + (wl-summary-save t wl-save-dir) + (wl-summary-unmark)))) (defun wl-summary-target-mark-pick () (interactive) + (wl-summary-check-target-mark) (wl-summary-pick wl-summary-buffer-target-mark-list 'delete)) -(defun wl-summary-mark-as-read (&optional notcrosses - leave-server-side-mark-untouched - displayed - number - cached) +(defun wl-summary-update-persistent-mark (&optional number) + "Synch up persistent mark of current line with msgdb's. +Return non-nil if the mark is updated" (interactive) + (let ((status (wl-summary-message-status number))) + (prog1 + (when wl-summary-buffer-persistent-mark-column + (save-excursion + (move-to-column wl-summary-buffer-persistent-mark-column) + (let ((inhibit-read-only t) + (buffer-read-only nil) + (mark (buffer-substring (- (point) 1) (point))) + (new-mark (wl-summary-persistent-mark number status))) + (prog1 + (unless (string= new-mark mark) + (delete-backward-char 1) + (insert new-mark) + (wl-summary-set-message-modified) + t) + (wl-summary-validate-persistent-mark (point-at-bol) + (point-at-eol)))))) + (when wl-summary-highlight + (wl-highlight-summary-current-line number status)) + (set-buffer-modified-p nil)))) + +(defsubst wl-summary-mark-as-read-internal (inverse + number-or-numbers + no-folder-mark + no-modeline-update) (save-excursion - (let* (eol - (inhibit-read-only t) - (buffer-read-only nil) - (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) -;;; (number-alist (elmo-msgdb-get-number-alist msgdb)) - (case-fold-search nil) - mark stat visible uncached new-mark marked) - (if number - (progn - (setq visible (wl-summary-jump-to-msg number)) - (setq mark (elmo-msgdb-get-mark msgdb number))) - ;; interactive - (setq visible t)) - (beginning-of-line) - (if (or (not visible) - (looking-at - (format "^ *\\(-?[0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$" - (regexp-quote wl-summary-read-uncached-mark) - (regexp-quote wl-summary-unread-uncached-mark) - (regexp-quote wl-summary-unread-cached-mark) - (regexp-quote wl-summary-new-mark)))) - (progn - (setq mark (or mark (wl-match-buffer 2))) - (when mark - (cond - ((string= mark wl-summary-new-mark) ; N - (setq stat 'new) - (setq uncached t)) - ((string= mark wl-summary-unread-uncached-mark) ; U - (setq stat 'unread) - (setq uncached t)) - ((string= mark wl-summary-unread-cached-mark) ; ! - (setq stat 'unread)) - (t - ;; no need to mark server. - (setq leave-server-side-mark-untouched t)))) - (setq number (or number (string-to-int (wl-match-buffer 1)))) - ;; set server side mark... - (setq new-mark (if (and uncached - (if (elmo-message-use-cache-p folder number) - (not (elmo-folder-local-p folder))) - (not cached)) - wl-summary-read-uncached-mark - nil)) - (if (not leave-server-side-mark-untouched) - (save-match-data - (setq marked (elmo-folder-mark-as-read - folder - (list number))))) - (if (or leave-server-side-mark-untouched - marked) - (progn - (cond ((eq stat 'unread) - (setq wl-summary-buffer-unread-count - (1- wl-summary-buffer-unread-count))) - ((eq stat 'new) - (setq wl-summary-buffer-new-count - (1- wl-summary-buffer-new-count)))) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count)) - (when (or stat cached) - (when visible - (goto-char (match-end 2)) - (delete-region (match-beginning 2) (match-end 2)) - (insert (or new-mark " "))) - (elmo-msgdb-set-mark msgdb number new-mark) - (wl-summary-set-mark-modified)) - (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line nil nil t))) - (if mark (message "Warning: Changing mark failed."))))) - (set-buffer-modified-p nil) - (if stat - (run-hooks 'wl-summary-unread-message-hook)) - number ;return value - ))) - -(defun wl-summary-mark-as-important (&optional number - mark - no-server-update) + (let ((folder wl-summary-buffer-elmo-folder) + unread-message number + number-list) + (setq number-list (cond ((numberp number-or-numbers) + (setq unread-message + (elmo-message-flagged-p + folder + number-or-numbers + 'unread)) + (list number-or-numbers)) + ((and (not (null number-or-numbers)) + (listp number-or-numbers)) + number-or-numbers) + ((setq number (wl-summary-message-number)) + ;; interactive + (setq unread-message + (elmo-message-flagged-p + folder + number + 'unread)) + (list number)))) + (if (null number-list) + (message "No message.") + (if inverse + (elmo-folder-set-flag folder number-list 'unread no-folder-mark) + (elmo-folder-unset-flag folder number-list 'unread no-folder-mark)) + (when (and unread-message + (not inverse)) + (dolist (number number-list) + (wl-summary-jump-to-msg number) + (run-hooks 'wl-summary-unread-message-hook))) + (unless no-modeline-update + ;; Update unread numbers. + (wl-summary-count-unread) + (wl-summary-update-modeline) + (wl-folder-update-unread + (wl-summary-buffer-folder-name) + wl-summary-buffer-unread-count)))))) + +(defun wl-summary-mark-as-read (&optional number-or-numbers + no-folder-mark + no-modeline-update) + (interactive) + (wl-summary-mark-as-read-internal nil + number-or-numbers + no-folder-mark + no-modeline-update)) + +(defun wl-summary-mark-as-unread (&optional number-or-numbers + no-folder-mark + no-modeline-update) (interactive) - (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) - 'internal) - (error "Cannot process mark in this folder")) + (wl-summary-mark-as-read-internal 'inverse + number-or-numbers + no-folder-mark + no-modeline-update)) + +(defsubst wl-summary-set-persistent-mark-internal (inverse + flag + &optional number-or-numbers + no-modeline-update + no-server + interactive) + "Set persistent mark." (save-excursion - (let* (eol - (inhibit-read-only t) - (buffer-read-only nil) - (folder wl-summary-buffer-elmo-folder) - (msgdb (wl-summary-buffer-msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - message-id visible) - (if number - (progn - (setq visible (wl-summary-jump-to-msg number)) - (setq mark (or mark (elmo-msgdb-get-mark msgdb number)))) - (setq visible t)) - (when visible - (if (null (setq number (wl-summary-message-number))) + (let ((folder wl-summary-buffer-elmo-folder) + number number-list) + (setq number-list (cond ((numberp number-or-numbers) + (list number-or-numbers)) + ((and (not (null number-or-numbers)) + (listp number-or-numbers)) + number-or-numbers) + ((setq number (wl-summary-message-number)) + ;; interactive + (list number)))) + (if (null number-list) + (message "No message.") + ;; XXX Only the first element of the list is checked. + (if (elmo-message-flag-available-p folder (car number-list) flag) (progn - (message "No message.") - (setq visible nil)) - (end-of-line) - (setq eol (point)) - (wl-summary-goto-previous-message-beginning))) - (if (or (and (not visible) - (assq number (elmo-msgdb-get-number-alist msgdb))) - (re-search-forward "^ *\\(-?[0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)) - (progn - (setq number (or number (string-to-int (wl-match-buffer 1)))) - (setq mark (or mark (wl-match-buffer 2))) - (setq message-id (elmo-message-field - wl-summary-buffer-elmo-folder - number - 'message-id)) - (if (string= mark wl-summary-important-mark) - (progn - ;; server side mark - (save-match-data - (unless no-server-update - (elmo-folder-unmark-important folder (list number)) - (elmo-msgdb-global-mark-delete message-id)) - ;; Remove cache if local folder. - (if (and (elmo-folder-local-p folder) - (not (eq 'mark - (elmo-folder-type-internal folder)))) - (elmo-file-cache-delete - (elmo-file-cache-get-path message-id)))) - (when visible - (delete-region (match-beginning 2) (match-end 2)) - (insert " ")) - (elmo-msgdb-set-mark msgdb number nil)) - ;; server side mark - (save-match-data - (unless no-server-update - (elmo-folder-mark-as-important folder (list number)))) - (when visible - (delete-region (match-beginning 2) (match-end 2)) - (insert wl-summary-important-mark)) - (elmo-msgdb-set-mark msgdb number - wl-summary-important-mark) - (if (eq (elmo-file-cache-exists-p message-id) 'entire) - (elmo-folder-mark-as-read folder (list number)) - ;; Force cache message. - (elmo-message-encache folder number 'read)) - (unless no-server-update - (elmo-msgdb-global-mark-set message-id - wl-summary-important-mark))) - (wl-summary-set-mark-modified))) - (if (and visible wl-summary-highlight) - (wl-highlight-summary-current-line nil nil t)))) - (set-buffer-modified-p nil) - number) + (if inverse + (elmo-folder-unset-flag folder number-list flag no-server) + (elmo-folder-set-flag folder number-list flag no-server)) + (unless no-modeline-update + ;; Update unread numbers. + ;; should elmo-flag-mark-as-read return unread numbers? + (wl-summary-count-unread) + (wl-summary-update-modeline) + (wl-folder-update-unread + (wl-summary-buffer-folder-name) + wl-summary-buffer-unread-count))) + (if interactive + (error "Flag `%s' is not available in this folder" flag))))))) + +(defun wl-summary-unset-persistent-mark (&optional flag + number-or-numbers + no-modeline-update + no-server) + "Unset persistent mark." + (interactive) + (when (interactive-p) + (let ((completion-ignore-case t)) + (setq flag (intern (downcase + (completing-read + "Mark name: " + (mapcar (lambda (flag) + (list (capitalize (symbol-name flag)))) + (wl-summary-get-available-flags)) + nil + 'require-match)))))) + (wl-summary-set-persistent-mark-internal 'inverse + flag + number-or-numbers + no-modeline-update + no-server + (interactive-p))) + +(defun wl-summary-set-persistent-mark (&optional flag + number-or-numbers + no-modeline-update + no-server) + "Set persistent mark." + (interactive) + (when (interactive-p) + (let ((completion-ignore-case t)) + (setq flag (intern (downcase + (completing-read + "Mark name: " + (mapcar (lambda (flag) + (list (capitalize (symbol-name flag)))) + (wl-summary-get-available-flags)) + nil + 'require-match)))))) + (wl-summary-set-persistent-mark-internal nil + flag + number-or-numbers + no-modeline-update + no-server + (interactive-p))) + +(defun wl-summary-toggle-persistent-mark (&optional force) + "Toggle persistent mark." + (interactive "P") + (let ((completion-ignore-case t) + flag) + (setq flag (intern (downcase + (completing-read + "Mark name: " + (mapcar (lambda (flag) + (list (capitalize (symbol-name flag)))) + (wl-summary-get-available-flags)) + nil + 'require-match)))) + (if (and (elmo-message-flagged-p wl-summary-buffer-elmo-folder + (wl-summary-message-number) + flag) + (not force)) + (wl-summary-unset-persistent-mark flag) + (wl-summary-set-persistent-mark flag)))) + +(defun wl-summary-mark-as-answered (&optional number-or-numbers + no-modeline-update) + (interactive) + (wl-summary-set-persistent-mark-internal + (and (interactive-p) + (elmo-message-flagged-p wl-summary-buffer-elmo-folder + (wl-summary-message-number) + 'answered)) + 'answered + number-or-numbers + no-modeline-update + nil + (interactive-p))) + +(defun wl-summary-mark-as-unanswered (&optional number-or-numbers + no-modeline-update) + (wl-summary-set-persistent-mark-internal + 'inverse + 'answered + number-or-numbers + no-modeline-update)) + +(defun wl-summary-decide-flag (folder number) + (let ((flags (elmo-get-global-flags (elmo-message-flags + folder number))) + (completion-ignore-case t) + new-flags) + (setq new-flags + (delq nil + (mapcar + (lambda (flag) + (and (> (length flag) 0) + (intern (downcase flag)))) + (wl-completing-read-multiple + "Flags: " + (mapcar (lambda (flag) + (list (capitalize (symbol-name flag)))) + elmo-global-flags) + nil nil (mapconcat (lambda (flag) + (capitalize (symbol-name flag))) + flags + ","))))) + (dolist (flag new-flags) + (unless (memq flag elmo-global-flags) + (when (elmo-local-flag-p flag) + (error "Cannot treat `%s'." flag)) + (unless (elmo-flag-valid-p flag) + (error "Invalid char in `%s'" flag)) + (if (y-or-n-p (format "Flag `%s' is not registered yet. Register?" + (capitalize (symbol-name flag)))) + (setq elmo-global-flags (append + elmo-global-flags + (list flag))) + (error "Stopped")))) + new-flags)) + +(defsubst wl-summary-set-flags-internal (&optional + number-or-numbers + flags + local + remove-all) + (save-excursion + (let ((folder wl-summary-buffer-elmo-folder) + number number-list) + (setq number-list (cond ((numberp number-or-numbers) + (list number-or-numbers)) + ((and (not (null number-or-numbers)) + (listp number-or-numbers)) + number-or-numbers) + ((setq number (wl-summary-message-number)) + ;; interactive + (list number)))) + (if remove-all + (setq flags nil) + (unless flags + (setq flags (wl-summary-decide-flag folder (car number-list))))) + (if (null number-list) + (message "No message.") + (dolist (number number-list) + (elmo-message-set-global-flags folder number flags local))) + flags))) + +(defun wl-summary-set-flags (&optional remove) + (interactive "P") + (wl-summary-set-flags-internal nil nil nil remove)) + +(defun wl-summary-mark-as-important (&optional prompt) + (interactive "P") + (if prompt + (wl-summary-set-flags-internal) + (wl-summary-set-persistent-mark-internal + (and (interactive-p) + (elmo-message-flagged-p wl-summary-buffer-elmo-folder + (wl-summary-message-number) + 'important)) + 'important + nil nil nil (interactive-p)))) + +(defun wl-summary-recover-message (number) + "Recover current message if it is killed." + (interactive (list (wl-summary-message-number))) + (if (null number) + (message "No message.") + (elmo-folder-recover-messages wl-summary-buffer-elmo-folder + (list number)))) ;;; Summary line. (defvar wl-summary-line-formatter nil) +(defun wl-summary-view-old-p () + "Return non-nil when summary view cache has old format." + (save-excursion + (goto-char (point-min)) + (and wl-summary-buffer-number-list + (not (re-search-forward "\r-?[0-9]+" (point-at-eol) t))))) + +(defun wl-summary-line-format-changed-p () + "Return non-nil when summary line format is changed." + (not (string= + wl-summary-buffer-line-format + (or (elmo-object-load (expand-file-name + wl-summary-line-format-file + (elmo-folder-msgdb-path + wl-summary-buffer-elmo-folder)) + wl-summary-buffer-mime-charset) + wl-summary-buffer-line-format)))) + +(defun wl-summary-line-format-save () + "Save current summary line format." + (elmo-object-save + (expand-file-name wl-summary-line-format-file + (elmo-folder-msgdb-path + wl-summary-buffer-elmo-folder)) + wl-summary-buffer-line-format + wl-summary-buffer-mime-charset)) + +(defun wl-summary-line-number () + (wl-set-string-width + (- wl-summary-buffer-number-column) + (number-to-string + (elmo-message-entity-number wl-message-entity)))) + (defun wl-summary-line-year () (aref wl-datevec 0)) (defun wl-summary-line-month () @@ -4039,19 +3478,9 @@ If ARG, exit virtual folder." (format "%02d" (aref wl-datevec 3))) (defun wl-summary-line-minute () (format "%02d" (aref wl-datevec 4))) -(defun wl-summary-line-open-bracket () - (if wl-thr-linked "<" "[")) -(defun wl-summary-line-close-bracket () - (if wl-thr-linked ">" "]")) -(defun wl-summary-line-children-number () - (if wl-thr-children-number - (concat "+" (int-to-string wl-thr-children-number) ":") - "")) -(defun wl-summary-line-thread-indent () - (or wl-thr-indent-string "")) (defun wl-summary-line-size () - (let ((size (elmo-msgdb-overview-entity-get-size wl-message-entity))) + (let ((size (elmo-message-entity-field wl-message-entity 'size))) (if size (cond ((<= 1 (/ size 1048576)) @@ -4067,91 +3496,76 @@ If ARG, exit virtual folder." (setq no-parent t)) ; no parent (setq subject (elmo-delete-char ?\n - (or (elmo-msgdb-overview-entity-get-subject - wl-message-entity) + (or (elmo-message-entity-field + wl-message-entity + 'subject) wl-summary-no-subject-message))) (setq parent-raw-subject - (elmo-msgdb-overview-entity-get-subject wl-parent-message-entity)) + (elmo-message-entity-field wl-parent-message-entity 'subject)) (setq parent-subject (if parent-raw-subject (elmo-delete-char ?\n parent-raw-subject))) - (setq subject - (if (or no-parent - (null parent-subject) - (not (wl-summary-subject-equal - subject parent-subject))) - (funcall wl-summary-subject-function subject) - "")) - (if (and (not wl-summary-width) - wl-summary-subject-length-limit) - (truncate-string subject - wl-summary-subject-length-limit) - subject))) + (if (or no-parent + (null parent-subject) + (not (wl-summary-subject-equal subject parent-subject))) + (funcall wl-summary-subject-function subject) + ""))) (defun wl-summary-line-from () (elmo-delete-char ?\n (funcall wl-summary-from-function - (elmo-msgdb-overview-entity-get-from - wl-message-entity)))) - -(defun wl-summary-line-children-and-from () - (concat - (wl-summary-line-children-number) " " - (wl-summary-line-from))) + (elmo-message-entity-field + wl-message-entity + 'from)))) + +(defun wl-summary-line-list-info () + (let ((list-info (wl-summary-get-list-info wl-message-entity))) + (if (car list-info) + (format (if (cdr list-info) "(%s %05.0f)" "(%s)") + (car list-info) (cdr list-info)) + ""))) (defun wl-summary-line-list-count () - (let ((folder wl-summary-buffer-folder-name) - (sequence) (ml-name) (ml-count) (subject-string)) - (setq sequence (elmo-msgdb-overview-entity-get-extra-field - wl-message-entity "x-sequence") - ml-name (or (elmo-msgdb-overview-entity-get-extra-field - wl-message-entity "x-ml-name") - (and sequence - (car (split-string sequence " ")))) - ml-count (or (elmo-msgdb-overview-entity-get-extra-field - wl-message-entity "x-mail-count") - (elmo-msgdb-overview-entity-get-extra-field - wl-message-entity "x-ml-count") - (and sequence - (cadr (split-string sequence " ")))) - subject-string - (elmo-delete-char ?\n - (or (elmo-msgdb-overview-entity-get-subject - wl-message-entity) - wl-summary-no-subject-message))) - (if (string-match - "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" - subject-string) - (progn - (if (not ml-name) (setq ml-name (match-string 1 subject-string))) - (if (not ml-count) (setq ml-count (match-string 2 subject-string))))) - (condition-case nil - (if (and ml-name ml-count) - (if (string= folder wl-default-folder) - (format " (%s %05d) " - (car (split-string ml-name " ")) - (string-to-int ml-count)) - (format " #%05d " (string-to-int ml-count))) - " ") - (error " ")))) + (let ((ml-count (cdr (wl-summary-get-list-info wl-message-entity)))) + (if ml-count + (format "%.0f" ml-count) + ""))) + +(defun wl-summary-line-attached () + (let ((content-type (elmo-message-entity-field + wl-message-entity 'content-type)) + (case-fold-search t)) + (if (and content-type + (string-match "multipart/mixed" content-type)) + "@" + ""))) + +;;; For future use. +;;(defun wl-summary-line-cached () +;; (if (elmo-message-cached-p wl-summary-buffer-elmo-folder +;; (elmo-message-entity-number wl-message-entity)) +;; " " +;; "u")) (defun wl-summary-create-line (wl-message-entity wl-parent-message-entity - temp-mark + wl-temp-mark + wl-status &optional wl-thr-children-number wl-thr-indent-string wl-thr-linked) "Create a summary line." (let ((wl-mime-charset wl-summary-buffer-mime-charset) + (wl-persistent-mark (wl-summary-persistent-mark-string + wl-summary-buffer-elmo-folder + wl-status)) (elmo-mime-charset wl-summary-buffer-mime-charset) (elmo-lang wl-summary-buffer-weekday-name-lang) - (wl-datevec (or (ignore-errors (timezone-fix-time - (elmo-msgdb-overview-entity-get-date - wl-message-entity) - nil - wl-summary-fix-timezone)) - (make-vector 5 0))) + (wl-datevec (or (elmo-time-to-datevec + (elmo-message-entity-field wl-message-entity 'date) + wl-summary-fix-timezone) + (make-vector 7 0))) (entity wl-message-entity) ; backward compatibility. line mark) (if (and wl-thr-indent-string @@ -4161,30 +3575,24 @@ If ARG, exit virtual folder." (setq wl-thr-indent-string (wl-set-string-width wl-summary-indent-length-limit wl-thr-indent-string))) - (setq line - (concat - (format - (concat "%" - (number-to-string wl-summary-buffer-number-column) - "s%s%s") - (number-to-string - (elmo-msgdb-overview-entity-get-number wl-message-entity)) - (or temp-mark " ") - (setq mark - (or (elmo-msgdb-get-mark - (wl-summary-buffer-msgdb) - (elmo-msgdb-overview-entity-get-number - wl-message-entity)) - " "))) - (funcall wl-summary-buffer-line-formatter))) + (setq line (funcall wl-summary-buffer-line-formatter)) (if wl-summary-width (setq line (wl-set-string-width - (- wl-summary-width 1) line))) + (- wl-summary-width 1) line nil + 'ignore-invalid))) + (setq line (concat line + "\r" + (number-to-string + (elmo-message-entity-number + wl-message-entity)))) + (wl-summary-validate-persistent-mark-string line) (if wl-summary-highlight - (wl-highlight-summary-line-string line - mark - temp-mark - wl-thr-indent-string)) + (wl-highlight-summary-line-string + (elmo-message-entity-number wl-message-entity) + line + wl-status + wl-temp-mark + wl-thr-indent-string)) line)) (defsubst wl-summary-proc-wday (wday-str year month mday) @@ -4193,40 +3601,24 @@ If ARG, exit virtual folder." (wl-match-string 1 wday-str) (elmo-date-get-week year month mday)))) -(defvar wl-summary-move-spec-plugged-alist - (` ((new . ((t . nil) - (p . (, wl-summary-new-mark)) - (p . (, (wl-regexp-opt - (list wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark)))) - (p . (, (regexp-quote wl-summary-important-mark))))) - (unread . ((t . nil) - (p . (, (wl-regexp-opt - (list wl-summary-new-mark - wl-summary-unread-uncached-mark - wl-summary-unread-cached-mark)))) - (p . (, (regexp-quote wl-summary-important-mark)))))))) - -(defvar wl-summary-move-spec-unplugged-alist - (` ((new . ((t . nil) - (p . (, wl-summary-unread-cached-mark)) - (p . (, (regexp-quote wl-summary-important-mark))))) - (unread . ((t . nil) - (p . (, wl-summary-unread-cached-mark)) - (p . (, (regexp-quote wl-summary-important-mark)))))))) +(defvar wl-summary-move-spec-alist + '((new . ((t . nil) + (p . new) + (p . unread) + (p . digest))) + (unread . ((t . nil) + (p . unread) + (p . digest))))) (defsubst wl-summary-next-message (num direction hereto) (if wl-summary-buffer-next-message-function (funcall wl-summary-buffer-next-message-function num direction hereto) (let ((cur-spec (cdr (assq wl-summary-move-order - (if (elmo-folder-plugged-p - wl-summary-buffer-elmo-folder) - wl-summary-move-spec-plugged-alist - wl-summary-move-spec-unplugged-alist)))) + 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) + flagged-list nums2) (unless hereto (setq nums (cdr nums))) (setq nums2 nums) (if cur-spec @@ -4234,12 +3626,15 @@ If ARG, exit virtual folder." (while cur-spec (setq nums nums2) (cond ((eq (car (car cur-spec)) 'p) - (if (setq marked-list - (elmo-folder-list-messages-mark-match + (if (setq flagged-list + (elmo-folder-list-flagged wl-summary-buffer-elmo-folder - (cdr (car cur-spec)))) + (cdr (car cur-spec)) t)) (while nums - (if (memq (car nums) marked-list) + (if (and (memq (car nums) flagged-list) + (elmo-message-accessible-p + wl-summary-buffer-elmo-folder + (car nums))) (throw 'done (car nums))) (setq nums (cdr nums))))) ((eq (car (car cur-spec)) 't) @@ -4264,7 +3659,7 @@ If ARG, exit virtual folder." (wl-thread-jump-to-msg num)) t))) ;; -;; Goto unread or important +;; Goto unread or global flag message ;; returns t if next message exists in this folder. (defun wl-summary-cursor-down (&optional hereto) (interactive "P") @@ -4281,61 +3676,78 @@ If ARG, exit virtual folder." (view (expand-file-name wl-summary-view-file dir)) (save-view wl-summary-buffer-view) (mark-list (copy-sequence wl-summary-buffer-target-mark-list)) - (refile-list (copy-sequence wl-summary-buffer-refile-list)) - (copy-list (copy-sequence wl-summary-buffer-copy-list)) - (delete-list (copy-sequence wl-summary-buffer-delete-list)) + (temp-list (copy-sequence wl-summary-buffer-temp-mark-list)) (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*")) + (temp-column wl-summary-buffer-temp-mark-column) (charset wl-summary-buffer-mime-charset)) - (if (file-directory-p dir) - (); ok. - (if (file-exists-p dir) - (error "File %s already exists" dir) - (elmo-make-directory dir))) - (if (eq save-view 'thread) - (wl-thread-save-entity dir)) - (unwind-protect - (progn - (when (file-writable-p cache) - (copy-to-buffer tmp-buffer (point-min) (point-max)) - (with-current-buffer tmp-buffer - (widen) - (setq wl-summary-buffer-target-mark-list mark-list - wl-summary-buffer-refile-list refile-list - wl-summary-buffer-copy-list copy-list - wl-summary-buffer-delete-list delete-list) - (wl-summary-delete-all-temp-marks 'no-msg) - (encode-mime-charset-region - (point-min) (point-max) charset) - (write-region-as-binary (point-min)(point-max) - cache nil 'no-msg))) - (when (file-writable-p view) ; 'thread or 'sequence - (save-excursion - (set-buffer tmp-buffer) - (erase-buffer) - (prin1 save-view tmp-buffer) - (princ "\n" tmp-buffer) - (write-region (point-min) (point-max) view nil 'no-msg)))) - ;; kill tmp buffer. - (kill-buffer tmp-buffer))))) + (when dir + (if (file-directory-p dir) + (); ok. + (if (file-exists-p dir) + (error "File %s already exists" dir) + (elmo-make-directory dir))) + (if (eq save-view 'thread) + (wl-thread-save-entity dir)) + (when wl-summary-check-line-format + (wl-summary-line-format-save)) + (unwind-protect + (progn + (when (file-writable-p cache) + (copy-to-buffer tmp-buffer (point-min) (point-max)) + (with-current-buffer tmp-buffer + (widen) + (make-local-variable 'wl-summary-highlight) + (setq wl-summary-highlight nil + wl-summary-buffer-target-mark-list mark-list + wl-summary-buffer-temp-mark-list temp-list + wl-summary-buffer-temp-mark-column temp-column) + (wl-summary-delete-all-temp-marks 'no-msg 'force) + (encode-coding-region + (point-min) (point-max) + (or (and wl-on-mule + ;; one in mcs-ltn1(apel<10.4) cannot take 2 arg. + (mime-charset-to-coding-system charset 'LF)) + ;; Mule 2 doesn't have `*ctext*unix'. + (mime-charset-to-coding-system charset))) + (write-region-as-binary (point-min)(point-max) + cache nil 'no-msg))) + (when (file-writable-p view) ; 'thread or 'sequence + (with-temp-buffer + (prin1 save-view (current-buffer)) + (princ "\n" (current-buffer)) + (write-region (point-min) (point-max) view nil 'no-msg)))) + ;; kill tmp buffer. + (kill-buffer tmp-buffer)))))) (defsubst wl-summary-get-sync-range (folder) (intern (or (and (elmo-folder-plugged-p folder) (wl-get-assoc-list-value wl-folder-sync-range-alist - (elmo-folder-name-internal folder))) + (elmo-folder-name-internal folder) + 'function)) wl-default-sync-range))) ;; redefined for wl-summary-sync-update (defun wl-summary-input-range (folder) "returns update or all or rescan." ;; for the case when parts are expanded in the bottom of the folder - (let ((input-range-list '("update" "all" "rescan" "first:" "last:" + (let ((input-range-list '("no-sync" + "first:" + "last:" "cache-status" - "no-sync" "rescan-noscore" "all-visible")) + "mark" + "rescan" + "rescan-noscore" + "rescan-thread" + "update" + "update-entirely" + "all" + "all-entirely")) (default (or (wl-get-assoc-list-value wl-folder-sync-range-alist - folder) + folder + 'function) wl-default-sync-range)) range) (setq range @@ -4474,9 +3886,26 @@ If ARG, exit virtual folder." (wl-message-select-buffer wl-message-buffer) (delete-window) (select-window (get-buffer-window cur-buf)) + (setq wl-message-buffer nil) (run-hooks 'wl-summary-toggle-disp-off-hook)) ;;; (switch-to-buffer cur-buf) - ))))) + ))) + (run-hooks 'wl-summary-buffer-window-scroll-functions))) + +(defun wl-summary-enter-handler (&optional arg) + "A command for `enter' key in the summary. +Basically, it shows next line of the message. +If optional argument ARG is specified, behave as followed. +If ARG is number, jump to the message. +Otherwise it shows previous line of the message." + (interactive "P") + (cond ((numberp arg) + (unless (wl-thread-jump-to-msg arg) + (message "Message (#%d) was not found." arg))) + (arg + (wl-summary-prev-line-content)) + (t + (wl-summary-next-line-content)))) (defun wl-summary-next-line-content () "Show next line of the message." @@ -4524,6 +3953,7 @@ Return t if message exists." cur-folder cur-number message-last-pos) (when (buffer-live-p wl-message-buffer) (save-window-excursion + (setq wl-current-summary-buffer (current-buffer)) (wl-message-select-buffer wl-message-buffer) (setq cur-folder wl-message-buffer-cur-folder) (setq cur-number wl-message-buffer-cur-number))) @@ -4532,16 +3962,15 @@ Return t if message exists." (progn (set-buffer wl-message-buffer) t) - (if (wl-summary-no-mime-p folder) - (wl-summary-redisplay-no-mime-internal folder number) - (wl-summary-redisplay-internal folder number)) + (wl-summary-redisplay-internal folder number) (when (buffer-live-p wl-message-buffer) (set-buffer wl-message-buffer)) nil))) (defun wl-summary-target-mark-forward (&optional arg) (interactive "P") - (let ((mlist (nreverse wl-summary-buffer-target-mark-list)) + (wl-summary-check-target-mark) + (let ((mlist (nreverse (copy-sequence wl-summary-buffer-target-mark-list))) (summary-buf (current-buffer)) (wl-draft-forward t) start-point @@ -4566,55 +3995,55 @@ Return t if message exists." (goto-char start-point) (save-excursion (set-buffer summary-buf) - (wl-summary-delete-all-temp-marks))) + (wl-summary-delete-all-target-marks))) (run-hooks 'wl-mail-setup-hook))) (defun wl-summary-target-mark-reply-with-citation (&optional arg) (interactive "P") - (let ((mlist (nreverse wl-summary-buffer-target-mark-list)) + (wl-summary-check-target-mark) + (let ((mlist (nreverse (copy-sequence wl-summary-buffer-target-mark-list))) (summary-buf (current-buffer)) change-major-mode-hook start-point draft-buf) (wl-summary-jump-to-msg (car mlist)) - (wl-summary-reply arg t) - (goto-char (point-max)) - (setq start-point (point-marker)) - (setq draft-buf (current-buffer)) - (save-window-excursion - (while mlist - (set-buffer summary-buf) - (delete-other-windows) - (wl-summary-jump-to-msg (car mlist)) - (wl-summary-redisplay) - (set-buffer draft-buf) - (goto-char (point-max)) - (wl-draft-yank-original) - (setq mlist (cdr mlist))) - (goto-char start-point) - (save-excursion - (set-buffer summary-buf) - (wl-summary-delete-all-temp-marks))) - (run-hooks 'wl-mail-setup-hook))) + (when (wl-summary-reply arg t) + (goto-char (point-max)) + (setq start-point (point-marker)) + (setq draft-buf (current-buffer)) + (save-window-excursion + (while mlist + (set-buffer summary-buf) + (delete-other-windows) + (wl-summary-jump-to-msg (car mlist)) + (wl-summary-redisplay) + (set-buffer draft-buf) + (goto-char (point-max)) + (wl-draft-yank-original) + (setq mlist (cdr mlist))) + (goto-char start-point) + (save-excursion + (set-buffer summary-buf) + (wl-summary-delete-all-target-marks))) + (wl-draft-reply-position wl-draft-reply-default-position) + (run-hooks 'wl-mail-setup-hook)))) (defun wl-summary-reply-with-citation (&optional arg) (interactive "P") (when (wl-summary-reply arg t) (goto-char (point-max)) (wl-draft-yank-original) + (wl-draft-reply-position wl-draft-reply-default-position) (run-hooks 'wl-mail-setup-hook))) (defun wl-summary-jump-to-msg-by-message-id (&optional id) (interactive) (let* ((original (wl-summary-message-number)) (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: ")))) - (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))) + (entity (elmo-message-entity wl-summary-buffer-elmo-folder msgid)) msg otherfld schar - (errmsg - (format "No message with id \"%s\" in the folder." msgid))) - (if (setq msg (car (rassoc msgid number-alist))) -;;; (wl-summary-jump-to-msg-internal -;;; (wl-summary-buffer-folder-name) msg 'no-sync) + (errmsg (format "No message with id \"%s\" in the folder." msgid))) + (if (setq msg (elmo-message-entity-number entity)) (progn (wl-thread-jump-to-msg msg) t) @@ -4632,9 +4061,9 @@ Return t if message exists." (wl-summary-buffer-folder-name) original 'no-sync)) (cond ((eq wl-summary-search-via-nntp 'confirm) (require 'elmo-nntp) - (message "Search message in nntp server \"%s\" ?" + (message "Search message in nntp server \"%s\" ? " elmo-nntp-default-server) - (setq schar (read-char)) + (setq schar (let ((cursor-in-echo-area t)) (read-char))) (cond ((eq schar ?y) (wl-summary-jump-to-msg-by-message-id-via-nntp msgid)) ((eq schar ?s) @@ -4642,12 +4071,16 @@ Return t if message exists." msgid (read-from-minibuffer "NNTP Server: "))) (t - (message errmsg) + (message "%s" errmsg) nil))) - (wl-summary-search-via-nntp + ((or (eq wl-summary-search-via-nntp 'force) + (and + (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) + 'nntp) + wl-summary-search-via-nntp)) (wl-summary-jump-to-msg-by-message-id-via-nntp msgid)) (t - (message errmsg) + (message "%s" errmsg) nil)))))) (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec) @@ -4700,9 +4133,10 @@ Return t if message exists." folder scan-type nil nil t) (if msgid (setq msg - (car (rassoc msgid - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))))) + (elmo-message-entity-number + (elmo-message-entity + wl-summary-buffer-elmo-folder + msgid)))) (setq entity (wl-folder-search-entity-by-name folder wl-folder-entity 'folder)) @@ -4717,6 +4151,7 @@ Return t if message exists." (defun wl-summary-jump-to-parent-message (arg) (interactive "P") (let ((cur-buf (current-buffer)) + (disp-msg wl-summary-buffer-disp-msg) (number (wl-summary-message-number)) (regexp "\\(<[^<>]*>\\)[ \t]*$") (i -1) ;; xxx @@ -4770,17 +4205,18 @@ Return t if message exists." (setq msg-id (if (null arg) (nth 0 ref-list) ;; previous (if (<= arg i) (nth (1- arg) ref-list) - (nth i ref-list))))))) - (set-buffer cur-buf) + (nth i ref-list)))))) + (set-buffer cur-buf) + (or disp-msg (wl-summary-toggle-disp-msg 'off))) (cond ((and (null msg-id) (null msg-num)) (message "No parent message!") nil) ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id)) - (wl-summary-redisplay) + (if wl-summary-buffer-disp-msg (wl-summary-redisplay)) (message "Searching parent message...done") t) ((and msg-num (wl-summary-jump-to-msg msg-num)) - (wl-summary-redisplay) + (if wl-summary-buffer-disp-msg (wl-summary-redisplay)) (message "Searching parent message...done") t) (t ; failed. @@ -4788,34 +4224,32 @@ Return t if message exists." nil))))) (defun wl-summary-reply (&optional arg without-setup-hook) - "Reply to current message. Default is \"wide\" reply. -Reply to author if invoked with ARG." + "Reply to current message. See also `wl-draft-reply'." (interactive "P") (let ((folder wl-summary-buffer-elmo-folder) (number (wl-summary-message-number)) (summary-buf (current-buffer)) + (winconf (current-window-configuration)) mes-buf) (when number (save-excursion - (wl-summary-redisplay-internal folder number)) - (setq mes-buf wl-message-buffer) + (wl-summary-set-message-buffer-or-redisplay)) (wl-message-select-buffer wl-message-buffer) - (set-buffer mes-buf) - (goto-char (point-min)) - (unless wl-draft-use-frame - (split-window-vertically) - (other-window 1)) - (when (setq mes-buf (wl-message-get-original-buffer)) - (wl-draft-reply mes-buf arg summary-buf) - (unless without-setup-hook - (run-hooks 'wl-mail-setup-hook))) + (condition-case err + (when (setq mes-buf (wl-message-get-original-buffer)) + (wl-draft-reply mes-buf arg summary-buf number) + (wl-draft-reply-position wl-draft-reply-default-position) + (unless without-setup-hook + (run-hooks 'wl-mail-setup-hook))) + (error (set-window-configuration winconf) + (signal (car err)(cdr err)))) + (with-current-buffer summary-buf (run-hooks 'wl-summary-reply-hook)) t))) -(defun wl-summary-write () +(defun wl-summary-write (folder) "Write a new draft from Summary." - (interactive) - (wl-draft (list (cons 'To "")) - nil nil nil nil (wl-summary-buffer-folder-name)) + (interactive (list (wl-summary-buffer-folder-name))) + (wl-draft (list (cons 'To "")) nil nil nil nil folder) (run-hooks 'wl-mail-setup-hook) (mail-position-on-field "To")) @@ -4827,12 +4261,10 @@ Reply to author if invoked with ARG." Call from `wl-summary-write-current-folder'. When guess function return nil, challenge next guess-function.") -(defun wl-summary-write-current-folder (&optional folder) +(defun wl-summary-write-current-folder (folder) "Write message to current FOLDER's newsgroup or mailing-list. Use function list is `wl-summary-write-current-folder-functions'." - (interactive) - ;; default FOLDER is current buffer folder - (setq folder (or folder (wl-summary-buffer-folder-name))) + (interactive (list (wl-summary-buffer-folder-name))) (let ((func-list wl-summary-write-current-folder-functions) guess-list guess-func) (while func-list @@ -4842,7 +4274,7 @@ Use function list is `wl-summary-write-current-folder-functions'." (setq guess-func (car func-list)) (setq func-list nil))) (if (null guess-func) - (wl-summary-write) + (wl-summary-write folder) (unless (or (stringp (nth 0 guess-list)) (stringp (nth 1 guess-list)) (stringp (nth 2 guess-list))) @@ -4862,7 +4294,6 @@ Use function list is `wl-summary-write-current-folder-functions'." (number (wl-summary-message-number)) (summary-buf (current-buffer)) (wl-draft-forward t) - mes-buf entity subject num) (if (null number) (message "No message.") @@ -4874,19 +4305,12 @@ Use function list is `wl-summary-write-current-folder-functions'." ;; Reload. (wl-summary-redisplay-internal nil nil 'force-reload) (wl-summary-redisplay-internal folder number)) - (setq mes-buf wl-message-buffer) - (wl-message-select-buffer mes-buf) - (unless wl-draft-use-frame - (split-window-vertically) - (other-window 1)) - ;; get original subject. - (if summary-buf - (save-excursion - (set-buffer summary-buf) - (setq subject - (or (elmo-message-field folder number 'subject) "")))) - (set-buffer mes-buf) - (wl-draft-forward subject summary-buf) + (wl-message-select-buffer wl-message-buffer) + (setq subject (with-current-buffer + wl-message-buffer-original-buffer + (std11-field-body "Subject"))) + (wl-draft-forward subject summary-buf number) + (with-current-buffer summary-buf (run-hooks 'wl-summary-forward-hook)) (unless without-setup-hook (run-hooks 'wl-mail-setup-hook))))) @@ -4905,83 +4329,61 @@ Use function list is `wl-summary-write-current-folder-functions'." (if (wl-message-next-page) (wl-summary-down t))))) -(defun wl-summary-prev (&optional interactive) - "" - (interactive) +(defsubst wl-summary-cursor-move-surface (downward interactive) (if wl-summary-move-direction-toggle - (setq wl-summary-move-direction-downward nil)) - (let ((skip-mark-regexp (mapconcat - 'regexp-quote - wl-summary-skip-mark-list "")) - goto-next regex-list regex next-entity finfo) + (setq wl-summary-move-direction-downward downward)) + (let ((start (point)) + (skip-tmark-regexp (wl-regexp-opt wl-summary-skip-mark-list)) + (skip t) + (column (current-column)) + goto-next next-entity finfo) (beginning-of-line) - (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder) - (setq regex (format "%s[^%s]" - wl-summary-message-regexp - (concat skip-mark-regexp "0-9"))) - (setq regex (format "%s[^%s]\\(%s\\|%s\\| \\)" - wl-summary-message-regexp - (concat skip-mark-regexp "0-9") - (regexp-quote wl-summary-unread-cached-mark) - (regexp-quote wl-summary-important-mark)))) - (unless (re-search-backward regex nil t) - (setq goto-next t)) - (beginning-of-line) - (if (not goto-next) - (progn - (if wl-summary-buffer-disp-msg - (wl-summary-redisplay))) - (if (or interactive (interactive-p)) - (if wl-summary-buffer-prev-folder-function - (funcall wl-summary-buffer-prev-folder-function) - (when wl-auto-select-next - (setq next-entity (wl-summary-get-prev-folder)) - (if next-entity - (setq finfo (wl-folder-get-entity-info next-entity)))) - (wl-ask-folder - '(lambda () (wl-summary-next-folder-or-exit next-entity)) - (format - "No more messages. Type SPC to go to %s." - (wl-summary-entity-info-msg next-entity finfo)))))))) + (while (and skip + (not (if downward (eobp) (bobp)))) + (if downward + (forward-line 1) + (forward-line -1)) + (setq skip (or (string-match skip-tmark-regexp + (wl-summary-temp-mark)) + (not (and (wl-summary-message-number) + (elmo-message-accessible-p + wl-summary-buffer-elmo-folder + (wl-summary-message-number))))))) + (if (if downward (eobp) (and (bobp) skip)) (setq goto-next t)) + (if (or (eobp) (and (bobp) skip)) + (goto-char start)) + (move-to-column column) -(defun wl-summary-next (&optional interactive) - "" - (interactive) - (if wl-summary-move-direction-toggle - (setq wl-summary-move-direction-downward t)) - (let ((skip-mark-regexp (mapconcat - 'regexp-quote - wl-summary-skip-mark-list "")) - goto-next regex regex-list next-entity finfo) - (end-of-line) - (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder) - (setq regex (format "%s[^%s]" - wl-summary-message-regexp - (concat skip-mark-regexp "0-9"))) - (setq regex (format "%s[^%s]\\(%s\\|%s\\| \\)" - wl-summary-message-regexp - (concat skip-mark-regexp "0-9") - (regexp-quote wl-summary-unread-cached-mark) - (regexp-quote wl-summary-important-mark)))) - (unless (re-search-forward regex nil t) - (forward-line 1) - (setq goto-next t)) - (beginning-of-line) (if (not goto-next) (if wl-summary-buffer-disp-msg (wl-summary-redisplay)) - (if (or interactive (interactive-p)) - (if wl-summary-buffer-next-folder-function - (funcall wl-summary-buffer-next-folder-function) + (if interactive + (cond + ((and (not downward) wl-summary-buffer-prev-folder-function) + (funcall wl-summary-buffer-prev-folder-function)) + ((and downward wl-summary-buffer-next-folder-function) + (funcall wl-summary-buffer-next-folder-function)) + (t (when wl-auto-select-next - (setq next-entity (wl-summary-get-next-folder)) + (setq next-entity + (if downward + (wl-summary-get-next-folder) + (wl-summary-get-prev-folder))) (if next-entity (setq finfo (wl-folder-get-entity-info next-entity)))) (wl-ask-folder '(lambda () (wl-summary-next-folder-or-exit next-entity)) (format "No more messages. Type SPC to go to %s." - (wl-summary-entity-info-msg next-entity finfo)))))))) + (wl-summary-entity-info-msg next-entity finfo))))))))) + +(defun wl-summary-prev (&optional interactive) + (interactive) + (wl-summary-cursor-move-surface nil (or interactive (interactive-p)))) + +(defun wl-summary-next (&optional interactive) + (interactive) + (wl-summary-cursor-move-surface t (or interactive (interactive-p)))) (defun wl-summary-up (&optional interactive skip-no-unread) "" @@ -5011,36 +4413,34 @@ Use function list is `wl-summary-write-current-folder-functions'." (wl-summary-entity-info-msg next-entity finfo))))))))) (defun wl-summary-get-prev-folder () - (let ((folder-buf (get-buffer wl-folder-buffer-name)) - last-entity cur-id) + (let ((folder-buf (get-buffer wl-folder-buffer-name))) (when folder-buf - (setq cur-id (save-excursion (set-buffer folder-buf) - wl-folder-buffer-cur-entity-id)) - (wl-folder-get-prev-folder cur-id)))) + (wl-folder-get-prev-folder + (with-current-buffer folder-buf + wl-folder-buffer-cur-entity-id))))) (defun wl-summary-get-next-folder () - (let ((folder-buf (get-buffer wl-folder-buffer-name)) - cur-id) + (let ((folder-buf (get-buffer wl-folder-buffer-name))) (when folder-buf - (setq cur-id (save-excursion (set-buffer folder-buf) - wl-folder-buffer-cur-entity-id)) - (wl-folder-get-next-folder cur-id)))) + (wl-folder-get-next-folder + (with-current-buffer folder-buf + wl-folder-buffer-cur-entity-id))))) (defun wl-summary-get-next-unread-folder () - (let ((folder-buf (get-buffer wl-folder-buffer-name)) - cur-id) + (let ((folder-buf (get-buffer wl-folder-buffer-name))) (when folder-buf - (setq cur-id (save-excursion (set-buffer folder-buf) - wl-folder-buffer-cur-entity-id)) - (wl-folder-get-next-folder cur-id 'unread)))) + (wl-folder-get-next-folder + (with-current-buffer folder-buf + wl-folder-buffer-cur-entity-id) + 'unread)))) (defun wl-summary-get-prev-unread-folder () - (let ((folder-buf (get-buffer wl-folder-buffer-name)) - cur-id) + (let ((folder-buf (get-buffer wl-folder-buffer-name))) (when folder-buf - (setq cur-id (save-excursion (set-buffer folder-buf) - wl-folder-buffer-cur-entity-id)) - (wl-folder-get-prev-folder cur-id 'unread)))) + (wl-folder-get-prev-folder + (with-current-buffer folder-buf + wl-folder-buffer-cur-entity-id) + 'unread)))) (defun wl-summary-down (&optional interactive skip-no-unread) (interactive) @@ -5067,33 +4467,134 @@ Use function list is `wl-summary-write-current-folder-functions'." "No more unread messages. Type SPC to go to %s." (wl-summary-entity-info-msg next-entity finfo))))))))) -(defun wl-summary-goto-last-displayed-msg () +(defun wl-summary-pop-to-last-message () + "Jump to last displayed message, and pop a new massage off the ring." (interactive) - (unless wl-summary-buffer-last-displayed-msg - (setq wl-summary-buffer-last-displayed-msg - wl-summary-buffer-current-msg)) - (if wl-summary-buffer-last-displayed-msg - (progn - (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg) - (if wl-summary-buffer-disp-msg - (wl-summary-redisplay))) - (message "No last message."))) + (let ((number (wl-summary-pop-message (wl-summary-message-number)))) + (unless number + (error "Empty message ring")) + (wl-summary-jump-to-msg number) + (when wl-summary-buffer-disp-msg + (let (wl-summary-buffer-message-ring) + (wl-summary-redisplay))))) + +(defun wl-summary-goto-last-displayed-msg (&optional arg) + "Jump to last displayed message." + (interactive "P") + (cond + ((eq last-command 'wl-summary-pop-to-last-message) + (setq this-command 'wl-summary-pop-to-last-message) + (wl-summary-pop-to-last-message)) + (arg + (setq this-command 'wl-summary-pop-to-last-message) + (wl-summary-pop-to-last-message)) + (t + (let ((current (wl-summary-message-number)) + (number (wl-summary-pop-message))) + (if number + (progn + (wl-summary-jump-to-msg number) + (if wl-summary-buffer-disp-msg + (wl-summary-redisplay) + (wl-summary-push-message current))) + (message "No last message.")))))) + +(defun wl-summary-message-display-type () + (when (and wl-summary-buffer-disp-msg + (buffer-live-p wl-message-buffer) + wl-summary-buffer-current-msg + (wl-summary-message-number) + (= (wl-summary-message-number) wl-summary-buffer-current-msg)) + (wl-message-buffer-display-type wl-message-buffer))) + +(defun wl-summary-buffer-display-mime-mode () + (or (wl-message-display-type-property (wl-summary-message-display-type) + :mime) + wl-summary-buffer-display-mime-mode)) + +(defun wl-summary-buffer-display-header-mode () + (or (wl-message-display-type-property (wl-summary-message-display-type) + :header) + wl-summary-buffer-display-header-mode)) + +(defun wl-summary-toggle-mime (&optional arg) + "Toggle MIME decoding. +If ARG is non-nil, ask coding-system to display the message in the current +MIME analysis mode. + +If ARG is numeric number, decode message as following: +1: Enable MIME analysis. +2: Enable MIME analysis only for headers. +3: Disable MIME analysis." + (interactive "P") + (let ((mime-mode (wl-summary-buffer-display-mime-mode)) + (elmo-mime-display-as-is-coding-system + elmo-mime-display-as-is-coding-system)) + (if (and (consp arg) (> (prefix-numeric-value arg) 4)) + (progn + (setq wl-summary-buffer-display-mime-mode mime-mode) + (wl-summary-update-modeline)) + (cond + ((numberp arg) + (setq mime-mode (case arg + (1 'mime) + (2 'header-only) + (3 'as-is) +;;; (4 'decode-only) + (5 'no-merge)))) + (arg + ;; Specify coding-system (doesn't change the MIME mode). + (setq elmo-mime-display-as-is-coding-system + (if (and arg + (not (wl-message-mime-analysis-p + (wl-summary-message-display-type)))) + (or (read-coding-system "Coding system: ") + elmo-mime-display-as-is-coding-system) + elmo-mime-display-as-is-coding-system))) + (t + ;; Change the MIME mode. + (setq mime-mode (or (cadr (memq mime-mode + wl-summary-display-mime-mode-list)) + (car wl-summary-display-mime-mode-list))))) + (wl-summary-redisplay-internal nil nil arg mime-mode)) + (message "MIME decoding: %s%s" + (upcase (symbol-name mime-mode)) + (if (and (not (eq mime-mode 'mime)) + (not (eq elmo-mime-display-as-is-coding-system + wl-cs-autoconv))) + (concat " (" + (symbol-name elmo-mime-display-as-is-coding-system) + ")") + "")))) (defun wl-summary-redisplay (&optional arg) + "Redisplay message." (interactive "P") - (if (and (not arg) - (wl-summary-no-mime-p wl-summary-buffer-elmo-folder)) - (wl-summary-redisplay-no-mime) - (wl-summary-redisplay-internal nil nil arg))) + (apply #'wl-summary-redisplay-internal nil nil arg + (unless (and (consp arg) (> (prefix-numeric-value arg) 4)) + (list wl-summary-buffer-display-mime-mode + wl-summary-buffer-display-header-mode)))) -(defsubst wl-summary-redisplay-internal (&optional folder number force-reload) - (interactive) - (let* ((msgdb (wl-summary-buffer-msgdb)) - (folder (or folder wl-summary-buffer-elmo-folder)) +(defun wl-summary-toggle-all-header (&optional arg) + "Toggle displaying message with all header." + (interactive "P") + (let ((header-mode (wl-summary-buffer-display-header-mode))) + (if (and (consp arg) (> (prefix-numeric-value arg) 4)) + (setq wl-summary-buffer-display-header-mode header-mode) + (wl-summary-redisplay-internal + nil nil arg nil + (if (eq header-mode 'all) 'partial 'all))))) + +(defun wl-summary-redisplay-internal (&optional folder number force-reload + mime-mode header-mode) + (let* ((folder (or folder wl-summary-buffer-elmo-folder)) (num (or number (wl-summary-message-number))) (wl-mime-charset wl-summary-buffer-mime-charset) (default-mime-charset wl-summary-buffer-mime-charset) - fld-buf fld-win thr-entity) + fld-buf fld-win thr-entity + (elmo-message-fetch-confirm (or elmo-message-fetch-confirm + (and force-reload + elmo-message-fetch-threshold)))) (if (and wl-thread-open-reading-thread (eq wl-summary-buffer-view 'thread) (not (wl-thread-entity-get-opened @@ -5104,106 +4605,46 @@ Use function list is `wl-summary-write-current-folder-functions'." (if num (progn (setq wl-summary-buffer-disp-msg t) - (setq wl-summary-buffer-last-displayed-msg - wl-summary-buffer-current-msg) + (wl-summary-push-message wl-summary-buffer-current-msg) ;; hide folder window (if (and (not wl-stay-folder-window) (setq fld-buf (get-buffer wl-folder-buffer-name))) (if (setq fld-win (get-buffer-window fld-buf)) (delete-window fld-win))) (setq wl-current-summary-buffer (current-buffer)) - (wl-summary-mark-as-read - nil - ;; not fetched, then change server-mark. - (if (wl-message-redisplay folder num 'mime - (or force-reload - (string= (elmo-folder-name-internal - folder) - wl-draft-folder))) - nil - ;; plugged, then leave server-mark. - (if (and - (not - (elmo-folder-local-p - wl-summary-buffer-elmo-folder)) - (elmo-folder-plugged-p - wl-summary-buffer-elmo-folder)) - 'leave)) - t ; displayed - nil - 'cached ; cached by reading. - ) - (setq wl-summary-buffer-current-msg num) - (when wl-summary-recenter - (recenter (/ (- (window-height) 2) 2)) - (if (not wl-summary-indent-length-limit) - (wl-horizontal-recenter))) - (wl-highlight-summary-displaying) - (wl-message-buffer-prefetch-next folder num - wl-message-buffer-prefetch-depth - (current-buffer) - wl-summary-buffer-mime-charset) - (run-hooks 'wl-summary-redisplay-hook)) - (message "No message to display.")))) - -(defun wl-summary-redisplay-no-mime (&optional ask-coding) - "Display message without MIME decoding. -If ASK-CODING is non-nil, coding-system for the message is asked." - (interactive "P") - (let ((elmo-mime-display-as-is-coding-system - (if ask-coding - (or (read-coding-system "Coding system: ") - elmo-mime-display-as-is-coding-system) - elmo-mime-display-as-is-coding-system))) - (wl-summary-redisplay-no-mime-internal))) - -(defun wl-summary-redisplay-no-mime-internal (&optional folder number) - (let* ((fld (or folder wl-summary-buffer-elmo-folder)) - (num (or number (wl-summary-message-number))) - wl-break-pages) - (if num - (progn - (setq wl-summary-buffer-disp-msg t) - (setq wl-summary-buffer-last-displayed-msg - wl-summary-buffer-current-msg) - (setq wl-current-summary-buffer (current-buffer)) - (wl-message-redisplay fld num 'as-is - (string= (elmo-folder-name-internal fld) - wl-draft-folder)) - (wl-summary-mark-as-read nil nil t) - (setq wl-summary-buffer-current-msg num) - (when wl-summary-recenter - (recenter (/ (- (window-height) 2) 2)) - (if (not wl-summary-indent-length-limit) - (wl-horizontal-recenter))) - (wl-highlight-summary-displaying) - (run-hooks 'wl-summary-redisplay-hook)) - (message "No message to display.") - (wl-ask-folder 'wl-summary-exit - "No more messages. Type SPC to go to folder mode.")))) - -(defun wl-summary-redisplay-all-header (&optional folder number) - (interactive) - (let* ((fld (or folder wl-summary-buffer-elmo-folder)) - (num (or number (wl-summary-message-number))) - (wl-mime-charset wl-summary-buffer-mime-charset) - (default-mime-charset wl-summary-buffer-mime-charset)) - (if num - (progn - (setq wl-summary-buffer-disp-msg t) - (setq wl-summary-buffer-last-displayed-msg - wl-summary-buffer-current-msg) - (setq wl-current-summary-buffer (current-buffer)) - (if (wl-message-redisplay fld num 'all-header - (string= (elmo-folder-name-internal fld) - wl-draft-folder)) - (wl-summary-mark-as-read nil nil t)) + (wl-message-redisplay folder num + (wl-message-make-display-type + (or mime-mode + (wl-summary-buffer-display-mime-mode)) + (or header-mode + (wl-summary-buffer-display-header-mode))) + (or force-reload + (string= (elmo-folder-name-internal folder) + wl-draft-folder))) + (when (elmo-message-use-cache-p folder num) + (elmo-message-set-cached folder num t)) + (ignore-errors + (if (elmo-message-flagged-p wl-summary-buffer-elmo-folder + num + 'unread) + (wl-summary-mark-as-read num) + (wl-summary-count-unread) + (wl-summary-update-modeline) + (wl-folder-update-unread + (wl-summary-buffer-folder-name) + wl-summary-buffer-unread-count))) (setq wl-summary-buffer-current-msg num) (when wl-summary-recenter (recenter (/ (- (window-height) 2) 2)) (if (not wl-summary-indent-length-limit) (wl-horizontal-recenter))) (wl-highlight-summary-displaying) + (wl-message-buffer-prefetch-next + folder num + (min (or wl-message-buffer-prefetch-depth 0) + (1- wl-message-buffer-cache-size)) + (current-buffer) + wl-summary-buffer-mime-charset) (run-hooks 'wl-summary-redisplay-hook)) (message "No message to display.")))) @@ -5271,6 +4712,7 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (defun wl-summary-supersedes-message () "Supersede current message." (interactive) + (wl-summary-toggle-disp-msg 'off) (let ((summary-buf (current-buffer)) message-buf from) (wl-summary-set-message-buffer-or-redisplay) @@ -5302,29 +4744,53 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (if message-buf (set-buffer message-buf)) (wl-draft-edit-string (buffer-substring (point-min) (point-max))))))) +(defun wl-summary-display-raw (&optional arg) + "Display current message in raw format." + (interactive) + (let ((number (wl-summary-message-number)) + (folder wl-summary-buffer-elmo-folder)) + (if number + (let ((raw (elmo-message-fetch-string + folder number + (elmo-find-fetch-strategy folder number))) + (raw-buffer (get-buffer-create "*wl:raw message*")) + (raw-mode-map (make-sparse-keymap))) + (with-current-buffer raw-buffer + (toggle-read-only -1) + (erase-buffer) + (princ raw raw-buffer) + (toggle-read-only t) + (goto-char (point-min)) + (switch-to-buffer-other-window raw-buffer) + (define-key raw-mode-map "l" 'toggle-truncate-lines) + (define-key raw-mode-map "q" 'kill-buffer-and-window) + (define-key raw-mode-map "," 'kill-buffer-and-window) + (use-local-map raw-mode-map))) + (message "No message to display.")) + number)) + (defun wl-summary-save (&optional arg wl-save-dir) "Save current message to disk." (interactive) (let ((filename) (num (wl-summary-message-number))) - (if (null wl-save-dir) - (setq wl-save-dir wl-temporary-file-directory)) + (unless wl-save-dir + (setq wl-save-dir wl-temporary-file-directory)) (if num (save-excursion (setq filename (expand-file-name - (int-to-string num) + (concat (int-to-string num) + wl-summary-save-file-suffix) wl-save-dir)) - (if (null (and arg - (null (file-exists-p filename)))) - (setq filename - (read-file-name "Save to file: " filename))) - + (when (or (null arg) + (file-exists-p filename)) + (setq filename (read-file-name "Save to file: " filename))) (wl-summary-set-message-buffer-or-redisplay) (set-buffer (wl-message-get-original-buffer)) - (if (and (null arg) (file-exists-p filename)) - (if (y-or-n-p "File already exists. override it? ") - (write-region (point-min) (point-max) filename)) - (write-region (point-min) (point-max) filename))) + (when (or arg + (not (file-exists-p filename)) + (y-or-n-p "File already exists. override it? ")) + (write-region-as-binary (point-min) (point-max) filename))) (message "No message to save.")) num)) @@ -5332,7 +4798,7 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (interactive "r") (save-excursion (save-restriction - (narrow-to-region beg end) + (wl-summary-narrow-to-region beg end) (goto-char (point-min)) (let ((wl-save-dir (wl-read-directory-name "Save to directory: " @@ -5359,8 +4825,8 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (interactive (list current-prefix-arg nil)) (if (null (wl-summary-message-number)) (message "No message.") - (setq command (read-string "Shell command on message: " - wl-summary-shell-command-last)) + (setq command (wl-read-shell-command "Shell command on message: " + wl-summary-shell-command-last)) (if (y-or-n-p "Send this message to pipe? ") (wl-summary-pipe-message-subr prefix command)))) @@ -5369,14 +4835,15 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (interactive (list current-prefix-arg nil)) (if (null wl-summary-buffer-target-mark-list) (message "No marked message.") - (setq command (read-string "Shell command on each marked message: " - wl-summary-shell-command-last)) + (setq command (wl-read-shell-command + "Shell command on each marked message: " + wl-summary-shell-command-last)) (when (y-or-n-p "Send each marked message to pipe? ") (while (car wl-summary-buffer-target-mark-list) (let ((num (car wl-summary-buffer-target-mark-list))) (wl-thread-jump-to-msg num) (wl-summary-pipe-message-subr prefix command) - (wl-summary-unmark num)))))) + (wl-summary-unmark)))))) (defun wl-summary-pipe-message-subr (prefix command) (save-excursion @@ -5418,26 +4885,21 @@ If ASK-CODING is non-nil, coding-system for the message is asked." wl-break-pages) (save-excursion (wl-summary-set-message-buffer-or-redisplay) - ;; (wl-summary-redisplay-internal) (let* ((buffer (generate-new-buffer " *print*")) (entity (progn (set-buffer summary-buffer) - (assoc (cdr (assq - (wl-summary-message-number) - (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))) - (elmo-msgdb-get-overview - (wl-summary-buffer-msgdb))))) + (elmo-message-entity + wl-summary-buffer-elmo-folder + (wl-summary-message-number)))) (wl-ps-subject - (and entity - (or (elmo-msgdb-overview-entity-get-subject entity) - ""))) + (or (elmo-message-entity-field entity 'subject 'string) + "")) (wl-ps-from - (and entity - (or (elmo-msgdb-overview-entity-get-from entity) ""))) + (or (elmo-message-entity-field entity 'from 'string) + "")) (wl-ps-date - (and entity - (or (elmo-msgdb-overview-entity-get-date entity) "")))) + (or (elmo-message-entity-field entity 'date 'string) + ""))) (run-hooks 'wl-ps-preprint-hook) (set-buffer wl-message-buffer) (copy-to-buffer buffer (point-min) (point-max)) @@ -5459,24 +4921,21 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (defun wl-summary-target-mark-print () (interactive) - (if (null wl-summary-buffer-target-mark-list) - (message "No marked message.") - (when (y-or-n-p "Print all marked messages. OK? ") - (while (car wl-summary-buffer-target-mark-list) - (let ((num (car wl-summary-buffer-target-mark-list))) - (wl-thread-jump-to-msg num) - (wl-summary-print-message) - (wl-summary-unmark num)))))) + (wl-summary-check-target-mark) + (when (y-or-n-p "Print all marked messages. OK? ") + (while (car wl-summary-buffer-target-mark-list) + (let ((num (car wl-summary-buffer-target-mark-list))) + (wl-thread-jump-to-msg num) + (wl-summary-print-message) + (wl-summary-unmark))))) (defun wl-summary-folder-info-update () - (let ((folder (elmo-string (wl-summary-buffer-folder-name))) - (num-db (elmo-msgdb-get-number-alist - (wl-summary-buffer-msgdb)))) - (wl-folder-set-folder-updated folder - (list 0 - (+ wl-summary-buffer-unread-count - wl-summary-buffer-new-count) - (length num-db))))) + (wl-folder-set-folder-updated + (elmo-string (wl-summary-buffer-folder-name)) + (list 0 + wl-summary-buffer-unread-count + (elmo-folder-length + wl-summary-buffer-elmo-folder)))) (defun wl-summary-get-original-buffer () "Get original buffer for the current summary." @@ -5488,10 +4947,11 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (interactive "P") (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder) (let (wl-use-scoring) - (wl-summary-rescan))) + (wl-summary-rescan nil nil nil t))) (defun wl-summary-target-mark-uudecode () (interactive) + (wl-summary-check-target-mark) (let ((mlist (reverse wl-summary-buffer-target-mark-list)) (summary-buf (current-buffer)) (tmp-buf (get-buffer-create "*WL UUENCODE*")) @@ -5553,7 +5013,7 @@ If ASK-CODING is non-nil, coding-system for the message is asked." filename nil 'no-msg)))) (save-excursion (set-buffer summary-buf) - (wl-summary-delete-all-temp-marks)) + (wl-summary-delete-all-target-marks)) (if (file-exists-p filename) (message "Saved as %s" filename))) (kill-buffer tmp-buf))))) @@ -5594,14 +5054,27 @@ If ASK-CODING is non-nil, coding-system for the message is asked." ;; sum)) ;; (message "Dropping...done")))) +(defun wl-summary-previous-message-number (msg) + "Return a message number previous to the message specified by MSG." + (let ((list wl-summary-buffer-number-list) + previous) + (while (and list (not (eq msg (car list)))) + (setq previous (car list)) + (setq list (cdr list))) + previous)) + +(defun wl-summary-next-message-number (msg) + "Return a message number next to the message specified by MSG." + (cadr (memq msg wl-summary-buffer-number-list))) + (defun wl-summary-default-get-next-msg (msg) (or (wl-summary-next-message msg (if wl-summary-move-direction-downward 'down 'up) nil) - (cadr (memq msg (if wl-summary-move-direction-downward - wl-summary-buffer-number-list - (reverse wl-summary-buffer-number-list)))))) + (if wl-summary-move-direction-downward + (wl-summary-next-message-number msg) + (wl-summary-previous-message-number msg)))) (defun wl-summary-save-current-message () "Save current message for `wl-summary-yank-saved-message'." @@ -5624,6 +5097,19 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (setq wl-summary-buffer-saved-message nil))) (message "There's no saved message."))) +(defun wl-summary-toggle-header-narrowing () + "Toggle message header narrowing." + (interactive) + (when wl-message-use-header-narrowing + (save-selected-window + (let* ((mbuf wl-message-buffer) + (mwin (when mbuf (get-buffer-window mbuf))) + (wpos (when mwin (window-start mwin)))) + (when mbuf + (set-buffer mbuf) + (wl-message-header-narrowing-toggle) + (and wpos (set-window-start mwin wpos))))))) + (require 'product) (product-provide (provide 'wl-summary) (require 'wl-version))