(require 'elmo)
(require 'elmo-multi)
+(eval-when-compile (require 'elmo-filter))
(require 'wl-message)
(require 'wl-vars)
(require 'wl-highlight)
(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)
(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)
(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
["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)]
;; 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 "\C-c\C-n" 'wl-summary-next-buffer)
(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)
(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 (or (null (get-text-property (point) 'face))
(wl-summary-persistent-mark-invalid-p))
- (setq number (wl-summary-message-number))
- (when number
- (setq 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))
+ (wl-summary-update-persistent-mark (wl-summary-message-number)))
(forward-line 1)))))
(set-buffer-modified-p nil)))
;; Handler of event from elmo-folder
(defun wl-summary-update-persistent-mark-on-event (buffer numbers)
- (save-excursion
- (set-buffer buffer)
- (if wl-summary-lazy-update-mark
- (let ((window-list (get-buffer-window-list (current-buffer) 'nomini t))
- invalidate)
- (dolist (number numbers)
- (when (wl-summary-message-visible-p number)
- (if (catch 'visible
- (let ((window-list window-list)
- win)
- (while (setq win (car window-list))
- (when (wl-summary-jump-to-msg number
- (window-start win)
- (window-end win))
- (throw 'visible t))
- (setq window-list (cdr window-list)))))
- (wl-summary-update-persistent-mark number)
- (setq invalidate t))))
- (when invalidate
- (wl-summary-invalidate-persistent-mark)
- (dolist (win window-list)
- (wl-summary-validate-persistent-mark
- (window-start win)
- (window-end win)))))
- (dolist (number numbers)
- (when (and (wl-summary-message-visible-p number)
- (wl-summary-jump-to-msg number))
- (wl-summary-update-persistent-mark number))))))
+ (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
(wl-summary-update-persistent-mark-on-event buffer numbers)))
(elmo-connect-signal
wl-summary-buffer-elmo-folder
- 'cache-changed
+ 'status-changed
(current-buffer)
- (elmo-define-signal-handler (buffer folder number)
- (wl-summary-update-persistent-mark-on-event buffer (list number))))
+ (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
(when (and (eq major-mode 'wl-summary-mode)
wl-summary-buffer-elmo-folder)
(elmo-disconnect-signal 'flag-changed (current-buffer))
- (elmo-disconnect-signal 'cache-changed (current-buffer))
+ (elmo-disconnect-signal 'status-changed (current-buffer))
(elmo-disconnect-signal 'update-overview (current-buffer))))
(defun wl-status-update ()
(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)
(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 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)
(when (boundp 'show-trailing-whitespace)
(setq show-trailing-whitespace nil))
-;;;(make-local-variable 'tab-width)
-;;;(setq tab-width 1)
+;;; (make-local-variable 'tab-width)
+;;; (setq tab-width 1)
(buffer-disable-undo (current-buffer))
(setq selective-display t
selective-display-ellipses nil)
(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<
- (or (elmo-message-entity-field x 'from t)
+ (or (elmo-message-entity-field x 'from)
wl-summary-no-from-message)
- (or (elmo-message-entity-field y 'from t)
+ (or (elmo-message-entity-field y 'from)
wl-summary-no-from-message)))
(defun wl-summary-overview-entity-compare-by-subject (x y)
(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 (reverse)
- "Sort summary lines into the order by message date; argument means descending order."
- (interactive "P")
- (wl-summary-rescan "date" reverse))
-(defun wl-summary-sort-by-number (reverse)
- "Sort summary lines into the order by message number; argument means descending order."
- (interactive "P")
- (wl-summary-rescan "number" reverse))
-(defun wl-summary-sort-by-subject (reverse)
- "Sort summary lines into the order by subject; argument means descending order."
- (interactive "P")
- (wl-summary-rescan "subject" reverse))
-(defun wl-summary-sort-by-from (reverse)
- "Sort summary lines into the order by from; argument means descending order."
- (interactive "P")
- (wl-summary-rescan "from" reverse))
-(defun wl-summary-sort-by-list-info (reverse)
- "Sort summary lines into the order by mailing list info; argument means descending order."
- (interactive "P")
- (wl-summary-rescan "list-info" reverse))
-(defun wl-summary-sort-by-size (reverse)
- "Sort summary lines into the order by message size; argument means descending order."
- (interactive "P")
- (wl-summary-rescan "size" reverse))
+(defun wl-summary-define-sort-command ()
+ "Define functions to sort summary lines by `wl-summary-sort-specs'."
+ (interactive)
+ (dolist (sort-by wl-summary-sort-specs)
+ (fset (intern (format "wl-summary-sort-by-%s" sort-by))
+ `(lambda (&optional reverse)
+ ,(format "\
+Sort summary lines into the order by %s.
+If optional argument REVERSE is non-nil, sort into descending order.
+
+This function is defined by `wl-summary-define-sort-command'." sort-by)
+ (interactive "P")
+ (wl-summary-rescan ,(symbol-name sort-by) reverse)))))
+
+(defun wl-summary-sort-function-from-spec (spec reverse)
+ (let (function)
+ (when (string-match "^!\\(.+\\)$" spec)
+ (setq spec (match-string 1 spec)
+ reverse (not reverse)))
+ (setq function
+ (intern (format "wl-summary-overview-entity-compare-by-%s" spec)))
+ (if reverse
+ `(lambda (x y) (not (,function x y)))
+ function)))
+
+(defun wl-summary-sort-messages (numbers sort-by reverse)
+ (let* ((functions (mapcar
+ (lambda (spec)
+ (wl-summary-sort-function-from-spec spec reverse))
+ (if (listp sort-by) sort-by (list sort-by))))
+ (predicate (if (= (length functions) 1)
+ (car functions)
+ (lambda (x y)
+ (let ((functions functions))
+ (catch 'done
+ (dolist (function functions)
+ (when (funcall function x y)
+ (throw 'done t))
+ (when (funcall function y x)
+ (throw 'done nil)))))))))
+ (mapcar #'elmo-message-entity-number
+ (sort (mapcar (lambda (number)
+ (elmo-message-entity
+ wl-summary-buffer-elmo-folder
+ number))
+ numbers)
+ predicate))))
(defun wl-summary-rescan (&optional sort-by reverse disable-killed disable-thread)
"Rescan current folder without updating."
(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))))
- (sort-label (if reverse "Reverse sorting" "Sorting"))
- (i 0)
num
expunged)
(erase-buffer)
(message "Re-scanning...")
- (when sort-by
- (message "%s by %s..." sort-label 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)))))
- (if reverse (setq numbers (nreverse numbers)))
- (message "%s by %s...done" sort-label 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-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)
(defun wl-summary-rescan-message (number &optional reparent)
"Rescan current message without updating."
- (interactive (list (wl-summary-message-number)))
+ (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)
(inhibit-read-only t))
(if (eq wl-summary-buffer-view 'thread)
(let* ((thread-entity (wl-thread-get-entity number))
- (descendant (wl-thread-entity-get-descendant thread-entity))
(thread-parent (wl-thread-entity-get-parent thread-entity))
(entity-parent (elmo-message-entity-number
(elmo-message-entity-parent folder entity)))
(progn
(wl-thread-entity-set-linked thread-entity nil)
(wl-thread-update-line-on-buffer-sub nil number))
- (wl-thread-delete-message number 'deep 'update)
- (dolist (number (cons number descendant))
- (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)))))
+ (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-flags folder number)
- (elmo-message-cached-p folder number)))))
+ (elmo-message-status folder number)))))
(when (and wl-summary-buffer-disp-msg
wl-summary-buffer-current-msg)
(save-excursion
(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)
(setq fields (cdr fields)))
(setq candidates (elmo-uniq-list candidates))
(elmo-with-enable-multibyte
- (mapcar (function
- (lambda (x)
- (setq components (std11-extract-address-components x))
- (cons (nth 1 components)
- (and (car components)
- (eword-decode-string
- (decode-mime-charset-string
- (car components)
- mime-charset))))))
- candidates))))
+ (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)
(or
(elmo-message-entity-field
wl-message-entity
- 'from t)
+ 'from)
"??")))))
" ]")
size))))
(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
(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))
(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))))
(defun wl-summary-sort (reverse)
"Sort summary lines into the selected order; argument means descending order."
(interactive "P")
- (wl-summary-rescan
- (completing-read
- (format "%s by (%s): "
- (if reverse "Reverse sort" "Sort")
- (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))
- reverse))
+ (let ((default-value (symbol-name wl-summary-default-sort-spec)))
+ (wl-summary-rescan
+ (wl-completing-read-multiple
+ (format "%s by (%s): " (if reverse "Reverse sort" "Sort") default-value)
+ (nconc
+ (mapcar (lambda (spec) (list (symbol-name spec)))
+ wl-summary-sort-specs)
+ (mapcar (lambda (spec) (list (concat "!" (symbol-name spec))))
+ wl-summary-sort-specs))
+ nil t nil nil
+ default-value)
+ reverse)))
(defun wl-summary-get-available-flags (&optional include-specials)
(let ((flags (elmo-uniq-list
(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
(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
- (elmo-message-entity-field entity 'message-id)
- (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)
(funcall wl-summary-buffer-mode-line-formatter)))
(defun wl-summary-jump-to-msg (&optional number beg end)
- (interactive "NJump to Number:")
- (let ((num (or number
- (string-to-int
- (read-from-minibuffer "Jump to Message(No.): "))))
- (pos (point))
- regexp)
- (setq regexp (concat "\r" (int-to-string num) "[^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))))
+ (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 ()
(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-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
'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)
(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))))
(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)))))))
(setq wl-summary-buffer-persistent-mark-version
(1+ wl-summary-buffer-persistent-mark-version)))
-(defsubst wl-summary-persistent-mark-string (folder flags cached)
+(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 (and (boundp var)
- (symbol-value 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-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)
(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)
(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)))
- (prog1
- (unless (string= new-mark mark)
- (delete-backward-char 1)
- (insert new-mark)
- (wl-summary-set-message-modified)
- t)
- (wl-summary-validate-persistent-mark (point-at-bol)
- (point-at-eol))))))
- (when wl-summary-highlight
- (wl-highlight-summary-current-line))
- (set-buffer-modified-p nil)))
+ (let ((status (wl-summary-message-status number)))
+ (prog1
+ (when wl-summary-buffer-persistent-mark-column
+ (save-excursion
+ (move-to-column wl-summary-buffer-persistent-mark-column)
+ (let ((inhibit-read-only t)
+ (buffer-read-only nil)
+ (mark (buffer-substring (- (point) 1) (point)))
+ (new-mark (wl-summary-persistent-mark number status)))
+ (prog1
+ (unless (string= new-mark mark)
+ (delete-backward-char 1)
+ (insert new-mark)
+ (wl-summary-set-message-modified)
+ t)
+ (wl-summary-validate-persistent-mark (point-at-bol)
+ (point-at-eol))))))
+ (when wl-summary-highlight
+ (wl-highlight-summary-current-line number status))
+ (set-buffer-modified-p nil))))
(defsubst wl-summary-mark-as-read-internal (inverse
number-or-numbers
'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
(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))
(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
(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)))
(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))
(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)))
(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
(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 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)
(if num
(save-excursion
(setq filename (expand-file-name
- (concat (int-to-string num)
+ (concat (number-to-string num)
wl-summary-save-file-suffix)
wl-save-dir))
(when (or (null arg)
(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-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))
(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