X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-summary.el;h=72811d5f4f4cde72810190984414f5679e26db42;hb=db8dc12b54edb97b4275c37d69d91a8f69b65605;hp=9f6f336186af2d4ec22f22d27f2f940c08bc2380;hpb=5923e5bfd9c02f0c41a48718c5c7e677b3e64f65;p=elisp%2Fwanderlust.git diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 9f6f336..72811d5 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,7 +61,7 @@ (defvar dragdrop-drop-functions) (defvar scrollbar-height) (defvar mail-reply-buffer) -(defvar elmo-global-flag-list) +(defvar elmo-global-flags) (defvar wl-summary-buffer-name "Summary") (defvar wl-summary-mode-map nil) @@ -68,14 +69,14 @@ (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)))) +(defun wl-summary-buffer-folder-name () + (and wl-summary-buffer-elmo-folder + (elmo-folder-name-internal wl-summary-buffer-elmo-folder))) (defvar wl-summary-buffer-disp-msg nil) (defvar wl-summary-buffer-disp-folder nil) (defvar wl-summary-buffer-temp-mark-list nil) -(defvar wl-summary-buffer-last-displayed-msg nil) +(defvar wl-summary-buffer-message-ring nil) (defvar wl-summary-buffer-current-msg nil) (defvar wl-summary-buffer-unread-count 0) (defvar wl-summary-buffer-new-count 0) @@ -91,7 +92,7 @@ (defvar wl-summary-buffer-temp-mark-column nil) (defvar wl-summary-buffer-persistent-mark-column nil) -(defvar wl-summary-buffer-unsync-mark-number-list nil) +(defvar wl-summary-buffer-persistent-mark-version 0) (defvar wl-summary-buffer-persistent nil) (defvar wl-summary-buffer-thread-nodes nil) @@ -109,6 +110,8 @@ (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) @@ -140,7 +143,7 @@ (make-variable-buffer-local 'wl-summary-buffer-disp-folder) (make-variable-buffer-local 'wl-summary-buffer-target-mark-list) (make-variable-buffer-local 'wl-summary-buffer-temp-mark-list) -(make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg) +(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) @@ -153,7 +156,7 @@ (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-unsync-mark-number-list) +(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) @@ -182,6 +185,8 @@ (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) @@ -192,8 +197,8 @@ (defvar wl-temp-mark) (defvar wl-persistent-mark) -(defmacro wl-summary-sticky-buffer-name (name) - (` (concat wl-summary-buffer-name ":" (, name)))) +(defun wl-summary-sticky-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) @@ -207,42 +212,25 @@ summary's folder name matches with `wl-summary-showto-folder-regexp' and (2) sender address is yours. See also variable `wl-use-petname'." - (let (retval tos ng) - (unless - (and (eq major-mode 'wl-summary-mode) + (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-message-entity-field - wl-message-entity 'to t)) - (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-message-entity-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 @@ -303,7 +291,8 @@ See also variable `wl-use-petname'." ["Resend bounced mail" wl-summary-resend-bounced-mail 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)] @@ -390,15 +379,22 @@ See also variable `wl-use-petname'." (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) @@ -416,6 +412,7 @@ See also variable `wl-use-petname'." (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) @@ -431,8 +428,9 @@ See also variable `wl-use-petname'." (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 "\C-cm" 'wl-summary-toggle-mime-buttons) (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) @@ -572,12 +570,46 @@ See also variable `wl-use-petname'." "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))))) + +(defsubst 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) @@ -585,18 +617,13 @@ See also variable `wl-use-petname'." (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)))) - number flags) + (error (window-end win))))) (save-excursion (goto-char beg) (while (and (< (point) end) (not (eobp))) - (when (null (get-text-property (point) 'face)) - (setq number (wl-summary-message-number) - flags (elmo-message-flags wl-summary-buffer-elmo-folder - number)) - (let (wl-summary-highlight) - (wl-summary-update-persistent-mark number flags)) - (wl-highlight-summary-current-line number flags)) + (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))) @@ -611,6 +638,79 @@ See also variable `wl-use-petname'." (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) + (with-current-buffer buffer + (save-excursion + (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)) @@ -647,21 +747,18 @@ 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. @@ -669,7 +766,7 @@ If ARG is non-nil, Supersedes message" (interactive "P") (wl-summary-toggle-disp-msg 'off) (cond - ((not (wl-summary-message-number)) + ((null (wl-summary-message-number)) (message "No message.")) (arg (wl-summary-supersedes-message)) @@ -679,7 +776,7 @@ If ARG is non-nil, Supersedes message" (mail-position-on-field "Newsgroups") (mail-position-on-field "To"))) (t - (wl-draft-edit-string (wl-summary-message-string))))) + (wl-draft-edit-string (wl-summary-message-string 'maybe))))) (defun wl-summary-resend-bounced-mail () "Re-mail the current message. @@ -723,14 +820,16 @@ you." (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. - (lang wl-summary-buffer-weekday-name-lang) 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) @@ -738,14 +837,16 @@ you." (wl-summary-create-line (elmo-msgdb-make-message-entity (luna-make-entity 'modb-entity-handler) - :number 10000 + :number dummy-number :from "foo" :subject "bar" :size 100) nil dummy-temp - '(new) - nil)) + (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) @@ -758,14 +859,13 @@ you." 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) (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 @@ -794,6 +894,7 @@ you." (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 @@ -833,11 +934,13 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (setq major-mode 'wl-summary-mode) (setq mode-name "Summary") (use-local-map wl-summary-mode-map) -;;;(setq default-directory (or wl-tmp-dir (expand-file-name "~/"))) +;;; (setq default-directory (or wl-tmp-dir (expand-file-name "~/"))) (setq buffer-read-only t) (setq truncate-lines t) -;;;(make-local-variable 'tab-width) -;;;(setq tab-width 1) + (when (boundp 'show-trailing-whitespace) + (setq show-trailing-whitespace nil)) +;;; (make-local-variable 'tab-width) +;;; (setq tab-width 1) (buffer-disable-undo (current-buffer)) (setq selective-display t selective-display-ellipses nil) @@ -849,7 +952,12 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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 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)) @@ -864,11 +972,9 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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-message-entity-field x 'date)) - (timezone-make-date-sortable - (elmo-message-entity-field y 'date))) + (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) @@ -880,12 +986,10 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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-message-entity-field x 'from t) - wl-summary-no-from-message)) - (wl-address-header-extract-address - (or (elmo-message-entity-field y 'from t) - 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." @@ -894,38 +998,17 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-get-list-info (entity) "Returns (\"ML-name\" . ML-count) of ENTITY." - (let (sequence ml-name ml-count subject return-path delivered-to mailing-list) - (setq sequence (elmo-message-entity-field entity 'x-sequence) - ml-name (or (elmo-message-entity-field entity 'x-ml-name) - (and sequence - (car (split-string sequence " ")))) - ml-count (or (elmo-message-entity-field entity 'x-mail-count) - (elmo-message-entity-field entity 'x-ml-count) - (and sequence - (cadr (split-string sequence " "))))) - (and (setq subject (elmo-message-entity-field entity 'subject t)) - (setq subject (elmo-delete-char ?\n subject)) - (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" subject) - (progn - (or ml-name (setq ml-name (match-string 1 subject))) - (or ml-count (setq ml-count (match-string 2 subject))))) - (and (setq return-path - (elmo-message-entity-field entity 'return-path)) - (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-" return-path) - (progn - (or ml-name (setq ml-name (match-string 1 return-path))) - (or ml-count (setq ml-count (match-string 2 return-path))))) - (and (setq delivered-to - (elmo-message-entity-field entity 'delivered-to)) - (string-match "^mailing list \\([^@]+\\)@" delivered-to) - (or ml-name (setq ml-name (match-string 1 delivered-to)))) - (and (setq mailing-list - (elmo-message-entity-field entity 'mailing-list)) - ;; *-help@, *-owner@, etc. - (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" mailing-list) - (or ml-name (setq ml-name (match-string 2 mailing-list)))) - (cons (and ml-name (car (split-string ml-name " "))) - (and ml-count (string-to-int ml-count))))) + (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." @@ -939,26 +1022,55 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (string< (or (car list-info-x) "") (or (car list-info-y) ""))))) -(defun wl-summary-sort-by-date () - (interactive) - (wl-summary-rescan "date")) -(defun wl-summary-sort-by-number () - (interactive) - (wl-summary-rescan "number")) -(defun wl-summary-sort-by-subject () - (interactive) - (wl-summary-rescan "subject")) -(defun wl-summary-sort-by-from () +(defun wl-summary-define-sort-command () + "Define functions to sort summary lines by `wl-summary-sort-specs'." (interactive) - (wl-summary-rescan "from")) -(defun wl-summary-sort-by-list-info () - (interactive) - (wl-summary-rescan "list-info")) -(defun wl-summary-sort-by-size () - (interactive) - (wl-summary-rescan "size")) + (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 disable-killed disable-thread) +(defun wl-summary-rescan (&optional sort-by reverse disable-killed disable-thread) "Rescan current folder without updating." (interactive) (let ((elmo-mime-charset wl-summary-buffer-mime-charset) @@ -973,49 +1085,34 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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)) - (predicate (and sort-by - (intern (format "wl-summary-overview-entity-compare-by-%s" - sort-by)))) - (i 0) num expunged) (erase-buffer) (message "Re-scanning...") - (when sort-by - (message "Sorting by %s..." sort-by) - (setq numbers - (sort numbers - (lambda (x y) - (funcall - predicate - (elmo-message-entity wl-summary-buffer-elmo-folder x) - (elmo-message-entity wl-summary-buffer-elmo-folder y))))) - (message "Sorting by %s...done" sort-by)) + (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-unsync-mark-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) - (while numbers - (wl-summary-insert-message (elmo-message-entity - wl-summary-buffer-elmo-folder - (car numbers)) - wl-summary-buffer-elmo-folder - nil) - (setq numbers (cdr numbers)) - (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) @@ -1025,12 +1122,8 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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") - (if (eq wl-summary-buffer-view 'thread) - (progn - (message "Inserting thread...") - (wl-thread-insert-top) - (message "Inserting thread...done"))) + (when (eq wl-summary-buffer-view 'thread) + (wl-thread-insert-top)) (when wl-use-scoring (wl-summary-score-headers (wl-summary-rescore-msgs wl-summary-buffer-number-list) @@ -1045,6 +1138,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) @@ -1111,9 +1254,9 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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))) + (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 ;; Note that folder is not commited here. @@ -1241,12 +1384,15 @@ 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))))) + (when (symbolp range) + (setq range (symbol-name range))) (cond ((string-match "rescan" range) (let ((msg (wl-summary-message-number)) (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)))) @@ -1285,18 +1431,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 - (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 + (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. @@ -1306,7 +1451,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." the-email) (while (not (or (eq (setq char (read-char)) ?\r) (eq char ?\n) - (eq char ? ) + (eq char (string-to-char " ")) (eq char ?e) (eq char ?c) (eq char ?d))) @@ -1316,7 +1461,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." ((or (eq char ?e) (eq char ?\n) (eq char ?\r) - (eq char ? )) + (eq char (string-to-char " "))) ;; Change Addresses (wl-address-add-or-change the-email @@ -1365,7 +1510,7 @@ Optional argument ADDR-STR is used as a target address if specified." (completing-read (format "Target address (%s): " address) (mapcar - (function (lambda (x) (cons (car x) (car x)))) + (lambda (x) (cons (car x) (car x))) candidates) nil nil nil nil address)))) (when address @@ -1383,7 +1528,7 @@ Optional argument ADDR-STR is used as a target address if specified." (nth 0 address) result))) ;;; i'd like to update summary-buffer, but... -;;; (wl-summary-rescan) +;;; (wl-summary-rescan) (run-hooks 'wl-summary-edit-addresses-hook)))))) (defun wl-summary-incorporate (&optional arg) @@ -1400,25 +1545,27 @@ If ARG is non-nil, checking is omitted." "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 - (elmo-inhibit-display-retrieval-progress t) - length msg) + (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 - (goto-char (point-min)) - (setq length (length targets)) - (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)) - (message "Retrieving... %d/%d" (incf count) length))) + (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) @@ -1460,7 +1607,7 @@ If ARG is non-nil, checking is omitted." (or (elmo-message-entity-field wl-message-entity - 'from t) + 'from) "??"))))) " ]") size)))) @@ -1469,20 +1616,11 @@ If ARG is non-nil, checking is omitted." (save-excursion (save-match-data ;; online - (if (or arg (not file-cached)) - (elmo-message-encache - wl-summary-buffer-elmo-folder - number)) + (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) - (when (and (wl-summary-jump-to-msg number) - (wl-summary-update-persistent-mark)) - (sit-for 0) - (wl-summary-count-unread) - (wl-summary-update-modeline) - (wl-folder-update-unread - (wl-summary-buffer-folder-name) - wl-summary-buffer-unread-count))) + number t)) t) nil))))) @@ -1490,12 +1628,12 @@ If ARG is non-nil, checking is omitted." (narrow-to-region (save-excursion (goto-char beg) - (beginning-of-line) - (point)) + (point-at-bol)) (save-excursion (goto-char end) - (if (eq (current-column) 0) (beginning-of-line) (end-of-line)) - (point)))) + (if (= (current-column) 0) + (point-at-bol) + (point-at-eol))))) (defun wl-summary-prefetch-region-no-mark (beg end &optional prefetch-marks) (interactive "r") @@ -1512,8 +1650,8 @@ If ARG is non-nil, checking is omitted." (message "Collecting marks...") (goto-char (point-min)) (while (not (eobp)) - (setq mark (wl-summary-persistent-mark) - msg (wl-summary-message-number)) + (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 @@ -1616,7 +1754,8 @@ If ARG is non-nil, checking is omitted." (if (null number-list) (message "No message.") (wl-summary-set-persistent-mark-internal remove 'answered - number-list) + number-list + nil nil (interactive-p)) (wl-summary-count-unread) (wl-summary-update-modeline)))) @@ -1631,10 +1770,20 @@ If ARG is non-nil, checking is omitted." 'important)))) (if (null number-list) (message "No message.") - (wl-summary-mark-as-important-internal remove number-list) + (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") + (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)) @@ -1642,15 +1791,10 @@ If ARG is non-nil, checking is omitted." (let ((folder wl-summary-buffer-elmo-folder) (cur-buf (current-buffer))) (message "Setting all msgs as read...") - (elmo-folder-set-flag + (elmo-folder-unset-flag folder (elmo-folder-list-flagged folder 'unread 'in-msgdb) - 'read) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (wl-summary-update-persistent-mark) - (forward-line 1))) + '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) @@ -1665,7 +1809,7 @@ If ARG is non-nil, checking is omitted." number) (setq number (wl-summary-message-number)) (elmo-message-set-cached folder number nil) - (when (wl-summary-update-persistent-mark) + (ignore-errors (elmo-file-cache-delete (elmo-file-cache-get-path (elmo-message-field wl-summary-buffer-elmo-folder @@ -1685,13 +1829,12 @@ If ARG is non-nil, checking is omitted." (setq msgid (elmo-message-field folder number 'message-id)) (elmo-message-set-cached folder number (elmo-file-cache-exists-p msgid)) - (wl-summary-update-persistent-mark) (forward-line 1)) (wl-summary-count-unread) (wl-summary-update-modeline) (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) @@ -1699,7 +1842,6 @@ If ARG is non-nil, checking is omitted." (msgs2 msgs) (len (length msgs)) (i 0) - ;(deleting-info (or deleting-info "Deleting...")) update-list) (elmo-kill-buffer wl-summary-search-buf-name) (while msgs @@ -1717,17 +1859,13 @@ If ARG is non-nil, checking is omitted." (delete-char 1) ; delete '\n' (setq wl-summary-buffer-number-list (delq (car msgs) wl-summary-buffer-number-list))))) -; (when (> 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)) - (wl-thread-cleanup-symbols msgs2)) - ;;(message (concat deleting-info "done")) + (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-summary-folder-info-update)))) @@ -1739,12 +1877,7 @@ If ARG is non-nil, checking is omitted." (goto-char beg) (while (and (< (point) end) (not (eobp))) (when (or (not check) - (let ((number (wl-summary-message-number))) - (when (memq number wl-summary-buffer-unsync-mark-number-list) - (setq wl-summary-buffer-unsync-mark-number-list - (delq number - wl-summary-buffer-unsync-mark-number-list)) - t))) + (wl-summary-persistent-mark-invalid-p)) (wl-summary-update-persistent-mark)) (forward-line 1)))) @@ -1764,67 +1897,53 @@ This function is defined for `window-scroll-functions'" (apply 'wl-summary-insert-thread args) (apply 'wl-summary-insert-sequential args))) -(defun wl-summary-sort () - (interactive) - (wl-summary-rescan - (completing-read - (format "Sort by (%s): " (symbol-name wl-summary-default-sort-spec)) - (mapcar (lambda (spec) - (list (symbol-name spec))) - wl-summary-sort-specs) - nil t nil nil (symbol-name wl-summary-default-sort-spec)))) +(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 persistent marks in summary." (interactive) (let ((mes "Updated ") diff diffs) - ;; synchronize marks. - (when (not (eq (elmo-folder-type-internal - wl-summary-buffer-elmo-folder) - 'internal)) - - (message "Updating marks...") - (dolist (flag elmo-global-flag-list) - (unless (memq flag elmo-preserved-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)) ; deletes - (setq mes (concat mes (format "-%d" (length diffs)))) - (while diffs - (wl-summary-remove-flags-internal (car diffs) - (list flag) 'no-server) - (setq diffs (cdr diffs))) - (setq diffs (car diff)) ; appends - (setq mes (concat mes (format "/+%d %s," (length diffs) flag))) - (while diffs - (wl-summary-add-flags-internal (car diffs) - (list flag) 'no-server) - (setq diffs (cdr diffs))))) - - (dolist (flag (delete 'new (delete 'cached - (copy-sequence elmo-preserved-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-unset-persistent-mark flag (car diffs) 'no-modeline) - (setq diffs (cdr diffs))) - (setq diffs (car diff) - mes (concat mes (format "/+%d %s " (length diffs) flag))) - (while diffs - (wl-summary-set-persistent-mark flag (car diffs) 'no-modeline) - (setq diffs (cdr diffs)))) - (if (interactive-p) (message "%s" mes))))) + (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)))) + (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 @@ -1844,8 +1963,8 @@ This function is defined for `window-scroll-functions'" (error "(Internal error) Folder is not set:%s" (buffer-name (current-buffer)))) ;; Flush pending append operations (disconnected operation). - ;;(setq seen-list - ;;(wl-summary-flush-pending-append-operations seen-list)) +;;; (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 crossed (elmo-folder-synchronize folder @@ -1858,8 +1977,7 @@ This function is defined for `window-scroll-functions'" (not wl-summary-lazy-highlight))) append-list delete-list update-thread update-top-list - num diff entity - (i 0)) + num diff entity) ;; Setup sync-all (if sync-all (wl-summary-sync-all-init)) (setq diff (elmo-list-diff (elmo-folder-list-messages @@ -1867,7 +1985,7 @@ This function is defined for `window-scroll-functions'" (not disable-killed) 'in-msgdb) wl-summary-buffer-number-list)) - (setq append-list (car diff)) + (setq append-list (sort (car diff) #'<)) (setq delete-list (cadr diff)) (when delete-list @@ -1881,27 +1999,22 @@ This function is defined for `window-scroll-functions'" (setq num (length append-list)) (setq wl-summary-delayed-update nil) (elmo-kill-buffer wl-summary-search-buf-name) - (dolist (number append-list) - (setq entity (elmo-message-entity folder number)) - (when (setq update-thread - (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-message-entity-number entity))) - (when (> num elmo-display-progress-threshold) - (setq i (+ i 1)) - (if (or (zerop (% i 5)) (= i num)) - (elmo-display-progress - 'wl-summary-sync-update - (if (eq wl-summary-buffer-view 'thread) - "Making thread..." - "Inserting message...") - (/ (* i 100) num))))) - (when wl-summary-delayed-update + (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-insert-message + entity folder + (not sync-all))) + (wl-append update-top-list update-thread)) + (if elmo-use-database + (elmo-database-msgid-put + (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) @@ -1919,16 +2032,11 @@ This function is defined for `window-scroll-functions'" update-top-list) (wl-thread-update-indent-string-thread (elmo-uniq-list update-top-list))) - (message (if (eq wl-summary-buffer-view 'thread) - "Making thread...done" - "Inserting message...done")) (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 message...") - (wl-thread-insert-top) - (message "Inserting message...done")) + (wl-thread-insert-top)) (if elmo-use-database (elmo-database-close)) (run-hooks 'wl-summary-sync-updated-hook) @@ -2015,43 +2123,42 @@ This function is defined for `window-scroll-functions'" (setq wl-summary-buffer-mode-line (funcall wl-summary-buffer-mode-line-formatter))) -(defun 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 (and (re-search-forward (concat "\r" num "[^0-9]") nil t) - (progn (backward-char 1) t)) - (re-search-backward (concat "\r" num "[^0-9]") nil t)) - (progn (beginning-of-line) t) - nil))) +(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" (number-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 (or (re-search-forward "\r\\(-?[0-9]+\\)" (point-at-eol) t) (re-search-forward "^ *\\(-?[0-9]+\\)" (point-at-eol) t)) - (string-to-int (wl-match-buffer 1)) + (string-to-number (wl-match-buffer 1)) nil))) (defun wl-summary-delete-all-msgs () @@ -2098,25 +2205,20 @@ If ARG, without confirm." (setq wl-summary-buffer-view 'thread)) (wl-summary-update-modeline) (force-mode-line-update) - (wl-summary-rescan nil nil t))) + (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") @@ -2159,7 +2261,7 @@ If ARG, without confirm." (wl-summary-sticky-buffer-name (wl-summary-buffer-folder-name))) ;;; ???hang up -;;; (rename-buffer (wl-summary-sticky-buffer-name +;;; (rename-buffer (wl-summary-sticky-buffer-name ;;; (wl-summary-buffer-folder-name)))) (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name))))) @@ -2179,7 +2281,7 @@ If ARG, without confirm." wl-summary-buffer-message-modified wl-summary-buffer-thread-modified wl-summary-buffer-number-list - wl-summary-buffer-unsync-mark-number-list + wl-summary-buffer-persistent-mark-version wl-summary-buffer-folder-name wl-summary-buffer-line-formatter) (and (eq wl-summary-buffer-view 'thread) @@ -2200,12 +2302,11 @@ 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) - (save-excursion - (set-buffer cur-buf) + (with-current-buffer cur-buf (symbol-value (car copy-variables)))) (setq copy-variables (cdr copy-variables))) (switch-to-buffer buf) @@ -2220,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 @@ -2277,17 +2382,19 @@ 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))) + (let ((discard-contents (or force-exit (not (wl-summary-sticky-p))))) + (when discard-contents (wl-summary-cleanup-temp-marks)) - (wl-summary-save-view) - (elmo-folder-commit wl-summary-buffer-elmo-folder) + (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) sticky)) (setq reuse-buf - (save-excursion - (set-buffer buf) + (with-current-buffer buf (string= (elmo-folder-name-internal folder) (wl-summary-buffer-folder-name)))) (unwind-protect @@ -2301,9 +2408,14 @@ 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) + (setq wl-summary-buffer-persistent-mark-version 0) (let ((inhibit-read-only t) (buffer-read-only nil)) (erase-buffer) @@ -2341,8 +2453,6 @@ If ARG, without confirm." (wl-summary-update-modeline))) (unless (eq wl-summary-buffer-view 'thread) (wl-summary-make-number-list)) - (setq wl-summary-buffer-unsync-mark-number-list - (copy-sequence wl-summary-buffer-number-list)) (when (and wl-summary-cache-use (or (and wl-summary-check-line-format (wl-summary-line-format-changed-p)) @@ -2420,7 +2530,8 @@ 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)) @@ -2439,6 +2550,11 @@ If ARG, without confirm." (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)) @@ -2471,16 +2587,21 @@ If ARG, without confirm." (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)) + (point-at-bol) (point-at-eol) '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)) + (point-at-bol) (point-at-eol) 'mouse-face nil)) + (elmo-progress-notify 'wl-summary-insert-line) (ignore-errors (run-hooks 'wl-summary-line-inserted-hook))) @@ -2492,12 +2613,7 @@ If ARG, without confirm." (goto-char (point-max)) (wl-summary-insert-line (wl-summary-create-line entity nil nil - (elmo-message-flags - wl-summary-buffer-elmo-folder - number) - (elmo-message-cached-p - wl-summary-buffer-elmo-folder - number))) + (elmo-message-status folder number))) (setq wl-summary-buffer-number-list (wl-append wl-summary-buffer-number-list (list (elmo-message-entity-number entity)))) @@ -2506,22 +2622,22 @@ If ARG, without confirm." (defun wl-summary-default-subject-filter (subject) (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" "")) (setq subject (elmo-replace-in-string subject "[ \t]" "")) - (elmo-replace-in-string subject "^\\[.*\\]" "")) + (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))) +(defsubst wl-summary-get-alike () + (elmo-get-hash-val (format "#%d" (wl-count-lines)) + wl-summary-alike-hashtb)) -(defun wl-summary-insert-headers (folder func mime-decode) +(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)) @@ -2562,15 +2678,12 @@ If ARG, without confirm." (message "Creating subject cache...") (wl-summary-insert-headers folder - (function - (lambda (x) - (funcall wl-summary-subject-filter-function - (elmo-message-entity-field x 'subject)))) - t) + (lambda (x) + (funcall wl-summary-subject-filter-function + (elmo-message-entity-field x 'subject)))) (message "Creating subject cache...done")) (setq match (funcall wl-summary-subject-filter-function - (elmo-message-entity-field entity 'subject - 'decode))) + (elmo-message-entity-field entity 'subject))) (if (string= match "") (setq match "\n")) (goto-char (point-max)) @@ -2660,10 +2773,9 @@ If ARG, without confirm." (if (and parent-number wl-summary-divide-thread-when-subject-changed (not (wl-summary-subject-equal - (or (elmo-message-entity-field entity - 'subject t) "") + (or (elmo-message-entity-field entity 'subject) "") (or (elmo-message-entity-field parent-entity - 'subject t) "")))) + 'subject) "")))) (setq parent-number nil)) (setq retval (wl-thread-insert-message entity @@ -2707,8 +2819,7 @@ If ARG, without confirm." entity parent-entity nil - (elmo-message-flags wl-summary-buffer-elmo-folder number) - (elmo-message-cached-p wl-summary-buffer-elmo-folder number) + (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))))))) @@ -2722,14 +2833,20 @@ If ARG, without confirm." i)) (defun wl-summary-pick (&optional from-list delete-marks) - (interactive) + (interactive "i\nP") (save-excursion - (let* ((condition (car (elmo-parse-search-condition - (elmo-read-search-condition + (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 - from-list)) + messages)) num) (if delete-marks (let ((mlist wl-summary-buffer-target-mark-list)) @@ -2766,7 +2883,7 @@ 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)) @@ -2802,59 +2919,85 @@ If ARG, exit virtual folder." (wl-summary-get-score-mark number) " "))) -(defsubst wl-summary-persistent-mark-string (folder flags cached) +(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-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, FLAGS and CACHED." +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) - (if (and (eq (car priorities) 'flag) - (elmo-get-global-flags flags 'ignore-preserved)) - (let ((specs wl-summary-flag-alist) + (let ((flag (car priorities))) + (cond + ((eq flag 'flag) + (let ((flags (elmo-get-global-flags flags 'ignore-preserved)) + (specs wl-summary-flag-alist) spec) - (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))) - (when (memq (car priorities) flags) + (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 - (if cached + (let ((var (intern-soft (format - "wl-summary-%s-cached-mark" (car priorities)) - (format - "wl-summary-%s-uncached-mark" (car priorities)))))) - (if (boundp var) - (symbol-value var) - (if cached - (downcase (substring (symbol-name (car priorities)) - 0 1)) - (upcase (substring (symbol-name (car priorities)) - 0 1)))))))) - (setq priorities (cdr priorities))) + (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-read-uncached-mark)))) + wl-summary-uncached-mark)))) -(defsubst wl-summary-message-mark (folder number &optional flags) +(defsubst wl-summary-message-mark (folder number &optional status) "Return mark of the message." (ignore-errors (wl-summary-persistent-mark-string folder - (or flags (setq flags (elmo-message-flags folder number))) - (memq 'cached flags) ; XXX for speed-up. - ))) + (or status (elmo-message-status folder number))))) -(defsubst wl-summary-persistent-mark (&optional number flags) +(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)) - flags) + status) " ")) (defun wl-summary-put-temp-mark (mark) @@ -2890,8 +3033,13 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (or (cadr (memq (current-buffer) buffers)) (car buffers))))) +(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 ((inhibit-read-only t) @@ -2903,6 +3051,7 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (defun wl-summary-target-mark-mark-as-unread () (interactive) + (wl-summary-check-target-mark) (save-excursion (goto-char (point-min)) (let ((inhibit-read-only t) @@ -2913,6 +3062,7 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (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) @@ -2933,6 +3083,7 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (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) @@ -2943,8 +3094,22 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (wl-summary-count-unread) (wl-summary-update-modeline)))) +(defun wl-summary-target-mark-recover () + "Recover killed messages which have target mark." + (interactive) + (wl-summary-check-target-mark) + (save-excursion + (let ((inhibit-read-only t) + (buffer-read-only nil) + 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) + (wl-summary-check-target-mark) (let ((wl-save-dir (wl-read-directory-name "Save to directory: " wl-temporary-file-directory)) @@ -2958,28 +3123,33 @@ The mark is decided according to the FOLDER, FLAGS and CACHED." (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-update-persistent-mark (&optional number flags) +(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) - (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 flags))) - (unless (string= new-mark mark) - (delete-backward-char 1) - (insert new-mark) - (wl-summary-set-message-modified) - t)))) - (when wl-summary-highlight - (wl-highlight-summary-current-line)) - (set-buffer-modified-p nil))) + (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 @@ -2988,7 +3158,7 @@ Return non-nil if the mark is updated" (save-excursion (let ((folder wl-summary-buffer-elmo-folder) unread-message number - number-list visible) + number-list) (setq number-list (cond ((numberp number-or-numbers) (setq unread-message (elmo-message-flagged-p @@ -3010,16 +3180,13 @@ Return non-nil if the mark is updated" (if (null number-list) (message "No message.") (if inverse - (elmo-folder-unset-flag folder number-list 'read no-folder-mark) - (elmo-folder-set-flag folder number-list 'read no-folder-mark)) - (dolist (number number-list) - (setq visible (wl-summary-jump-to-msg number)) - (unless inverse - (when unread-message - (run-hooks 'wl-summary-unread-message-hook))) - ;; set mark on buffer - (when visible - (wl-summary-update-persistent-mark))) + (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) @@ -3047,13 +3214,15 @@ Return non-nil if the mark is updated" no-modeline-update)) (defsubst wl-summary-set-persistent-mark-internal (inverse - &optional flag - number-or-numbers - no-modeline-update) + flag + &optional number-or-numbers + no-modeline-update + no-server + interactive) "Set persistent mark." (save-excursion (let ((folder wl-summary-buffer-elmo-folder) - number number-list visible) + number number-list) (setq number-list (cond ((numberp number-or-numbers) (list number-or-numbers)) ((and (not (null number-or-numbers)) @@ -3064,61 +3233,88 @@ Return non-nil if the mark is updated" (list number)))) (if (null number-list) (message "No message.") - (if inverse - (elmo-folder-unset-flag folder number-list flag) - (elmo-folder-set-flag folder number-list flag)) - (dolist (number number-list) - (setq visible (wl-summary-jump-to-msg number)) - ;; set mark on buffer - (when visible - (wl-summary-update-persistent-mark))) - (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)))))) + ;; XXX Only the first element of the list is checked. + (if (elmo-message-flag-available-p folder (car number-list) flag) + (progn + (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-modeline-update + no-server) "Unset persistent mark." (interactive) (when (interactive-p) - (setq flag (intern (downcase - (completing-read - "Flag: " - (mapcar (lambda (flag) - (list (capitalize (symbol-name flag)))) - elmo-preserved-flags) - nil - 'require-match))))) + (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-modeline-update + no-server + (interactive-p))) (defun wl-summary-set-persistent-mark (&optional flag number-or-numbers - no-modeline-update) + 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 - "Flag: " + "Mark name: " (mapcar (lambda (flag) (list (capitalize (symbol-name flag)))) - elmo-preserved-flags) + (wl-summary-get-available-flags)) nil - 'require-match))))) - (wl-summary-set-persistent-mark-internal - nil - flag - number-or-numbers - no-modeline-update)) + '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) @@ -3130,7 +3326,9 @@ Return non-nil if the mark is updated" 'answered)) 'answered number-or-numbers - no-modeline-update)) + no-modeline-update + nil + (interactive-p))) (defun wl-summary-mark-as-unanswered (&optional number-or-numbers no-modeline-update) @@ -3155,18 +3353,22 @@ Return non-nil if the mark is updated" "Flags: " (mapcar (lambda (flag) (list (capitalize (symbol-name flag)))) - elmo-global-flag-list) + elmo-global-flags) nil nil (mapconcat (lambda (flag) (capitalize (symbol-name flag))) flags ","))))) (dolist (flag new-flags) - (unless (memq flag elmo-global-flag-list) - (if (y-or-n-p (format "Flag `%s' does not exist yet. Create?" + (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-flag-list (append - elmo-global-flag-list - (list flag))) + (setq elmo-global-flags (append + elmo-global-flags + (list flag))) (error "Stopped")))) new-flags)) @@ -3177,7 +3379,7 @@ Return non-nil if the mark is updated" remove-all) (save-excursion (let ((folder wl-summary-buffer-elmo-folder) - number number-list visible) + number number-list) (setq number-list (cond ((numberp number-or-numbers) (list number-or-numbers)) ((and (not (null number-or-numbers)) @@ -3193,92 +3395,32 @@ Return non-nil if the mark is updated" (if (null number-list) (message "No message.") (dolist (number number-list) - (elmo-message-set-global-flags folder number flags local) - (setq visible (wl-summary-jump-to-msg number)) - ;; set mark on buffer - (when visible - (wl-summary-update-persistent-mark)))) + (elmo-message-set-global-flags folder number flags local))) flags))) -(defsubst wl-summary-add-flags-internal (&optional - number-or-numbers - flags - local) - (save-excursion - (let ((folder wl-summary-buffer-elmo-folder) - set-flags msg number-list visible) - (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 msg (wl-summary-message-number)) - ;; interactive - (list msg)))) - (if (null number-list) - (message "No message.") - (dolist (number number-list) - (setq set-flags - (elmo-get-global-flags - (elmo-message-flags folder number))) - (setq set-flags (nconc flags set-flags)) - (elmo-message-set-global-flags folder number set-flags local) - (setq visible (wl-summary-jump-to-msg number)) - ;; set mark on buffer - (when visible - (wl-summary-update-persistent-mark))))))) - -(defsubst wl-summary-remove-flags-internal (&optional - number-or-numbers - flags - local) - (save-excursion - (let ((folder wl-summary-buffer-elmo-folder) - set-flags msg number-list visible) - (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 msg (wl-summary-message-number)) - ;; interactive - (list msg)))) - (if (null number-list) - (message "No message.") - (dolist (number number-list) - (setq set-flags (elmo-get-global-flags - (elmo-message-flags folder number))) - (dolist (flag flags) - (setq set-flags (delq flag set-flags))) - (elmo-message-set-global-flags folder number set-flags local) - (setq visible (wl-summary-jump-to-msg number)) - ;; set mark on buffer - (when visible - (wl-summary-update-persistent-mark))))))) - (defun wl-summary-set-flags (&optional remove) (interactive "P") - (if (eq 'flag (elmo-folder-type-internal wl-summary-buffer-elmo-folder)) - (error "Cannot process flags in this folder")) (wl-summary-set-flags-internal nil nil nil remove)) -(defun wl-summary-mark-as-important-internal (inverse - &optional number-or-numbers) - (if inverse - (wl-summary-remove-flags-internal number-or-numbers '(important)) - (wl-summary-add-flags-internal number-or-numbers '(important)))) - (defun wl-summary-mark-as-important (&optional prompt) (interactive "P") - (if (eq 'flag (elmo-folder-type-internal wl-summary-buffer-elmo-folder)) - (error "Cannot process flags in this folder")) (if prompt (wl-summary-set-flags-internal) - (wl-summary-mark-as-important-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)) + '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) @@ -3352,18 +3494,16 @@ Return non-nil if the mark is updated" (elmo-delete-char ?\n (or (elmo-message-entity-field wl-message-entity - 'subject t) + 'subject) wl-summary-no-subject-message))) (setq parent-raw-subject - (elmo-message-entity-field wl-parent-message-entity - 'subject t)) + (elmo-message-entity-field wl-parent-message-entity 'subject)) (setq parent-subject (if parent-raw-subject (elmo-delete-char ?\n parent-raw-subject))) (if (or no-parent (null parent-subject) - (not (wl-summary-subject-equal - subject parent-subject))) + (not (wl-summary-subject-equal subject parent-subject))) (funcall wl-summary-subject-function subject) ""))) @@ -3372,7 +3512,7 @@ Return non-nil if the mark is updated" (funcall wl-summary-from-function (elmo-message-entity-field wl-message-entity - 'from t)))) + 'from)))) (defun wl-summary-line-list-info () (let ((list-info (wl-summary-get-list-info wl-message-entity))) @@ -3397,17 +3537,16 @@ Return non-nil if the mark is updated" ""))) ;;; 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-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 wl-temp-mark - wl-flags - wl-cached + wl-status &optional wl-thr-children-number wl-thr-indent-string @@ -3416,17 +3555,13 @@ Return non-nil if the mark is updated" (let ((wl-mime-charset wl-summary-buffer-mime-charset) (wl-persistent-mark (wl-summary-persistent-mark-string wl-summary-buffer-elmo-folder - wl-flags - wl-cached)) + 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-message-entity-field - wl-message-entity - 'date) - 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 @@ -3446,11 +3581,12 @@ Return non-nil if the mark is updated" (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 (elmo-message-entity-number wl-message-entity) line - wl-flags + wl-status wl-temp-mark wl-thr-indent-string)) line)) @@ -3572,11 +3708,9 @@ Return non-nil if the mark is updated" (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) + (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)))))) @@ -3615,7 +3749,7 @@ Return non-nil if the mark is updated" (setq range (completing-read (format "Range (%s): " default) (mapcar - (function (lambda (x) (cons x x))) + (lambda (x) (cons x x)) input-range-list))) (if (string= range "") default @@ -3754,6 +3888,21 @@ Return non-nil if the mark is updated" ))) (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." (interactive) @@ -3809,15 +3958,14 @@ 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") + (wl-summary-check-target-mark) (let ((mlist (nreverse (copy-sequence wl-summary-buffer-target-mark-list))) (summary-buf (current-buffer)) (wl-draft-forward t) @@ -3841,13 +3989,13 @@ Return t if message exists." (wl-draft-body-goto-top) (wl-draft-enclose-digest-region (point) (point-max))) (goto-char start-point) - (save-excursion - (set-buffer summary-buf) + (with-current-buffer summary-buf (wl-summary-delete-all-target-marks))) (run-hooks 'wl-mail-setup-hook))) (defun wl-summary-target-mark-reply-with-citation (&optional arg) (interactive "P") + (wl-summary-check-target-mark) (let ((mlist (nreverse (copy-sequence wl-summary-buffer-target-mark-list))) (summary-buf (current-buffer)) change-major-mode-hook @@ -3869,8 +4017,7 @@ Return t if message exists." (wl-draft-yank-original) (setq mlist (cdr mlist))) (goto-char start-point) - (save-excursion - (set-buffer summary-buf) + (with-current-buffer summary-buf (wl-summary-delete-all-target-marks))) (wl-draft-reply-position wl-draft-reply-default-position) (run-hooks 'wl-mail-setup-hook)))) @@ -4071,8 +4218,7 @@ 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)) @@ -4082,9 +4228,7 @@ Reply to author if invoked with ARG." (when number (save-excursion (wl-summary-set-message-buffer-or-redisplay)) - (setq mes-buf wl-message-buffer) (wl-message-select-buffer wl-message-buffer) - (set-buffer mes-buf) (condition-case err (when (setq mes-buf (wl-message-get-original-buffer)) (wl-draft-reply mes-buf arg summary-buf number) @@ -4096,11 +4240,10 @@ Reply to author if invoked with ARG." (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")) @@ -4112,12 +4255,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 @@ -4127,7 +4268,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))) @@ -4147,7 +4288,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.") @@ -4159,17 +4299,10 @@ 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) - ;; get original subject. - (if summary-buf - (save-excursion - (set-buffer summary-buf) - (setq subject - (or (elmo-message-entity-field - (elmo-message-entity folder number) 'subject 'decode) - "")))) - (set-buffer mes-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 @@ -4274,36 +4407,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) @@ -4330,31 +4461,131 @@ 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)))) -(defun wl-summary-redisplay-internal (&optional folder number force-reload) +(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) - no-folder-mark 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)))) @@ -4368,116 +4599,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)) - (setq no-folder-mark - ;; If cache is used, change folder-mark. - (if (wl-message-redisplay folder num - 'mime - (or - force-reload - (string= (elmo-folder-name-internal - folder) - wl-draft-folder))) - nil - ;; plugged, then leave folder-mark. - (if (and (not (elmo-folder-local-p - wl-summary-buffer-elmo-folder)) - (elmo-folder-plugged-p - wl-summary-buffer-elmo-folder)) - 'leave))) + (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 no-folder-mark) - (wl-summary-update-persistent-mark))) - (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)) - (when (elmo-message-use-cache-p fld num) - (elmo-message-set-cached fld num t)) - (ignore-errors - (if (elmo-message-flagged-p fld num 'unread) - (wl-summary-mark-as-read num); no-folder-mark) - (wl-summary-update-persistent-mark))) - (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)) - (when (elmo-message-use-cache-p fld num) - (elmo-message-set-cached fld num t)) - (if (wl-message-redisplay fld num 'all-header - (string= (elmo-folder-name-internal fld) - wl-draft-folder)) - (wl-summary-mark-as-read num)) + (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.")))) @@ -4577,30 +4738,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 - (concat (int-to-string num) + (concat (number-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)) @@ -4635,8 +4819,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)))) @@ -4645,8 +4829,9 @@ 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))) @@ -4694,7 +4879,6 @@ 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) @@ -4702,15 +4886,14 @@ If ASK-CODING is non-nil, coding-system for the message is asked." wl-summary-buffer-elmo-folder (wl-summary-message-number)))) (wl-ps-subject - (and entity - (or (elmo-message-entity-field entity 'subject t) - ""))) + (or (elmo-message-entity-field entity 'subject 'string) + "")) (wl-ps-from - (and entity - (or (elmo-message-entity-field entity 'from t) ""))) + (or (elmo-message-entity-field entity 'from 'string) + "")) (wl-ps-date - (and entity - (or (elmo-message-entity-field entity 'date) "")))) + (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)) @@ -4732,14 +4915,13 @@ 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)))))) + (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 () (wl-folder-set-folder-updated @@ -4759,10 +4941,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 nil nil t))) + (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*")) @@ -4822,57 +5005,69 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (as-binary-output-file (write-region (point-min) (point-max) filename nil 'no-msg)))) - (save-excursion - (set-buffer summary-buf) + (with-current-buffer summary-buf (wl-summary-delete-all-target-marks)) (if (file-exists-p filename) (message "Saved as %s" filename))) (kill-buffer tmp-buf))))) -;; Someday -;; (defun wl-summary-drop-unsync () -;; "Drop all unsync messages." -;; (interactive) -;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name)) -;; (error "You cannot drop unsync messages in this folder")) -;; (if (or (not (interactive-p)) -;; (y-or-n-p "Drop all unsync messages? ")) -;; (let* ((folder-list (elmo-folder-get-primitive-folder-list -;; (wl-summary-buffer-folder-name))) -;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name))) -;; (sum 0) -;; (multi-num 0) -;; pair) -;; (message "Dropping...") -;; (while folder-list -;; (setq pair (elmo-folder-message-numbers (car folder-list))) -;; (when is-multi ;; dirty hack... -;; (incf multi-num) -;; (setcar pair (+ (* multi-num elmo-multi-divide-number) -;; (car pair)))) -;; (elmo-msgdb-set-number-alist -;; (wl-summary-buffer-msgdb) -;; (nconc -;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)) -;; (list (cons (car pair) nil)))) -;; (setq sum (+ sum (cdr pair))) -;; (setq folder-list (cdr folder-list))) -;; (wl-summary-set-message-modified) -;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) -;; (list 0 -;; (+ wl-summary-buffer-unread-count -;; wl-summary-buffer-new-count) -;; sum)) -;; (message "Dropping...done")))) +;;; Someday +;;;(defun wl-summary-drop-unsync () +;;; "Drop all unsync messages." +;;; (interactive) +;;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name)) +;;; (error "You cannot drop unsync messages in this folder")) +;;; (if (or (not (interactive-p)) +;;; (y-or-n-p "Drop all unsync messages? ")) +;;; (let* ((folder-list (elmo-folder-get-primitive-folder-list +;;; (wl-summary-buffer-folder-name))) +;;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name))) +;;; (sum 0) +;;; (multi-num 0) +;;; pair) +;;; (message "Dropping...") +;;; (while folder-list +;;; (setq pair (elmo-folder-message-numbers (car folder-list))) +;;; (when is-multi ;; dirty hack... +;;; (incf multi-num) +;;; (setcar pair (+ (* multi-num elmo-multi-divide-number) +;;; (car pair)))) +;;; (elmo-msgdb-set-number-alist +;;; (wl-summary-buffer-msgdb) +;;; (nconc +;;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)) +;;; (list (cons (car pair) nil)))) +;;; (setq sum (+ sum (cdr pair))) +;;; (setq folder-list (cdr folder-list))) +;;; (wl-summary-set-message-modified) +;;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name) +;;; (list 0 +;;; (+ wl-summary-buffer-unread-count +;;; wl-summary-buffer-new-count) +;;; 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'." @@ -4908,6 +5103,13 @@ If ASK-CODING is non-nil, coding-system for the message is asked." (wl-message-header-narrowing-toggle) (and wpos (set-window-start mwin wpos))))))) +(defun wl-summary-toggle-mime-buttons () + "Toggle visibility of mime buttons." + (interactive) + (customize-set-value 'mime-view-buttons-visible (not mime-view-buttons-visible)) + (wl-message-buffer-cache-clean-up) + (wl-summary-redisplay)) + (require 'product) (product-provide (provide 'wl-summary) (require 'wl-version))