-;;; wl-summary.el -- Summary mode for Wanderlust.
+;;; wl-summary.el --- Summary mode for Wanderlust.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;;; Code:
;;
-(require 'elmo2)
+(require 'elmo)
(require 'elmo-multi)
(require 'wl-message)
(require 'wl-vars)
(defvar wl-summary-mode-map nil)
(defvar wl-current-summary-buffer nil)
-(defvar wl-summary-buffer-msgdb nil)
-(defvar wl-summary-buffer-folder-name nil)
-(defvar wl-summary-buffer-folder-indicator 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))))
+
+(defmacro wl-summary-buffer-msgdb ()
+ (` (and wl-summary-buffer-elmo-folder
+ (elmo-folder-msgdb wl-summary-buffer-elmo-folder))))
+
(defvar wl-summary-buffer-disp-msg nil)
(defvar wl-summary-buffer-disp-folder nil)
(defvar wl-summary-buffer-refile-list nil)
(defvar wl-summary-buffer-delete-list nil)
(defvar wl-summary-buffer-last-displayed-msg nil)
(defvar wl-summary-buffer-current-msg nil)
-(defvar wl-summary-buffer-unread-status " (0 new/0 unread)")
(defvar wl-summary-buffer-unread-count 0)
(defvar wl-summary-buffer-new-count 0)
(defvar wl-summary-buffer-mime-charset nil)
(defvar wl-summary-buffer-weekday-name-lang nil)
(defvar wl-summary-buffer-thread-indent-set-alist nil)
-(defvar wl-summary-buffer-message-redisplay-func nil)
-(defvar wl-summary-buffer-view 'thread)
+(defvar wl-summary-buffer-view nil)
(defvar wl-summary-buffer-message-modified nil)
(defvar wl-summary-buffer-mark-modified nil)
(defvar wl-summary-buffer-thread-modified nil)
+
(defvar wl-summary-buffer-number-column nil)
-(defvar wl-summary-buffer-number-regexp nil)
+(defvar wl-summary-buffer-temp-mark-column nil)
+(defvar wl-summary-buffer-persistent-mark-column nil)
+
(defvar wl-summary-buffer-persistent nil)
(defvar wl-summary-buffer-thread-nodes nil)
(defvar wl-summary-buffer-target-mark-list nil)
(defvar wl-summary-buffer-prev-refile-destination nil)
(defvar wl-summary-buffer-prev-copy-destination nil)
(defvar wl-summary-buffer-saved-message nil)
-(defvar wl-summary-buffer-prev-folder-func nil)
-(defvar wl-summary-buffer-next-folder-func nil)
-(defvar wl-summary-buffer-exit-func nil)
+(defvar wl-summary-buffer-prev-folder-function nil)
+(defvar wl-summary-buffer-next-folder-function nil)
+(defvar wl-summary-buffer-exit-function nil)
+(defvar wl-summary-buffer-next-message-function nil)
+(defvar wl-summary-buffer-number-list nil)
+(defvar wl-summary-buffer-msgdb nil)
+(defvar wl-summary-buffer-folder-name nil)
+(defvar wl-summary-buffer-line-formatter nil)
+(defvar wl-summary-buffer-line-format nil)
+(defvar wl-summary-buffer-mode-line-formatter nil)
+(defvar wl-summary-buffer-mode-line nil)
+
(defvar wl-thread-indent-level-internal nil)
(defvar wl-thread-have-younger-brother-str-internal nil)
(defvar wl-thread-youngest-child-str-internal nil)
(defvar wl-summary-alike-hashtb nil)
(defvar wl-summary-search-buf-name " *wl-search-subject*")
(defvar wl-summary-delayed-update nil)
+(defvar wl-summary-search-buf-folder-name nil)
-(defvar wl-summary-get-petname-func 'wl-address-get-petname-1)
-
-(defvar wl-summary-message-regexp "^ *\\([0-9]+\\)")
+(defvar wl-summary-get-petname-function 'wl-address-get-petname-1)
(defvar wl-summary-shell-command-last "")
(defvar wl-ps-preprint-hook nil)
(defvar wl-ps-print-hook nil)
-(make-variable-buffer-local 'wl-summary-buffer-msgdb)
+(make-variable-buffer-local 'wl-summary-buffer-elmo-folder)
+(make-variable-buffer-local 'wl-summary-search-buf-folder-name)
(make-variable-buffer-local 'wl-summary-buffer-disp-msg)
(make-variable-buffer-local 'wl-summary-buffer-disp-folder)
(make-variable-buffer-local 'wl-summary-buffer-refile-list)
(make-variable-buffer-local 'wl-summary-buffer-copy-list)
(make-variable-buffer-local 'wl-summary-buffer-target-mark-list)
(make-variable-buffer-local 'wl-summary-buffer-delete-list)
-(make-variable-buffer-local 'wl-summary-buffer-folder-name)
-(make-variable-buffer-local 'wl-summary-buffer-folder-indicator)
(make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg)
-(make-variable-buffer-local 'wl-summary-buffer-unread-status)
(make-variable-buffer-local 'wl-summary-buffer-unread-count)
(make-variable-buffer-local 'wl-summary-buffer-new-count)
(make-variable-buffer-local 'wl-summary-buffer-mime-charset)
(make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang)
(make-variable-buffer-local 'wl-summary-buffer-thread-indent-set)
-(make-variable-buffer-local 'wl-summary-buffer-message-redisplay-func)
(make-variable-buffer-local 'wl-summary-buffer-view)
(make-variable-buffer-local 'wl-summary-buffer-message-modified)
(make-variable-buffer-local 'wl-summary-buffer-mark-modified)
(make-variable-buffer-local 'wl-summary-buffer-thread-modified)
(make-variable-buffer-local 'wl-summary-buffer-number-column)
-(make-variable-buffer-local 'wl-summary-buffer-number-regexp)
+(make-variable-buffer-local 'wl-summary-buffer-temp-mark-column)
+(make-variable-buffer-local 'wl-summary-buffer-persistent-mark-column)
(make-variable-buffer-local 'wl-summary-buffer-persistent)
(make-variable-buffer-local 'wl-summary-buffer-thread-nodes)
(make-variable-buffer-local 'wl-summary-buffer-prev-refile-destination)
(make-variable-buffer-local 'wl-thread-vertical-str-internal)
(make-variable-buffer-local 'wl-thread-horizontal-str-internal)
(make-variable-buffer-local 'wl-thread-space-str-internal)
-(make-variable-buffer-local 'wl-summary-buffer-prev-folder-func)
-(make-variable-buffer-local 'wl-summary-buffer-next-folder-func)
-(make-variable-buffer-local 'wl-summary-buffer-exit-func)
+(make-variable-buffer-local 'wl-summary-buffer-prev-folder-function)
+(make-variable-buffer-local 'wl-summary-buffer-next-folder-function)
+(make-variable-buffer-local 'wl-summary-buffer-exit-function)
+(make-variable-buffer-local 'wl-summary-buffer-next-message-function)
+(make-variable-buffer-local 'wl-summary-buffer-number-list)
+(make-variable-buffer-local 'wl-summary-buffer-msgdb)
+(make-variable-buffer-local 'wl-summary-buffer-folder-name)
+(make-variable-buffer-local 'wl-summary-buffer-line-formatter)
+(make-variable-buffer-local 'wl-summary-buffer-line-format)
+(make-variable-buffer-local 'wl-summary-buffer-mode-line-formatter)
+(make-variable-buffer-local 'wl-summary-buffer-mode-line)
+
+(defvar wl-datevec)
+(defvar wl-thr-indent-string)
+(defvar wl-thr-children-number)
+(defvar wl-thr-linked)
+(defvar wl-message-entity)
+(defvar wl-parent-message-entity)
+(defvar wl-temp-mark)
+(defvar wl-persistent-mark)
;; internal functions (dummy)
(unless (fboundp 'wl-summary-append-message-func-internal)
- (defun wl-summary-append-message-func-internal (entity overview
- mark-alist update
+ (defun wl-summary-append-message-func-internal (entity msgdb update
&optional force-insert)))
-(unless (fboundp 'wl-summary-from-func-internal)
- (defun wl-summary-from-func-internal (from)
- from))
-(unless (fboundp 'wl-summary-subject-func-internal)
- (defun wl-summary-subject-func-internal (subject)
- subject))
-(unless (fboundp 'wl-summary-subject-filter-func-internal)
- (defun wl-summary-subject-filter-func-internal (subject)
- subject))
-
-(defmacro wl-summary-sticky-buffer-name (folder)
- (` (concat wl-summary-buffer-name ":" (, folder))))
+
+(defmacro 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)
(substring subject-string (match-end 0))
subject-string))
-(eval-when-compile (defvar-maybe entity nil)) ; silence byte compiler.
(defun wl-summary-default-from (from)
+ "Instance of `wl-summary-from-function'.
+Ordinarily returns the sender name. Returns recipient names if (1)
+summary's folder name matches with `wl-summary-showto-folder-regexp'
+and (2) sender address is yours.
+
+See also variable `wl-use-petname'."
(let (retval tos ng)
(unless
(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-summary-buffer-folder-name))
(wl-address-user-mail-address-p from)
(cond
- ((and (setq tos (elmo-msgdb-overview-entity-get-to entity))
+ ((and (setq tos (elmo-msgdb-overview-entity-get-to
+ wl-message-entity))
(not (string= "" tos)))
(setq retval
(concat "To:"
(eword-decode-string
(if wl-use-petname
(or
- (funcall wl-summary-get-petname-func to)
+ (funcall
+ wl-summary-get-petname-function to)
(car
(std11-extract-address-components to))
to)
(wl-parse-addresses tos)
","))))
((setq ng (elmo-msgdb-overview-entity-get-extra-field
- entity "newsgroups"))
+ wl-message-entity "newsgroups"))
(setq retval (concat "Ng:" ng)))))
(if wl-use-petname
- (setq retval (or (funcall wl-summary-get-petname-func from)
+ (setq retval (or (funcall wl-summary-get-petname-function from)
(car (std11-extract-address-components from))
from))
(setq retval from)))
(defun wl-summary-simple-from (string)
(if wl-use-petname
- (or (funcall wl-summary-get-petname-func string)
+ (or (funcall wl-summary-get-petname-function string)
(car (std11-extract-address-components string))
string)
string))
+(defvar wl-summary-sort-specs '(number date subject from list-info))
+(defvar wl-summary-default-sort-spec 'date)
+
(defvar wl-summary-mode-menu-spec
'("Summary"
["Read" wl-summary-read t]
["By Number" wl-summary-sort-by-number t]
["By Date" wl-summary-sort-by-date t]
["By From" wl-summary-sort-by-from t]
- ["By Subject" wl-summary-sort-by-subject t])
+ ["By Subject" wl-summary-sort-by-subject t]
+ ["By List Info" wl-summary-sort-by-list-info t])
"----"
("Message Operation"
["Mark as read" wl-summary-mark-as-read t]
"----"
("Writing Messages"
["Write a message" wl-summary-write t]
+ ["Write for current folder" wl-summary-write-current-folder t]
["Reply" wl-summary-reply t]
["Reply with citation" wl-summary-reply-with-citation t]
["Forward" wl-summary-forward t])
(define-key wl-summary-mode-map [(shift button5)]
'wl-summary-down)
(define-key wl-summary-mode-map 'button2 'wl-summary-click))
- (if wl-on-nemacs
- (defun wl-summary-setup-mouse ())
- (defun wl-summary-setup-mouse ()
- (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev)
- (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next)
- (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up)
- (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down)
- (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click))))
+ (defun wl-summary-setup-mouse ()
+ (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev)
+ (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next)
+ (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up)
+ (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down)
+ (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click)))
(if wl-summary-mode-map
()
(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)
- (unless wl-on-nemacs
- (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page))
+ (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page)
(define-key wl-summary-mode-map "\r" 'wl-summary-next-line-content)
(define-key wl-summary-mode-map "\C-m" 'wl-summary-next-line-content)
(define-key wl-summary-mode-map "/" 'wl-thread-open-close)
(define-key wl-summary-mode-map "-" 'wl-summary-prev-line-content)
(define-key wl-summary-mode-map "\e\r" 'wl-summary-prev-line-content)
(define-key wl-summary-mode-map "g" 'wl-summary-goto-folder)
+ (define-key wl-summary-mode-map "G" 'wl-summary-goto-folder-sticky)
(define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all)
- (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync)
(define-key wl-summary-mode-map "a" 'wl-summary-reply)
(define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation)
(define-key wl-summary-mode-map "p" 'wl-summary-prev)
(define-key wl-summary-mode-map "N" 'wl-summary-down)
(define-key wl-summary-mode-map "P" 'wl-summary-up)
-;;;(define-key wl-summary-mode-map "w" 'wl-draft)
(define-key wl-summary-mode-map "w" 'wl-summary-write)
(define-key wl-summary-mode-map "W" 'wl-summary-write-current-folder)
-;;;(define-key wl-summary-mode-map "e" 'wl-draft-open-file)
(define-key wl-summary-mode-map "e" 'wl-summary-save)
(define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
+ (define-key wl-summary-mode-map "\C-c\C-a" 'wl-addrmgr)
+ (define-key wl-summary-mode-map "\C-c\C-p" 'wl-summary-previous-buffer)
+ (define-key wl-summary-mode-map "\C-c\C-n" 'wl-summary-next-buffer)
(define-key wl-summary-mode-map "H" 'wl-summary-redisplay-all-header)
(define-key wl-summary-mode-map "M" 'wl-summary-redisplay-no-mime)
(define-key wl-summary-mode-map "B" 'wl-summary-burst)
(define-key wl-summary-mode-map "Z" 'wl-status-update)
(define-key wl-summary-mode-map "#" 'wl-summary-print-message)
(define-key wl-summary-mode-map "|" 'wl-summary-pipe-message)
+ (define-key wl-summary-mode-map "z" 'wl-summary-suspend)
(define-key wl-summary-mode-map "q" 'wl-summary-exit)
(define-key wl-summary-mode-map "Q" 'wl-summary-force-exit)
(define-key wl-summary-mode-map "d" 'wl-summary-delete)
(define-key wl-summary-mode-map "u" 'wl-summary-unmark)
(define-key wl-summary-mode-map "U" 'wl-summary-unmark-all)
+ (define-key wl-summary-mode-map "D" 'wl-summary-erase)
;; thread commands
(define-key wl-summary-mode-map "t" (make-sparse-keymap))
(define-key wl-summary-mode-map "mA" 'wl-summary-target-mark-reply-with-citation)
(define-key wl-summary-mode-map "mf" 'wl-summary-target-mark-forward)
(define-key wl-summary-mode-map "m?" 'wl-summary-target-mark-pick)
+ (define-key wl-summary-mode-map "m#" 'wl-summary-target-mark-print)
+ (define-key wl-summary-mode-map "m|" 'wl-summary-target-mark-pipe)
;; region commands
(define-key wl-summary-mode-map "r" (make-sparse-keymap))
(define-key wl-summary-mode-map "\M-t" 'wl-toggle-plugged)
(define-key wl-summary-mode-map "\C-t" 'wl-plugged-change)
;;
+ (define-key wl-summary-mode-map "\C-x\C-s" 'wl-summary-save-status)
(wl-summary-setup-mouse)
(easy-menu-define
wl-summary-mode-menu
(defun wl-summary-display-top ()
(interactive)
(goto-char (point-min))
+ (when wl-summary-lazy-highlight
+ (wl-highlight-summary-window))
(if wl-summary-buffer-disp-msg
(wl-summary-redisplay)))
(interactive)
(goto-char (point-max))
(forward-line -1)
+ (when wl-summary-lazy-highlight
+ (wl-highlight-summary-window))
(if wl-summary-buffer-disp-msg
(wl-summary-redisplay)))
-(defun wl-summary-collect-unread (mark-alist &optional folder)
- (let (mark ret-val)
- (while mark-alist
- (setq mark (cadr (car mark-alist)))
- (and mark
- (or (string= mark wl-summary-new-mark)
- (string= mark wl-summary-unread-uncached-mark)
- (string= mark wl-summary-unread-cached-mark))
- (setq ret-val (cons (car (car mark-alist)) ret-val)))
- (setq mark-alist (cdr mark-alist)))
- ret-val))
-
-(defun wl-summary-count-unread (mark-alist &optional folder)
- (let ((new 0)
- (unread 0)
- mark)
- (while mark-alist
- (setq mark (cadr (car mark-alist)))
- (and mark
- (cond
- ((string= mark wl-summary-new-mark)
- (setq new (+ 1 new)))
- ((or (string= mark wl-summary-unread-uncached-mark)
- (string= mark wl-summary-unread-cached-mark))
- (setq unread (+ 1 unread)))))
- (setq mark-alist (cdr mark-alist)))
+(defun wl-summary-count-unread ()
+ (let ((pair
+ (elmo-msgdb-count-marks (wl-summary-buffer-msgdb)
+ wl-summary-new-mark
+ (list wl-summary-unread-uncached-mark
+ wl-summary-unread-cached-mark))))
(if (eq major-mode 'wl-summary-mode)
- (setq wl-summary-buffer-new-count new
- wl-summary-buffer-unread-count unread))
- (+ new unread)))
+ (setq wl-summary-buffer-new-count (car pair)
+ wl-summary-buffer-unread-count (cdr pair)))
+ pair))
+
+(defun wl-summary-message-string (&optional use-cache)
+ "Return full body string of current message.
+If optional USE-CACHE is non-nil, use cache if exists."
+ (let ((number (wl-summary-message-number))
+ (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)))))
(defun wl-summary-reedit (&optional arg)
"Re-edit current message.
If ARG is non-nil, Supersedes message"
(interactive "P")
+ (wl-summary-toggle-disp-msg 'off)
(if arg
(wl-summary-supersedes-message)
- (if (string= wl-summary-buffer-folder-name wl-draft-folder)
- (if (wl-summary-message-number)
- (unwind-protect
- (wl-draft-reedit (wl-summary-message-number))
- (if (wl-message-news-p)
- (mail-position-on-field "Newsgroups")
- (mail-position-on-field "To"))
- (delete-other-windows)))
- (save-excursion
- (let ((mmelmo-force-fetch-entire-message t))
- (if (null (wl-summary-message-number))
- (message "No message.")
- (wl-summary-set-message-buffer-or-redisplay)
- (set-buffer (wl-message-get-original-buffer))
- (wl-draft-edit-string (buffer-substring (point-min)
- (point-max)))))))))
+ (if (string= (wl-summary-buffer-folder-name) wl-draft-folder)
+ (when (wl-summary-message-number)
+ (wl-draft-reedit (wl-summary-message-number))
+ (if (wl-message-news-p)
+ (mail-position-on-field "Newsgroups")
+ (mail-position-on-field "To")))
+ (wl-draft-edit-string (wl-summary-message-string)))))
(defun wl-summary-resend-bounced-mail ()
"Re-mail the current message.
contains some mail you have written but has been bounced back to
you."
(interactive)
+ (wl-summary-toggle-disp-msg 'off)
(save-excursion
- (let ((mmelmo-force-fetch-entire-message t))
- (wl-summary-set-message-buffer-or-redisplay)
- (set-buffer (wl-message-get-original-buffer))
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (cond
- ((and
- (re-search-forward
- (concat "^\\($\\|[Cc]ontent-[Tt]ype:[ \t]+multipart/report\\)") nil t)
- (not (bolp))
- (re-search-forward "boundary=\"\\([^\"]+\\)\"" nil t))
- (let ((boundary (buffer-substring (match-beginning 1) (match-end 1)))
- start)
- (cond
- ((and (setq start (re-search-forward
- (concat "^--" boundary "\n"
- "[Cc]ontent-[Tt]ype:[ \t]+"
- "\\(message/rfc822\\|text/rfc822-headers\\)\n"
- "\\(.+\n\\)*\n") nil t))
- (re-search-forward
- (concat "\n\\(--" boundary "\\)--\n") nil t))
- (wl-draft-edit-string (buffer-substring start (match-beginning 1))))
- (t
- (message "Seems no message/rfc822 part.")))))
- ((let ((case-fold-search t))
- (re-search-forward wl-rejected-letter-start nil t))
- (skip-chars-forward " \t\n")
- (wl-draft-edit-string (buffer-substring (point) (point-max))))
- (t
- (message "Does not appear to be a rejected letter.")))))))
+ (wl-summary-set-message-buffer-or-redisplay)
+ (set-buffer (wl-message-get-original-buffer))
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (cond
+ ((and
+ (re-search-forward
+ (concat "^\\($\\|[Cc]ontent-[Tt]ype:[ \t]+multipart/\\(report\\|mixed\\)\\)") nil t)
+ (not (bolp))
+ (re-search-forward "boundary=\"\\([^\"]+\\)\"" nil t))
+ (let ((boundary (buffer-substring (match-beginning 1) (match-end 1)))
+ start)
+ (cond
+ ((and (setq start (re-search-forward
+ (concat "^--" boundary "\n"
+ "\\([Cc]ontent-[Dd]escription:.*\n\\)?"
+ "[Cc]ontent-[Tt]ype:[ \t]+"
+ "\\(message/rfc822\\|text/rfc822-headers\\).*\n"
+ "\\(.+\n\\)*\n") nil t))
+ (re-search-forward
+ (concat "\n\\(--" boundary "\\)--\n") nil t))
+ (wl-draft-edit-string (buffer-substring start (match-beginning 1))))
+ (t
+ (message "Seems no message/rfc822 part.")))))
+ ((let ((case-fold-search t))
+ (re-search-forward wl-rejected-letter-start nil t))
+ (skip-chars-forward " \t\n")
+ (wl-draft-edit-string (buffer-substring (point) (point-max))))
+ (t
+ (message "Does not appear to be a rejected letter."))))))
(defun wl-summary-resend-message (address)
"Resend the current message to ADDRESS."
(message "No address specified.")
(message "Resending message to %s..." address)
(save-excursion
- (let ((mmelmo-force-fetch-entire-message t))
- (wl-summary-set-message-buffer-or-redisplay)
+ (let ((original (wl-summary-get-original-buffer)))
;; We first set up a normal mail buffer.
(set-buffer (get-buffer-create " *wl-draft-resend*"))
(buffer-disable-undo (current-buffer))
(delete-region (point) (point-max))
(let ((beg (point)))
;; Insert the message to be resent.
- (insert-buffer-substring (wl-message-get-original-buffer))
+ (insert-buffer-substring original)
(goto-char (point-min))
(search-forward "\n\n")
(forward-char -1)
(kill-buffer (current-buffer)))
(message "Resending message to %s...done" address))))
-(defun wl-summary-msgdb-load-async (folder)
- "Loading msgdb and selecting FOLDER is executed asynchronously in IMAP4."
- (if (and (elmo-folder-plugged-p folder)
- (eq (elmo-folder-get-type folder) 'imap4))
- (let ((spec (elmo-folder-get-spec folder))
- session mailbox
- msgdb response tag)
- (unwind-protect
- (progn
- (setq session (elmo-imap4-get-session spec)
- mailbox (elmo-imap4-spec-mailbox spec)
- tag (elmo-imap4-send-command session
- (list "select "
- (elmo-imap4-mailbox
- mailbox))))
- (setq msgdb (elmo-msgdb-load (elmo-string folder)))
- (setq response (elmo-imap4-read-response session tag)))
- (if response
- (elmo-imap4-session-set-current-mailbox-internal session mailbox)
- (and session
- (elmo-imap4-session-set-current-mailbox-internal session nil))
- (message "Select mailbox %s failed" mailbox)))
- msgdb)
- (elmo-msgdb-load (elmo-string folder))))
+(defun wl-summary-detect-mark-position ()
+ (let ((column wl-summary-buffer-number-column)
+ (formatter wl-summary-buffer-line-formatter)
+ (dummy-temp (char-to-string 200))
+ (dummy-persistent (char-to-string 201))
+ temp persistent)
+ (with-temp-buffer
+ (setq wl-summary-buffer-number-column column
+ wl-summary-buffer-line-formatter formatter)
+ (insert
+ (wl-summary-create-line
+ (elmo-msgdb-make-entity
+ :number 10000
+ :from "foo"
+ :subject "bar"
+ :size 100)
+ nil
+ dummy-temp
+ dummy-persistent))
+ (goto-char (point-min))
+ (setq temp (save-excursion
+ (search-forward dummy-temp nil t)
+ (current-column))
+ persistent (save-excursion
+ (search-forward dummy-persistent nil t)
+ (current-column))))
+ (setq wl-summary-buffer-temp-mark-column temp
+ wl-summary-buffer-persistent-mark-column persistent)))
(defun wl-summary-buffer-set-folder (folder)
- (setq wl-summary-buffer-folder-name folder)
- (setq wl-summary-buffer-folder-indicator
- (if (memq 'modeline wl-use-folder-petname)
- (wl-folder-get-petname folder)
- folder))
- (when (wl-summary-sticky-p)
- (make-local-variable 'wl-message-buf-name)
- (setq wl-message-buf-name (format "%s:%s" wl-message-buf-name folder)))
+ (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
- folder)
+ (elmo-folder-name-internal folder))
wl-mime-charset))
(setq wl-summary-buffer-weekday-name-lang
(or (wl-get-assoc-list-value
wl-folder-weekday-name-lang-alist
- folder)
+ (elmo-folder-name-internal folder))
wl-summary-weekday-name-lang))
(setq wl-summary-buffer-thread-indent-set
(wl-get-assoc-list-value
wl-folder-thread-indent-set-alist
- folder))
- (setq wl-summary-buffer-persistent (wl-folder-persistent-p folder))
+ (elmo-folder-name-internal folder)))
+ (setq wl-summary-buffer-number-column
+ (or (wl-get-assoc-list-value wl-summary-number-column-alist
+ (wl-summary-buffer-folder-name))
+ wl-summary-default-number-column))
+ (wl-line-formatter-setup
+ wl-summary-buffer-line-formatter
+ (setq wl-summary-buffer-line-format
+ (or (wl-get-assoc-list-value
+ wl-folder-summary-line-format-alist
+ (elmo-folder-name-internal folder))
+ wl-summary-line-format))
+ wl-summary-line-format-spec-alist)
+ (wl-line-formatter-setup
+ wl-summary-buffer-mode-line-formatter
+ wl-summary-mode-line-format
+ wl-summary-mode-line-format-spec-alist)
+ (wl-summary-detect-mark-position)
+ (setq wl-summary-buffer-persistent
+ (wl-folder-persistent-p (elmo-folder-name-internal folder)))
+ (elmo-folder-set-persistent-internal folder wl-summary-buffer-persistent)
+ ;; process duplicates.
+ (elmo-folder-set-process-duplicates-internal
+ folder (cdr (elmo-string-matched-assoc
+ (elmo-folder-name-internal folder)
+ wl-folder-process-duplicates-alist)))
(setq
wl-thread-indent-level-internal
(or (nth 0 wl-summary-buffer-thread-indent-set)
wl-thread-space-str-internal
(or (nth 5 wl-summary-buffer-thread-indent-set)
wl-thread-space-str))
- (setq wl-thread-indent-regexp
- (concat
- (regexp-quote wl-thread-have-younger-brother-str-internal) "\\|"
- (regexp-quote wl-thread-youngest-child-str-internal) "\\|"
- (regexp-quote wl-thread-vertical-str-internal) "\\|"
- (regexp-quote wl-thread-horizontal-str-internal) "\\|"
- (regexp-quote wl-thread-space-str-internal)))
(run-hooks 'wl-summary-buffer-set-folder-hook))
(defun wl-summary-mode ()
;;;(make-local-variable 'tab-width)
;;;(setq tab-width 1)
(buffer-disable-undo (current-buffer))
- (if wl-use-semi
- (setq wl-summary-buffer-message-redisplay-func
- 'wl-mmelmo-message-redisplay)
- (setq wl-summary-buffer-message-redisplay-func
- 'wl-normal-message-redisplay))
- (wl-mode-line-buffer-identification '("Wanderlust: "
- wl-summary-buffer-folder-indicator
- wl-summary-buffer-unread-status))
+ (setq selective-display t
+ selective-display-ellipses nil)
+ (wl-mode-line-buffer-identification '(wl-summary-buffer-mode-line))
(easy-menu-add wl-summary-mode-menu)
(when wl-summary-lazy-highlight
- (make-local-variable 'window-scroll-functions)
- (add-hook 'window-scroll-functions 'wl-highlight-summary-window))
+ (if wl-on-xemacs
+ (progn
+ (make-local-variable 'pre-idle-hook)
+ (add-hook 'pre-idle-hook 'wl-highlight-summary-window))
+ (make-local-variable 'window-scroll-functions)
+ (add-hook 'window-scroll-functions 'wl-highlight-summary-window)))
;; 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))
(string< (elmo-msgdb-overview-entity-get-subject-no-decode x)
(elmo-msgdb-overview-entity-get-subject-no-decode 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-msgdb-overview-entity-get-extra-field
+ entity "x-sequence")
+ ml-name (or (elmo-msgdb-overview-entity-get-extra-field
+ entity "x-ml-name")
+ (and sequence
+ (car (split-string sequence " "))))
+ ml-count (or (elmo-msgdb-overview-entity-get-extra-field
+ entity "x-mail-count")
+ (elmo-msgdb-overview-entity-get-extra-field
+ entity "x-ml-count")
+ (and sequence
+ (cadr (split-string sequence " ")))))
+ (and (setq subject (elmo-msgdb-overview-entity-get-subject
+ entity))
+ (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-msgdb-overview-entity-get-extra-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-msgdb-overview-entity-get-extra-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-msgdb-overview-entity-get-extra-field
+ entity "mailing-list"))
+ (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" mailing-list) ; *-help@, *-owner@, etc.
+ (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)))))
+
+(defun wl-summary-overview-entity-compare-by-list-info (x y)
+ "Compare entity X and Y by mailing-list info."
+ (let* ((list-info-x (wl-summary-get-list-info x))
+ (list-info-y (wl-summary-get-list-info y)))
+ (if (equal (car list-info-x) (car list-info-y))
+ (if (equal (cdr list-info-x) (cdr list-info-y))
+ (wl-summary-overview-entity-compare-by-date x y)
+ (< (or (cdr list-info-x) 0)
+ (or (cdr list-info-y) 0)))
+ (string< (or (car list-info-x) "")
+ (or (car list-info-y) "")))))
+
(defun wl-summary-sort-by-date ()
(interactive)
(wl-summary-rescan "date"))
(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-rescan (&optional sort-by)
"Rescan current folder without updating."
(interactive)
(let* ((cur-buf (current-buffer))
- (msgdb wl-summary-buffer-msgdb)
+ (msgdb (wl-summary-buffer-msgdb))
(overview (elmo-msgdb-get-overview msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
(elmo-mime-charset wl-summary-buffer-mime-charset)
i percent num
gc-message entity
expunged)
(fset 'wl-summary-append-message-func-internal
(wl-summary-get-append-message-func))
- (wl-summary-buffer-number-column-detect nil)
(erase-buffer)
(message "Re-scanning...")
(setq i 0)
(intern (format "wl-summary-overview-entity-compare-by-%s"
sort-by))))
(message "Sorting by %s...done" sort-by)
- (elmo-msgdb-set-overview wl-summary-buffer-msgdb
+ (elmo-msgdb-set-overview (wl-summary-buffer-msgdb)
overview))
(setq curp overview)
(set-buffer cur-buf)
(setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2)))
(setq wl-thread-entity-list nil)
(setq wl-thread-entities nil)
+ (setq wl-summary-buffer-number-list nil)
(setq wl-summary-buffer-target-mark-list nil)
(setq wl-summary-buffer-refile-list nil)
(setq wl-summary-buffer-delete-list nil)
(setq wl-summary-delayed-update nil)
(elmo-kill-buffer wl-summary-search-buf-name)
- (message "Constructing summary structure...")
(while curp
(setq entity (car curp))
- (wl-summary-append-message-func-internal entity overview mark-alist
- nil)
+ (wl-summary-append-message-func-internal entity msgdb nil)
(setq curp (cdr curp))
(when (> num elmo-display-progress-threshold)
(setq i (+ i 1))
(elmo-msgdb-overview-entity-get-number
(cdar wl-summary-delayed-update)))
(wl-summary-append-message-func-internal
- (cdar wl-summary-delayed-update)
- overview mark-alist nil t)
+ (cdar wl-summary-delayed-update) msgdb nil t)
(setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
(message "Constructing summary structure...done")
(set-buffer cur-buf)
- (when (eq wl-summary-buffer-view 'thread)
- (message "Inserting thread...")
- (wl-thread-insert-top)
- (message "Inserting thread...done"))
+ (if (eq wl-summary-buffer-view 'thread)
+ (progn
+ (message "Inserting thread...")
+ (wl-thread-insert-top)
+ (message "Inserting thread...done"))
+ (wl-summary-make-number-list))
(when wl-use-scoring
(setq wl-summary-scored nil)
(wl-summary-score-headers nil msgdb
(setq expunged (wl-summary-score-update-all-lines)))
(message "%d message(s) are expunged by scoring." (length expunged))))
(wl-summary-set-message-modified)
- (wl-summary-count-unread mark-alist)
+ (wl-summary-count-unread)
(wl-summary-update-modeline)
(goto-char (point-max))
(forward-line -1)
"folder mode"))
(defun wl-summary-set-message-modified ()
+ (elmo-folder-set-message-modified-internal
+ wl-summary-buffer-elmo-folder t)
(setq wl-summary-buffer-message-modified t))
(defun wl-summary-message-modified-p ()
wl-summary-buffer-message-modified)
(defun wl-summary-set-mark-modified ()
+ (elmo-folder-set-mark-modified-internal
+ wl-summary-buffer-elmo-folder t)
(setq wl-summary-buffer-mark-modified t))
(defun wl-summary-mark-modified-p ()
wl-summary-buffer-mark-modified)
(defun wl-summary-thread-modified-p ()
wl-summary-buffer-thread-modified)
-(defun wl-summary-msgdb-save ()
- "Save msgdb if modified."
- (when wl-summary-buffer-msgdb
- (save-excursion
- (let (path)
- (when (wl-summary-message-modified-p)
- (setq path (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
- (elmo-msgdb-overview-save
- path
- (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
- (elmo-msgdb-number-save
- path
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- (elmo-folder-set-info-max-by-numdb
- (elmo-string wl-summary-buffer-folder-name)
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))
- (setq wl-summary-buffer-message-modified nil)
- (run-hooks 'wl-summary-buffer-message-saved-hook))
- (when (wl-summary-mark-modified-p)
- (or path
- (setq path (elmo-msgdb-expand-path
- wl-summary-buffer-folder-name)))
- (elmo-msgdb-mark-save
- path
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
-;;; (elmo-folder-set-info-hashtb
-;;; (elmo-string wl-summary-buffer-folder-name)
-;;; nil nil
-;;; 0
-;;; (+ wl-summary-buffer-new-count wl-summary-buffer-unread-count))
-;;; (setq wl-folder-info-alist-modified t)
- (setq wl-summary-buffer-mark-modified nil)
- (run-hooks 'wl-summary-buffer-mark-saved-hook))))))
-
(defsubst wl-summary-cleanup-temp-marks (&optional sticky)
(if (or wl-summary-buffer-refile-list
wl-summary-buffer-copy-list
wl-summary-buffer-delete-list)
- (if (y-or-n-p "Marks remain to be executed. Execute them? ")
+ (if (y-or-n-p (format "Execute remaining marks in %s? "
+ (wl-summary-buffer-folder-name)))
(progn
(wl-summary-exec)
(if (or wl-summary-buffer-refile-list
(setq wl-summary-scored nil))
;; a subroutine for wl-summary-exit/wl-save-status
-(defun wl-summary-save-status (&optional sticky)
+;; Note that folder is not commited here.
+(defun wl-summary-save-view ()
;; already in summary buffer.
(when wl-summary-buffer-persistent
;; save the current summary buffer view.
(or (wl-summary-message-modified-p)
(wl-summary-mark-modified-p)
(wl-summary-thread-modified-p)))
- (wl-summary-save-view-cache))
- ;; save msgdb ...
- (wl-summary-msgdb-save)))
+ (wl-summary-save-view-cache))))
+
+(defun wl-summary-save-status ()
+ "Save summary view and msgdb."
+ (interactive)
+ (if (interactive-p) (message "Saving summary status..."))
+ (wl-summary-save-view)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)
+ (elmo-folder-check wl-summary-buffer-elmo-folder)
+ (if wl-use-scoring (wl-score-save))
+ (if (interactive-p) (message "Saving summary status...done.")))
(defun wl-summary-force-exit ()
"Exit current summary. Buffer is deleted even the buffer is sticky."
(interactive "P")
(let ((summary-buf (current-buffer))
(sticky (wl-summary-sticky-p))
- (message-buf (get-buffer wl-message-buf-name))
summary-win
message-buf message-win
folder-buf folder-win)
- (if wl-summary-buffer-exit-func
- (funcall wl-summary-buffer-exit-func)
- (wl-summary-cleanup-temp-marks sticky)
+ (run-hooks 'wl-summary-exit-pre-hook)
+ (if wl-summary-buffer-exit-function
+ (funcall wl-summary-buffer-exit-function)
+ (if (or force-exit (not sticky))
+ (wl-summary-cleanup-temp-marks sticky))
(unwind-protect
;; save summary status
(progn
- (wl-summary-save-status sticky)
- (elmo-commit wl-summary-buffer-folder-name)
- (if wl-use-scoring
- (wl-score-save)))
+ (wl-summary-save-view)
+ (if (or force-exit (not sticky))
+ (elmo-folder-close wl-summary-buffer-elmo-folder)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)
+ (elmo-folder-check wl-summary-buffer-elmo-folder))
+ (if wl-use-scoring (wl-score-save)))
;; for sticky summary
(wl-delete-all-overlays)
(setq wl-summary-buffer-disp-msg nil)
(elmo-kill-buffer wl-summary-search-buf-name)
;; delete message window if displayed.
- (if (setq message-buf (get-buffer wl-message-buf-name))
- (if (setq message-win (get-buffer-window message-buf))
- (delete-window message-win)))
+ (if (and wl-message-buffer (get-buffer-window wl-message-buffer))
+ (delete-window (get-buffer-window wl-message-buffer)))
+ (if (and wl-summary-use-frame
+ (> (length (visible-frame-list)) 1))
+ (delete-frame))
(if (setq folder-buf (get-buffer wl-folder-buffer-name))
- (if (setq folder-win (get-buffer-window folder-buf))
- ;; folder win is already displayed.
- (select-window folder-win)
- ;; folder win is not displayed.
- (switch-to-buffer folder-buf))
+ (if wl-summary-use-frame
+ (let (select-frame)
+ (save-selected-window
+ (dolist (frame (visible-frame-list))
+ (select-frame frame)
+ (if (get-buffer-window folder-buf)
+ (setq select-frame frame))))
+ (if select-frame
+ (select-frame select-frame)
+ (switch-to-buffer folder-buf)))
+ (if (setq folder-win (get-buffer-window folder-buf))
+ ;; folder win is already displayed.
+ (select-window folder-win)
+ ;; folder win is not displayed.
+ (switch-to-buffer folder-buf)))
;; currently no folder buffer
(wl-folder))
(and wl-folder-move-cur-folder
(not sticky))
(progn
(set-buffer summary-buf)
- (and (get-buffer wl-message-buf-name)
- (kill-buffer wl-message-buf-name))
- ;; kill buffers of mime-view-caesar
- (wl-kill-buffers
- (format "^%s-([0-9 ]+)$" (regexp-quote wl-message-buf-name)))
(kill-buffer summary-buf)))
(run-hooks 'wl-summary-exit-hook)))))
-(defun wl-summary-sync-force-update (&optional unset-cursor)
+(defun wl-summary-suspend ()
(interactive)
- (let ((msgdb-dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
- (type (elmo-folder-get-type wl-summary-buffer-folder-name))
- ret-val seen-list)
- (unwind-protect
- (progn
- (if wl-summary-buffer-persistent
- (setq seen-list (elmo-msgdb-seen-load msgdb-dir)))
- (setq ret-val (wl-summary-sync-update3 seen-list unset-cursor))
- (if wl-summary-buffer-persistent
- (progn
- (if (and (eq type 'imap4)
- (not (elmo-folder-plugged-p
- wl-summary-buffer-folder-name)))
- (let* ((msgdb wl-summary-buffer-msgdb)
- (number-alist (elmo-msgdb-get-number-alist msgdb)))
- (elmo-mark-as-read wl-summary-buffer-folder-name
- (mapcar
- (lambda (msgid)
- (car (rassoc msgid number-alist)))
- seen-list) msgdb)))
- (elmo-msgdb-seen-save msgdb-dir nil))))
- (set-buffer (current-buffer)))
- (if (interactive-p)
- (message "%s" ret-val))
- ret-val))
+ (wl-summary-exit)
+ (wl-folder-suspend))
+
+(defun wl-summary-sync-force-update (&optional unset-cursor no-check)
+ (interactive)
+ (wl-summary-sync-update unset-cursor nil no-check))
(defsubst wl-summary-sync-all-init ()
(wl-summary-cleanup-temp-marks)
(wl-summary-set-mark-modified)
(setq wl-thread-entity-hashtb (elmo-make-hash
(* (length (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)) 2)))
- (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil))
+ (wl-summary-buffer-msgdb))) 2)))
(setq wl-thread-entity-list nil)
(setq wl-thread-entities nil)
+ (setq wl-summary-buffer-number-list nil)
(setq wl-summary-buffer-target-mark-list nil)
(setq wl-summary-buffer-refile-list nil)
(setq wl-summary-buffer-copy-list nil)
- (setq wl-summary-buffer-delete-list nil)
- (wl-summary-buffer-number-column-detect nil))
+ (setq wl-summary-buffer-delete-list nil))
(defun wl-summary-sync (&optional unset-cursor force-range)
(interactive)
- (let* ((folder wl-summary-buffer-folder-name)
+ (let* ((folder wl-summary-buffer-elmo-folder)
(inhibit-read-only t)
(buffer-read-only nil)
- (msgdb-dir (elmo-msgdb-expand-path
- folder))
- (range (or force-range (wl-summary-input-range folder)))
- mes seen-list killed-list)
- (cond ((or (string= range "all")
- (string= range "all-visible"))
- ;; initialize buffer local databases.
- (unless (elmo-folder-plugged-p folder) ; forbidden
- (error "Unplugged"))
- (setq seen-list
- (nconc
- (elmo-msgdb-mark-alist-to-seen-list
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)
- (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb)
- (concat wl-summary-important-mark
- wl-summary-read-uncached-mark))
- (elmo-msgdb-seen-load msgdb-dir)))
- (setq killed-list (elmo-msgdb-killed-list-load msgdb-dir))
- (elmo-clear-killed wl-summary-buffer-folder-name)
- (condition-case nil
- (setq mes (wl-summary-sync-update3 seen-list unset-cursor
- (string= range "all")))
- (quit
- ;; Resume killed-list if quit.
- (message "") ; clear minibuffer.
- (elmo-msgdb-killed-list-save msgdb-dir killed-list)))
- (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen.
- (if mes (message "%s" mes)))
-;;; (wl-summary-sync-all folder t))
- ((string= range "rescan")
+ (msgdb-dir (elmo-folder-msgdb-path folder))
+ (range (or force-range (wl-summary-input-range
+ (elmo-folder-name-internal folder)))))
+ (cond ((string= range "rescan")
(let ((msg (wl-summary-message-number)))
(wl-summary-rescan)
(and msg (wl-summary-jump-to-msg msg))))
wl-use-scoring)
(wl-summary-rescan)
(and msg (wl-summary-jump-to-msg msg))))
+ ((string= range "cache-status")
+ (let ((msg (wl-summary-message-number)))
+ (wl-summary-resume-cache-status)
+ (and msg (wl-summary-jump-to-msg msg))))
((or (string-match "last:" range)
(string-match "first:" range))
- (wl-summary-goto-folder-subr (concat "/" range "/" folder)
- 'force-update nil nil t))
- ((string= range "no-sync")
- ;; do nothing.
- )
+ (wl-summary-goto-folder-subr (concat "/" range "/"
+ (elmo-folder-name-internal
+ folder))
+ 'force-update nil nil t))
(t
- (setq seen-list (elmo-msgdb-seen-load msgdb-dir))
- (setq mes (wl-summary-sync-update3 seen-list unset-cursor))
- (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen.
- (if mes (message "%s" mes))))))
+ (wl-summary-sync-update unset-cursor
+ (cond ((string= range "all") 'all)
+ ((string= range "all-visible")
+ 'visible-only)))))))
(defvar wl-summary-edit-addresses-candidate-fields
;; First element becomes default.
;; returns nil if there's no change.
(if (elmo-get-hash-val (downcase the-email) wl-address-petname-hash)
(let (char)
- (message (format "'%s' already exists. (e)dit/(d)elete/(c)ancel?"
- the-email))
+ (message "'%s' already exists. (e)dit/(d)elete/(c)ancel?"
+ the-email)
(while (not (or (eq (setq char (read-char)) ?\r)
(eq char ?\n)
(eq char ? )
(eq char ?\r)
(eq char ? ))
;; Change Addresses
- (wl-address-petname-add-or-change
+ (wl-address-add-or-change
the-email
- (elmo-get-hash-val the-email wl-address-petname-hash)
(wl-address-header-extract-realname
(cdr (assoc
(let ((completion-ignore-case t) comp)
(setq comp
(try-completion the-email wl-address-completion-list))
(if (equal comp t) the-email comp))
- wl-address-completion-list))) t)
+ wl-address-completion-list))))
"edited")
((eq char ?d)
;; Delete Addresses
(if (y-or-n-p (format "Delete '%s'? "
the-email))
(progn
- (wl-address-petname-delete the-email)
+ (wl-address-delete the-email)
"deleted")
(message "")
nil))
(t (message "")
nil)))
;; Add Petname
- (wl-address-petname-add-or-change
- the-email name-in-addr name-in-addr)
+ (wl-address-add-or-change the-email name-in-addr)
"added"))
(defun wl-summary-edit-addresses (&optional addr-str)
(if (null (wl-summary-message-number))
(message "No message.")
(save-excursion
- (wl-summary-set-message-buffer-or-redisplay))
- (let* ((charset wl-summary-buffer-mime-charset)
- (candidates
- (with-current-buffer (wl-message-get-original-buffer)
- (wl-summary-edit-addresses-collect-candidate-fields
- charset)))
- address pair result)
- (if addr-str
- (setq address addr-str)
- (when candidates
- (setq address (car (car candidates)))
- (setq address
- (completing-read
- (format "Target address (%s): " address)
- (mapcar
- (function (lambda (x) (cons (car x) (car x))))
- candidates)
- nil nil nil nil address))))
- (when address
- (setq pair (assoc address candidates))
- (unless pair
- (setq pair (cons address nil)))
- (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
- ;; update alias
- (wl-status-update)
- (setq address (assoc (car pair) wl-address-list))
- (if address
- (message "%s, %s, <%s> is %s."
- (nth 2 address)
- (nth 1 address)
- (nth 0 address)
- result)))
+ (let* ((charset wl-summary-buffer-mime-charset)
+ (candidates
+ (with-current-buffer (wl-summary-get-original-buffer)
+ (wl-summary-edit-addresses-collect-candidate-fields
+ charset)))
+ address pair result)
+ (if addr-str
+ (setq address addr-str)
+ (when candidates
+ (setq address (car (car candidates)))
+ (setq address
+ (completing-read
+ (format "Target address (%s): " address)
+ (mapcar
+ (function (lambda (x) (cons (car x) (car x))))
+ candidates)
+ nil nil nil nil address))))
+ (when address
+ (setq pair (assoc address candidates))
+ (unless pair
+ (setq pair (cons address nil)))
+ (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
+ ;; update alias
+ (wl-status-update)
+ (setq address (assoc (car pair) wl-address-list))
+ (if address
+ (message "%s, %s, <%s> is %s."
+ (nth 2 address)
+ (nth 1 address)
+ (nth 0 address)
+ result)))
;;; i'd like to update summary-buffer, but...
;;; (wl-summary-rescan)
- (run-hooks 'wl-summary-edit-addresses-hook)))))
+ (run-hooks 'wl-summary-edit-addresses-hook))))))
(defun wl-summary-incorporate (&optional arg)
"Check and prefetch all uncached messages.
"Returns status-mark. if skipped, returns nil."
;; prefetching procedure.
(save-excursion
- (let* ((msgdb wl-summary-buffer-msgdb)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ (let* ((msgdb (wl-summary-buffer-msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(message-id (cdr (assq number number-alist)))
- (ov (assoc message-id
- (elmo-msgdb-get-overview msgdb)))
- (entity ov)
+ (ov (elmo-msgdb-overview-get-entity message-id msgdb))
+ (wl-message-entity ov)
+ (entity ov) ; backward compatibility.
(size (elmo-msgdb-overview-entity-get-size ov))
(inhibit-read-only t)
(buffer-read-only nil)
+ (file-cached (elmo-file-cache-exists-p message-id))
(force-read (and size
- (or (null wl-prefetch-threshold)
+ (or (and (null wl-prefetch-confirm) arg)
+ (null wl-prefetch-threshold)
(< size wl-prefetch-threshold))))
mark new-mark)
- (if (or arg
- (null (elmo-cache-exists-p message-id)))
- (unwind-protect
- (progn
- (when (and size (not force-read) wl-prefetch-confirm)
- (setq force-read
- (save-restriction
- (widen)
- (y-or-n-p
- (format
- "Message from %s has %d bytes. Prefetch it? "
- (concat
- "[ "
- (save-match-data
- (wl-set-string-width
- wl-from-width
- (wl-summary-from-func-internal
- (eword-decode-string
- (elmo-delete-char
- ?\"
- (or
- (elmo-msgdb-overview-entity-get-from ov)
- "??")))))) " ]")
- size))))
- (message "")) ; flush.
- (setq mark (cadr (assq number mark-alist)))
- (if force-read
- (save-excursion
- (save-match-data
- (if (and (null (elmo-folder-plugged-p
- wl-summary-buffer-folder-name))
- elmo-enable-disconnected-operation)
- (progn;; append-queue for offline
- (elmo-dop-prefetch-msgs
- wl-summary-buffer-folder-name (list number))
- (setq new-mark
- (cond
- ((string= mark
- wl-summary-unread-uncached-mark)
- wl-summary-unread-cached-mark)
- ((string= mark wl-summary-new-mark)
- (setq wl-summary-buffer-new-count
- (- wl-summary-buffer-new-count 1))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- ((or (null mark)
- (string= mark wl-summary-read-uncached-mark))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- (t mark))))
- ;; online
- (elmo-prefetch-msg wl-summary-buffer-folder-name
- number
- (wl-message-get-original-buffer)
- msgdb)
- (setq new-mark
- (cond
- ((string= mark
- wl-summary-unread-uncached-mark)
- wl-summary-unread-cached-mark)
- ((string= mark wl-summary-new-mark)
- (setq wl-summary-buffer-new-count
- (- wl-summary-buffer-new-count 1))
- (setq wl-summary-buffer-unread-count
- (+ wl-summary-buffer-unread-count 1))
- wl-summary-unread-cached-mark)
- ((string= mark wl-summary-read-uncached-mark)
- nil)
- (t mark))))
- (setq mark-alist (elmo-msgdb-mark-set
- mark-alist number new-mark))
- (or new-mark (setq new-mark " "))
- (elmo-msgdb-set-mark-alist msgdb mark-alist)
- (wl-summary-set-mark-modified)
- (wl-summary-update-modeline)
- (wl-folder-update-unread
- wl-summary-buffer-folder-name
- (+ wl-summary-buffer-unread-count
- wl-summary-buffer-new-count)))
- new-mark))))))))
+ (unwind-protect
+ (progn
+ (when (and (or arg (not file-cached))
+ size (not force-read) wl-prefetch-confirm)
+ (setq force-read
+ (save-restriction
+ (widen)
+ (y-or-n-p
+ (format
+ "Message from %s has %d bytes. Prefetch it? "
+ (concat
+ "[ "
+ (save-match-data
+ (wl-set-string-width
+ 17
+ (funcall wl-summary-from-function
+ (eword-decode-string
+ (elmo-delete-char
+ ?\"
+ (or
+ (elmo-msgdb-overview-entity-get-from ov)
+ "??")))))) " ]")
+ size))))
+ (message "")) ; flush.
+ (setq mark (elmo-msgdb-get-mark msgdb number))
+ (if force-read
+ (save-excursion
+ (save-match-data
+ ;; online
+ (if (or arg (not file-cached))
+ (elmo-message-encache
+ wl-summary-buffer-elmo-folder
+ number))
+ (setq new-mark
+ (cond
+ ((string= mark
+ wl-summary-unread-uncached-mark)
+ wl-summary-unread-cached-mark)
+ ((string= mark wl-summary-new-mark)
+ (setq wl-summary-buffer-new-count
+ (- wl-summary-buffer-new-count 1))
+ (setq wl-summary-buffer-unread-count
+ (+ wl-summary-buffer-unread-count 1))
+ wl-summary-unread-cached-mark)
+ ((string= mark wl-summary-read-uncached-mark)
+ nil)
+ (t mark)))
+ (elmo-msgdb-set-mark msgdb number new-mark)
+ (or new-mark (setq new-mark " "))
+ (wl-summary-set-mark-modified)
+ (wl-summary-update-modeline)
+ (wl-folder-update-unread
+ (wl-summary-buffer-folder-name)
+ (+ wl-summary-buffer-unread-count
+ wl-summary-buffer-new-count)))
+ new-mark)))))))
;;(defvar wl-summary-message-uncached-marks
;; (list wl-summary-new-mark
(message "Collecting marks...")
(goto-char (point-min))
(while (not (eobp))
- (beginning-of-line)
- (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
- (setq mark (wl-match-buffer 2))
- (setq msg (string-to-int (wl-match-buffer 1)))
- (if (or (and (null prefetch-marks)
- msg
- (null (elmo-cache-exists-p
- (cdr (assq msg
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))))))
- (member mark prefetch-marks))
- (setq targets (nconc targets (list msg))))
- (setq entity (wl-thread-get-entity msg))
- (if (or (not (eq wl-summary-buffer-view 'thread))
- (wl-thread-entity-get-opened entity))
- (); opened. no hidden children.
- ;; hidden children!!
- (setq targets (nconc
- targets
- (wl-thread-get-children-msgs-uncached
- msg prefetch-marks)))))
+ (setq mark (wl-summary-persistent-mark)
+ msg (wl-summary-message-number))
+ (if (or (and (null prefetch-marks)
+ msg
+ (null (elmo-file-cache-exists-p
+ (elmo-message-field
+ wl-summary-buffer-elmo-folder
+ msg
+ 'message-id))))
+ (member mark prefetch-marks))
+ (setq targets (nconc targets (list msg))))
+ (setq entity (wl-thread-get-entity msg))
+ (if (or (not (eq wl-summary-buffer-view 'thread))
+ (wl-thread-entity-get-opened entity))
+ (); opened. no hidden children.
+ (setq targets (nconc
+ targets
+ (wl-thread-get-children-msgs-uncached
+ msg prefetch-marks))))
(forward-line 1))
(setq length (length targets))
(message "Prefetching...")
"Prefetch current message."
(interactive "P")
(save-excursion
- (save-match-data
- (beginning-of-line)
- (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
- (goto-char (match-beginning 2))
- (let ((inhibit-read-only t)
- (buffer-read-only nil)
- mark)
- (setq mark (wl-summary-prefetch-msg
- (string-to-int (wl-match-buffer 1)) arg))
- (when mark
- (delete-region (match-beginning 2)
- (match-end 2))
- (insert mark)
- (if wl-summary-highlight
- (wl-highlight-summary-current-line)))
- (set-buffer-modified-p nil)
- mark)))))
-
-(defun wl-summary-delete-all-status-marks-on-buffer ()
- (interactive)
- (save-excursion
- (goto-char (point-min))
(let ((inhibit-read-only t)
(buffer-read-only nil)
- (case-fold-search nil))
- (while (re-search-forward
- (concat "^" wl-summary-buffer-number-regexp ".\\(.\\)") nil t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert " ")))))
+ (mark (wl-summary-persistent-mark)))
+ (setq mark (wl-summary-prefetch-msg (wl-summary-message-number) arg))
+ (when mark
+ (delete-backward-char 1)
+ (insert mark)
+ (if wl-summary-highlight
+ (wl-highlight-summary-current-line)))
+ (set-buffer-modified-p nil)
+ mark)))
(defun wl-summary-delete-marks-on-buffer (marks)
(while marks
(defun wl-summary-delete-all-temp-marks-on-buffer (&optional sticky)
;; for summary view cache saving.
- (interactive)
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t)
- (buffer-read-only nil)
- (case-fold-search nil)
- (regexp (concat "^" wl-summary-buffer-number-regexp "\\([^ ]\\)" )))
- (while (re-search-forward regexp nil t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert " ")
- (if (and sticky wl-summary-highlight)
- (wl-highlight-summary-current-line))))))
-
-(defun wl-summary-delete-all-marks (mark-alist mark)
- "Delete all MARKs in MARK-ALIST."
- (let ((malist mark-alist)
- (ret-val mark-alist)
- entity)
- (while malist
- (setq entity (car malist))
- (if (string= (cadr entity) mark)
- ;; delete this entity
- (setq ret-val (delete entity ret-val)))
- (setq malist (cdr malist)))
- ret-val))
-
-;; Does not work correctly...
+ (buffer-read-only nil))
+ (while (not (eobp))
+ (unless (string= (wl-summary-temp-mark) " ")
+ (delete-backward-char 1)
+ (insert " "))
+ (forward-line 1)))))
+
(defun wl-summary-mark-as-read-region (beg end)
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region beg end)
-;;; use narrowing.
-;;; (save-excursion (goto-char end)
-;;; (end-of-line) (point)))
(goto-char (point-min))
(if (eq wl-summary-buffer-view 'thread)
(progn
children)
(if (wl-thread-entity-get-opened entity)
;; opened...mark line.
- ;; Crossposts are not processed
- (wl-summary-mark-as-read t)
+ (wl-summary-mark-as-read number)
;; closed
- (wl-summary-mark-as-read t) ; mark itself.
+ (wl-summary-mark-as-read number) ; mark itself.
(setq children (wl-thread-get-children-msgs number))
(while children
- (wl-summary-mark-as-read t nil nil (car children))
+ (wl-summary-mark-as-read (car children))
(setq children (cdr children))))
(forward-line 1))))
(while (not (eobp))
- (wl-summary-mark-as-read t)
+ (wl-summary-mark-as-read (wl-summary-message-number))
(forward-line 1)))))
- (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline))
(defun wl-summary-mark-as-unread-region (beg end)
(while (not (eobp))
(wl-summary-mark-as-unread)
(forward-line 1)))))
- (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline))
(defun wl-summary-mark-as-important-region (beg end)
(while (not (eobp))
(wl-summary-mark-as-important)
(forward-line 1)))))
- (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline))
(defun wl-summary-mark-as-read-all ()
(interactive)
(if (or (not (interactive-p))
(y-or-n-p "Mark all messages as read? "))
- (let* ((folder wl-summary-buffer-folder-name)
+ (let* ((folder wl-summary-buffer-elmo-folder)
(cur-buf (current-buffer))
- (msgdb wl-summary-buffer-msgdb)
-;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (malist mark-alist)
+ (msgdb (wl-summary-buffer-msgdb))
(inhibit-read-only t)
(buffer-read-only nil)
(case-fold-search nil)
msg mark)
(message "Setting all msgs as read...")
- (elmo-mark-as-read folder (wl-summary-collect-unread mark-alist)
- msgdb)
+ (elmo-folder-mark-as-read folder
+ (elmo-folder-list-unreads
+ folder
+ (list wl-summary-unread-cached-mark
+ wl-summary-unread-uncached-mark
+ wl-summary-new-mark)))
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9 ]\\)" nil t)
- (setq msg (string-to-int (wl-match-buffer 1)))
- (setq mark (wl-match-buffer 2))
- (when (and (not (string= mark wl-summary-important-mark))
+ (while (not (eobp))
+ (setq msg (wl-summary-message-number))
+ (setq mark (wl-summary-persistent-mark))
+ (when (and (not (string= mark " "))
+ (not (string= mark wl-summary-important-mark))
(not (string= mark wl-summary-read-uncached-mark)))
- (delete-region (match-beginning 2) (match-end 2))
- (if (or (not (elmo-use-cache-p folder msg))
+ (delete-backward-char 1)
+ (if (or (not (elmo-message-use-cache-p folder msg))
(string= mark wl-summary-unread-cached-mark))
(progn
(insert " ")
- (setq mark-alist
- (elmo-msgdb-mark-set
- mark-alist
- msg
-;;; Use msg instead of (cdr (assq msg number-alist)).
-;;; (cdr (assq msg number-alist))
- nil)))
+ (elmo-msgdb-set-mark msgdb msg nil))
;; New mark and unread-uncached mark
(insert wl-summary-read-uncached-mark)
- (setq mark-alist
- (elmo-msgdb-mark-set mark-alist
- msg
-;;; (cdr (assq msg number-alist))
- wl-summary-read-uncached-mark)))
+ (elmo-msgdb-set-mark
+ msgdb msg wl-summary-read-uncached-mark))
(if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t)))))
- (setq mark-alist (wl-summary-set-as-read-mark-alist mark-alist))
+ (wl-highlight-summary-current-line nil nil t)))
+ (forward-line 1)))
+ (elmo-folder-replace-marks
+ folder
+ (list (cons wl-summary-unread-cached-mark
+ nil)
+ (cons wl-summary-unread-uncached-mark
+ wl-summary-read-uncached-mark)
+ (cons wl-summary-new-mark
+ wl-summary-read-uncached-mark)))
(wl-summary-set-mark-modified)
- (set-buffer cur-buf); why is this needed???
- (elmo-msgdb-set-mark-alist msgdb mark-alist)
- (wl-folder-update-unread wl-summary-buffer-folder-name 0)
+ (wl-folder-update-unread (wl-summary-buffer-folder-name) 0)
(setq wl-summary-buffer-unread-count 0)
(setq wl-summary-buffer-new-count 0)
(wl-summary-update-modeline)
(save-excursion
(let* ((inhibit-read-only t)
(buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
(case-fold-search nil)
mark number unread new-mark)
-;;; (re-search-backward "^ *[0-9]+..[0-9]+/[0-9]+" nil t) ; set cursor line
- (beginning-of-line)
- (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
- (progn
- (setq mark (wl-match-buffer 2))
- (cond
- ((or (string= mark wl-summary-new-mark)
- (string= mark wl-summary-unread-uncached-mark)
- (string= mark wl-summary-important-mark))
- ;; noop
- )
- ((string= mark wl-summary-unread-cached-mark)
- (setq new-mark wl-summary-unread-uncached-mark))
- (t
- (setq new-mark wl-summary-read-uncached-mark)))
- (when new-mark
- (setq number (string-to-int (wl-match-buffer 1)))
- (delete-region (match-beginning 2) (match-end 2))
- (goto-char (match-beginning 2))
- (insert new-mark)
- (elmo-cache-delete (cdr (assq number number-alist))
- wl-summary-buffer-folder-name
- number)
- (setq mark-alist
- (elmo-msgdb-mark-set mark-alist number new-mark))
- (elmo-msgdb-set-mark-alist msgdb mark-alist)
- (wl-summary-set-mark-modified)
- (if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t))
- (set-buffer-modified-p nil)))))))
+ (setq mark (wl-summary-persistent-mark))
+ (cond
+ ((or (string= mark wl-summary-new-mark)
+ (string= mark wl-summary-unread-uncached-mark)
+ (string= mark wl-summary-important-mark))
+ ;; noop
+ )
+ ((string= mark wl-summary-unread-cached-mark)
+ (setq new-mark wl-summary-unread-uncached-mark))
+ (t
+ (setq new-mark wl-summary-read-uncached-mark)))
+ (when new-mark
+ (setq number (wl-summary-message-number))
+ (delete-backward-char 1)
+ (insert new-mark)
+ (elmo-file-cache-delete
+ (elmo-file-cache-get-path
+ (elmo-message-field wl-summary-buffer-elmo-folder
+ number
+ 'message-id)))
+ (elmo-msgdb-set-mark msgdb number new-mark)
+ (wl-summary-set-mark-modified)
+ (if wl-summary-highlight
+ (wl-highlight-summary-current-line nil nil t))
+ (set-buffer-modified-p nil)))))
(defun wl-summary-resume-cache-status ()
"Resume the cache status of all messages in the current folder."
(interactive)
- (let* ((folder wl-summary-buffer-folder-name)
+ (let* ((folder wl-summary-buffer-elmo-folder)
(cur-buf (current-buffer))
- (msgdb wl-summary-buffer-msgdb)
+ (msgdb (wl-summary-buffer-msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
(inhibit-read-only t)
(buffer-read-only nil)
(case-fold-search nil)
(message "Resuming cache status...")
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" nil t)
- (setq msg (string-to-int
- (wl-match-buffer 1)))
- (setq mark (wl-match-buffer 2))
- (setq msgid (cdr (assq msg number-alist)))
+ (while (not (eobp))
+ (setq msg (wl-summary-message-number))
+ (setq mark (wl-summary-persistent-mark))
+ (setq msgid (elmo-msgdb-get-field msgdb msg 'message-id))
(setq set-mark nil)
- (if (elmo-cache-exists-p msgid folder msg)
+ (if (elmo-file-cache-exists-p msgid)
(if (or
(string= mark wl-summary-unread-uncached-mark) ; U -> !
- (string= mark wl-summary-new-mark) ; N -> !
+ (string= mark wl-summary-new-mark) ; N -> !
)
(setq set-mark wl-summary-unread-cached-mark)
(if (string= mark wl-summary-read-uncached-mark) ; u -> ' '
(setq set-mark wl-summary-unread-uncached-mark) ; ! -> U
)))
(when set-mark
- (delete-region (match-beginning 2) (match-end 2))
+ (delete-backward-char 1)
(insert set-mark)
- (setq mark-alist
- (elmo-msgdb-mark-set
- mark-alist msg ; msgid
- (if (string= set-mark " ") nil set-mark)))
+ (elmo-msgdb-set-mark msgdb msg
+ (if (string= set-mark " ") nil set-mark))
(if wl-summary-highlight
- (wl-highlight-summary-current-line))))
+ (wl-highlight-summary-current-line)))
+ (forward-line 1))
(wl-summary-set-mark-modified)
- (set-buffer cur-buf); why is this needed???
- (elmo-msgdb-set-mark-alist msgdb mark-alist)
- (wl-summary-count-unread mark-alist)
+ (wl-summary-count-unread)
(wl-summary-update-modeline)
(message "Resuming cache status...done")
(set-buffer-modified-p nil))))
-(defun wl-summary-resume-marks-and-highlight ()
- (let* ((msgdb wl-summary-buffer-msgdb)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
-;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
- (count (count-lines (point-min)(point-max)))
- (i 0)
- msg-num percent smark)
- (save-excursion
- (goto-char (point-min))
- (message "Resuming all marks...")
- (while (not (eobp))
- (setq msg-num (wl-summary-message-number))
- (setq smark (car (cdr (assq msg-num mark-alist))))
- (if (looking-at (format "^ *%s \\( \\)" msg-num))
- (progn
- (goto-char (match-end 1))
- (delete-region (match-beginning 1) (match-end 1))
- (insert (or smark " "))))
- (wl-highlight-summary-current-line smark)
- (when (> count elmo-display-progress-threshold)
- (setq i (+ i 1))
- (setq percent (/ (* i 100) count))
- (elmo-display-progress
- 'wl-summary-resume-marks-and-highlight "Resuming all marks..."
- percent))
- (forward-line 1)))
- (message "Resuming all marks...done")))
-
-(defun wl-summary-resume-marks ()
- (let* ((msgdb wl-summary-buffer-msgdb)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (count (length mark-alist))
- (i 0)
- entity msg-num percent)
- (save-excursion
- (message "Resuming all marks...")
- (while mark-alist
- (setq entity (car mark-alist))
- (if (setq msg-num (car (rassoc (car entity) number-alist)))
- (progn
-;;; (goto-char (point-min))
- (if (re-search-forward (format "^ *%s \\( \\)" msg-num) nil t)
- (progn
- (delete-region (match-beginning 1) (match-end 1))
- (insert (or (cadr entity)
- " ")))
- (if (re-search-backward (format "^ *%s \\( \\)" msg-num) nil t)
- (progn
- (goto-char (match-end 1))
- (delete-region (match-beginning 1) (match-end 1))
- (insert (or (cadr entity)
- " ")))))))
- (when (> count elmo-display-progress-threshold)
- (setq i (+ i 1))
- (setq percent (/ (* i 100) count))
- (elmo-display-progress
- 'wl-summary-resume-marks "Resuming all marks..."
- percent))
- (setq mark-alist (cdr mark-alist)))
- (message "Resuming all marks...done"))))
-
(defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info)
(interactive)
(save-excursion
(wl-thread-delete-message (car msgs))))
(setq update-list (delq (car msgs) update-list)))
(goto-char (point-min))
- (if (re-search-forward (format "^ *%d[^0-9]\\([^0-9]\\).*$"
- (car msgs)) nil t)
+ (if (wl-summary-jump-to-msg (car msgs))
(progn
- (delete-region (match-beginning 0) (match-end 0))
+ (delete-region (point-at-bol) (point-at-eol))
(delete-char 1) ; delete '\n'
- )))
+ (setq wl-summary-buffer-number-list
+ (delq (car msgs) wl-summary-buffer-number-list)))))
(when (and deleting-info
(> len elmo-display-progress-threshold))
(setq i (1+ i))
(wl-thread-update-line-msgs (elmo-uniq-list update-list)
(unless deleting-info 'no-msg))
(wl-thread-cleanup-symbols msgs2))
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline)
(wl-folder-update-unread
- wl-summary-buffer-folder-name
+ (wl-summary-buffer-folder-name)
(+ wl-summary-buffer-unread-count wl-summary-buffer-new-count)))))
-(defun wl-summary-set-as-read-mark-alist (mark-alist)
- (let ((marks (list (cons wl-summary-unread-cached-mark
- nil)
- (cons wl-summary-unread-uncached-mark
- wl-summary-read-uncached-mark)
- (cons wl-summary-new-mark
- wl-summary-read-uncached-mark)))
- (ret-val mark-alist)
- entity pair)
- (while mark-alist
- (setq entity (car mark-alist))
- (when (setq pair (assoc (cadr entity) marks))
- (if (elmo-use-cache-p wl-summary-buffer-folder-name
- (caar mark-alist))
- (if (cdr pair)
- (setcar (cdr entity) (cdr pair))
- (setq ret-val (delete entity ret-val)))
- (setq ret-val (delete entity ret-val))))
- (setq mark-alist (cdr mark-alist)))
- ret-val))
-
-(defun wl-summary-set-status-marks (mark-alist before after)
- "Set the BEFORE marks to AFTER."
- (let ((ret-val mark-alist)
- entity)
- (while mark-alist
- (setq entity (car mark-alist))
- (when (string= (cadr entity) before)
- (if after
- (setcar (cdr entity) after)
- (setq ret-val (delete entity ret-val))))
- (setq mark-alist (cdr mark-alist)))
- ret-val))
-
-(defun wl-summary-set-status-marks-on-buffer (before after)
- "Set the MARKS marks on buffer."
+(defun wl-summary-replace-status-marks (before after)
+ "Replace the status marks on buffer."
(interactive)
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t)
- (buffer-read-only nil)
- (regexp (concat "^" wl-summary-buffer-number-regexp ".\\(\\%s\\)")))
- (while (re-search-forward
- (format regexp (regexp-quote before)) nil t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert after)
- (if wl-summary-highlight
- (wl-highlight-summary-current-line))))))
+ (buffer-read-only nil))
+ (while (not (eobp))
+ (when (string= (wl-summary-persistent-mark) before)
+ (delete-backward-char 1)
+ (insert after)
+ (if wl-summary-highlight
+ (wl-highlight-summary-current-line)))
+ (forward-line 1)))))
(defun wl-summary-get-delete-folder (folder)
(if (string= folder wl-trash-folder)
((or (equal type 'remove) (equal type 'null))
'null)
(t;; (equal type 'trash)
- wl-trash-folder)))))
-
-(defun wl-summary-delete-important-msgs-from-list (delete-list
- mark-alist)
- (let ((dlist delete-list))
- (while dlist
- (if (string= wl-summary-important-mark
- (car (cdr (assq (car dlist) mark-alist))))
- (setq delete-list (delete (car dlist) delete-list)))
- (setq dlist (cdr dlist)))
- delete-list))
-
-(defun wl-summary-delete-canceled-msgs-from-list (delete-list msgdb)
- (let ((dlist delete-list))
- (while dlist
- (if (null (cdr (assq (car dlist) (cadr msgdb))))
- (setq delete-list (delete (car dlist) delete-list)))
- (setq dlist (cdr dlist)))
- delete-list))
+ (let ((trash-folder (wl-folder-get-elmo-folder wl-trash-folder)))
+ (unless (elmo-folder-exists-p trash-folder)
+ (if (y-or-n-p
+ (format "Trash Folder %s does not exist, create it? "
+ wl-trash-folder))
+ (elmo-folder-create trash-folder)
+ (error "Trash Folder is not created"))))
+ wl-trash-folder)))))
(defun wl-summary-get-append-message-func ()
(if (eq wl-summary-buffer-view 'thread)
'wl-summary-insert-thread-entity
-;;; 'wl-summary-insert-thread
- 'wl-summary-insert-summary))
+ 'wl-summary-insert-sequential))
(defun wl-summary-sort ()
(interactive)
- (let ((sort-by (let ((input-range-list '("number" "date" "subject" "from"))
- (default "date")
- in)
- (setq in
- (completing-read
- (format "Sort by (%s): " default)
- (mapcar
- (function (lambda (x) (cons x x)))
- input-range-list)))
- (if (string= in "")
- default
- in))))
- (if (not (member sort-by '("number" "date" "subject" "from")))
- (error "Sort by %s is not implemented" sort-by))
- (wl-summary-rescan sort-by)))
+ (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-sync-marks ()
"Update marks in summary."
(interactive)
- (let ((plugged (elmo-folder-plugged-p wl-summary-buffer-folder-name))
- (last-progress 0)
+ (let ((last-progress 0)
(i 0)
- mark-alist unread-marks msgs mark importants unreads
- importants-in-db unreads-in-db has-imap4 diff diffs
- mes num-ma progress)
+ unread-marks importants unreads
+ importants-in-db unreads-in-db diff diffs
+ mes progress)
;; synchronize marks.
- (when (not (eq (elmo-folder-get-type
- wl-summary-buffer-folder-name)
+ (when (not (eq (elmo-folder-type-internal
+ wl-summary-buffer-elmo-folder)
'internal))
(message "Updating marks...")
(setq unread-marks (list wl-summary-unread-cached-mark
wl-summary-unread-uncached-mark
wl-summary-new-mark)
- mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)
- num-ma (length mark-alist)
- importants (elmo-list-folder-important
- wl-summary-buffer-folder-name
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- unreads (elmo-list-folder-unread
- wl-summary-buffer-folder-name
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)
+ importants-in-db (elmo-folder-list-messages-mark-match
+ wl-summary-buffer-elmo-folder
+ (regexp-quote wl-summary-important-mark))
+ unreads-in-db (elmo-folder-list-messages-mark-match
+ wl-summary-buffer-elmo-folder
+ (wl-regexp-opt unread-marks))
+ importants (elmo-folder-list-importants
+ wl-summary-buffer-elmo-folder
+ wl-summary-important-mark)
+ unreads (elmo-folder-list-unreads
+ wl-summary-buffer-elmo-folder
unread-marks))
- (while mark-alist
- (if (string= (cadr (car mark-alist))
- wl-summary-important-mark)
- (setq importants-in-db (cons (car (car mark-alist))
- importants-in-db))
- (if (member (cadr (car mark-alist)) unread-marks)
- (setq unreads-in-db (cons (car (car mark-alist))
- unreads-in-db))))
- (setq mark-alist (cdr mark-alist))
- (when (> num-ma elmo-display-progress-threshold)
- (setq i (1+ i)
- progress (/ (* i 100) num-ma))
- (if (not (eq progress last-progress))
- (elmo-display-progress 'wl-summary-sync-marks
- "Updating marks..."
- progress))
- (setq last-progress progress)))
(setq diff (elmo-list-diff importants importants-in-db))
(setq diffs (cadr diff)) ; important-deletes
(setq mes (format "Updated (-%d" (length diffs)))
(setq diffs (cadr diff))
(setq mes (concat mes (format "(-%d" (length diffs))))
(while diffs
- (wl-summary-mark-as-read t 'no-server nil (car diffs))
+ (wl-summary-mark-as-read (car diffs) 'no-folder)
(setq diffs (cdr diffs)))
(setq diffs (car diff)) ; unread-appends
(setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs))))
(setq diffs (cdr diffs)))
(if (interactive-p) (message mes)))))
-(defun wl-summary-confirm-appends (appends)
- (let ((len (length appends))
- in)
- (if (> len wl-summary-update-confirm-threshold)
- (if (y-or-n-p (format "Too many messages(%d). Continue? " len))
- appends
- (setq in wl-summary-update-confirm-threshold)
- (catch 'end
- (while t
- (setq in (read-from-minibuffer "Update number: "
- (int-to-string in))
- in (string-to-int in))
- (if (< len in)
- (throw 'end len))
- (if (y-or-n-p (format "%d messages are disappeared. OK? "
- (max (- len in) 0)))
- (throw 'end in))))
- (nthcdr (max (- len in) 0) appends))
- appends)))
-
-(defun wl-summary-sync-update3 (&optional seen-list unset-cursor sync-all)
- "Update the summary view."
+(defun wl-summary-sync-update (&optional unset-cursor sync-all no-check)
+ "Update the summary view to the newest folder status."
(interactive)
- (let* ((folder wl-summary-buffer-folder-name)
- (cur-buf (current-buffer))
- (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
- (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
-;;; (location (elmo-msgdb-get-location msgdb))
+ (let* ((folder wl-summary-buffer-elmo-folder)
(case-fold-search nil)
(elmo-mime-charset wl-summary-buffer-mime-charset)
(inhibit-read-only t)
(buffer-read-only nil)
- diff initial-append-list append-list delete-list has-nntp
- i num result
gc-message
- in-folder
- in-db curp
- overview-append
- entity ret-val crossed crossed2
- update-thread update-top-list mark
- expunged msgs unreads importants)
-;;; (setq seen-list nil) ;for debug.
- (fset 'wl-summary-append-message-func-internal
- (wl-summary-get-append-message-func))
- ;; Flush pending append operations (disconnected operation).
- (setq seen-list
- (wl-summary-flush-pending-append-operations seen-list))
- (goto-char (point-max))
- (wl-folder-confirm-existence folder 'force)
- (message "Checking folder diff...")
- (elmo-commit folder)
- (setq in-folder (elmo-list-folder folder sync-all))
- (setq in-db (unless sync-all (sort (mapcar 'car number-alist) '<)))
- (if (not elmo-use-killed-list)
- (setq diff (if (eq (elmo-folder-get-type folder) 'multi)
- (elmo-multi-list-bigger-diff in-folder in-db)
- (elmo-list-bigger-diff in-folder in-db)))
- (setq diff (elmo-list-diff in-folder in-db)))
- (setq initial-append-list (car diff))
- (setq delete-list (cadr diff))
- (message "Checking folder diff...done")
- ;; Confirm appended message number.
- (setq append-list (wl-summary-confirm-appends initial-append-list))
- (when (and elmo-use-killed-list
- (not (eq (length initial-append-list)
- (length append-list)))
- (setq diff (elmo-list-diff initial-append-list append-list)))
- (elmo-msgdb-append-to-killed-list folder (car diff)))
- ;; Setup sync-all
- (if sync-all (wl-summary-sync-all-init))
- ;; Don't delete important-marked msgs other than 'internal.
- (unless (eq (elmo-folder-get-type folder) 'internal)
- (setq delete-list
- (wl-summary-delete-important-msgs-from-list delete-list
- mark-alist)))
- (if (and has-nntp
- (elmo-nntp-max-number-precedes-list-active-p))
- ;; XXX this does not work correctly in rare case.
- (setq delete-list
- (wl-summary-delete-canceled-msgs-from-list
- delete-list
- wl-summary-buffer-msgdb)))
- (if (or (equal diff '(nil nil))
- (equal diff '(nil))
- (and (eq (length delete-list) 0)
- (eq (length initial-append-list) 0)))
+ overview number-alist
+ curp num i new-msgdb
+ append-list delete-list crossed
+ update-thread update-top-list
+ expunged mes sync-result entity)
+ (unwind-protect
(progn
- ;; For max-number update...
- (if (and (elmo-folder-contains-type folder 'nntp)
- (elmo-nntp-max-number-precedes-list-active-p)
- (elmo-update-number folder wl-summary-buffer-msgdb))
- (wl-summary-set-message-modified)
- (setq ret-val (format "No update is needed for \"%s\"" folder))))
- (when delete-list
- (message "Deleting...")
- (elmo-msgdb-delete-msgs folder delete-list
- wl-summary-buffer-msgdb t) ; reserve cache.
-;;; (set-buffer cur-buf)
- (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
- (message "Deleting...done"))
-;;; (set-buffer cur-buf)
- ;; Change "New" marks to "Uncached Unread" marks.
- (wl-summary-set-status-marks mark-alist
- wl-summary-new-mark
- wl-summary-unread-uncached-mark)
- (wl-summary-set-status-marks-on-buffer
- wl-summary-new-mark
- wl-summary-unread-uncached-mark)
- (setq num (length append-list))
- (if append-list
- (progn
- (setq i 0)
- (setq result (elmo-msgdb-create
- folder
- append-list
- wl-summary-new-mark
- wl-summary-unread-cached-mark ; !
- wl-summary-read-uncached-mark ; u ;; XXXX
- wl-summary-important-mark
- seen-list))
- ;; delete duplicated messages.
- (when (elmo-folder-contains-multi folder)
- (setq crossed (elmo-multi-delete-crossposts
- wl-summary-buffer-msgdb result))
- (setq result (cdr crossed))
- (setq crossed (car crossed)))
- (setq overview-append (car result))
- (setq wl-summary-buffer-msgdb
- (elmo-msgdb-append wl-summary-buffer-msgdb result t))
- ;; set these value for append-message-func
- (setq overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
- (setq number-alist (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))
- (setq mark-alist (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb))
-;;; (setq location (elmo-msgdb-get-location msgdb))
- (setq curp overview-append)
- (setq num (length curp))
- (setq wl-summary-delayed-update nil)
- (elmo-kill-buffer wl-summary-search-buf-name)
- (while curp
- (setq entity (car curp))
- (when (setq update-thread
- (wl-summary-append-message-func-internal
- entity overview mark-alist
- (not sync-all)))
- (wl-append update-top-list update-thread))
- (if elmo-use-database
- (elmo-database-msgid-put
- (car entity) folder
- (elmo-msgdb-overview-entity-get-number entity)))
- (setq curp (cdr curp))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (if (or (zerop (% i 5)) (= i num))
- (elmo-display-progress
- 'wl-summary-sync-update3 "Updating thread..."
- (/ (* i 100) num)))))
- (when wl-summary-delayed-update
- (while wl-summary-delayed-update
- (message "Parent (%d) of message %d is no entity"
- (caar wl-summary-delayed-update)
- (elmo-msgdb-overview-entity-get-number
- (cdar wl-summary-delayed-update)))
- (when (setq update-thread
- (wl-summary-append-message-func-internal
- (cdar wl-summary-delayed-update)
- overview mark-alist (not sync-all) t))
- (wl-append update-top-list update-thread))
- (setq wl-summary-delayed-update
- (cdr wl-summary-delayed-update))))
- (when (and (eq wl-summary-buffer-view 'thread)
- update-top-list)
- (wl-thread-update-indent-string-thread
- (elmo-uniq-list update-top-list)))
- (message "Updating thread...done")
-;;; (set-buffer cur-buf)
- ))
- (wl-summary-set-message-modified)
- (wl-summary-set-mark-modified)
- (when (and sync-all (eq wl-summary-buffer-view 'thread))
- (elmo-kill-buffer wl-summary-search-buf-name)
- (message "Inserting thread...")
- (setq wl-thread-entity-cur 0)
- (wl-thread-insert-top)
- (message "Inserting thread...done"))
- (if elmo-use-database
- (elmo-database-close))
- (run-hooks 'wl-summary-sync-updated-hook)
- (setq ret-val (format "Updated (-%d/+%d) message(s)"
- (length delete-list) num)))
- ;; synchronize marks.
- (if wl-summary-auto-sync-marks
- (wl-summary-sync-marks))
- ;; scoring
- (when wl-use-scoring
- (setq wl-summary-scored nil)
- (wl-summary-score-headers nil wl-summary-buffer-msgdb
- (and sync-all
- (wl-summary-rescore-msgs number-alist))
- sync-all)
- (when (and wl-summary-scored
- (setq expunged (wl-summary-score-update-all-lines)))
- (setq ret-val (concat ret-val
- (format " (%d expunged)"
- (length expunged))))))
- ;; crosspost
- (setq crossed2 (wl-summary-update-crosspost))
- (if (or crossed crossed2)
- (let ((crosses (+ (or crossed 0)
- (or crossed2 0))))
- (setq ret-val
- (if ret-val
- (concat ret-val
- (format " (%d crosspost)" crosses))
- (format "%d crosspost message(s)" crosses))))
- (and ret-val
- (setq ret-val (concat ret-val "."))))
- ;; Update Folder mode
- (wl-folder-set-folder-updated folder (list 0
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb))
- (length in-folder)))
- (wl-summary-update-modeline)
- (wl-summary-buffer-number-column-detect t)
- ;;
- (unless unset-cursor
- (goto-char (point-min))
- (if (not (wl-summary-cursor-down t))
- (progn
- (goto-char (point-max))
- (forward-line -1))
- (if (and wl-summary-highlight
- (not (get-text-property (point) 'face)))
- (save-excursion
- (forward-line (- 0
- (or
- wl-summary-partial-highlight-above-lines
- wl-summary-highlight-partial-threshold)))
- (wl-highlight-summary (point) (point-max))))))
- (wl-delete-all-overlays)
- (set-buffer-modified-p nil)
- ret-val))
+ (unless wl-summary-buffer-elmo-folder
+ (error "(Internal error) Folder is not set:%s" (buffer-name
+ (current-buffer))))
+ (fset 'wl-summary-append-message-func-internal
+ (wl-summary-get-append-message-func))
+ ;; Flush pending append operations (disconnected operation).
+ ;;(setq seen-list
+ ;;(wl-summary-flush-pending-append-operations seen-list))
+ (goto-char (point-max))
+ (wl-folder-confirm-existence folder (elmo-folder-plugged-p folder))
+ (setq sync-result (elmo-folder-synchronize
+ folder
+ wl-summary-new-mark
+ wl-summary-unread-uncached-mark
+ wl-summary-unread-cached-mark
+ wl-summary-read-uncached-mark
+ wl-summary-important-mark
+ sync-all no-check))
+ (setq new-msgdb (nth 0 sync-result))
+ (setq delete-list (nth 1 sync-result))
+ (setq crossed (nth 2 sync-result))
+ (if sync-result
+ (progn
+ ;; Setup sync-all
+ (if sync-all (wl-summary-sync-all-init))
+; (if (and has-nntp
+; (elmo-nntp-max-number-precedes-list-active-p))
+ ;; XXX this does not work correctly in rare case.
+; (setq delete-list
+; (wl-summary-delete-canceled-msgs-from-list
+; delete-list
+; (wl-summary-buffer-msgdb))))
+ (when delete-list
+ (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
+ (message "Deleting...done"))
+ (when new-msgdb
+ (wl-summary-replace-status-marks
+ wl-summary-new-mark
+ wl-summary-unread-uncached-mark))
+ (setq append-list (elmo-msgdb-get-overview new-msgdb))
+ (setq curp append-list)
+ (setq num (length curp))
+ (when append-list
+ (setq i 0)
+
+ ;; set these value for append-message-func
+ (setq overview (elmo-msgdb-get-overview
+ (elmo-folder-msgdb folder)))
+ (setq number-alist (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb folder)))
+
+ (setq wl-summary-delayed-update nil)
+ (elmo-kill-buffer wl-summary-search-buf-name)
+ (while curp
+ (setq entity (car curp))
+ (when (setq update-thread
+ (wl-summary-append-message-func-internal
+ entity (elmo-folder-msgdb folder)
+ (not sync-all)))
+ (wl-append update-top-list update-thread))
+ (if elmo-use-database
+ (elmo-database-msgid-put
+ (car entity) (elmo-folder-name-internal folder)
+ (elmo-msgdb-overview-entity-get-number entity)))
+ (setq curp (cdr curp))
+ (when (> num elmo-display-progress-threshold)
+ (setq i (+ i 1))
+ (if (or (zerop (% i 5)) (= i num))
+ (elmo-display-progress
+ 'wl-summary-sync-update "Updating thread..."
+ (/ (* i 100) num)))))
+ (when wl-summary-delayed-update
+ (while wl-summary-delayed-update
+ (message "Parent (%d) of message %d is no entity"
+ (caar wl-summary-delayed-update)
+ (elmo-msgdb-overview-entity-get-number
+ (cdar wl-summary-delayed-update)))
+ (when (setq update-thread
+ (wl-summary-append-message-func-internal
+ (cdar wl-summary-delayed-update)
+ (elmo-folder-msgdb folder)
+ (not sync-all) t))
+ (wl-append update-top-list update-thread))
+ (setq wl-summary-delayed-update
+ (cdr wl-summary-delayed-update))))
+ (when (and (eq wl-summary-buffer-view 'thread)
+ update-top-list)
+ (wl-thread-update-indent-string-thread
+ (elmo-uniq-list update-top-list)))
+ (message "Updating thread...done"))
+ (unless (eq wl-summary-buffer-view 'thread)
+ (wl-summary-make-number-list))
+ (wl-summary-set-message-modified)
+ (wl-summary-set-mark-modified)
+ (when (and sync-all (eq wl-summary-buffer-view 'thread))
+ (elmo-kill-buffer wl-summary-search-buf-name)
+ (message "Inserting thread...")
+ (wl-thread-insert-top)
+ (message "Inserting thread...done"))
+ (if elmo-use-database
+ (elmo-database-close))
+ (run-hooks 'wl-summary-sync-updated-hook)
+ (setq mes
+ (if (and (eq (length delete-list) 0)
+ (eq num 0))
+ (format
+ "No updates for \"%s\"" (elmo-folder-name-internal
+ folder))
+ (format "Updated (-%d/+%d) message(s)"
+ (length delete-list) num))))
+ (setq mes "Quit updating.")))
+ ;; synchronize marks.
+ (if (and wl-summary-auto-sync-marks sync-result)
+ (wl-summary-sync-marks))
+ ;; scoring
+ (when wl-use-scoring
+ (setq wl-summary-scored nil)
+ (wl-summary-score-headers nil (wl-summary-buffer-msgdb)
+ (and sync-all
+ (wl-summary-rescore-msgs number-alist))
+ sync-all)
+ (when (and wl-summary-scored
+ (setq expunged (wl-summary-score-update-all-lines)))
+ (setq mes (concat mes
+ (format " (%d expunged)"
+ (length expunged))))))
+ (if (and crossed (> crossed 0))
+ (setq mes
+ (if mes
+ (concat mes
+ (format " (%d crosspost)" crossed))
+ (format "%d crosspost message(s)" crossed)))
+ (and mes (setq mes (concat mes "."))))
+ ;; Update Folder mode
+ (wl-folder-set-folder-updated
+ (elmo-folder-name-internal folder)
+ (list 0
+ (let ((pair (wl-summary-count-unread)))
+ (+ (car pair) (cdr pair)))
+ (elmo-folder-messages folder)))
+ (wl-summary-update-modeline)
+ ;;
+ (unless unset-cursor
+ (goto-char (point-min))
+ (if (not (wl-summary-cursor-down t))
+ (progn
+ (goto-char (point-max))
+ (forward-line -1))
+ (if (and wl-summary-highlight
+ (not (get-text-property (point) 'face)))
+ (save-excursion
+ (forward-line (- 0
+ (or
+ wl-summary-partial-highlight-above-lines
+ wl-summary-highlight-partial-threshold)))
+ (wl-highlight-summary (point) (point-max))))))
+ (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder))
+ (wl-delete-all-overlays)
+ (set-buffer-modified-p nil)
+ (if mes (message "%s" mes)))))
(defun wl-summary-set-score-mark (mark)
(save-excursion
(buffer-read-only nil)
msg-num
cur-mark)
- (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
- (setq msg-num (string-to-int (wl-match-buffer 1)))
- (setq cur-mark (wl-match-buffer 2))
- (when (member cur-mark (list " "
- wl-summary-score-below-mark
- wl-summary-score-over-mark))
- (goto-char (match-end 1))
- (delete-region (match-beginning 2) (match-end 2))
- (insert mark)
- (if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t))
- (set-buffer-modified-p nil))))))
+ (setq msg-num (wl-summary-message-number))
+ (setq cur-mark (wl-summary-temp-mark))
+ (when (member cur-mark (list " "
+ wl-summary-score-below-mark
+ wl-summary-score-over-mark))
+ (delete-backward-char 1)
+ (insert mark)
+ (if wl-summary-highlight
+ (wl-highlight-summary-current-line nil nil t))
+ (set-buffer-modified-p nil)))))
(defun wl-summary-get-score-mark (msg-num)
(let ((score (cdr (assq msg-num wl-summary-scored))))
"+")))))
(defun wl-summary-update-modeline ()
- (setq wl-summary-buffer-unread-status
- (format " {%s}(%d new/%d unread)"
- (if (eq wl-summary-buffer-view 'thread)
- "T" "S")
- wl-summary-buffer-new-count
- (+ wl-summary-buffer-new-count
- wl-summary-buffer-unread-count))))
-
-(defsubst wl-summary-jump-to-msg (&optional number)
+ (setq wl-summary-buffer-mode-line
+ (funcall wl-summary-buffer-mode-line-formatter)))
+
+(defun wl-summary-jump-to-msg (&optional number)
(interactive)
(let ((num (or number
(string-to-int
(read-from-minibuffer "Jump to Message(No.): ")))))
(setq num (int-to-string num))
- (if (re-search-forward (concat "^[ \t]*" num "[^0-9]") nil t)
- (progn
- (beginning-of-line)
- t)
- (if (re-search-backward (concat "^[ \t]*" num "[^0-9]") nil t)
- (progn
- (beginning-of-line)
- t)
- nil))))
+ (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-highlight-msgs (msgs)
(save-excursion
(defun wl-summary-message-number ()
(save-excursion
(beginning-of-line)
- (if (looking-at "^ *\\([0-9]+\\)")
+ (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))
nil)))
-(defun wl-summary-move (src dsts-msgs)
- (let* ((dsts (car dsts-msgs)) ; (+foo +bar)
-;;; (msgs (cdr dsts-msgs)) ; (1 2 3)
-;;; (msgdb wl-summary-buffer-msgdb)
-;;; result)
- )
- (while dsts
- (setq dsts (cdr dsts)))))
-
-(defun wl-summary-flush-pending-append-operations (&optional seen-list)
- "Execute append operations that are done while offline status."
- (when (and (elmo-folder-plugged-p wl-summary-buffer-folder-name)
- elmo-enable-disconnected-operation)
- (let* ((resumed-list (elmo-dop-append-list-load
- wl-summary-buffer-folder-name t))
- (append-list (elmo-dop-append-list-load
- wl-summary-buffer-folder-name))
- (appends (append resumed-list append-list))
- (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
- dels pair)
- (when appends
- (while appends
- (if (setq pair (rassoc (car appends) number-alist))
- (setq dels (append dels (list (car pair)))))
- (setq appends (cdr appends)))
- (when dels
- (setq seen-list
- (elmo-msgdb-add-msgs-to-seen-list-subr
- dels
- wl-summary-buffer-msgdb
- (concat wl-summary-important-mark
- wl-summary-read-uncached-mark)
- seen-list))
- (message "Resuming summary status...")
- (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name
- dels wl-summary-buffer-msgdb t)
- (wl-summary-delete-messages-on-buffer dels)
- (message "Resuming summary status...done"))
- ;; delete resume-file
- (elmo-dop-append-list-save wl-summary-buffer-folder-name nil t)
- (when append-list
- (elmo-dop-flush-pending-append-operations
- wl-summary-buffer-folder-name append-list)))))
- seen-list)
-
(defun wl-summary-delete-all-msgs ()
(interactive)
(let ((cur-buf (current-buffer))
- (dels (elmo-list-folder wl-summary-buffer-folder-name)))
+ (dels (elmo-folder-list-messages wl-summary-buffer-elmo-folder)))
(set-buffer cur-buf)
(if (null dels)
(message "No message to delete.")
(if (y-or-n-p (format "%s has %d message(s). Delete all? "
- wl-summary-buffer-folder-name
+ (wl-summary-buffer-folder-name)
(length dels)))
(progn
(message "Deleting...")
- (elmo-delete-msgs wl-summary-buffer-folder-name dels
- wl-summary-buffer-msgdb)
- (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name
- dels wl-summary-buffer-msgdb)
-;;; (elmo-msgdb-save wl-summary-buffer-folder-name nil)
+ (elmo-folder-delete-messages
+ wl-summary-buffer-elmo-folder dels)
+ (elmo-msgdb-delete-msgs (wl-summary-buffer-msgdb)
+ dels)
+;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil)
(wl-summary-set-message-modified)
(wl-summary-set-mark-modified)
- (wl-folder-set-folder-updated wl-summary-buffer-folder-name
+ (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
(list 0 0 0))
;;; for thread.
;;; (setq wl-thread-top-entity '(nil t nil nil))
(defun wl-summary-goto-folder (&optional arg)
(interactive "P")
- (wl-summary-goto-folder-subr nil nil nil arg t))
+ (wl-summary-goto-folder-subr nil nil nil nil t nil arg))
+
+(defun wl-summary-goto-folder-sticky ()
+ (interactive)
+ (wl-summary-goto-folder-subr nil nil nil t t))
(defun wl-summary-goto-last-visited-folder ()
(interactive)
(wl-folder-get-entity-id entity))))
(wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t))
-(defun wl-summary-sticky-p (&optional fld)
- (if fld
- (get-buffer (wl-summary-sticky-buffer-name fld))
+(defun wl-summary-sticky-p (&optional folder)
+ (if folder
+ (get-buffer (wl-summary-sticky-buffer-name
+ (elmo-folder-name-internal folder)))
(not (string= wl-summary-buffer-name (buffer-name)))))
-(defun wl-summary-always-sticky-folder-p (fld)
+(defun wl-summary-always-sticky-folder-p (folder)
(or (eq t wl-summary-always-sticky-folder-list)
- (wl-string-match-member fld wl-summary-always-sticky-folder-list)))
+ (wl-string-match-member
+ (elmo-folder-name-internal folder)
+ wl-summary-always-sticky-folder-list)))
(defun wl-summary-stick (&optional force)
"Make current summary buffer sticky."
(wl-summary-toggle-disp-msg 'off)
(wl-summary-switch-to-clone-buffer
(wl-summary-sticky-buffer-name
- wl-summary-buffer-folder-name))
+ (wl-summary-buffer-folder-name)))
;;; ???hang up
;;; (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-folder-name))))
+ (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name)))))
(defun wl-summary-switch-to-clone-buffer (buffer-name)
(let ((cur-buf (current-buffer))
(msg (wl-summary-message-number))
(buf (get-buffer-create buffer-name))
- (folder wl-summary-buffer-folder-name)
+ (folder wl-summary-buffer-elmo-folder)
(copy-variables
(append '(wl-summary-buffer-view
wl-summary-buffer-refile-list
wl-summary-buffer-delete-list
wl-summary-buffer-copy-list
wl-summary-buffer-target-mark-list
- wl-summary-buffer-msgdb
+ wl-summary-buffer-elmo-folder
wl-summary-buffer-number-column
- wl-summary-buffer-number-regexp
+ wl-summary-buffer-temp-mark-column
+ wl-summary-buffer-persistent-mark-column
wl-summary-buffer-message-modified
wl-summary-buffer-mark-modified
- wl-summary-buffer-thread-modified)
+ wl-summary-buffer-thread-modified
+ wl-summary-buffer-number-list
+ wl-summary-buffer-msgdb
+ wl-summary-buffer-folder-name
+ wl-summary-buffer-line-formatter)
(and (eq wl-summary-buffer-view 'thread)
'(wl-thread-entity-hashtb
wl-thread-entities
'(wl-summary-scored
wl-summary-default-score
wl-summary-important-above
- wl-summary-temp-above
+ wl-summary-target-above
wl-summary-mark-below
wl-summary-expunge-below))
(and (featurep 'wl-score)
(setq copy-variables (cdr copy-variables)))
(switch-to-buffer buf)
(kill-buffer cur-buf)
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline)
(if msg
(if (eq wl-summary-buffer-view 'thread)
(get-buffer (wl-summary-sticky-buffer-name folder)))
(get-buffer wl-summary-buffer-name)))
-(defun wl-summary-get-buffer-create (folder &optional force-sticky)
+(defun wl-summary-get-buffer-create (name &optional force-sticky)
(if force-sticky
(get-buffer-create
- (wl-summary-sticky-buffer-name folder))
- (or (get-buffer (wl-summary-sticky-buffer-name folder))
+ (wl-summary-sticky-buffer-name name))
+ (or (get-buffer (wl-summary-sticky-buffer-name name))
(get-buffer-create wl-summary-buffer-name))))
-(defun wl-summary-disp-msg (folder disp-msg)
- (let (disp mes-win)
- (if (and disp-msg
- wl-summary-buffer-disp-msg)
- (let ((view-message-buffer (get-buffer wl-message-buf-name))
- (number (wl-summary-message-number))
- cur-folder cur-number sel-win)
- (when view-message-buffer
- (save-excursion
- (set-buffer view-message-buffer)
- (setq cur-folder wl-message-buffer-cur-folder
- cur-number wl-message-buffer-cur-number))
- (when (and (string= folder cur-folder)
- (eq number cur-number))
- (setq sel-win (selected-window))
- (wl-select-buffer view-message-buffer)
- (select-window sel-win)
- (setq disp t)))))
- (if (not disp)
- (setq wl-summary-buffer-disp-msg nil))
- (when (and (not disp)
- (setq mes-win (wl-message-buffer-window)))
- (delete-window mes-win)
- (run-hooks 'wl-summary-toggle-disp-off-hook))))
-
-(defun wl-summary-goto-folder-subr (&optional folder scan-type other-window
- sticky interactive scoring)
+(defun wl-summary-make-number-list ()
+ (setq wl-summary-buffer-number-list
+ (mapcar
+ (lambda (x) (elmo-msgdb-overview-entity-get-number x))
+ (elmo-msgdb-get-overview (wl-summary-buffer-msgdb)))))
+
+(defun wl-summary-auto-select-msg-p (unread-msg)
+ (and unread-msg
+ (not (string=
+ (elmo-msgdb-get-mark
+ (wl-summary-buffer-msgdb)
+ unread-msg)
+ wl-summary-important-mark))))
+
+(defsubst wl-summary-open-folder (folder)
+ ;; Select folder
+ (let ((elmo-mime-charset wl-summary-buffer-mime-charset))
+ (unwind-protect
+ (elmo-folder-open folder 'load-msgdb)
+ ;; For compatibility
+ (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder))
+ (setq wl-summary-buffer-folder-name (elmo-folder-name-internal
+ folder)))))
+
+(defun wl-summary-goto-folder-subr (&optional name scan-type other-window
+ sticky interactive scoring
+ force-exit)
"Display target folder on summary."
(interactive)
(let* ((keep-cursor (memq this-command
wl-summary-keep-cursor-command))
- (fld (or folder (wl-summary-read-folder wl-default-folder)))
- (cur-fld wl-summary-buffer-folder-name)
- buf mes hilit reuse-buf
+ (name (or name (wl-summary-read-folder wl-default-folder)))
+ (cur-fld wl-summary-buffer-elmo-folder)
+ folder buf mes hilit reuse-buf
retval entity)
- (if (string= fld "")
- (setq fld wl-default-folder))
- (when (and (not (string= cur-fld fld)) ; folder is moved.
+ (if (string= name "")
+ (setq name wl-default-folder))
+ (setq folder (wl-folder-get-elmo-folder name))
+ (when (and (not (string=
+ (and cur-fld (elmo-folder-name-internal cur-fld))
+ (elmo-folder-name-internal folder))) ; folder is moved.
(eq major-mode 'wl-summary-mode)) ; called in summary.
- (setq wl-summary-last-visited-folder wl-summary-buffer-folder-name)
- (wl-summary-cleanup-temp-marks (wl-summary-sticky-p))
- (wl-summary-save-status 'keep)) ;; keep current buffer, anyway.
- (setq buf (wl-summary-get-buffer-create fld sticky))
+ (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name))
+ (run-hooks 'wl-summary-exit-pre-hook)
+ (if (or force-exit (not (wl-summary-sticky-p)))
+ (wl-summary-cleanup-temp-marks (wl-summary-sticky-p)))
+ (wl-summary-save-view)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)
+ (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)
- (string= fld wl-summary-buffer-folder-name)))
+ (string= (elmo-folder-name-internal folder)
+ (wl-summary-buffer-folder-name))))
(unwind-protect
(if reuse-buf
(if interactive
(set-buffer buf)
(unless (eq major-mode 'wl-summary-mode)
(wl-summary-mode))
- (wl-summary-buffer-set-folder fld)
+ (wl-summary-buffer-set-folder folder)
(setq wl-summary-buffer-disp-msg nil)
(setq wl-summary-buffer-last-displayed-msg nil)
(setq wl-summary-buffer-current-msg nil)
(inhibit-read-only t)
(buffer-read-only nil))
(erase-buffer)
- ;; resume summary cache
+ ;; Resume summary view
(if wl-summary-cache-use
- (let* ((dir (elmo-msgdb-expand-path fld))
+ (let* ((dir (elmo-folder-msgdb-path folder))
(cache (expand-file-name wl-summary-cache-file dir))
(view (expand-file-name wl-summary-view-file dir)))
(when (file-exists-p cache)
- (as-binary-input-file
- (insert-file-contents cache))
+ (insert-file-contents-as-binary cache)
(elmo-set-buffer-multibyte
default-enable-multibyte-characters)
(decode-mime-charset-region
(point-min)(point-max)
- wl-summary-buffer-mime-charset))
- (when (file-exists-p view)
+ wl-summary-buffer-mime-charset 'LF))
+ (if (file-exists-p view)
+ (setq wl-summary-buffer-view
+ (wl-summary-load-file-object view))
(setq wl-summary-buffer-view
- (wl-summary-load-file-object view)))
- (if (eq wl-summary-buffer-view 'thread)
- (wl-thread-resume-entity fld))))
- ;; Load msgdb
- (setq wl-summary-buffer-msgdb nil) ; new msgdb
- (setq wl-summary-buffer-msgdb
- (wl-summary-msgdb-load-async fld))
- (if (null wl-summary-buffer-msgdb)
- (setq wl-summary-buffer-msgdb
- (elmo-msgdb-load (elmo-string fld))))
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (or (wl-get-assoc-list-value
+ wl-summary-default-view-alist
+ (elmo-folder-name-internal folder))
+ wl-summary-default-view)))
+ (wl-thread-resume-entity folder)
+ (wl-summary-open-folder folder))
+ (setq wl-summary-buffer-view
+ (wl-summary-load-file-object
+ (expand-file-name wl-summary-view-file
+ (elmo-folder-msgdb-path folder))))
+ (wl-summary-open-folder folder)
+ (wl-summary-rescan))
+ (wl-summary-count-unread)
(wl-summary-update-modeline)))
- (wl-summary-buffer-number-column-detect t)
- (wl-summary-disp-msg fld (and reuse-buf keep-cursor))
+ (unless (eq wl-summary-buffer-view 'thread)
+ (wl-summary-make-number-list))
+ (when (and wl-summary-cache-use
+ (or (and wl-summary-check-line-format
+ (wl-summary-line-format-changed-p))
+ (wl-summary-view-old-p)))
+ (wl-summary-rescan))
+ (wl-summary-toggle-disp-msg (if wl-summary-buffer-disp-msg 'on 'off))
(unless (and reuse-buf keep-cursor)
;(setq hilit wl-summary-highlight)
(unwind-protect
(if (and (not scan-type)
interactive
(not wl-ask-range))
- (setq scan-type (wl-summary-get-sync-range fld)))
+ (setq scan-type (wl-summary-get-sync-range folder)))
(cond
((eq scan-type nil)
(wl-summary-sync 'unset-cursor))
((eq scan-type 'no-sync))
((or (eq scan-type 'force-update)
(eq scan-type 'update))
- (setq mes (wl-summary-sync-force-update 'unset-cursor)))))
+ (setq mes (wl-summary-sync-force-update
+ 'unset-cursor 'no-check)))))
(if interactive
(switch-to-buffer buf)
(set-buffer buf))
;; stick always-sticky-folder
- (when (wl-summary-always-sticky-folder-p fld)
+ (when (wl-summary-always-sticky-folder-p folder)
(or (wl-summary-sticky-p) (wl-summary-stick t)))
(run-hooks 'wl-summary-prepared-pre-hook)
(set-buffer-modified-p nil)
(goto-char (point-min))
(if (wl-summary-cursor-down t)
- (let ((unreadp (wl-thread-next-mark-p
- (wl-thread-entity-get-mark
- (wl-summary-message-number))
- wl-summary-move-order)))
- (cond ((and wl-auto-select-first unreadp)
+ (let ((unreadp (wl-summary-next-message
+ (wl-summary-message-number)
+ 'down t)))
+ (cond ((and wl-auto-select-first
+ (wl-summary-auto-select-msg-p unreadp))
+ ;; wl-auto-select-first is non-nil and
+ ;; unreadp is non-nil but not important
(setq retval 'disp-msg))
- ((not unreadp)
+ ((and wl-auto-prefetch-first
+ (wl-summary-auto-select-msg-p unreadp))
+ ;; wl-auto-select-first is non-nil and
+ ;; unreadp is non-nil but not important
+ (setq retval 'prefetch-msg))
+ ((not (wl-summary-auto-select-msg-p unreadp))
+ ;; unreadp is nil or important
(setq retval 'more-next))))
(goto-char (point-max))
(if (elmo-folder-plugged-p folder)
wl-summary-highlight-partial-threshold)))
(wl-highlight-summary (point) (point-max)))
(wl-highlight-summary (point-min) (point-max))))
- (if (null wl-summary-buffer-msgdb) ;; one more try.
- (setq wl-summary-buffer-msgdb
- (elmo-msgdb-load (elmo-string fld))))
(if (eq retval 'disp-msg)
(wl-summary-redisplay))
+ (if (eq retval 'prefetch-msg)
+ (wl-message-buffer-prefetch
+ folder
+ (wl-summary-message-number)
+ wl-message-buffer-prefetch-depth
+ (current-buffer)
+ wl-summary-buffer-mime-charset))
(if mes (message "%s" mes))
(if (and interactive wl-summary-recenter)
(recenter (/ (- (window-height) 2) 2))))))
;; set current entity-id
(if (and (not folder)
(setq entity
- (wl-folder-search-entity-by-name fld
+ (wl-folder-search-entity-by-name (elmo-folder-name-internal
+ folder)
wl-folder-entity
'folder)))
;; entity-id is unknown.
(wl-folder-set-current-entity-id
(wl-folder-get-entity-id entity)))
+ (when (and wl-summary-lazy-highlight
+ wl-on-xemacs)
+ (sit-for 0))
(unwind-protect
(run-hooks 'wl-summary-prepared-hook)
(set-buffer-modified-p nil))
retval))
-(defun wl-summary-summary-line-already-exists-p (parent-number buffer)
- "Return the depth."
- (set-buffer buffer)
- (goto-char (point-max))
- (let ((depth 0))
- (when (re-search-backward (format "^ *%s..../..\(.*\)..:.. "
- parent-number) nil t)
- (goto-char (match-end 0))
- (while (string-match wl-thread-indent-regexp
- (char-to-string
- (char-after (point))))
- (setq depth (+ 1 depth))
- (forward-char))
- (/ depth wl-thread-indent-level-internal))))
-
-(defun wl-summary-goto-bottom-of-current-thread ()
- (if (re-search-forward (concat "^" wl-summary-buffer-number-regexp
- "..../..\(.*\)..:.. [[<]") nil t)
- ()
- (goto-char (point-max))))
+(defun wl-summary-goto-previous-message-beginning ()
+ (end-of-line)
+ (re-search-backward "\r\\(-?[0-9]+\\)" nil t)
+ (beginning-of-line))
(defun wl-summary-goto-top-of-current-thread ()
(wl-summary-jump-to-msg
(save-excursion (beginning-of-line)(point))
(save-excursion (end-of-line)(point))
'mouse-face nil))
- (condition-case nil ; it's dangerous, so ignore error.
- (run-hooks 'wl-summary-line-inserted-hook)
- (error (ding)
- (message "Error in wl-summary-line-inserted-hook"))))
-
-(defun wl-summary-insert-summary (entity database mark-alist dummy &optional dummy)
- (let ((overview-entity entity)
- summary-line msg)
- (setq msg (elmo-msgdb-overview-entity-get-number entity))
- (when (setq summary-line
- (wl-summary-overview-create-summary-line
- msg entity nil 0 mark-alist))
- (let ((inhibit-read-only t)
- buffer-read-only)
- (goto-char (point-max))
- (wl-summary-insert-line summary-line)))))
+ (ignore-errors
+ (run-hooks 'wl-summary-line-inserted-hook)))
+
+(defun wl-summary-insert-sequential (entity msgdb &rest args)
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (goto-char (point-max))
+ (wl-summary-insert-line
+ (wl-summary-create-line entity nil nil
+ (elmo-msgdb-get-mark
+ msgdb
+ (elmo-msgdb-overview-entity-get-number
+ entity))))))
(defun wl-summary-default-subject-filter (subject)
(let ((case-fold-search t))
- (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\):" ""))
+ (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" ""))
(setq subject (elmo-replace-in-string subject "[ \t]" ""))
(elmo-replace-in-string subject "^\\[.*\\]" "")))
(defun wl-summary-subject-equal (subject1 subject2)
- (string= (wl-summary-subject-filter-func-internal subject1)
- (wl-summary-subject-filter-func-internal 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))
(setq this (funcall func ov))
(and this (setq this (std11-unfold-string this)))
(if (equal last this)
- (wl-append alike (list ov))
+ (setq alike (cons ov alike))
(when last
(wl-summary-put-alike alike)
(insert last ?\n))
(run-hooks 'wl-summary-insert-headers-hook)))
(defun wl-summary-search-by-subject (entity overview)
- (let ((buf (get-buffer-create wl-summary-search-buf-name))
- (folder-name wl-summary-buffer-folder-name)
- match founds found-entity)
- (save-excursion
- (set-buffer buf)
+ (let ((summary-buf (current-buffer))
+ (buf (get-buffer-create wl-summary-search-buf-name))
+ (folder-name (wl-summary-buffer-folder-name))
+ match founds cur result)
+ (with-current-buffer buf
(let ((case-fold-search t))
- (when (or (not (string= wl-summary-buffer-folder-name folder-name))
+ (when (or (not (string= wl-summary-search-buf-folder-name folder-name))
(zerop (buffer-size)))
- (setq wl-summary-buffer-folder-name folder-name)
+ (setq wl-summary-search-buf-folder-name folder-name)
+ (message "Creating subject cache...")
(wl-summary-insert-headers
overview
(function
(lambda (x)
- (wl-summary-subject-filter-func-internal
- (elmo-msgdb-overview-entity-get-subject-no-decode x))))
- t))
- (setq match (wl-summary-subject-filter-func-internal
- (elmo-msgdb-overview-entity-get-subject entity)))
+ (funcall wl-summary-subject-filter-function
+ (elmo-msgdb-overview-entity-get-subject-no-decode x))))
+ t)
+ (message "Creating subject cache...done"))
+ (setq match (funcall wl-summary-subject-filter-function
+ (elmo-msgdb-overview-entity-get-subject entity)))
(if (string= match "")
(setq match "\n"))
(goto-char (point-max))
- (while (and (not founds)
+ (while (and (null result)
(not (= (point) (point-min)))
(search-backward match nil t))
;; check exactly match
- (when (and (bolp)
- (= (point-at-eol)
- (match-end 0)))
- (setq found-entity (wl-summary-get-alike))
- (if (and found-entity
- ;; Is founded entity myself or children?
- (not (string=
- (elmo-msgdb-overview-entity-get-id entity)
- (elmo-msgdb-overview-entity-get-id (car found-entity))))
- (not (wl-thread-descendant-p
- (elmo-msgdb-overview-entity-get-number entity)
- (elmo-msgdb-overview-entity-get-number (car found-entity)))))
- ;; return matching entity
- (setq founds found-entity))))
- (if founds
- (car founds))))))
-
-(defun wl-summary-insert-thread-entity (entity overview mark-alist update
+ (when (and (bolp) (= (point-at-eol)(match-end 0)))
+ (setq founds (wl-summary-get-alike))
+ (with-current-buffer summary-buf
+ (while founds
+ (when (and
+ ;; the first element of found-entity list exists on
+ ;; thread tree.
+ (wl-thread-get-entity
+ (elmo-msgdb-overview-entity-get-number
+ (car founds)))
+ ;; message id is not same as myself.
+ (not (string=
+ (elmo-msgdb-overview-entity-get-id entity)
+ (elmo-msgdb-overview-entity-get-id (car founds))))
+ ;; not a descendant.
+ (not (wl-thread-descendant-p
+ (elmo-msgdb-overview-entity-get-number entity)
+ (elmo-msgdb-overview-entity-get-number
+ (car founds)))))
+ (setq result (car founds)
+ founds nil))
+ (setq founds (cdr founds))))))
+ result))))
+
+(defun wl-summary-insert-thread-entity (entity msgdb update
&optional force-insert)
- (let (update-list entity-stack)
+ (let* ((overview (elmo-msgdb-get-overview msgdb))
+ this-id
+ parent-entity
+ parent-number
+ (case-fold-search t)
+ cur number overview2 cur-entity linked retval delayed-entity
+ update-list entity-stack)
(while entity
- (let* ((this-id (elmo-msgdb-overview-entity-get-id entity))
- (parent-entity
- (elmo-msgdb-overview-get-parent-entity entity overview));; temp
-;;; (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
- (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
- (case-fold-search t)
- msg overview2 cur-entity linked retval delayed-entity)
- (setq msg (elmo-msgdb-overview-entity-get-number entity))
+ (setq this-id (elmo-msgdb-overview-entity-get-id entity)
+ parent-entity
+ (elmo-msgdb-get-parent-entity entity msgdb)
+ parent-number (elmo-msgdb-overview-entity-get-number
+ parent-entity))
+ (setq number (elmo-msgdb-overview-entity-get-number entity))
+ ;; If thread loop detected, set parent as nil.
+ (setq cur entity)
+ (while cur
+ (if (eq number (elmo-msgdb-overview-entity-get-number
+ (setq cur
+ (elmo-msgdb-get-parent-entity cur msgdb))))
+ (setq parent-number nil
+ cur nil)))
+ (if (and parent-number
+ (not (wl-thread-get-entity parent-number))
+ (not force-insert))
+ ;; parent exists in overview, but not in wl-thread-entities
+ (progn
+ (wl-append wl-summary-delayed-update
+ (list (cons parent-number entity)))
+ (setq entity nil)) ;; exit loop
+ ;; Search parent by subject.
+ (when (and (null parent-number)
+ wl-summary-search-parent-by-subject-regexp
+ (string-match
+ wl-summary-search-parent-by-subject-regexp
+ (elmo-msgdb-overview-entity-get-subject entity)))
+ (let ((found (wl-summary-search-by-subject entity overview)))
+ (when (and found
+ (not (member found wl-summary-delayed-update)))
+ (setq parent-entity found)
+ (setq parent-number
+ (elmo-msgdb-overview-entity-get-number parent-entity))
+ (setq linked t))))
+ ;; If subject is change, divide thread.
(if (and parent-number
- (not (wl-thread-get-entity parent-number))
- (not force-insert))
- ;; parent is exists in overview, but not exists in wl-thread-entities
- (progn
- (wl-append wl-summary-delayed-update
- (list (cons parent-number entity)))
- (setq entity nil)) ;; exit loop
- ;; Search parent by subject.
- (when (and (null parent-number)
- wl-summary-search-parent-by-subject-regexp
- (string-match wl-summary-search-parent-by-subject-regexp
- (elmo-msgdb-overview-entity-get-subject entity)))
- (let ((found (wl-summary-search-by-subject entity overview)))
- (when (and found
- (not (member found wl-summary-delayed-update)))
- (setq parent-entity found)
- (setq parent-number
- (elmo-msgdb-overview-entity-get-number parent-entity))
- (setq linked t))))
- ;; If subject is change, divide thread.
- (if (and parent-number
- wl-summary-divide-thread-when-subject-changed
- (not (wl-summary-subject-equal
- (or (elmo-msgdb-overview-entity-get-subject
- entity) "")
- (or (elmo-msgdb-overview-entity-get-subject
- parent-entity) ""))))
- (setq parent-number nil))
- ;;
- (setq retval
- (wl-thread-insert-message entity overview mark-alist
- msg parent-number update linked))
- (and retval
- (wl-append update-list (list retval)))
- (setq entity nil) ; exit loop
- (while (setq delayed-entity (assq msg wl-summary-delayed-update))
- (setq wl-summary-delayed-update
- (delete delayed-entity wl-summary-delayed-update))
- ;; update delayed message
- (wl-append entity-stack (list (cdr delayed-entity)))))
- (if (and (not entity)
- entity-stack)
- (setq entity (pop entity-stack)))))
+ wl-summary-divide-thread-when-subject-changed
+ (not (wl-summary-subject-equal
+ (or (elmo-msgdb-overview-entity-get-subject
+ entity) "")
+ (or (elmo-msgdb-overview-entity-get-subject
+ parent-entity) ""))))
+ (setq parent-number nil))
+ (setq retval
+ (wl-thread-insert-message entity
+ number parent-number update linked))
+ (and retval
+ (wl-append update-list (list retval)))
+ (setq entity nil) ; exit loop
+ (while (setq delayed-entity (assq number wl-summary-delayed-update))
+ (setq wl-summary-delayed-update
+ (delq delayed-entity wl-summary-delayed-update))
+ ;; update delayed message
+ (wl-append entity-stack (list (cdr delayed-entity)))))
+ (if (and (not entity)
+ entity-stack)
+ (setq entity (pop entity-stack))))
update-list))
(defun wl-summary-update-thread (entity
- overview
- mark-alist
thr-entity
parent-entity)
- (let* ((depth 0)
- (this-id (elmo-msgdb-overview-entity-get-id entity))
+ (let* ((this-id (elmo-msgdb-overview-entity-get-id entity))
(overview-entity entity)
(parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
+ (number (elmo-msgdb-overview-entity-get-number entity))
(parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
- summary-line msg subject-differ)
+ insert-line)
(cond
((or (not parent-id)
(string= this-id parent-id))
(goto-char (point-max))
- (beginning-of-line))
+ (beginning-of-line)
+ (setq insert-line t))
;; parent already exists in buffer.
- ((setq depth (or (wl-summary-summary-line-already-exists-p
- parent-number (current-buffer)) -1))
- (setq depth (+ 1 depth))
- (wl-thread-goto-bottom-of-sub-thread)))
- (if (and (setq msg (elmo-msgdb-overview-entity-get-number entity)))
- (if (setq summary-line
- (wl-summary-overview-create-summary-line
- msg entity parent-entity depth mark-alist
- (wl-thread-maybe-get-children-num msg)
- nil thr-entity))
- (let ((inhibit-read-only t)
- (buffer-read-only nil))
- (wl-summary-insert-line summary-line))))))
+ ((wl-summary-jump-to-msg parent-number)
+ (wl-thread-goto-bottom-of-sub-thread)
+ (setq insert-line t)))
+ (when insert-line
+ (let (buffer-read-only)
+ (wl-summary-insert-line
+ (wl-summary-create-line
+ entity
+ parent-entity
+ nil
+ (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) number)
+ (wl-thread-maybe-get-children-num number)
+ (wl-thread-make-indent-string thr-entity)
+ (wl-thread-entity-get-linked thr-entity)))))))
(defun wl-summary-mark-as-unread (&optional number
no-server-update
(let* (eol
(inhibit-read-only t)
(buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
- new-mark visible mark)
+ new-mark visible mark cur-mark)
(if number
(progn
(setq visible (wl-summary-jump-to-msg number))
- (unless (setq mark (cadr (assq number mark-alist)))
+ (unless (setq mark (elmo-msgdb-get-mark msgdb number))
(setq mark " ")))
;; interactive
(setq visible t))
(message "No message.")
(end-of-line)
(setq eol (point))
- (re-search-backward (concat "^" wl-summary-buffer-number-regexp
- "..../..")) ; set cursor line
- (beginning-of-line)))
+ (wl-summary-goto-previous-message-beginning)))
(if (or (and (not visible)
;; already exists in msgdb.
- (assq number (elmo-msgdb-get-number-alist msgdb)))
- (re-search-forward
- (format (concat "^ *\\("
- (if number (int-to-string number)
- "[0-9]+")
- "\\)[^0-9]\\(%s\\|%s\\)")
- wl-summary-read-uncached-mark
- " ") eol t))
+ (elmo-msgdb-overview-get-entity number msgdb))
+ (progn
+ ;; visible.
+ (setq cur-mark (wl-summary-persistent-mark))
+ (or (string= cur-mark " ")
+ (string= cur-mark wl-summary-read-uncached-mark))))
(progn
- (setq number (or number (string-to-int (wl-match-buffer 1))))
- (setq mark (or mark (elmo-match-buffer 2)))
+ (setq number (or number (wl-summary-message-number)))
+ (setq mark (or mark cur-mark))
(save-match-data
(setq new-mark (if (string= mark
wl-summary-read-uncached-mark)
wl-summary-unread-uncached-mark
- (if (elmo-use-cache-p folder number)
+ (if (elmo-message-use-cache-p folder number)
wl-summary-unread-mark
wl-summary-unread-uncached-mark))))
;; server side mark
(unless no-server-update
- (unless (elmo-mark-as-unread folder (list number)
- msgdb)
- (error "Setting mark failed")))
+ (save-match-data
+ (unless (elmo-folder-unmark-read folder (list number))
+ (error "Setting mark failed"))))
(when visible
- (delete-region (match-beginning 2) (match-end 2))
+ (delete-backward-char 1)
(insert new-mark))
- (setq mark-alist
- (elmo-msgdb-mark-set mark-alist
- number
- new-mark))
- (elmo-msgdb-set-mark-alist msgdb mark-alist)
+ (elmo-msgdb-set-mark msgdb number new-mark)
(unless no-modeline-update
(setq wl-summary-buffer-unread-count
(+ 1 wl-summary-buffer-unread-count))
(wl-summary-update-modeline)
(wl-folder-update-unread
- folder
+ (wl-summary-buffer-folder-name)
(+ wl-summary-buffer-unread-count
wl-summary-buffer-new-count)))
(wl-summary-set-mark-modified)
(set-buffer-modified-p nil))
(defun wl-summary-delete (&optional number)
- "Mark Delete mark 'D'.
+ "Mark a delete mark 'D'.
If optional argument NUMBER is specified, mark message specified by NUMBER."
(interactive)
(let* ((buffer-num (wl-summary-message-number))
(save-excursion
(let ((inhibit-read-only t)
(buffer-read-only nil)
- (buf (current-buffer))
- sol eol rs re)
+ (buf (current-buffer))
+ sol eol rs re)
(beginning-of-line)
(setq sol (point))
- (end-of-line)
+ (search-forward "\r")
+ (forward-char -1)
(setq eol (point))
(setq rs (next-single-property-change sol 'wl-summary-destination
buf eol))
(wl-append msglist result)))
(forward-line 1)))
(elmo-uniq-list msglist))
- (let* ((case-fold-search nil)
- (re (format (concat wl-summary-message-regexp "%s")
- (regexp-quote mark))))
- (while (re-search-forward re nil t)
+ (while (not (eobp))
+ (when (string= (wl-summary-temp-mark) mark)
(setq msglist (cons (wl-summary-message-number) msglist)))
- (nreverse msglist)))))))
+ (forward-line 1)))))))
(defun wl-summary-exec ()
(interactive)
(message "No marks")
(save-excursion
(let ((del-fld (wl-summary-get-delete-folder
- wl-summary-buffer-folder-name))
+ (wl-summary-buffer-folder-name)))
(start (point))
(unread-marks (list wl-summary-unread-cached-mark
wl-summary-unread-uncached-mark
wl-summary-new-mark))
(refiles (append moves dels))
- (refile-executed 0)
(refile-failures 0)
- (copy-executed 0)
(copy-failures 0)
(copy-len (length copies))
refile-len
(wl-inverse-alist refiles wl-summary-buffer-refile-list))
(goto-char start) ; avoid moving cursor to
; the bottom line.
+ (when (> refile-len elmo-display-progress-threshold)
+ (elmo-progress-set 'elmo-folder-move-messages
+ refile-len "Moving messages..."))
(while dst-msgs
-;;; (elmo-msgdb-add-msgs-to-seen-list
-;;; (car (car dst-msgs)) ;dst-folder
-;;; (cdr (car dst-msgs)) ;msgs
-;;; wl-summary-buffer-msgdb
-;;; (concat wl-summary-important-mark
-;;; wl-summary-read-uncached-mark))
(setq result nil)
(condition-case nil
- (setq result (elmo-move-msgs wl-summary-buffer-folder-name
- (cdr (car dst-msgs))
- (car (car dst-msgs))
- wl-summary-buffer-msgdb
- refile-len
- refile-executed
- (not (null (cdr dst-msgs)))
- nil ; no-delete
- nil ; same-number
- unread-marks))
+ (setq result (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ (cdr (car dst-msgs))
+ (if (eq 'null (car (car dst-msgs)))
+ 'null
+ (wl-folder-get-elmo-folder
+ (car (car dst-msgs))))
+ (wl-summary-buffer-msgdb)
+ (not (null (cdr dst-msgs)))
+ nil ; no-delete
+ nil ; same-number
+ unread-marks
+ t))
(error nil))
(if result ; succeeded.
(progn
;; update refile-alist.
(setq wl-summary-buffer-refile-list
(wl-delete-associations (cdr (car dst-msgs))
- wl-summary-buffer-refile-list)))
+ wl-summary-buffer-refile-list)))
(setq refile-failures
(+ refile-failures (length (cdr (car dst-msgs))))))
- (setq refile-executed (+ refile-executed (length (cdr (car dst-msgs)))))
(setq dst-msgs (cdr dst-msgs)))
+ (elmo-progress-clear 'elmo-folder-move-messages)
;; end refile
;; begin cOpy...
(setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
+ (when (> copy-len elmo-display-progress-threshold)
+ (elmo-progress-set 'elmo-folder-move-messages
+ copy-len "Copying messages..."))
(while dst-msgs
-;;; (elmo-msgdb-add-msgs-to-seen-list
-;;; (car (car dst-msgs)) ;dst-folder
-;;; (cdr (car dst-msgs)) ;msgs
-;;; wl-summary-buffer-msgdb
-;;; (concat wl-summary-important-mark
-;;; wl-summary-read-uncached-mark))
(setq result nil)
(condition-case nil
- (setq result (elmo-move-msgs wl-summary-buffer-folder-name
- (cdr (car dst-msgs))
- (car (car dst-msgs))
- wl-summary-buffer-msgdb
- copy-len
- copy-executed
- (not (null (cdr dst-msgs)))
- t ; t is no-delete (copy)
- nil ; same number
- unread-marks))
+ (setq result (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ (cdr (car dst-msgs))
+ (wl-folder-get-elmo-folder
+ (car (car dst-msgs)))
+ (wl-summary-buffer-msgdb)
+ (not (null (cdr dst-msgs)))
+ t ; t is no-delete (copy)
+ nil ; same number
+ unread-marks
+ t))
(error nil))
(if result ; succeeded.
(progn
wl-summary-buffer-copy-list)))
(setq copy-failures
(+ copy-failures (length (cdr (car dst-msgs))))))
- (setq copy-executed (+ copy-executed (length (cdr (car dst-msgs)))))
(setq dst-msgs (cdr dst-msgs)))
+ ;; Hide progress bar.
+ (elmo-progress-clear 'elmo-folder-move-messages)
;; end cOpy
(wl-summary-folder-info-update)
(wl-summary-set-message-modified)
(wl-summary-set-mark-modified)
(run-hooks 'wl-summary-exec-hook)
+ (unless (and wl-message-buffer
+ (eq (wl-summary-message-number)
+ (with-current-buffer wl-message-buffer
+ wl-message-buffer-cur-number)))
+ (wl-summary-toggle-disp-msg 'off))
(set-buffer-modified-p nil)
(message (concat "Executing ... done"
(if (> refile-failures 0)
"")
"."))))))
+(defun wl-summary-erase (&optional number)
+ "Erase message actually, without moving it to trash."
+ (interactive)
+ (if (elmo-folder-writable-p wl-summary-buffer-elmo-folder)
+ (let* ((buffer-num (wl-summary-message-number))
+ (msg-num (or number buffer-num)))
+ (if (null msg-num)
+ (message "No message.")
+ (let* ((msgdb (wl-summary-buffer-msgdb))
+ (entity (elmo-msgdb-overview-get-entity msg-num msgdb))
+ (subject (elmo-delete-char
+ ?\n (or (elmo-msgdb-overview-entity-get-subject
+ entity)
+ wl-summary-no-subject-message))))
+ (when (yes-or-no-p
+ (format "Erase \"%s\" without moving it to trash? "
+ (truncate-string subject 30)))
+ (wl-summary-unmark msg-num)
+ (elmo-folder-delete-messages wl-summary-buffer-elmo-folder
+ (list msg-num))
+ (wl-summary-sync nil "update")))))
+ (message "Read-only folder.")))
+
(defun wl-summary-read-folder (default &optional purpose ignore-error
no-create init)
(let ((fld (completing-read
(format "Folder name %s(%s): " (or purpose "")
default)
- (or wl-folder-completion-func
+ (or wl-folder-completion-function
(if (memq 'read-folder wl-use-folder-petname)
(wl-folder-get-entity-with-petname)
wl-folder-entity-hashtb))
(setq fld default))
(setq fld (elmo-string (wl-folder-get-realname fld)))
(if (string-match "\n" fld)
- (error "Not supported folder name: %s" fld))
+ (error "Not supported folder name: %s" fld))
(unless no-create
(if ignore-error
- (ignore-errors (wl-folder-confirm-existence fld))
- (wl-folder-confirm-existence fld)))
+ (condition-case nil
+ (wl-folder-confirm-existence
+ (wl-folder-get-elmo-folder
+ fld))
+ (error))
+ (wl-folder-confirm-existence (wl-folder-get-elmo-folder
+ fld))))
fld))
(defun wl-summary-print-destination (msg-num folder)
len rs re c)
(setq len (string-width folder))
(if (< len 1) ()
- (end-of-line)
+ ;;(end-of-line)
+ (beginning-of-line)
+ (search-forward "\r")
+ (forward-char -1)
(setq re (point))
(setq c 0)
(while (< c len)
(setq c (+ c (char-width (following-char)))))
(and (> c len) (setq folder (concat " " folder)))
(setq rs (point))
- (put-text-property rs re 'invisible t)
+ (when wl-summary-width
+ (put-text-property rs re 'invisible t))
(put-text-property rs re 'wl-summary-destination t)
(goto-char re)
(wl-highlight-refile-destination-string folder)
(insert folder)
(set-buffer-modified-p nil))))
-;; override.
-(when wl-on-nemacs
- (defun wl-summary-print-destination (msg-num &optional folder))
- (defun wl-summary-remove-destination ()))
-
(defsubst wl-summary-get-mark (number)
"Return a temporal mark of message specified by NUMBER."
(or (and (memq number wl-summary-buffer-delete-list) "D")
See `wl-refile-policy-alist' for more details."
(interactive)
(let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
- wl-summary-buffer-folder-name)))
+ (wl-summary-buffer-folder-name))))
(cond ((eq policy 'copy)
(if (interactive-p)
(call-interactively 'wl-summary-copy)
(wl-summary-refile-subr 'copy (interactive-p) dst number))
(defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number)
- (interactive)
(let* ((buffer-num (wl-summary-message-number))
(msg-num (or number buffer-num))
(msgid (and msg-num
- (cdr (assq msg-num
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))))
+ (elmo-message-field wl-summary-buffer-elmo-folder
+ msg-num 'message-id)))
(entity (and msg-num
(elmo-msgdb-overview-get-entity
- msg-num wl-summary-buffer-msgdb)))
+ msg-num (wl-summary-buffer-msgdb))))
(variable
(intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
folder mark already tmp-folder)
(or (wl-refile-guess entity) wl-trash-folder)
(format "for %s" copy-or-refile)))))
;; Cache folder hack by okada@opaopa.org
- (if (and (eq (car (elmo-folder-get-spec
- (wl-folder-get-realname folder))) 'cache)
+ (if (and (eq (elmo-folder-type-internal
+ (wl-folder-get-elmo-folder
+ (wl-folder-get-realname folder))) 'cache)
(not (string= folder
(setq tmp-folder
(concat "'cache/"
(progn
(setq folder tmp-folder)
(message "Force refile to %s." folder)))
- (if (string= folder wl-summary-buffer-folder-name)
+ (if (string= folder (wl-summary-buffer-folder-name))
(error "Same folder"))
- (unless (or (elmo-folder-plugged-p wl-summary-buffer-folder-name)
- (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) 'pipe)
- (elmo-folder-plugged-p
- (elmo-pipe-spec-dst (elmo-folder-get-spec wl-summary-buffer-folder-name))))
- (elmo-cache-exists-p msgid))
- (error "Unplugged (no cache or msgid)"))
- (if (or (string= folder wl-queue-folder)
+ (if (or (not (elmo-folder-writable-p (wl-folder-get-elmo-folder folder)))
+ (string= folder wl-queue-folder)
(string= folder wl-draft-folder))
(error "Don't %s messages to %s" copy-or-refile folder))
;; learn for refile.
(wl-summary-prev)
(wl-summary-next)))
-(defsubst wl-summary-no-auto-refile-message-p (msg mark-alist)
- (member (cadr (assq msg mark-alist)) wl-summary-auto-refile-skip-marks))
+(defsubst wl-summary-no-auto-refile-message-p (msg)
+ (member (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg)
+ wl-summary-auto-refile-skip-marks))
(defun wl-summary-auto-refile (&optional open-all)
"Set refile mark automatically according to 'wl-refile-guess-by-rule'."
(if (and (eq wl-summary-buffer-view 'thread)
open-all)
(wl-thread-open-all))
- (let* ((spec wl-summary-buffer-folder-name)
- (overview (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist
- wl-summary-buffer-msgdb))
+ (let* ((spec (wl-summary-buffer-folder-name))
checked-dsts
(count 0)
number dst thr-entity)
(goto-line 1)
(while (not (eobp))
(setq number (wl-summary-message-number))
- (when (and (not (wl-summary-no-auto-refile-message-p number
- mark-alist))
- (setq dst
- (wl-folder-get-realname
- (wl-refile-guess-by-rule
- (elmo-msgdb-overview-get-entity
- number wl-summary-buffer-msgdb))))
- (not (equal dst spec)))
- (when (not (member dst checked-dsts))
- (wl-folder-confirm-existence dst)
- (setq checked-dsts (cons dst checked-dsts)))
- (if (wl-summary-refile dst number)
- (incf count))
- (message "Marking...%d message(s)." count))
- (if (eq wl-summary-buffer-view 'thread)
- ;; process invisible children.
- (unless (wl-thread-entity-get-opened
- (setq thr-entity (wl-thread-get-entity number)))
- (let ((messages
- (elmo-delete-if
- (function
- (lambda (x)
- (wl-summary-no-auto-refile-message-p
- x mark-alist)))
- (wl-thread-entity-get-descendant thr-entity))))
- (while messages
- (when (and (setq dst
- (wl-refile-guess-by-rule
- (elmo-msgdb-overview-get-entity
- (car messages) wl-summary-buffer-msgdb)))
- (not (equal dst spec)))
- (if (wl-summary-refile dst (car messages))
- (incf count))
- (message "Marking...%d message(s)." count))
- (setq messages (cdr messages))))))
+ (dolist (number (cons number
+ (and (eq wl-summary-buffer-view 'thread)
+ ;; process invisible children.
+ (not (wl-thread-entity-get-opened
+ (setq thr-entity
+ (wl-thread-get-entity number))))
+ (wl-thread-entity-get-descendant
+ thr-entity))))
+ (when (and (not (wl-summary-no-auto-refile-message-p
+ number))
+ (setq dst
+ (wl-folder-get-realname
+ (wl-refile-guess-by-rule
+ (elmo-msgdb-overview-get-entity
+ number (wl-summary-buffer-msgdb)))))
+ (not (equal dst spec))
+ (let ((pair (assoc dst checked-dsts))
+ ret)
+ (if pair
+ (cdr pair)
+ (setq ret
+ (condition-case nil
+ (progn
+ (wl-folder-confirm-existence
+ (wl-folder-get-elmo-folder dst))
+ t)
+ (error)))
+ (setq checked-dsts (cons (cons dst ret) checked-dsts))
+ ret)))
+ (if (wl-summary-refile dst number)
+ (incf count))
+ (message "Marking...%d message(s)." count)))
(forward-line))
(if (eq count 0)
(message "No message was marked.")
(setq visible (wl-summary-jump-to-msg number))
(setq visible t))
;; Delete mark on buffer.
- (when (and visible
- (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)"))
- (goto-char (match-end 2))
- (or number
- (setq number (string-to-int (wl-match-buffer 1))))
- (setq cur-mark (wl-match-buffer 2))
+ (when visible
+ (setq cur-mark (wl-summary-temp-mark))
(if (string= cur-mark " ")
()
- (delete-region (match-beginning 2) (match-end 2))
+ (delete-backward-char 1)
+ (or number
+ (setq number (wl-summary-message-number)))
(if (setq score-mark (wl-summary-get-score-mark number))
(insert score-mark)
(insert " ")))
(if wl-summary-highlight
(wl-highlight-summary-current-line nil nil score-mark))
(set-buffer-modified-p nil))
- ;; Remove from temporary mark structure.
+ ;; Remove from temporal mark structure.
(and number
(wl-summary-delete-mark number)))))
(defun wl-summary-refile-region (beg end)
- "Put copy mark on messages in the region specified by BEG and END."
+ "Put refile mark on messages in the region specified by BEG and END."
(interactive "r")
(wl-summary-refile-region-subr "refile" beg end))
;; guess by first msg
(let* ((msgid (cdr (assq (wl-summary-message-number)
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb))))
+ (wl-summary-buffer-msgdb)))))
(function (intern (format "wl-summary-%s" copy-or-refile)))
(entity (assoc msgid (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
folder)
(if entity
(setq folder (wl-summary-read-folder (wl-refile-guess entity)
(wl-summary-target-mark-region (point-min) (point-max))
(setq wl-summary-buffer-target-mark-list
(mapcar 'car
- (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))))
+ (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))))
(defun wl-summary-delete-all-mark (mark)
(goto-char (point-min))
- (let ((case-fold-search nil))
- (while (re-search-forward (format "^ *[0-9]+%s"
- (regexp-quote mark)) nil t)
+ (while (not (eobp))
+ (when (string= (wl-summary-temp-mark) mark)
(wl-summary-unmark))
- (cond ((string= mark "*")
- (setq wl-summary-buffer-target-mark-list nil))
- ((string= mark "D")
- (setq wl-summary-buffer-delete-list nil))
- ((string= mark "O")
- (setq wl-summary-buffer-copy-list nil))
- ((string= mark "o")
- (setq wl-summary-buffer-refile-list nil)))))
+ (forward-line 1))
+ (cond ((string= mark "*")
+ (setq wl-summary-buffer-target-mark-list nil))
+ ((string= mark "D")
+ (setq wl-summary-buffer-delete-list nil))
+ ((string= mark "O")
+ (setq wl-summary-buffer-copy-list nil))
+ ((string= mark "o")
+ (setq wl-summary-buffer-refile-list nil))))
(defun wl-summary-unmark-all ()
"Unmark all according to what you input."
(defun wl-summary-target-mark-thread ()
(interactive)
- (let (beg end)
- (end-of-line)
- (wl-summary-goto-top-of-current-thread)
- (wl-thread-force-open)
- (setq beg (point))
- (end-of-line)
- (wl-summary-goto-bottom-of-current-thread)
-;;; (forward-line -1)
- (beginning-of-line)
- (setq end (point))
- (wl-summary-target-mark-region beg end)))
+ (wl-thread-call-region-func 'wl-summary-target-mark-region t))
(defun wl-summary-target-mark-msgs (msgs)
- (while msgs
- (if (eq wl-summary-buffer-view 'thread)
- (wl-thread-jump-to-msg (car msgs))
- (wl-summary-jump-to-msg (car msgs)))
- (wl-summary-target-mark (wl-summary-message-number))
- (setq msgs (cdr msgs))))
+ "Return the number of marked messages."
+ (let ((i 0) num)
+ (while msgs
+ (if (eq wl-summary-buffer-view 'thread)
+ (wl-thread-jump-to-msg (car msgs))
+ (wl-summary-jump-to-msg (car msgs)))
+ (setq num (wl-summary-message-number))
+ (when (eq num (car msgs))
+ (wl-summary-target-mark num)
+ (setq i (1+ i)))
+ (setq msgs (cdr msgs)))
+ i))
(defun wl-summary-pick (&optional from-list delete-marks)
(interactive)
- (let ((result (elmo-msgdb-search
- wl-summary-buffer-folder-name
- (elmo-read-search-condition wl-summary-pick-field-default)
- wl-summary-buffer-msgdb)))
- (if delete-marks
- (let ((mlist wl-summary-buffer-target-mark-list))
- (while mlist
- (when (wl-summary-jump-to-msg (car mlist))
- (wl-summary-unmark))
- (setq mlist (cdr mlist)))
- (setq wl-summary-buffer-target-mark-list nil)))
- (if from-list
- (setq result (elmo-list-filter from-list result)))
- (message "%d message(s) are picked." (length result))
- (if (null result)
- (message "No message was picked.")
- (wl-summary-target-mark-msgs result))))
+ (save-excursion
+ (let* ((condition (car (elmo-parse-search-condition
+ (elmo-read-search-condition
+ wl-summary-pick-field-default))))
+ (result (elmo-folder-search wl-summary-buffer-elmo-folder
+ condition
+ from-list))
+ num)
+ (if delete-marks
+ (let ((mlist wl-summary-buffer-target-mark-list))
+ (while mlist
+ (when (wl-summary-jump-to-msg (car mlist))
+ (wl-summary-unmark))
+ (setq mlist (cdr mlist)))
+ (setq wl-summary-buffer-target-mark-list nil)))
+ (if (and result
+ (setq num (wl-summary-target-mark-msgs result))
+ (> num 0))
+ (if (= num (length result))
+ (message "%d message(s) are picked." num)
+ (message "%d(%d) message(s) are picked." num
+ (- (length result) num)))
+ (message "No message was picked.")))))
(defun wl-summary-unvirtual ()
"Exit from current virtual folder."
(interactive)
(if (eq 'filter
- (elmo-folder-get-type wl-summary-buffer-folder-name))
- (wl-summary-goto-folder-subr (nth 2 (elmo-folder-get-spec
- wl-summary-buffer-folder-name))
- 'update nil nil t)
+ (elmo-folder-type-internal wl-summary-buffer-elmo-folder))
+ (wl-summary-goto-folder-subr
+ (elmo-folder-name-internal
+ (elmo-filter-folder-target-internal
+ wl-summary-buffer-elmo-folder))
+ 'update nil nil t)
(error "This folder is not filtered")))
(defun wl-summary-virtual (&optional arg)
(elmo-read-search-condition
wl-summary-pick-field-default)
"/"
- wl-summary-buffer-folder-name)
+ (wl-summary-buffer-folder-name))
'update nil nil t)))
-(defun wl-summary-delete-all-temp-marks ()
+(defun wl-summary-delete-all-temp-marks (&optional no-msg)
+ "Erase all temp marks from buffer."
(interactive)
- (save-excursion
- (goto-char (point-min))
- (message "Unmarking...")
- (while (not (eobp))
- (wl-summary-unmark)
- (forward-line))
- (message "Unmarking...done")
- (setq wl-summary-buffer-target-mark-list nil)
- (setq wl-summary-buffer-delete-list nil)
- (setq wl-summary-buffer-refile-list nil)
- (setq wl-summary-buffer-copy-list nil)))
+ (when (or wl-summary-buffer-target-mark-list
+ wl-summary-buffer-delete-list
+ wl-summary-buffer-refile-list
+ wl-summary-buffer-copy-list)
+ (save-excursion
+ (goto-char (point-min))
+ (unless no-msg
+ (message "Unmarking..."))
+ (while (not (eobp))
+ (wl-summary-unmark)
+ (forward-line 1))
+ (unless no-msg
+ (message "Unmarking...done"))
+ (setq wl-summary-buffer-target-mark-list nil)
+ (setq wl-summary-buffer-delete-list nil)
+ (setq wl-summary-buffer-refile-list nil)
+ (setq wl-summary-buffer-copy-list nil))))
(defun wl-summary-delete-mark (number)
"Delete temporary mark of the message specified by NUMBER."
(setq wl-summary-buffer-refile-list
(delq pair wl-summary-buffer-refile-list))))))))
+(defsubst wl-summary-temp-mark ()
+ "Move to the temp-mark column and return mark string."
+ (move-to-column wl-summary-buffer-temp-mark-column)
+ (buffer-substring (- (point) 1) (point)))
+
+(defsubst wl-summary-persistent-mark ()
+ "Move to the persistent-mark column and return mark string."
+ (move-to-column wl-summary-buffer-persistent-mark-column)
+ (buffer-substring (- (point) 1) (point)))
+
(defun wl-summary-mark-line (mark)
"Put MARK on current line. Return message number."
(save-excursion
(beginning-of-line)
(let ((inhibit-read-only t)
- (buffer-read-only nil)
- msg-num
- cur-mark)
- (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
- (setq msg-num (string-to-int (wl-match-buffer 1)))
- (setq cur-mark (wl-match-buffer 2))
- (goto-char (match-end 1))
- (delete-region (match-beginning 2) (match-end 2))
-;;; (wl-summary-delete-mark msg-num)
- (insert mark)
- (if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t))
- (set-buffer-modified-p nil)
- msg-num))))
+ (buffer-read-only nil))
+ (wl-summary-temp-mark) ; mark
+ (delete-backward-char 1)
+ (insert mark)
+ (if wl-summary-highlight
+ (wl-highlight-summary-current-line nil nil t))
+ (set-buffer-modified-p nil))))
(defun wl-summary-target-mark-delete ()
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
- number mlist)
- (while (re-search-forward regexp nil t)
- (let (wl-summary-buffer-disp-msg)
- (when (setq number (wl-summary-message-number))
- (wl-summary-delete number)
- (setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))))
+ (let (number mlist)
+ (while (not (eobp))
+ (when (string= (wl-summary-temp-mark) "*")
+ (let (wl-summary-buffer-disp-msg)
+ (when (setq number (wl-summary-message-number))
+ (wl-summary-delete number)
+ (setq wl-summary-buffer-target-mark-list
+ (delq number wl-summary-buffer-target-mark-list)))))
+ (forward-line 1))
(setq mlist wl-summary-buffer-target-mark-list)
(while mlist
(wl-append wl-summary-buffer-delete-list (list (car mlist)))
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist))))))
-(defun wl-summary-target-mark-prefetch ()
- (interactive)
+(defun wl-summary-target-mark-prefetch (&optional ignore-cache)
+ (interactive "P")
(save-excursion
(let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
(inhibit-read-only t)
skipped
new-mark)
(while mlist
- (setq new-mark (wl-summary-prefetch-msg (car mlist)))
+ (setq new-mark (wl-summary-prefetch-msg (car mlist) ignore-cache))
(if new-mark
(progn
(message "Prefetching... %d/%d message(s)"
(when (wl-summary-jump-to-msg (car mlist))
(wl-summary-unmark)
(when new-mark
- (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)")
- (delete-region (match-beginning 1) (match-end 1)))
- (goto-char (match-beginning 1))
+ (wl-summary-persistent-mark) ; move
+ (delete-backward-char 1)
(insert new-mark)
(if wl-summary-highlight
(wl-highlight-summary-current-line))
(intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
(function
(intern (format "wl-summary-%s" copy-or-refile)))
+ (numlist wl-summary-buffer-number-list)
regexp number msgid entity folder mlist)
(save-excursion
- (goto-char (point-min))
- (setq regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
;; guess by first mark
- (when (re-search-forward regexp nil t)
- (setq msgid (cdr (assq (setq number (wl-summary-message-number))
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
- entity (assoc msgid
- (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
+ (while numlist
+ (if (memq (car numlist) wl-summary-buffer-target-mark-list)
+ (setq number (car numlist)
+ numlist nil))
+ (setq numlist (cdr numlist)))
+ (when number
+ (setq msgid (elmo-message-field wl-summary-buffer-elmo-folder
+ number 'message-id)
+ entity (elmo-msgdb-overview-get-entity
+ number (wl-summary-buffer-msgdb)))
(if (null entity)
(error "Cannot %s" copy-or-refile))
- (funcall function
- (setq folder (wl-summary-read-folder
- (wl-refile-guess entity)
- (format "for %s" copy-or-refile)))
- number)
- (if number
- (setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))
- (while (re-search-forward regexp nil t)
- (let (wl-summary-buffer-disp-msg)
- (when (setq number (wl-summary-message-number))
- (funcall function folder number)
- (setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))))
+ (setq folder (wl-summary-read-folder
+ (wl-refile-guess entity)
+ (format "for %s" copy-or-refile)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (string= (wl-summary-temp-mark) "*")
+ (let (wl-summary-buffer-disp-msg)
+ (when (setq number (wl-summary-message-number))
+ (funcall function folder number)
+ (setq wl-summary-buffer-target-mark-list
+ (delq number wl-summary-buffer-target-mark-list)))))
+ (forward-line 1))
;; process invisible messages.
(setq mlist wl-summary-buffer-target-mark-list)
(while mlist
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist)))))))
+(defun wl-summary-next-buffer ()
+ "Switch to next summary buffer."
+ (interactive)
+ (let ((buffers (sort (wl-collect-summary)
+ (lambda (buffer1 buffer2)
+ (string-lessp (buffer-name buffer1)
+ (buffer-name buffer2))))))
+ (switch-to-buffer
+ (or (cadr (memq (current-buffer) buffers))
+ (car buffers)))))
+
+(defun wl-summary-previous-buffer ()
+ "Switch to previous summary buffer."
+ (interactive)
+ (let ((buffers (sort (wl-collect-summary)
+ (lambda (buffer1 buffer2)
+ (not (string-lessp (buffer-name buffer1)
+ (buffer-name buffer2)))))))
+ (switch-to-buffer
+ (or (cadr (memq (current-buffer) buffers))
+ (car buffers)))))
+
(defun wl-summary-target-mark-copy ()
(interactive)
(wl-summary-target-mark-refile-subr "copy"))
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
- (inhibit-read-only t)
+ (let ((inhibit-read-only t)
(buffer-read-only nil)
+ wl-summary-buffer-disp-msg
number mlist)
- (while (re-search-forward regexp nil t)
- (let (wl-summary-buffer-disp-msg)
+ (while (not (eobp))
+ (when (string= (wl-summary-temp-mark) "*")
;; delete target-mark from buffer.
- (delete-region (match-beginning 1) (match-end 1))
+ (delete-backward-char 1)
(insert " ")
- (setq number (wl-summary-mark-as-read t))
+ (setq number (wl-summary-message-number))
+ (wl-summary-mark-as-read number)
(if wl-summary-highlight
(wl-highlight-summary-current-line))
(if number
(setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))))
+ (delq number wl-summary-buffer-target-mark-list))))
+ (forward-line 1))
(setq mlist wl-summary-buffer-target-mark-list)
(while mlist
- (wl-summary-mark-as-read t nil nil (car mlist))
+ (wl-summary-mark-as-read (car mlist))
(setq wl-summary-buffer-target-mark-list
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist)))
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline))))
(defun wl-summary-target-mark-mark-as-unread ()
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
- (inhibit-read-only t)
+ (let ((inhibit-read-only t)
(buffer-read-only nil)
+ wl-summary-buffer-disp-msg
number mlist)
- (while (re-search-forward regexp nil t)
- (let (wl-summary-buffer-disp-msg)
- ;; delete target-mark from buffer.
- (delete-region (match-beginning 1) (match-end 1))
+ (while (not (eobp))
+ (when (string= (wl-summary-temp-mark) "*")
+ (delete-backward-char 1)
(insert " ")
(setq number (wl-summary-mark-as-unread))
(if wl-summary-highlight
(wl-highlight-summary-current-line))
(if number
(setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))))
+ (delq number wl-summary-buffer-target-mark-list))))
+ (forward-line 1))
(setq mlist wl-summary-buffer-target-mark-list)
(while mlist
(wl-summary-mark-as-unread (car mlist))
(setq wl-summary-buffer-target-mark-list
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist)))
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline))))
(defun wl-summary-target-mark-mark-as-important ()
(interactive)
(save-excursion
(goto-char (point-min))
- (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
- (inhibit-read-only t)
+ (let ((inhibit-read-only t)
(buffer-read-only nil)
+ wl-summary-buffer-disp-msg
number mlist)
- (while (re-search-forward regexp nil t)
- (let (wl-summary-buffer-disp-msg)
+ (while (not (eobp))
+ (when (string= (wl-summary-temp-mark) "*")
;; delete target-mark from buffer.
- (delete-region (match-beginning 1) (match-end 1))
+ (delete-backward-char 1)
(insert " ")
(setq number (wl-summary-mark-as-important))
(if wl-summary-highlight
(wl-highlight-summary-current-line))
(if number
(setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))))
+ (delq number wl-summary-buffer-target-mark-list))))
+ (forward-line 1))
(setq mlist wl-summary-buffer-target-mark-list)
(while mlist
(wl-summary-mark-as-important (car mlist))
(setq wl-summary-buffer-target-mark-list
(delq (car mlist) wl-summary-buffer-target-mark-list))
(setq mlist (cdr mlist)))
- (wl-summary-count-unread
- (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
+ (wl-summary-count-unread)
(wl-summary-update-modeline))))
(defun wl-summary-target-mark-save ()
(interactive)
- (save-excursion
- (goto-char (point-min))
- (let ((wl-save-dir
- (wl-read-directory-name "Save to directory: " wl-tmp-dir))
- (regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
- number mlist)
- (if (null (file-exists-p wl-save-dir))
- (make-directory wl-save-dir))
- (while (re-search-forward regexp nil t)
- (let (wl-summary-buffer-disp-msg)
- (setq number (wl-summary-save t wl-save-dir))
- (wl-summary-unmark)
- (if number
- (setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list))))))))
+ (let ((wl-save-dir
+ (wl-read-directory-name "Save to directory: "
+ wl-temporary-file-directory))
+ number)
+ (if (null (file-exists-p wl-save-dir))
+ (make-directory wl-save-dir))
+ (while (setq number (car wl-summary-buffer-target-mark-list))
+ (wl-thread-jump-to-msg number)
+ (wl-summary-save t wl-save-dir)
+ (wl-summary-unmark number))))
(defun wl-summary-target-mark-pick ()
(interactive)
(wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
-(defun wl-summary-mark-as-read (&optional notcrosses
- leave-server-side-mark-untouched
- displayed
- number
- cached)
+(defun wl-summary-mark-as-read (&optional number no-folder-mark)
(interactive)
(save-excursion
- (let* (eol
- (inhibit-read-only t)
- (buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
-;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
- (case-fold-search nil)
- mark stat visible uncached new-mark marked)
- (if number
- (progn
- (setq visible (wl-summary-jump-to-msg number))
- (setq mark (cadr (assq number mark-alist))))
- (setq visible t))
- (beginning-of-line)
- (if (or (not visible)
- (looking-at
- (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
- (regexp-quote wl-summary-read-uncached-mark)
- (regexp-quote wl-summary-unread-uncached-mark)
- (regexp-quote wl-summary-unread-cached-mark)
- (regexp-quote wl-summary-new-mark))))
- (progn
- (setq mark (or mark (wl-match-buffer 2)))
- (when mark
- (cond
- ((string= mark wl-summary-new-mark) ; N
- (setq stat 'new)
- (setq uncached t))
- ((string= mark wl-summary-unread-uncached-mark) ; U
- (setq stat 'unread)
- (setq uncached t))
- ((string= mark wl-summary-unread-cached-mark) ; !
- (setq stat 'unread))
- (t
- ;; no need to mark server.
- (setq leave-server-side-mark-untouched t))))
- (setq number (or number (string-to-int (wl-match-buffer 1))))
- ;; set server side mark...
- (setq new-mark (if (and uncached
- (if (elmo-use-cache-p folder number)
- (not (elmo-folder-local-p folder)))
- (not cached))
- wl-summary-read-uncached-mark
- nil))
- (if (not leave-server-side-mark-untouched)
- (setq marked (elmo-mark-as-read folder
- (list number) msgdb)))
- (if (or leave-server-side-mark-untouched
- marked)
- (progn
- (cond ((eq stat 'unread)
- (setq wl-summary-buffer-unread-count
- (1- wl-summary-buffer-unread-count)))
- ((eq stat 'new)
- (setq wl-summary-buffer-new-count
- (1- wl-summary-buffer-new-count))))
- (wl-summary-update-modeline)
- (wl-folder-update-unread
- folder
- (+ wl-summary-buffer-unread-count
- wl-summary-buffer-new-count))
- (when (or stat cached)
- (when visible
- (goto-char (match-end 2))
- (delete-region (match-beginning 2) (match-end 2))
- (insert (or new-mark " ")))
- (setq mark-alist
- (elmo-msgdb-mark-set mark-alist number new-mark))
- (elmo-msgdb-set-mark-alist msgdb mark-alist)
- (wl-summary-set-mark-modified))
- (if (and visible wl-summary-highlight)
- (wl-highlight-summary-current-line nil nil t))
- (if (not notcrosses)
- (wl-summary-set-crosspost nil
- (and wl-summary-buffer-disp-msg
- (interactive-p)))))
- (if mark (message "Warning: Changing mark failed.")))))
+ (let ((buffer-read-only nil)
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
+ (case-fold-search nil)
+ cur-mark mark stat visible uncached new-mark marked)
+ (setq number (or number (wl-summary-message-number))
+ visible (if number
+ (wl-summary-jump-to-msg number)
+ ;; interactive
+ t)
+ mark (elmo-msgdb-get-mark msgdb number))
+ (cond
+ ((string= mark wl-summary-new-mark) ; N
+ (setq stat 'new))
+ ((string= mark wl-summary-unread-uncached-mark) ; U
+ (setq stat 'unread))
+ ((string= mark wl-summary-unread-cached-mark) ; !
+ (setq stat 'unread))
+ ((string= mark wl-summary-read-uncached-mark) ; u
+ (setq stat 'read))
+ (t
+ ;; no need to mark server.
+ (setq no-folder-mark t)))
+ (setq new-mark
+ (if (and (if (elmo-message-use-cache-p folder number)
+ (not (elmo-folder-local-p folder)))
+ (not (elmo-file-cache-exists-p
+ (elmo-message-field wl-summary-buffer-elmo-folder
+ number 'message-id))))
+ wl-summary-read-uncached-mark
+ nil))
+ ;; folder mark.
+ (unless no-folder-mark
+ (setq marked (elmo-folder-mark-as-read folder (list number))))
+ (when (or no-folder-mark marked)
+ (cond ((eq stat 'unread)
+ (setq wl-summary-buffer-unread-count
+ (1- wl-summary-buffer-unread-count)))
+ ((eq stat 'new)
+ (setq wl-summary-buffer-new-count
+ (1- wl-summary-buffer-new-count))))
+ (wl-summary-update-modeline)
+ (wl-folder-update-unread
+ (wl-summary-buffer-folder-name)
+ (+ wl-summary-buffer-unread-count
+ wl-summary-buffer-new-count))
+ (when stat
+ ;; set mark on buffer
+ (when visible
+ (unless (string= (wl-summary-persistent-mark) new-mark)
+ (delete-backward-char 1)
+ (insert (or new-mark " "))))
+ ;; set msgdb mark.
+ (unless (string= mark new-mark)
+ (elmo-msgdb-set-mark msgdb number new-mark))
+ (wl-summary-set-mark-modified))
+ (if (and visible wl-summary-highlight)
+ (wl-highlight-summary-current-line nil nil t)))
(set-buffer-modified-p nil)
(if stat
(run-hooks 'wl-summary-unread-message-hook))
mark
no-server-update)
(interactive)
- (if (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
'internal)
(error "Cannot process mark in this folder"))
(save-excursion
(let* (eol
(inhibit-read-only t)
(buffer-read-only nil)
- (folder wl-summary-buffer-folder-name)
- (msgdb wl-summary-buffer-msgdb)
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ (folder wl-summary-buffer-elmo-folder)
+ (msgdb (wl-summary-buffer-msgdb))
(number-alist (elmo-msgdb-get-number-alist msgdb))
- message-id visible)
+ message-id visible cur-mark)
(if number
(progn
(setq visible (wl-summary-jump-to-msg number))
- (setq mark (or mark (cadr (assq number mark-alist)))))
+ (setq mark (or mark (elmo-msgdb-get-mark msgdb number))))
(setq visible t))
(when visible
- (if (null (wl-summary-message-number))
+ (if (null (setq number (wl-summary-message-number)))
(progn
(message "No message.")
(setq visible nil))
(end-of-line)
(setq eol (point))
- (re-search-backward (concat "^" wl-summary-buffer-number-regexp
- "..../..") nil t)) ; set cursor line
- )
- (beginning-of-line)
- (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)
+ (wl-summary-goto-previous-message-beginning)))
+ (if (or (and (not visible)
+ ;; already exists in msgdb.
+ (elmo-msgdb-overview-get-entity number msgdb))
+ (setq cur-mark (wl-summary-persistent-mark)))
(progn
- (setq number (or number (string-to-int (wl-match-buffer 1))))
- (setq mark (or mark (wl-match-buffer 2)))
- (setq message-id (cdr (assq number number-alist)))
+ (setq number (or number (wl-summary-message-number)))
+ (setq mark (or mark cur-mark))
+ (setq message-id (elmo-message-field
+ wl-summary-buffer-elmo-folder
+ number
+ 'message-id))
(if (string= mark wl-summary-important-mark)
(progn
;; server side mark
- (unless no-server-update
- (elmo-unmark-important folder (list number) msgdb)
- (elmo-msgdb-global-mark-delete message-id))
- ;; Remove cache if local folder.
- (if (elmo-folder-local-p folder)
- (elmo-cache-delete message-id folder number))
+ (save-match-data
+ (unless no-server-update
+ (elmo-folder-unmark-important folder (list number))
+ (elmo-msgdb-global-mark-delete message-id))
+ ;; Remove cache if local folder.
+ (if (and (elmo-folder-local-p folder)
+ (not (eq 'mark
+ (elmo-folder-type-internal folder))))
+ (elmo-file-cache-delete
+ (elmo-file-cache-get-path message-id))))
(when visible
- (delete-region (match-beginning 2) (match-end 2))
+ (delete-backward-char 1)
(insert " "))
- (setq mark-alist
- (elmo-msgdb-mark-set mark-alist
- number
- nil)))
+ (elmo-msgdb-set-mark msgdb number nil))
;; server side mark
- (unless no-server-update
- (elmo-mark-as-important folder (list number) msgdb))
+ (save-match-data
+ (unless no-server-update
+ (elmo-folder-mark-as-important folder (list number))))
(when visible
- (delete-region (match-beginning 2) (match-end 2))
+ (delete-backward-char 1)
(insert wl-summary-important-mark))
- (setq mark-alist
- (elmo-msgdb-mark-set mark-alist
- (string-to-int (wl-match-buffer 1))
- wl-summary-important-mark))
- ;; Force cache message!!
- (save-match-data
- (unless (elmo-cache-exists-p message-id)
- (elmo-force-cache-msg folder number message-id
- (elmo-msgdb-get-location msgdb))))
+ (elmo-msgdb-set-mark msgdb number
+ wl-summary-important-mark)
+ (if (eq (elmo-file-cache-exists-p message-id) 'entire)
+ (elmo-folder-mark-as-read folder (list number))
+ ;; Force cache message.
+ (elmo-message-encache folder number 'read))
(unless no-server-update
(elmo-msgdb-global-mark-set message-id
wl-summary-important-mark)))
- (elmo-msgdb-set-mark-alist msgdb mark-alist)
(wl-summary-set-mark-modified)))
(if (and visible wl-summary-highlight)
(wl-highlight-summary-current-line nil nil t))))
(set-buffer-modified-p nil)
number)
-(defsubst wl-summary-format-date (date-string)
+;;; Summary line.
+(defvar wl-summary-line-formatter nil)
+
+(defun wl-summary-view-old-p ()
+ "Return non-nil when summary view cache has old format."
+ (save-excursion
+ (goto-char (point-min))
+ (and wl-summary-buffer-number-list
+ (not (re-search-forward "\r-?[0-9]+" (point-at-eol) t)))))
+
+(defun wl-summary-line-format-changed-p ()
+ "Return non-nil when summary line format is changed."
+ (not (string=
+ wl-summary-buffer-line-format
+ (or (elmo-object-load (expand-file-name
+ wl-summary-line-format-file
+ (elmo-folder-msgdb-path
+ wl-summary-buffer-elmo-folder))
+ wl-summary-buffer-mime-charset)
+ wl-summary-buffer-line-format))))
+
+(defun wl-summary-line-format-save ()
+ "Save current summary line format."
+ (elmo-object-save
+ (expand-file-name wl-summary-line-format-file
+ (elmo-folder-msgdb-path
+ wl-summary-buffer-elmo-folder))
+ wl-summary-buffer-line-format
+ wl-summary-buffer-mime-charset))
+
+(defun wl-summary-line-number ()
+ (wl-set-string-width
+ (- wl-summary-buffer-number-column)
+ (number-to-string
+ (elmo-msgdb-overview-entity-get-number wl-message-entity))))
+
+(defun wl-summary-line-year ()
+ (aref wl-datevec 0))
+(defun wl-summary-line-month ()
+ (format "%02d" (aref wl-datevec 1)))
+(defun wl-summary-line-day ()
+ (format "%02d" (aref wl-datevec 2)))
+(defun wl-summary-line-day-of-week ()
(condition-case nil
- (let ((datevec (timezone-fix-time date-string nil
- wl-summary-fix-timezone)))
- (format "%02d/%02d(%s)%02d:%02d"
- (aref datevec 1)
- (aref datevec 2)
- (elmo-date-get-week (aref datevec 0)
- (aref datevec 1)
- (aref datevec 2))
- (aref datevec 3)
- (aref datevec 4)))
- (error "??/??(??)??:??")))
-
-(defun wl-summary-overview-create-summary-line (msg
- entity
- parent-entity
- depth
- mark-alist
- &optional
- children-num
- temp-mark thr-entity
- subject-differ)
- (let ((wl-mime-charset wl-summary-buffer-mime-charset)
- (elmo-mime-charset wl-summary-buffer-mime-charset)
- no-parent before-indent
- from subject parent-raw-subject parent-subject
- mark line
- (elmo-lang wl-summary-buffer-weekday-name-lang)
- (children-num (if children-num (int-to-string children-num)))
- (thr-str "")
- linked)
- (when thr-entity
- (setq thr-str (wl-thread-make-indent-string thr-entity))
- (setq linked (wl-thread-entity-get-linked thr-entity)))
- (if (string= thr-str "")
+ (elmo-date-get-week (aref wl-datevec 0)
+ (aref wl-datevec 1)
+ (aref wl-datevec 2))
+ (error "??")))
+(defun wl-summary-line-hour ()
+ (format "%02d" (aref wl-datevec 3)))
+(defun wl-summary-line-minute ()
+ (format "%02d" (aref wl-datevec 4)))
+
+(defun wl-summary-line-size ()
+ (let ((size (elmo-msgdb-overview-entity-get-size wl-message-entity)))
+ (if size
+ (cond
+ ((<= 1 (/ size 1048576))
+ (format "%.0fM" (/ size 1048576.0)))
+ ((<= 1 (/ size 1024))
+ (format "%.0fK" (/ size 1024.0)))
+ (t (format "%dB" size)))
+ "")))
+
+(defun wl-summary-line-subject ()
+ (let (no-parent subject parent-raw-subject parent-subject)
+ (if (string= wl-thr-indent-string "")
(setq no-parent t)) ; no parent
- (if (and wl-summary-width
- wl-summary-indent-length-limit
- (< wl-summary-indent-length-limit
- (string-width thr-str)))
- (setq thr-str (wl-set-string-width
- wl-summary-indent-length-limit
- thr-str)))
- (setq from
- (wl-set-string-width
- (if children-num
- (- wl-from-width (length children-num) 2)
- wl-from-width)
- (elmo-delete-char ?\n
- (wl-summary-from-func-internal
- (elmo-msgdb-overview-entity-get-from entity)))))
(setq subject
(elmo-delete-char ?\n
(or (elmo-msgdb-overview-entity-get-subject
- entity)
+ wl-message-entity)
wl-summary-no-subject-message)))
(setq parent-raw-subject
- (elmo-msgdb-overview-entity-get-subject parent-entity))
+ (elmo-msgdb-overview-entity-get-subject wl-parent-message-entity))
(setq parent-subject
(if parent-raw-subject
(elmo-delete-char ?\n parent-raw-subject)))
- (setq mark (or (cadr (assq msg mark-alist)) " "))
- (setq line
- (concat
- (setq before-indent
- (format (concat "%"
- (int-to-string
- wl-summary-buffer-number-column)
- "s%s%s%s %s")
- msg
- (or temp-mark " ")
- mark
- (wl-summary-format-date
- (elmo-msgdb-overview-entity-get-date entity))
- (if thr-str thr-str "")))
- (format (if linked
- "<%s > %s"
- "[%s ] %s")
- (if children-num
- (concat "+" children-num ": " from)
- (concat " " from))
- (progn
- (setq subject
- (if (or no-parent
- (null parent-subject)
- (not (wl-summary-subject-equal
- subject parent-subject)))
- (wl-summary-subject-func-internal subject) ""))
- (if (and (not wl-summary-width)
- wl-subject-length-limit)
- (truncate-string subject wl-subject-length-limit)
- subject)))))
+ (if (or no-parent
+ (null parent-subject)
+ (not (wl-summary-subject-equal
+ subject parent-subject)))
+ (funcall wl-summary-subject-function subject)
+ "")))
+
+(defun wl-summary-line-from ()
+ (elmo-delete-char ?\n
+ (funcall wl-summary-from-function
+ (elmo-msgdb-overview-entity-get-from
+ wl-message-entity))))
+
+(defun wl-summary-line-list-info ()
+ (let ((list-info (wl-summary-get-list-info wl-message-entity)))
+ (if (car list-info)
+ (format (if (cdr list-info) "(%s %05d)" "(%s)")
+ (car list-info) (cdr list-info))
+ "")))
+
+(defun wl-summary-line-list-count ()
+ (let ((ml-count (cdr (wl-summary-get-list-info wl-message-entity))))
+ (if ml-count
+ (format "%.0f" ml-count)
+ "")))
+
+(defun wl-summary-line-attached ()
+ (let ((content-type (elmo-msgdb-overview-entity-get-extra-field
+ wl-message-entity "content-type"))
+ (case-fold-search t))
+ (if (and content-type
+ (string-match "multipart/mixed" content-type))
+ "@"
+ "")))
+
+(defun wl-summary-create-line (wl-message-entity
+ wl-parent-message-entity
+ wl-temp-mark
+ wl-persistent-mark
+ &optional
+ wl-thr-children-number
+ wl-thr-indent-string
+ wl-thr-linked)
+ "Create a summary line."
+ (let ((wl-mime-charset wl-summary-buffer-mime-charset)
+ (elmo-mime-charset wl-summary-buffer-mime-charset)
+ (elmo-lang wl-summary-buffer-weekday-name-lang)
+ (wl-datevec (or (ignore-errors (timezone-fix-time
+ (elmo-msgdb-overview-entity-get-date
+ wl-message-entity)
+ nil
+ wl-summary-fix-timezone))
+ (make-vector 5 0)))
+ (entity wl-message-entity) ; backward compatibility.
+ line mark)
+ (if (and wl-thr-indent-string
+ wl-summary-indent-length-limit
+ (< wl-summary-indent-length-limit
+ (string-width wl-thr-indent-string)))
+ (setq wl-thr-indent-string (wl-set-string-width
+ wl-summary-indent-length-limit
+ wl-thr-indent-string)))
+ (setq line (funcall wl-summary-buffer-line-formatter))
(if wl-summary-width (setq line
(wl-set-string-width
- (- wl-summary-width 1) line)))
+ (- wl-summary-width 1) line nil
+ 'ignore-invalid)))
+ (setq line (concat line
+ "\r"
+ (number-to-string
+ (elmo-msgdb-overview-entity-get-number
+ wl-message-entity))))
(if wl-summary-highlight
(wl-highlight-summary-line-string line
- mark
- temp-mark
- thr-str))
+ wl-persistent-mark
+ wl-temp-mark
+ wl-thr-indent-string))
line))
-(defsubst wl-summary-buffer-number-column-detect (update)
- (let (end)
- (save-excursion
- (goto-char (point-min))
- (setq wl-summary-buffer-number-column
- (or
- (if (and update
- (setq end (if (re-search-forward "^ *[0-9]+[^0-9]" nil t)
- (point))))
- (- end (progn (beginning-of-line) (point)) 1))
- (wl-get-assoc-list-value wl-summary-number-column-alist
- wl-summary-buffer-folder-name)
- wl-summary-default-number-column))
- (setq wl-summary-buffer-number-regexp
- (wl-repeat-string "." wl-summary-buffer-number-column)))))
-
(defsubst wl-summary-proc-wday (wday-str year month mday)
(save-match-data
(if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
(wl-match-string 1 wday-str)
(elmo-date-get-week year month mday))))
-(defmacro wl-summary-cursor-move-regex ()
- (` (let ((mark-alist
- (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
- (cond ((eq wl-summary-move-order 'new)
- (list
- (list
- wl-summary-new-mark)
- (list
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark
- wl-summary-important-mark)))
- ((eq wl-summary-move-order 'unread)
- (list
- (list
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark
- wl-summary-new-mark)
- (list
- wl-summary-important-mark)))
- (t
- (list
- (list
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark
- wl-summary-new-mark
- wl-summary-important-mark))))
- (cond ((eq wl-summary-move-order 'unread)
- (list
- (list
- wl-summary-unread-cached-mark)
- (list
- wl-summary-important-mark)))
- (t
- (list
- (list
- wl-summary-unread-cached-mark
- wl-summary-important-mark)))))))
- (mapcar
- (function
- (lambda (mark-list)
- (concat wl-summary-message-regexp
- ".\\("
- (mapconcat 'regexp-quote
- mark-list
- "\\|")
- "\\)\\|"
- wl-summary-message-regexp "\\*")))
- mark-alist))))
-
-;;
-;; Goto unread or important
-;;
-(defun wl-summary-cursor-up (&optional hereto)
- (interactive "P")
- (if (and (not wl-summary-buffer-target-mark-list)
- (eq wl-summary-buffer-view 'thread))
- (progn
- (if (eobp)
- (forward-line -1))
- (wl-thread-jump-to-prev-unread hereto))
- (if hereto
- (end-of-line)
- (beginning-of-line))
- (let ((case-fold-search nil)
- regex-list)
- (setq regex-list (wl-summary-cursor-move-regex))
- (catch 'done
- (while regex-list
- (when (re-search-backward
- (car regex-list)
- nil t nil)
- (beginning-of-line)
- (throw 'done t))
- (setq regex-list (cdr regex-list)))
- (beginning-of-line)
- (throw 'done nil)))))
-
+(defvar wl-summary-move-spec-plugged-alist
+ (` ((new . ((t . nil)
+ (p . (, wl-summary-new-mark))
+ (p . (, (wl-regexp-opt
+ (list wl-summary-unread-uncached-mark
+ wl-summary-unread-cached-mark))))
+ (p . (, (regexp-quote wl-summary-important-mark)))))
+ (unread . ((t . nil)
+ (p . (, (wl-regexp-opt
+ (list wl-summary-new-mark
+ wl-summary-unread-uncached-mark
+ wl-summary-unread-cached-mark))))
+ (p . (, (regexp-quote wl-summary-important-mark))))))))
+
+(defvar wl-summary-move-spec-unplugged-alist
+ (` ((new . ((t . nil)
+ (p . (, wl-summary-unread-cached-mark))
+ (p . (, (regexp-quote wl-summary-important-mark)))))
+ (unread . ((t . nil)
+ (p . (, wl-summary-unread-cached-mark))
+ (p . (, (regexp-quote wl-summary-important-mark))))))))
+
+(defsubst wl-summary-next-message (num direction hereto)
+ (if wl-summary-buffer-next-message-function
+ (funcall wl-summary-buffer-next-message-function num direction hereto)
+ (let ((cur-spec (cdr (assq wl-summary-move-order
+ (if (elmo-folder-plugged-p
+ wl-summary-buffer-elmo-folder)
+ wl-summary-move-spec-plugged-alist
+ wl-summary-move-spec-unplugged-alist))))
+ (nums (memq num (if (eq direction 'up)
+ (reverse wl-summary-buffer-number-list)
+ wl-summary-buffer-number-list)))
+ marked-list nums2)
+ (unless hereto (setq nums (cdr nums)))
+ (setq nums2 nums)
+ (if cur-spec
+ (catch 'done
+ (while cur-spec
+ (setq nums nums2)
+ (cond ((eq (car (car cur-spec)) 'p)
+ (if (setq marked-list
+ (elmo-folder-list-messages-mark-match
+ wl-summary-buffer-elmo-folder
+ (cdr (car cur-spec))))
+ (while nums
+ (if (memq (car nums) marked-list)
+ (throw 'done (car nums)))
+ (setq nums (cdr nums)))))
+ ((eq (car (car cur-spec)) 't)
+ (if wl-summary-buffer-target-mark-list
+ (while nums
+ (if (memq (car nums)
+ wl-summary-buffer-target-mark-list)
+ (throw 'done (car nums)))
+ (setq nums (cdr nums))))))
+ (setq cur-spec (cdr cur-spec))))
+ (car nums)))))
+
+(defsubst wl-summary-cursor-move (direction hereto)
+ (when (and (eq direction 'up)
+ (eobp))
+ (forward-line -1)
+ (setq hereto t))
+ (let (num)
+ (when (setq num (wl-summary-next-message (wl-summary-message-number)
+ direction hereto))
+ (if (numberp num)
+ (wl-thread-jump-to-msg num))
+ t)))
;;
;; Goto unread or important
;; returns t if next message exists in this folder.
(defun wl-summary-cursor-down (&optional hereto)
(interactive "P")
- (if (and (null wl-summary-buffer-target-mark-list)
- (eq wl-summary-buffer-view 'thread))
- (wl-thread-jump-to-next-unread hereto)
- (if hereto
- (beginning-of-line)
- (end-of-line))
- (let ((case-fold-search nil)
- regex-list)
- (setq regex-list (wl-summary-cursor-move-regex))
- (catch 'done
- (while regex-list
- (when (re-search-forward
- (car regex-list)
- nil t nil)
- (beginning-of-line)
- (throw 'done t))
- (setq regex-list (cdr regex-list)))
- (beginning-of-line)
- (throw 'done nil)))))
+ (wl-summary-cursor-move 'down hereto))
+
+(defun wl-summary-cursor-up (&optional hereto)
+ (interactive "P")
+ (wl-summary-cursor-move 'up hereto))
(defun wl-summary-save-view-cache ()
(save-excursion
- (let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
+ (let* ((dir (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder))
(cache (expand-file-name wl-summary-cache-file dir))
(view (expand-file-name wl-summary-view-file dir))
(save-view wl-summary-buffer-view)
+ (mark-list (copy-sequence wl-summary-buffer-target-mark-list))
+ (refile-list (copy-sequence wl-summary-buffer-refile-list))
+ (copy-list (copy-sequence wl-summary-buffer-copy-list))
+ (delete-list (copy-sequence wl-summary-buffer-delete-list))
(tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
+ (temp-column wl-summary-buffer-temp-mark-column)
(charset wl-summary-buffer-mime-charset))
(if (file-directory-p dir)
(); ok.
(elmo-make-directory dir)))
(if (eq save-view 'thread)
(wl-thread-save-entity dir))
+ (when wl-summary-check-line-format
+ (wl-summary-line-format-save))
(unwind-protect
(progn
(when (file-writable-p cache)
(copy-to-buffer tmp-buffer (point-min) (point-max))
(with-current-buffer tmp-buffer
(widen)
- (encode-mime-charset-region
- (point-min) (point-max) charset)
+ (make-local-variable 'wl-summary-highlight)
+ (setq wl-summary-highlight nil
+ wl-summary-buffer-target-mark-list mark-list
+ wl-summary-buffer-refile-list refile-list
+ wl-summary-buffer-copy-list copy-list
+ wl-summary-buffer-delete-list delete-list
+ wl-summary-buffer-temp-mark-column temp-column)
+ (wl-summary-delete-all-temp-marks)
+ (encode-coding-region
+ (point-min) (point-max)
+ (or (and wl-on-mule ; one in mcs-ltn1(apel<10.4) cannot take 2 arg.
+ (mime-charset-to-coding-system charset 'LF))
+ ;; Mule 2 doesn't have `*ctext*unix'.
+ (mime-charset-to-coding-system charset)))
(write-region-as-binary (point-min)(point-max)
cache nil 'no-msg)))
(when (file-writable-p view) ; 'thread or 'sequence
(elmo-folder-plugged-p folder)
(wl-get-assoc-list-value
wl-folder-sync-range-alist
- folder))
+ (elmo-folder-name-internal folder)))
wl-default-sync-range)))
;; redefined for wl-summary-sync-update
"returns update or all or rescan."
;; for the case when parts are expanded in the bottom of the folder
(let ((input-range-list '("update" "all" "rescan" "first:" "last:"
+ "cache-status"
"no-sync" "rescan-noscore" "all-visible"))
(default (or (wl-get-assoc-list-value
wl-folder-sync-range-alist
(defun wl-summary-toggle-disp-folder (&optional arg)
(interactive)
- (let (fld-buf fld-win
- (view-message-buffer (wl-message-get-buffer-create))
- (cur-buf (current-buffer))
- (summary-win (get-buffer-window (current-buffer))))
+ (let ((cur-buf (current-buffer))
+ (summary-win (get-buffer-window (current-buffer)))
+ fld-buf fld-win)
(cond
((eq arg 'on)
(setq wl-summary-buffer-disp-folder t)
((eq arg 'off)
(setq wl-summary-buffer-disp-folder nil)
;; hide your wl-message window!
- (wl-select-buffer view-message-buffer)
- (delete-window)
+ (when (buffer-live-p wl-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
+ (delete-window))
(select-window (get-buffer-window cur-buf))
;; display wl-folder window!!
(if (setq fld-buf (get-buffer wl-folder-buffer-name))
(setq wl-summary-buffer-disp-folder t)))
(if (not wl-summary-buffer-disp-folder)
;; hide message window
- (let ((mes-win (get-buffer-window view-message-buffer))
+ (let ((mes-win (and wl-message-buffer
+ (get-buffer-window wl-message-buffer)))
(wl-stay-folder-window t))
(if mes-win (delete-window mes-win))
;; hide your folder window
(run-hooks 'wl-summary-toggle-disp-folder-off-hook)
;; resume message window.
(when mes-win
- (wl-select-buffer view-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
(run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
- (select-window (get-buffer-window cur-buf)))
- )
+ (select-window (get-buffer-window cur-buf))))
;; hide message window
- (let ((mes-win (get-buffer-window view-message-buffer))
- (wl-stay-folder-window t))
+ (let ((wl-stay-folder-window t)
+ (mes-win (and wl-message-buffer
+ (get-buffer-window wl-message-buffer))))
(if mes-win (delete-window mes-win))
(select-window (get-buffer-window cur-buf))
;; display wl-folder window!!
;; resume message window.
(run-hooks 'wl-summary-toggle-disp-folder-on-hook)
(when mes-win
- (wl-select-buffer view-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
(run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
- (select-window (get-buffer-window cur-buf))))
- ))))
+ (select-window (get-buffer-window cur-buf))))))))
(run-hooks 'wl-summary-toggle-disp-folder-hook))
(defun wl-summary-toggle-disp-msg (&optional arg)
(interactive)
- (let (fld-buf fld-win
- (view-message-buffer (wl-message-get-buffer-create))
- (cur-buf (current-buffer))
+ (let ((cur-buf (current-buffer))
+ fld-buf fld-win
summary-win)
(cond
((eq arg 'on)
(setq wl-summary-buffer-disp-msg t)
- ;; hide your 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))))
+ (save-excursion
+ ;; hide your 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))
+ (unless (one-window-p fld-win)
+ (delete-window fld-win))))))
((eq arg 'off)
(wl-delete-all-overlays)
(setq wl-summary-buffer-disp-msg nil)
(save-excursion
- (wl-select-buffer view-message-buffer)
- (delete-window)
- (and (get-buffer-window cur-buf)
- (select-window (get-buffer-window cur-buf)))
- (run-hooks 'wl-summary-toggle-disp-off-hook)))
+ (when (buffer-live-p wl-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
+ (delete-window)
+ (and (get-buffer-window cur-buf)
+ (select-window (get-buffer-window cur-buf))))
+ (run-hooks 'wl-summary-toggle-disp-off-hook)))
(t
- (if (get-buffer-window view-message-buffer) ; already displayed
+ (if (and wl-message-buffer
+ (get-buffer-window wl-message-buffer)) ; already displayed
(setq wl-summary-buffer-disp-msg nil)
(setq wl-summary-buffer-disp-msg t))
(if wl-summary-buffer-disp-msg
(run-hooks 'wl-summary-toggle-disp-on-hook))
(wl-delete-all-overlays)
(save-excursion
- (wl-select-buffer view-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
(delete-window)
(select-window (get-buffer-window cur-buf))
(run-hooks 'wl-summary-toggle-disp-off-hook))
)))))
(defun wl-summary-next-line-content ()
+ "Show next line of the message."
(interactive)
(let ((cur-buf (current-buffer)))
(wl-summary-toggle-disp-msg 'on)
(defun wl-summary-next-page ()
(interactive)
- (wl-message-next-page))
+ (let ((cur-buf (current-buffer)))
+ (wl-summary-toggle-disp-msg 'on)
+ (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
+ (set-buffer cur-buf)
+ (wl-message-next-page))))
(defun wl-summary-prev-page ()
(interactive)
- (wl-message-prev-page))
+ (let ((cur-buf (current-buffer)))
+ (wl-summary-toggle-disp-msg 'on)
+ (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
+ (set-buffer cur-buf)
+ (wl-message-prev-page))))
(defsubst wl-summary-no-mime-p (folder)
- (wl-string-match-member folder wl-summary-no-mime-folder-list))
-
-(defun wl-summary-set-message-buffer-or-redisplay (&optional ignore-original)
- ;; if current message is not displayed, display it.
- ;; return t if exists.
- (let ((folder wl-summary-buffer-folder-name)
+ (wl-string-match-member (elmo-folder-name-internal folder)
+ wl-summary-no-mime-folder-list))
+
+(defun wl-summary-set-message-buffer-or-redisplay (&rest args)
+ "Set message buffer.
+If message is not displayed yet, display it.
+Return t if message exists."
+ (let ((folder wl-summary-buffer-elmo-folder)
(number (wl-summary-message-number))
- cur-folder cur-number message-last-pos
- (view-message-buffer (wl-message-get-buffer-create)))
- (save-excursion
- (set-buffer view-message-buffer)
- (setq cur-folder wl-message-buffer-cur-folder)
- (setq cur-number wl-message-buffer-cur-number))
- (if (and (not ignore-original)
- (not
- (and (eq number (wl-message-original-buffer-number))
- (string= folder (wl-message-original-buffer-folder)))))
+ cur-folder cur-number message-last-pos)
+ (when (buffer-live-p wl-message-buffer)
+ (save-window-excursion
+ (wl-message-select-buffer wl-message-buffer)
+ (setq cur-folder wl-message-buffer-cur-folder)
+ (setq cur-number wl-message-buffer-cur-number)))
+ (if (and (string= (elmo-folder-name-internal folder) (or cur-folder ""))
+ (eq number (or cur-number 0)))
(progn
- (if (wl-summary-no-mime-p folder)
- (wl-summary-redisplay-no-mime folder number)
- (wl-summary-redisplay-internal folder number))
- nil)
- (if (and (string= folder (or cur-folder ""))
- (eq number (or cur-number 0)))
- (progn
- (set-buffer view-message-buffer)
- t)
- (if (wl-summary-no-mime-p folder)
- (wl-summary-redisplay-no-mime folder number)
- (wl-summary-redisplay-internal folder number))
- nil))))
+ (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))
+ (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-jump-to-msg (car mlist))
(wl-summary-reply arg t)
(goto-char (point-max))
- (setq start-point (point))
+ (setq start-point (point-marker))
(setq draft-buf (current-buffer))
(save-window-excursion
(while mlist
(set-buffer summary-buf)
+ (delete-other-windows)
(wl-summary-jump-to-msg (car mlist))
(wl-summary-redisplay)
(set-buffer draft-buf)
(interactive)
(let* ((original (wl-summary-message-number))
(msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
- (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
+ (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))
msg otherfld schar
(errmsg
(format "No message with id \"%s\" in the folder." msgid)))
(if (setq msg (car (rassoc msgid number-alist)))
;;; (wl-summary-jump-to-msg-internal
-;;; wl-summary-buffer-folder-name msg 'no-sync)
+;;; (wl-summary-buffer-folder-name) msg 'no-sync)
(progn
(wl-thread-jump-to-msg msg)
t)
t ; succeed.
;; Back to original.
(wl-summary-jump-to-msg-internal
- wl-summary-buffer-folder-name original 'no-sync))
+ (wl-summary-buffer-folder-name) original 'no-sync))
(cond ((eq wl-summary-search-via-nntp 'confirm)
+ (require 'elmo-nntp)
(message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
- elmo-default-nntp-server)
+ elmo-nntp-default-server)
(setq schar (read-char))
(cond ((eq schar ?y)
(wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
user server port type spec)
(if server-spec
(if (string-match "^-" server-spec)
- (setq spec (elmo-nntp-get-spec server-spec)
- user (nth 2 spec)
- server (nth 3 spec)
- port (nth 4 spec)
- type (nth 5 spec))
+ (setq spec (wl-folder-get-elmo-folder server-spec)
+ user (elmo-net-folder-user-internal spec)
+ server (elmo-net-folder-server-internal spec)
+ port (elmo-net-folder-port-internal spec)
+ type (elmo-net-folder-stream-type-internal spec))
(setq server server-spec)))
(when (setq ret (elmo-nntp-get-newsgroup-by-msgid
msgid
- (or server elmo-default-nntp-server)
- (or user elmo-default-nntp-user)
- (or port elmo-default-nntp-port)
- (or type elmo-default-nntp-stream-type)))
- (setq newsgroups (wl-parse-newsgroups ret))
+ (or server elmo-nntp-default-server)
+ (or user elmo-nntp-default-user)
+ (or port elmo-nntp-default-port)
+ (or type elmo-nntp-default-stream-type)))
+ (setq newsgroups (elmo-nntp-parse-newsgroups ret))
(setq folder (concat "-" (car newsgroups)
(elmo-nntp-folder-postfix user server port type)))
(catch 'found
(if ret
(wl-summary-jump-to-msg-internal folder nil 'update msgid)
(message "No message id \"%s\" in nntp server \"%s\"."
- msgid (or server elmo-default-nntp-server))
+ msgid (or server elmo-nntp-default-server))
nil)))
(defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
(let (wl-auto-select-first entity)
- (if (or (string= folder wl-summary-buffer-folder-name)
+ (if (or (string= folder (wl-summary-buffer-folder-name))
(y-or-n-p
(format
"Message was found in the folder \"%s\". Jump to it? "
(setq msg
(car (rassoc msgid
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))))
+ (wl-summary-buffer-msgdb))))))
(setq entity (wl-folder-search-entity-by-name folder
wl-folder-entity
'folder))
(defun wl-summary-jump-to-parent-message (arg)
(interactive "P")
(let ((cur-buf (current-buffer))
+ (disp-msg wl-summary-buffer-disp-msg)
(number (wl-summary-message-number))
(regexp "\\(<[^<>]*>\\)[ \t]*$")
(i -1) ;; xxx
(setq msg-id
(if (null arg) (nth 0 ref-list) ;; previous
(if (<= arg i) (nth (1- arg) ref-list)
- (nth i ref-list)))))))
- (set-buffer cur-buf)
+ (nth i ref-list))))))
+ (set-buffer cur-buf)
+ (or disp-msg (wl-summary-toggle-disp-msg 'off)))
(cond ((and (null msg-id) (null msg-num))
(message "No parent message!")
nil)
((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
- (wl-summary-redisplay)
+ (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
(message "Searching parent message...done")
t)
((and msg-num (wl-summary-jump-to-msg msg-num))
- (wl-summary-redisplay)
+ (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
(message "Searching parent message...done")
t)
(t ; failed.
"Reply to current message. Default is \"wide\" reply.
Reply to author if invoked with ARG."
(interactive "P")
- (let ((folder wl-summary-buffer-folder-name)
+ (let ((folder wl-summary-buffer-elmo-folder)
(number (wl-summary-message-number))
(summary-buf (current-buffer))
mes-buf)
- (if number
- (unwind-protect
- (progn
- (wl-summary-redisplay-internal folder number)
- (wl-select-buffer
- (get-buffer (setq mes-buf (wl-current-message-buffer))))
- (set-buffer mes-buf)
- (goto-char (point-min))
- (or wl-draft-use-frame
- (split-window-vertically))
- (other-window 1)
- (when (setq mes-buf (wl-message-get-original-buffer))
- (wl-draft-reply mes-buf arg summary-buf)
- (unless without-setup-hook
- (run-hooks 'wl-mail-setup-hook)))
- t)))))
+ (when number
+ (save-excursion
+ (wl-summary-redisplay-internal folder number))
+ (setq mes-buf wl-message-buffer)
+ (wl-message-select-buffer wl-message-buffer)
+ (set-buffer mes-buf)
+ (goto-char (point-min))
+ (when (setq mes-buf (wl-message-get-original-buffer))
+ (wl-draft-reply mes-buf arg summary-buf)
+ (unless without-setup-hook
+ (run-hooks 'wl-mail-setup-hook)))
+ t)))
(defun wl-summary-write ()
"Write a new draft from Summary."
(interactive)
- (wl-draft nil nil nil nil nil
- nil nil nil nil nil nil (current-buffer))
+ (wl-draft (list (cons 'To ""))
+ nil nil nil nil (wl-summary-buffer-folder-name))
(run-hooks 'wl-mail-setup-hook)
(mail-position-on-field "To"))
wl-folder-guess-mailing-list-by-refile-rule
wl-folder-guess-mailing-list-by-folder-name)
"Newsgroups or Mailing List address guess functions list.
-Call from `wl-summary-write-current-folder'")
+Call from `wl-summary-write-current-folder'.
+When guess function return nil, challenge next guess-function.")
(defun wl-summary-write-current-folder (&optional folder)
"Write message to current FOLDER's newsgroup or mailing-list.
Use function list is `wl-summary-write-current-folder-functions'."
(interactive)
- (let (newsgroups to cc)
- ;; default FOLDER is current buffer folder
- (setq folder (or folder wl-summary-buffer-folder-name))
- (let ((flist wl-summary-write-current-folder-functions)
- guess-list)
- (while flist
- (setq guess-list (funcall (car flist) folder))
- (if (or (nth 0 guess-list) ; To:
-;;; (nth 1 guess-list) ; Cc:
- (nth 2 guess-list)) ; Newsgroups:
- (setq flist nil)
- (setq flist (cdr flist))))
- (if guess-list
- (progn
- (wl-draft (nth 0 guess-list) ; To:
- nil nil
- (nth 1 guess-list) ; Cc:
- nil
- (nth 2 guess-list)) ; Newsgroups:
- (run-hooks 'wl-mail-setup-hook))
-;;; (error "%s is not newsgroup" folder)
- (error "Can't guess by folder %s" folder)))))
+ ;; default FOLDER is current buffer folder
+ (setq folder (or folder (wl-summary-buffer-folder-name)))
+ (let ((func-list wl-summary-write-current-folder-functions)
+ guess-list guess-func)
+ (while func-list
+ (setq guess-list (funcall (car func-list) folder))
+ (if (null guess-list)
+ (setq func-list (cdr func-list))
+ (setq guess-func (car func-list))
+ (setq func-list nil)))
+ (if (null guess-func)
+ (wl-summary-write)
+ (unless (or (stringp (nth 0 guess-list))
+ (stringp (nth 1 guess-list))
+ (stringp (nth 2 guess-list)))
+ (error "Invalid value return guess function `%s'"
+ (symbol-name guess-func)))
+ (wl-draft (list (cons 'To (nth 0 guess-list))
+ (cons 'Cc (nth 1 guess-list))
+ (cons 'Newsgroups (nth 2 guess-list)))
+ nil nil nil nil folder)
+ (run-hooks 'wl-mail-setup-hook)
+ (mail-position-on-field "Subject"))))
(defun wl-summary-forward (&optional without-setup-hook)
""
(interactive)
- (let ((folder wl-summary-buffer-folder-name)
+ (let ((folder wl-summary-buffer-elmo-folder)
(number (wl-summary-message-number))
(summary-buf (current-buffer))
(wl-draft-forward t)
+ mes-buf
entity subject num)
(if (null number)
(message "No message.")
- (wl-summary-redisplay-internal folder number)
- (wl-select-buffer (get-buffer wl-message-buf-name))
- (or wl-draft-use-frame
- (split-window-vertically))
- (other-window 1)
+ (if (and (elmo-message-use-cache-p folder number)
+ (eq (elmo-file-cache-status
+ (elmo-file-cache-get
+ (elmo-message-field folder number 'message-id)))
+ 'section))
+ ;; 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 num (wl-summary-message-number))
- (setq entity (assoc (cdr (assq num
- (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
- (elmo-msgdb-get-overview
- wl-summary-buffer-msgdb)))
- (and entity
- (setq subject
- (or (elmo-msgdb-overview-entity-get-subject entity)
- "")))))
+ (setq subject
+ (or (elmo-message-field folder number 'subject) ""))))
+ (set-buffer mes-buf)
(wl-draft-forward subject summary-buf)
(unless without-setup-hook
(run-hooks 'wl-mail-setup-hook)))))
(wl-summary-read))
(defun wl-summary-read ()
- ""
+ "Proceed reading message in the summary buffer."
(interactive)
- (let ((folder wl-summary-buffer-folder-name)
- (number (wl-summary-message-number))
- cur-folder cur-number message-last-pos
- (view-message-buffer (get-buffer-create wl-message-buf-name))
- (sticky-buf-name (and (wl-summary-sticky-p) wl-message-buf-name))
- (summary-buf-name (buffer-name)))
- (save-excursion
- (set-buffer view-message-buffer)
- (when (and sticky-buf-name
- (not (wl-local-variable-p 'wl-message-buf-name
- (current-buffer))))
- (make-local-variable 'wl-message-buf-name)
- (setq wl-message-buf-name sticky-buf-name)
- (make-local-variable 'wl-message-buffer-cur-summary-buffer)
- (setq wl-message-buffer-cur-summary-buffer summary-buf-name))
- (setq cur-folder wl-message-buffer-cur-folder)
- (setq cur-number wl-message-buffer-cur-number))
+ (let ((cur-buf (current-buffer)))
(wl-summary-toggle-disp-msg 'on)
- (if (and (string= folder cur-folder)
- (eq number cur-number))
- (progn
- (if (wl-summary-next-page)
- (wl-summary-down t)))
-;;; (wl-summary-scroll-up-content)))
- (if (wl-summary-no-mime-p folder)
- (wl-summary-redisplay-no-mime folder number)
- (wl-summary-redisplay-internal folder number)))))
+ (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
+ (set-buffer cur-buf)
+ (if (wl-message-next-page)
+ (wl-summary-down t)))))
-(defun wl-summary-prev (&optional interactive)
- ""
- (interactive)
+(defsubst wl-summary-cursor-move-surface (downward interactive)
(if wl-summary-move-direction-toggle
- (setq wl-summary-move-direction-downward nil))
- (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
- (skip-mark-regexp (mapconcat
- 'regexp-quote
- wl-summary-skip-mark-list ""))
- goto-next regex-list regex next-entity finfo)
- (beginning-of-line)
- (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
- (setq regex (format "^%s[^%s]"
- wl-summary-buffer-number-regexp
- skip-mark-regexp))
- (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
- wl-summary-buffer-number-regexp
- skip-mark-regexp
- (regexp-quote wl-summary-unread-cached-mark)
- (regexp-quote wl-summary-important-mark))))
- (unless (re-search-backward regex nil t)
- (setq goto-next t))
- (beginning-of-line)
- (if (not goto-next)
- (progn
- (if wl-summary-buffer-disp-msg
- (wl-summary-redisplay)))
- (if (or interactive (interactive-p))
- (if wl-summary-buffer-prev-folder-func
- (funcall wl-summary-buffer-prev-folder-func)
- (when wl-auto-select-next
- (setq next-entity (wl-summary-get-prev-folder))
- (if next-entity
- (setq finfo (wl-folder-get-entity-info next-entity))))
- (wl-ask-folder
- '(lambda () (wl-summary-next-folder-or-exit next-entity))
- (format
- "No more messages. Type SPC to go to %s."
- (wl-summary-entity-info-msg next-entity finfo))))))))
+ (setq wl-summary-move-direction-downward downward))
+ (let ((start (point))
+ (skip-tmark-regexp (wl-regexp-opt wl-summary-skip-mark-list))
+ (skip t)
+ skip-pmark-regexp goto-next next-entity finfo)
+ (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
+ ()
+ (setq skip-pmark-regexp
+ (wl-regexp-opt (list " "
+ wl-summary-unread-cached-mark
+ wl-summary-important-mark))))
+ (while (and skip
+ (not (if downward (eobp) (bobp))))
+ (if downward
+ (forward-line 1)
+ (forward-line -1))
+ (setq skip (or (string-match skip-tmark-regexp
+ (save-excursion
+ (wl-summary-temp-mark)))
+ (and skip-pmark-regexp
+ (not (string-match
+ skip-pmark-regexp
+ (save-excursion
+ (wl-summary-persistent-mark))))))))
+
+ (if (if downward (eobp) (and (bobp) skip)) (setq goto-next t))
+ (if (or (eobp) (and (bobp) skip))
+ (goto-char start))
-(defun wl-summary-next (&optional interactive)
- ""
- (interactive)
- (if wl-summary-move-direction-toggle
- (setq wl-summary-move-direction-downward t))
- (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
- (skip-mark-regexp (mapconcat
- 'regexp-quote
- wl-summary-skip-mark-list ""))
- goto-next regex regex-list next-entity finfo)
- (end-of-line)
- (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
- (setq regex (format "^%s[^%s]"
- wl-summary-buffer-number-regexp
- skip-mark-regexp))
- (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
- wl-summary-buffer-number-regexp
- skip-mark-regexp
- (regexp-quote wl-summary-unread-cached-mark)
- (regexp-quote wl-summary-important-mark))))
- (unless (re-search-forward regex nil t)
- (forward-line 1)
- (setq goto-next t))
(beginning-of-line)
+
(if (not goto-next)
(if wl-summary-buffer-disp-msg
(wl-summary-redisplay))
- (if (or interactive (interactive-p))
- (if wl-summary-buffer-next-folder-func
- (funcall wl-summary-buffer-next-folder-func)
+ (if interactive
+ (cond
+ ((and (not downward) wl-summary-buffer-prev-folder-function)
+ (funcall wl-summary-buffer-prev-folder-function))
+ ((and downward wl-summary-buffer-next-folder-function)
+ (funcall wl-summary-buffer-next-folder-function))
+ (t
(when wl-auto-select-next
- (setq next-entity (wl-summary-get-next-folder))
+ (setq next-entity
+ (if downward
+ (wl-summary-get-next-folder)
+ (wl-summary-get-prev-folder)))
(if next-entity
(setq finfo (wl-folder-get-entity-info next-entity))))
(wl-ask-folder
'(lambda () (wl-summary-next-folder-or-exit next-entity))
(format
"No more messages. Type SPC to go to %s."
- (wl-summary-entity-info-msg next-entity finfo))))))))
+ (wl-summary-entity-info-msg next-entity finfo)))))))))
+
+(defun wl-summary-prev (&optional interactive)
+ (interactive)
+ (wl-summary-cursor-move-surface nil (or interactive (interactive-p))))
+
+(defun wl-summary-next (&optional interactive)
+ (interactive)
+ (wl-summary-cursor-move-surface t (or interactive (interactive-p))))
(defun wl-summary-up (&optional interactive skip-no-unread)
""
(wl-summary-redisplay))
(if (or interactive
(interactive-p))
- (if wl-summary-buffer-prev-folder-func
- (funcall wl-summary-buffer-prev-folder-func)
+ (if wl-summary-buffer-prev-folder-function
+ (funcall wl-summary-buffer-prev-folder-function)
(let (next-entity finfo)
(when wl-auto-select-next
(progn
(wl-summary-redisplay))
(if (or interactive
(interactive-p))
- (if wl-summary-buffer-next-folder-func
- (funcall wl-summary-buffer-next-folder-func)
+ (if wl-summary-buffer-next-folder-function
+ (funcall wl-summary-buffer-next-folder-function)
(let (next-entity finfo)
(when wl-auto-select-next
(setq next-entity (wl-summary-get-next-unread-folder)))
(defun wl-summary-redisplay (&optional arg)
(interactive "P")
(if (and (not arg)
- (wl-summary-no-mime-p wl-summary-buffer-folder-name))
+ (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
(wl-summary-redisplay-no-mime)
(wl-summary-redisplay-internal nil nil arg)))
(defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
(interactive)
- (let* ((msgdb wl-summary-buffer-msgdb)
- (fld (or folder wl-summary-buffer-folder-name))
+ (let* ((msgdb (wl-summary-buffer-msgdb))
+ (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)
- (wl-message-redisplay-func
- wl-summary-buffer-message-redisplay-func)
fld-buf fld-win thr-entity)
(if (and wl-thread-open-reading-thread
(eq wl-summary-buffer-view 'thread)
(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))
- (if (wl-message-redisplay fld num 'mime msgdb force-reload)
- (wl-summary-mark-as-read nil
- ;; cached, then change server-mark.
- (if wl-message-cache-used
- nil
- ;; plugged, then leave server-mark.
- (if (and
- (not
- (elmo-folder-local-p
- wl-summary-buffer-folder-name))
- (elmo-folder-plugged-p
- wl-summary-buffer-folder-name))
- 'leave))
- t ; displayed
- nil
- 'cached ; cached by reading.
- )
- )
+ (setq wl-current-summary-buffer (current-buffer))
+ (wl-summary-mark-as-read
+ num
+ ;; not fetched, then change server-mark.
+ (if (wl-message-redisplay folder num 'mime
+ (or force-reload
+ (string= (elmo-folder-name-internal
+ folder)
+ wl-draft-folder)))
+ nil
+ ;; plugged, then leave server-mark.
+ (if (and
+ (not
+ (elmo-folder-local-p
+ wl-summary-buffer-elmo-folder))
+ (elmo-folder-plugged-p
+ wl-summary-buffer-elmo-folder))
+ 'leave)))
(setq wl-summary-buffer-current-msg num)
(when wl-summary-recenter
(recenter (/ (- (window-height) 2) 2))
- (if (not wl-summary-width)
+ (if (not wl-summary-indent-length-limit)
(wl-horizontal-recenter)))
(wl-highlight-summary-displaying)
- (wl-cache-prefetch-next fld num (current-buffer))
+ (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 folder number)
- (interactive)
- (let* ((msgdb wl-summary-buffer-msgdb)
- (fld (or folder wl-summary-buffer-folder-name))
+(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-mime-charset wl-summary-buffer-mime-charset)
- (default-mime-charset wl-summary-buffer-mime-charset)
wl-break-pages)
(if num
(progn
(setq wl-summary-buffer-last-displayed-msg
wl-summary-buffer-current-msg)
(setq wl-current-summary-buffer (current-buffer))
- (wl-normal-message-redisplay fld num 'no-mime msgdb)
- (wl-summary-mark-as-read nil nil t)
+ (wl-message-redisplay fld num 'as-is
+ (string= (elmo-folder-name-internal fld)
+ wl-draft-folder))
+ (wl-summary-mark-as-read num)
(setq wl-summary-buffer-current-msg num)
(when wl-summary-recenter
(recenter (/ (- (window-height) 2) 2))
- (if (not wl-summary-width)
+ (if (not wl-summary-indent-length-limit)
(wl-horizontal-recenter)))
(wl-highlight-summary-displaying)
(run-hooks 'wl-summary-redisplay-hook))
(defun wl-summary-redisplay-all-header (&optional folder number)
(interactive)
- (let* ((msgdb wl-summary-buffer-msgdb)
- (fld (or folder wl-summary-buffer-folder-name))
+ (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)
- (wl-message-redisplay-func wl-summary-buffer-message-redisplay-func))
+ (default-mime-charset wl-summary-buffer-mime-charset))
(if num
(progn
(setq wl-summary-buffer-disp-msg t)
(setq wl-summary-buffer-last-displayed-msg
wl-summary-buffer-current-msg)
(setq wl-current-summary-buffer (current-buffer))
- (if (wl-message-redisplay fld num 'all-header msgdb); t if displayed.
- (wl-summary-mark-as-read nil nil t))
+ (if (wl-message-redisplay fld num 'all-header
+ (string= (elmo-folder-name-internal fld)
+ wl-draft-folder))
+ (wl-summary-mark-as-read num))
(setq wl-summary-buffer-current-msg num)
(when wl-summary-recenter
(recenter (/ (- (window-height) 2) 2))
- (if (not wl-summary-width)
+ (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."))))
(defun wl-summary-jump-to-current-message ()
+ "Jump into Message buffer."
(interactive)
(let (message-buf message-win)
- (if (setq message-buf (get-buffer wl-message-buf-name))
+ (if (setq message-buf wl-message-buffer)
(if (setq message-win (get-buffer-window message-buf))
(select-window message-win)
- (wl-select-buffer (get-buffer wl-message-buf-name)))
+ (wl-message-select-buffer wl-message-buffer))
(wl-summary-redisplay)
- (wl-select-buffer (get-buffer wl-message-buf-name)))
- (goto-char (point-min))))
+ (wl-message-select-buffer wl-message-buffer))))
(defun wl-summary-cancel-message ()
"Cancel an article on news."
(set-buffer message-buf))
(unless (wl-message-news-p)
(set-buffer summary-buf)
- (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
'nntp)
(y-or-n-p "Cannot get Newsgroups. Fetch again? "))
(progn
(defun wl-summary-supersedes-message ()
"Supersede current message."
(interactive)
+ (wl-summary-toggle-disp-msg 'off)
(let ((summary-buf (current-buffer))
- (mmelmo-force-fetch-entire-message t)
message-buf from)
(wl-summary-set-message-buffer-or-redisplay)
(if (setq message-buf (wl-message-get-original-buffer))
(set-buffer message-buf))
(unless (wl-message-news-p)
(set-buffer summary-buf)
- (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
+ (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
'nntp)
(y-or-n-p "Cannot get Newsgroups. Fetch again? "))
(progn
"Supersedes: " message-id "\n"
(and followup-to
(concat "Followup-To: " followup-to "\n")))))
- (set-buffer (wl-message-get-original-buffer))
+ (if message-buf (set-buffer message-buf))
(wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
(defun wl-summary-save (&optional arg wl-save-dir)
+ "Save current message to disk."
(interactive)
(let ((filename)
- (num (wl-summary-message-number))
- (mmelmo-force-fetch-entire-message t))
+ (num (wl-summary-message-number)))
(if (null wl-save-dir)
- (setq wl-save-dir wl-tmp-dir))
+ (setq wl-save-dir wl-temporary-file-directory))
(if num
(save-excursion
(setq filename (expand-file-name
(narrow-to-region beg end)
(goto-char (point-min))
(let ((wl-save-dir
- (wl-read-directory-name "Save to directory: " wl-tmp-dir)))
+ (wl-read-directory-name "Save to directory: "
+ wl-temporary-file-directory)))
(if (null (file-exists-p wl-save-dir))
(make-directory wl-save-dir))
(if (eq wl-summary-buffer-view 'thread)
(setq command (read-string "Shell command on message: "
wl-summary-shell-command-last))
(if (y-or-n-p "Send this message to pipe? ")
- (save-excursion
- (wl-summary-set-message-buffer-or-redisplay)
- (set-buffer (wl-message-get-original-buffer))
- (if (string= command "")
- (setq command wl-summary-shell-command-last))
- (goto-char (point-min)) ; perhaps this line won't be necessary
- (if prefix
- (search-forward "\n\n"))
- (shell-command-on-region (point) (point-max) command nil)
- (setq wl-summary-shell-command-last command)))))
+ (wl-summary-pipe-message-subr prefix command))))
+
+(defun wl-summary-target-mark-pipe (prefix command)
+ "Send each marked messages via pipe."
+ (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))
+ (when (y-or-n-p "Send each marked message to pipe? ")
+ (while (car wl-summary-buffer-target-mark-list)
+ (let ((num (car wl-summary-buffer-target-mark-list)))
+ (wl-thread-jump-to-msg num)
+ (wl-summary-pipe-message-subr prefix command)
+ (wl-summary-unmark num))))))
+
+(defun wl-summary-pipe-message-subr (prefix command)
+ (save-excursion
+ (wl-summary-set-message-buffer-or-redisplay)
+ (set-buffer (wl-message-get-original-buffer))
+ (if (string= command "")
+ (setq command wl-summary-shell-command-last))
+ (goto-char (point-min)) ; perhaps this line won't be necessary
+ (if prefix
+ (search-forward "\n\n"))
+ (shell-command-on-region (point) (point-max) command nil)
+ (setq wl-summary-shell-command-last command)))
(defun wl-summary-print-message (&optional arg)
(interactive "P")
(if (or (not (interactive-p))
(y-or-n-p "Print ok? "))
(progn
- (let* ((message-buffer (get-buffer wl-message-buf-name))
-;;; (summary-buffer (get-buffer wl-summary-buffer-name))
- (buffer (generate-new-buffer " *print*")))
- (set-buffer message-buffer)
+ (let ((buffer (generate-new-buffer " *print*")))
(copy-to-buffer buffer (point-min) (point-max))
(set-buffer buffer)
- (funcall wl-print-buffer-func)
+ (funcall wl-print-buffer-function)
(kill-buffer buffer)))
(message "")))))
(defun wl-summary-print-message-with-ps-print (&optional filename)
+ "Print message via ps-print."
(interactive)
(if (null (wl-summary-message-number))
(message "No message.")
(let ((summary-buffer (current-buffer))
wl-break-pages)
(save-excursion
-;;; (wl-summary-set-message-buffer-or-redisplay)
- (wl-summary-redisplay-internal)
- (let* ((message-buffer (get-buffer wl-message-buf-name))
- (buffer (generate-new-buffer " *print*"))
+ (wl-summary-set-message-buffer-or-redisplay)
+ ;; (wl-summary-redisplay-internal)
+ (let* ((buffer (generate-new-buffer " *print*"))
(entity (progn
(set-buffer summary-buffer)
(assoc (cdr (assq
(wl-summary-message-number)
(elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
(elmo-msgdb-get-overview
- wl-summary-buffer-msgdb))))
+ (wl-summary-buffer-msgdb)))))
(wl-ps-subject
(and entity
(or (elmo-msgdb-overview-entity-get-subject entity)
(and entity
(or (elmo-msgdb-overview-entity-get-date entity) ""))))
(run-hooks 'wl-ps-preprint-hook)
- (set-buffer message-buffer)
+ (set-buffer wl-message-buffer)
(copy-to-buffer buffer (point-min) (point-max))
(set-buffer buffer)
(unwind-protect
(list "/pagenumberstring load"
(concat "(" wl-ps-date ")"))))
(run-hooks 'wl-ps-print-hook)
- (funcall wl-ps-print-buffer-func filename))
+ (funcall wl-ps-print-buffer-function filename))
(kill-buffer buffer)))))
(message ""))))
(if (featurep 'ps-print) ; ps-print is available.
(fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
+(defun wl-summary-target-mark-print ()
+ (interactive)
+ (if (null wl-summary-buffer-target-mark-list)
+ (message "No marked message.")
+ (when (y-or-n-p "Print all marked messages. OK? ")
+ (while (car wl-summary-buffer-target-mark-list)
+ (let ((num (car wl-summary-buffer-target-mark-list)))
+ (wl-thread-jump-to-msg num)
+ (wl-summary-print-message)
+ (wl-summary-unmark num))))))
+
(defun wl-summary-folder-info-update ()
- (let ((folder (elmo-string wl-summary-buffer-folder-name))
+ (let ((folder (elmo-string (wl-summary-buffer-folder-name)))
(num-db (elmo-msgdb-get-number-alist
- wl-summary-buffer-msgdb)))
+ (wl-summary-buffer-msgdb))))
(wl-folder-set-folder-updated folder
(list 0
(+ wl-summary-buffer-unread-count
wl-summary-buffer-new-count)
(length num-db)))))
-(defun wl-summary-get-newsgroups ()
- (let ((spec-list (elmo-folder-get-primitive-spec-list
- (elmo-string wl-summary-buffer-folder-name)))
- ng-list)
- (while spec-list
- (when (eq (caar spec-list) 'nntp)
- (wl-append ng-list (list (nth 1 (car spec-list)))))
- (setq spec-list (cdr spec-list)))
- ng-list))
-
-(defun wl-summary-set-crosspost (&optional type redisplay)
- (let* ((number (wl-summary-message-number))
- (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name
- number))
- (folder (nth 1 spec))
- message-buf newsgroups)
- (when (eq (car spec) 'nntp)
- (if redisplay
- (wl-summary-redisplay))
- (save-excursion
- (if (setq message-buf (wl-message-get-original-buffer))
- (set-buffer message-buf))
- (setq newsgroups (std11-field-body "newsgroups")))
- (when newsgroups
- (let* ((msgdb wl-summary-buffer-msgdb)
- (num-db (elmo-msgdb-get-number-alist msgdb))
- (ng-list (wl-summary-get-newsgroups)) ;; for multi folder
- crosspost-folders)
- (when (setq crosspost-folders
- (elmo-list-delete ng-list
- (wl-parse-newsgroups newsgroups t)))
- (elmo-crosspost-message-set (cdr (assq number num-db)) ;;message-id
- crosspost-folders
- type) ;;not used
- (setq wl-crosspost-alist-modified t)))))))
-
-(defun wl-summary-is-crosspost-folder (spec-list fld-list)
- (let (fld flds)
- (while spec-list
- (if (and (eq (caar spec-list) 'nntp)
- (member (setq fld (nth 1 (car spec-list))) fld-list))
- (wl-append flds (list fld)))
- (setq spec-list (cdr spec-list)))
- flds))
-
-(defun wl-summary-update-crosspost ()
- (let* ((msgdb wl-summary-buffer-msgdb)
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- (spec-list (elmo-folder-get-primitive-spec-list
- (elmo-string wl-summary-buffer-folder-name)))
- (alist elmo-crosspost-message-alist)
- (crossed 0)
- mark ngs num)
- (when (assq 'nntp spec-list)
- (while alist
- (when (setq ngs
- (wl-summary-is-crosspost-folder
- spec-list
- (nth 1 (car alist))))
- (when (setq num (car (rassoc (caar alist) number-alist)))
- (if (and (setq mark (cadr (assq num mark-alist)))
- (member mark (list wl-summary-new-mark
- wl-summary-unread-uncached-mark
- wl-summary-unread-cached-mark)))
- (setq crossed (1+ crossed)))
- (if (wl-summary-jump-to-msg num)
- (wl-summary-mark-as-read t);; opened
- (wl-summary-mark-as-read t nil nil num)));; closed
- ;; delete if message does't exists.
- (elmo-crosspost-message-delete (caar alist) ngs)
- (setq wl-crosspost-alist-modified t))
- (setq alist (cdr alist))))
- (if (> crossed 0)
- crossed)))
-
-(defun wl-crosspost-alist-load ()
- (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
- (setq wl-crosspost-alist-modified nil))
-
-(defun wl-crosspost-alist-save ()
- (when wl-crosspost-alist-modified
- ;; delete non-exists newsgroups
- (let ((alist elmo-crosspost-message-alist)
- newsgroups)
- (while alist
- (setq newsgroups
- (elmo-delete-if
- '(lambda (x)
- (not (intern-soft x wl-folder-newsgroups-hashtb)))
- (nth 1 (car alist))))
- (if newsgroups
- (setcar (cdar alist) newsgroups)
- (setq elmo-crosspost-message-alist
- (delete (car alist) elmo-crosspost-message-alist)))
- (setq alist (cdr alist)))
- (elmo-crosspost-alist-save elmo-crosspost-message-alist)
- (setq wl-crosspost-alist-modified nil))))
+(defun wl-summary-get-original-buffer ()
+ "Get original buffer for the current summary."
+ (save-excursion
+ (wl-summary-set-message-buffer-or-redisplay)
+ (wl-message-get-original-buffer)))
(defun wl-summary-pack-number (&optional arg)
(interactive "P")
- (setq wl-summary-buffer-msgdb
- (elmo-pack-number
- wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg))
+ (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
(let (wl-use-scoring)
(wl-summary-rescan)))
(set-buffer summary-buf)
(wl-summary-jump-to-msg (car mlist))
(wl-summary-redisplay)
- (set-buffer (setq orig-buf (wl-message-get-original-buffer)))
+ (set-buffer (setq orig-buf (wl-summary-get-original-buffer)))
(goto-char (point-min))
(cond ((= i 1) ; first
(if (setq filename (wl-message-uu-substring
(set-buffer tmp-buf)
(message "Exec %s..." wl-prog-uudecode)
(unwind-protect
- (let ((decode-dir wl-tmp-dir))
+ (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-tmp-dir)))
+ wl-temporary-file-directory)))
(setq decode-dir
(wl-read-directory-name "Save to directory: "
- wl-tmp-dir))
+ wl-temporary-file-directory))
(setq filename (expand-file-name filename decode-dir)))
(if (file-exists-p filename)
(or (yes-or-no-p (format "File %s exists. Save anyway? "
(message "Saved as %s" filename)))
(kill-buffer tmp-buf)))))
-(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-max-of-folder (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-default-get-next-msg (msg)
- (let (next)
- (if (and (not wl-summary-buffer-target-mark-list)
- (eq wl-summary-buffer-view 'thread)
- (if (eq wl-summary-move-direction-downward nil)
- (setq next (wl-thread-get-prev-unread msg))
- (setq next (wl-thread-get-next-unread msg))))
- next
- (save-excursion
- (wl-summary-jump-to-msg msg)
- (let (wl-summary-buffer-disp-msg)
- (if (eq wl-summary-move-direction-downward nil)
- (unless (wl-summary-cursor-up)
- (wl-summary-prev))
- (unless (wl-summary-cursor-down)
- (wl-summary-next)))
- (wl-summary-message-number))))))
-
-(defsubst wl-cache-prefetch-p (fld &optional num)
- (cond ((and num wl-cache-prefetch-folder-type-list)
- (memq
- (elmo-folder-number-get-type fld num)
- wl-cache-prefetch-folder-type-list))
- (wl-cache-prefetch-folder-type-list
- (let ((list wl-cache-prefetch-folder-type-list)
- type)
- (catch 'done
- (while (setq type (pop list))
- (if (elmo-folder-contains-type fld type)
- (throw 'done t))))))
- ((consp wl-cache-prefetch-folder-list)
- (wl-string-match-member fld wl-cache-prefetch-folder-list))
- (t
- wl-cache-prefetch-folder-list)))
-
-(defconst wl-cache-prefetch-idle-time
- (if (featurep 'lisp-float-type) (/ (float 1) (float 10)) 1))
-
-(defun wl-cache-prefetch-next (fld msg &optional summary)
- (if (wl-cache-prefetch-p fld)
- (if elmo-use-buffer-cache
-;;; (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.")
- (save-excursion
- (set-buffer (or summary (get-buffer wl-summary-buffer-name)))
- (let ((next (funcall wl-cache-prefetch-get-next-func msg)))
- (when (and next
- (wl-cache-prefetch-p fld next))
- (if (not (fboundp 'run-with-idle-timer))
- (when (sit-for wl-cache-prefetch-idle-time)
- (wl-cache-prefetch-message fld next summary))
- (run-with-idle-timer
- wl-cache-prefetch-idle-time
- nil
- 'wl-cache-prefetch-message fld next summary)
- (sit-for 0))))))))
-
-(defvar wl-cache-prefetch-debug nil)
-(defun wl-cache-prefetch-message (folder msg summary &optional next)
- (when (buffer-live-p summary)
- (save-excursion
- (set-buffer summary)
- (when (string= folder wl-summary-buffer-folder-name)
- (unless next
- (setq next msg))
- (let* ((msgdb wl-summary-buffer-msgdb)
- (message-id (cdr (assq next
- (elmo-msgdb-get-number-alist msgdb)))))
- (if (not (elmo-buffer-cache-hit (list folder next message-id)))
- (let* ((size (elmo-msgdb-overview-entity-get-size
- (assoc message-id
- (elmo-msgdb-get-overview msgdb)))))
- (when (or (elmo-local-file-p folder next)
- (not (and (integerp size)
- wl-cache-prefetch-threshold
- (>= size wl-cache-prefetch-threshold)
- (not (elmo-cache-exists-p message-id
- folder next)))))
- (if wl-cache-prefetch-debug
- (message "Reading %d..." msg))
- (elmo-buffer-cache-message folder next msgdb nil 'unread)
- (if wl-cache-prefetch-debug
- (message "Reading %d... done" 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))))))
(defun wl-summary-save-current-message ()
"Save current message for `wl-summary-yank-saved-message'."
projects / elisp / wanderlust.git / blobdiff