(require 'elmo)
(require 'elmo-multi)
+(eval-when-compile (require 'elmo-filter))
(require 'wl-message)
(require 'wl-vars)
(require 'wl-highlight)
(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)
(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)
(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)
(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)
(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)
(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)
(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)
(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)
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
(defvar wl-summary-mode-menu-spec
'("Summary"
["Read" wl-summary-read t]
+ ["Edit draft message" wl-summary-reedit :visible (string= (wl-summary-buffer-folder-name) wl-draft-folder)]
["Prev page" wl-summary-prev-page t]
["Next page" wl-summary-next-page t]
["Top" wl-summary-display-top t]
["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)]
()
(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 "f" 'wl-summary-forward)
(define-key wl-summary-mode-map "$" 'wl-summary-mark-as-important)
(define-key wl-summary-mode-map "F" 'wl-summary-set-flags)
+ (define-key wl-summary-mode-map "\M-k" 'wl-summary-toggle-persistent-mark)
(define-key wl-summary-mode-map "&" 'wl-summary-mark-as-answered)
(define-key wl-summary-mode-map "@" 'wl-summary-edit-addresses)
(define-key wl-summary-mode-map "\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)
"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)
(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)))
(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))
(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.
(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))
(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.
(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)
(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)
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
(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
(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)
(wl-summary-window-scroll-functions))
(when wl-summary-buffer-window-scroll-functions
(let ((hook (if wl-on-xemacs 'pre-idle-hook 'window-scroll-functions)))
- (make-local-hook hook)
+ (if (fboundp 'make-local-hook)
+ (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))
+ (if (fboundp 'make-local-hook)
+ (make-local-hook hook))
+ (add-hook hook #'wl-summary-buffer-detach nil t))
;; This hook may contain the function `wl-setup-summary' for reasons
;; of system internal to accord facilities for the Emacs variants.
(run-hooks 'wl-summary-mode-hook))
(defun wl-summary-overview-entity-compare-by-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)
(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."
(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."
(string< (or (car list-info-x) "")
(or (car list-info-y) "")))))
-(defun wl-summary-sort-by-date ()
+(defun wl-summary-define-sort-command ()
+ "Define functions to sort summary lines by `wl-summary-sort-specs'."
(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 ()
- (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)
(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)
(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)
(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)
(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.
(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))))
(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.
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)))
((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
(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
(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)
"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)
(widen)
(y-or-n-p
(format
- "Message from %s has %d bytes. Prefetch it? "
+ "Message from %s has %s bytes. Prefetch it? "
(concat
"[ "
(save-match-data
(or
(elmo-message-entity-field
wl-message-entity
- 'from t)
+ 'from)
"??")))))
" ]")
- size))))
+ (do ((size (/ size 1024.0) (/ size 1024.0))
+ ;; kilo, mega, giga, tera, peta, exa
+ (post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes)))
+ ((< size 1024) (format "%.0f%s" size (car post-fixes))))))))
(message ""))) ; flush.
(if force-read
(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)))))
(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")
(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
(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))))
'important))))
(if (null number-list)
(message "No message.")
- (wl-summary-set-persistent-mark-internal remove 'important 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))
(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)
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
(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)
(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
(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))))
(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))))
(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)
- (if include-specials
- (elmo-uniq-list (append elmo-global-flag-list elmo-preserved-flags))
- (delq 'new (delq 'cached
- (elmo-uniq-list
- (append elmo-global-flag-list
- elmo-preserved-flags
- nil))))))
+ (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 (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)))))
+ (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
(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
(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
(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
(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)
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)
(setq wl-summary-buffer-mode-line
(funcall wl-summary-buffer-mode-line-formatter)))
-(defun wl-summary-jump-to-msg (&optional number)
- (interactive "NJump to Number:")
- (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 ()
(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")
(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)))))
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)
(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)
(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
(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
(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)
(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))
(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))
(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))
(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)))
(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))))
(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))
(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))
(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
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)))))))
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))
(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))
(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)
(let ((inhibit-read-only t)
(buffer-read-only nil))
(move-to-column wl-summary-buffer-temp-mark-column)
- (delete-backward-char 1)
+ (delete-char -1)
(insert mark)))))
(defun wl-summary-next-buffer ()
(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)
(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)
(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)
(defun wl-summary-target-mark-set-flags (&optional remove)
(interactive "P")
+ (wl-summary-check-target-mark)
(save-excursion
(let ((inhibit-read-only t)
(buffer-read-only nil)
(wl-summary-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))
(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-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
(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
(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)
no-modeline-update))
(defsubst wl-summary-set-persistent-mark-internal (inverse
- &optional flag
- number-or-numbers
+ flag
+ &optional number-or-numbers
no-modeline-update
- no-server)
+ 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))
(list number))))
(if (null number-list)
(message "No message.")
- (if inverse
- (elmo-folder-unset-flag folder number-list flag no-server)
- (elmo-folder-set-flag folder number-list flag no-server))
- (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
(let ((completion-ignore-case t))
(setq flag (intern (downcase
(completing-read
- "Flag: "
+ "Mark name: "
(mapcar (lambda (flag)
(list (capitalize (symbol-name flag))))
(wl-summary-get-available-flags))
flag
number-or-numbers
no-modeline-update
- no-server))
+ no-server
+ (interactive-p)))
(defun wl-summary-set-persistent-mark (&optional flag
number-or-numbers
(let ((completion-ignore-case t))
(setq flag (intern (downcase
(completing-read
- "Flag: "
+ "Mark name: "
(mapcar (lambda (flag)
(list (capitalize (symbol-name flag))))
(wl-summary-get-available-flags))
flag
number-or-numbers
no-modeline-update
- no-server))
+ no-server
+ (interactive-p)))
+
+(defun wl-summary-toggle-persistent-mark (&optional force)
+ "Toggle persistent mark."
+ (interactive "P")
+ (let ((completion-ignore-case t)
+ flag)
+ (setq flag (intern (downcase
+ (completing-read
+ "Mark name: "
+ (mapcar (lambda (flag)
+ (list (capitalize (symbol-name flag))))
+ (wl-summary-get-available-flags))
+ nil
+ 'require-match))))
+ (if (and (elmo-message-flagged-p wl-summary-buffer-elmo-folder
+ (wl-summary-message-number)
+ flag)
+ (not force))
+ (wl-summary-unset-persistent-mark flag)
+ (wl-summary-set-persistent-mark flag))))
(defun wl-summary-mark-as-answered (&optional number-or-numbers
no-modeline-update)
'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)
"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))
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))
(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)))
(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 (&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-set-persistent-mark-internal
(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)
(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)
"")))
(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)))
"")))
;;; 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
(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
(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))
(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))))))
(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
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 th message."
+Otherwise it shows previous line of the message."
(interactive "P")
(cond ((numberp arg)
- (unless (wl-summary-jump-to-msg arg)
+ (unless (wl-thread-jump-to-msg arg)
(message "Message (#%d) was not found." arg)))
(arg
(wl-summary-prev-line-content))
(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)
(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
(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))))
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))
(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)
(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"))
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
(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)))
(number (wl-summary-message-number))
(summary-buf (current-buffer))
(wl-draft-forward t)
- mes-buf
entity subject num)
(if (null number)
(message "No message.")
;; 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
(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)
"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))))
(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."))))
(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)
- 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)))
-
+ (setq filename (concat (number-to-string num) wl-summary-save-file-suffix))
+ (when (or (null arg)
+ (file-exists-p filename))
+ (setq filename (expand-file-name (read-file-name "Save to file: " wl-save-dir nil nil 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))
(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))))
(interactive (list current-prefix-arg nil))
(if (null wl-summary-buffer-target-mark-list)
(message "No marked message.")
- (setq command (read-string "Shell command on each marked message: "
- wl-summary-shell-command-last))
+ (setq command (wl-read-shell-command
+ "Shell command on each marked message: "
+ wl-summary-shell-command-last))
(when (y-or-n-p "Send each marked message to pipe? ")
(while (car wl-summary-buffer-target-mark-list)
(let ((num (car wl-summary-buffer-target-mark-list)))
wl-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)
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))
(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
(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*"))
(unwind-protect
(let ((decode-dir wl-temporary-file-directory))
(if (not wl-prog-uudecode-no-stdout-option)
- (setq filename (read-file-name "Save to file: "
- (expand-file-name
- (elmo-safe-filename filename)
- wl-temporary-file-directory)))
+ (setq filename (expand-file-name (read-file-name "Save to file: " wl-temporary-file-directory nil nil (elmo-safe-filename))))
(setq decode-dir
(wl-read-directory-name "Save to directory: "
wl-temporary-file-directory))
(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'."
(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))
projects / elisp / wanderlust.git / blobdiff