wl/wl-summary.el

   1 ;;; wl-summary.el -- Summary mode for Wanderlust.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
   5 ;; Copyright (C) 1999,2000      TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
   6 ;; Copyright (C) 1999,2000      Kenichi OKADA <okada@opaopa.org>
   7
   8 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   9 ;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
  10 ;;      TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
  11 ;;      Kenichi OKADA <okada@opaopa.org>
  12 ;; Keywords: mail, net news
  13
  14 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  15
  16 ;; This program is free software; you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation; either version 2, or (at your option)
  19 ;; any later version.
  20 ;;
  21 ;; This program is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25 ;;
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  29 ;; Boston, MA 02111-1307, USA.
  30 ;;
  31
  32 ;;; Commentary:
  33 ;;
  34
  35 ;;; Code:
  36 ;;
  37
  38 (require 'elmo2)
  39 (require 'elmo-multi)
  40 (require 'wl-message)
  41 (require 'wl-vars)
  42 (require 'wl-highlight)
  43 (require 'wl-refile)
  44 (require 'wl-util)
  45 (condition-case nil (require 'timezone) (error nil))
  46 (condition-case nil (require 'easymenu) (error nil))
  47 (require 'elmo-date)
  48 (condition-case nil (require 'ps-print) (error nil))
  49
  50 (eval-when-compile
  51   (require 'cl)
  52   (condition-case () (require 'timer) (error nil))
  53   (defalias-maybe 'ps-print-buffer-with-faces 'ignore)
  54   (defalias-maybe 'elmo-database-msgid-put 'ignore)
  55   (defalias-maybe 'elmo-database-close 'ignore)
  56   (defalias-maybe 'elmo-database-msgid-get 'ignore)
  57   (defalias-maybe 'run-with-idle-timer 'ignore)
  58   (defalias-maybe 'ps-print-preprint 'ignore))
  59
  60 (defvar dragdrop-drop-functions)
  61 (defvar scrollbar-height)
  62 (defvar mail-reply-buffer)
  63
  64 (defvar wl-summary-buffer-name "Summary")
  65 (defvar wl-summary-mode-map nil)
  66 (defvar wl-current-summary-buffer nil)
  67
  68 (defvar wl-summary-buffer-msgdb       nil)
  69 (defvar wl-summary-buffer-folder-name nil)
  70 (defvar wl-summary-buffer-folder-indicator nil)
  71 (defvar wl-summary-buffer-disp-msg    nil)
  72 (defvar wl-summary-buffer-disp-folder nil)
  73 (defvar wl-summary-buffer-refile-list nil)
  74 (defvar wl-summary-buffer-delete-list nil)
  75 (defvar wl-summary-buffer-last-displayed-msg nil)
  76 (defvar wl-summary-buffer-current-msg nil)
  77 (defvar wl-summary-buffer-unread-status " (0 new/0 unread)")
  78 (defvar wl-summary-buffer-unread-count 0)
  79 (defvar wl-summary-buffer-new-count    0)
  80 (defvar wl-summary-buffer-mime-charset  nil)
  81 (defvar wl-summary-buffer-weekday-name-lang  nil)
  82 (defvar wl-summary-buffer-thread-indent-set-alist  nil)
  83 (defvar wl-summary-buffer-message-redisplay-func nil)
  84 (defvar wl-summary-buffer-view 'thread)
  85 (defvar wl-summary-buffer-message-modified nil)
  86 (defvar wl-summary-buffer-mark-modified nil)
  87 (defvar wl-summary-buffer-thread-modified nil)
  88 (defvar wl-summary-buffer-number-column nil)
  89 (defvar wl-summary-buffer-number-regexp nil)
  90 (defvar wl-summary-buffer-persistent nil)
  91 (defvar wl-summary-buffer-thread-nodes nil)
  92 (defvar wl-summary-buffer-target-mark-list nil)
  93 (defvar wl-summary-buffer-copy-list nil)
  94 (defvar wl-summary-buffer-prev-refile-destination nil)
  95 (defvar wl-summary-buffer-prev-copy-destination nil)
  96 (defvar wl-summary-buffer-saved-message nil)
  97 (defvar wl-summary-buffer-prev-folder-func nil)
  98 (defvar wl-summary-buffer-next-folder-func nil)
  99 (defvar wl-summary-buffer-exit-func nil)
 100 (defvar wl-thread-indent-level-internal nil)
 101 (defvar wl-thread-have-younger-brother-str-internal nil)
 102 (defvar wl-thread-youngest-child-str-internal nil)
 103 (defvar wl-thread-vertical-str-internal nil)
 104 (defvar wl-thread-horizontal-str-internal nil)
 105 (defvar wl-thread-space-str-internal nil)
 106 (defvar wl-summary-last-visited-folder nil)
 107 (defvar wl-read-folder-hist nil)
 108 (defvar wl-summary-scored nil)
 109 (defvar wl-crosspost-alist-modified nil)
 110 (defvar wl-summary-alike-hashtb nil)
 111 (defvar wl-summary-search-buf-name " *wl-search-subject*")
 112 (defvar wl-summary-delayed-update nil)
 113
 114 (defvar wl-summary-get-petname-func 'wl-address-get-petname-1)
 115
 116 (defvar wl-summary-message-regexp "^ *\\([0-9]+\\)")
 117
 118 (defvar wl-summary-shell-command-last "")
 119
 120 (defvar wl-ps-preprint-hook nil)
 121 (defvar wl-ps-print-hook nil)
 122
 123 (make-variable-buffer-local 'wl-summary-buffer-msgdb)
 124 (make-variable-buffer-local 'wl-summary-buffer-disp-msg)
 125 (make-variable-buffer-local 'wl-summary-buffer-disp-folder)
 126 (make-variable-buffer-local 'wl-summary-buffer-refile-list)
 127 (make-variable-buffer-local 'wl-summary-buffer-copy-list)
 128 (make-variable-buffer-local 'wl-summary-buffer-target-mark-list)
 129 (make-variable-buffer-local 'wl-summary-buffer-delete-list)
 130 (make-variable-buffer-local 'wl-summary-buffer-folder-name)
 131 (make-variable-buffer-local 'wl-summary-buffer-folder-indicator)
 132 (make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg)
 133 (make-variable-buffer-local 'wl-summary-buffer-unread-status)
 134 (make-variable-buffer-local 'wl-summary-buffer-unread-count)
 135 (make-variable-buffer-local 'wl-summary-buffer-new-count)
 136 (make-variable-buffer-local 'wl-summary-buffer-mime-charset)
 137 (make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang)
 138 (make-variable-buffer-local 'wl-summary-buffer-thread-indent-set)
 139 (make-variable-buffer-local 'wl-summary-buffer-message-redisplay-func)
 140 (make-variable-buffer-local 'wl-summary-buffer-view)
 141 (make-variable-buffer-local 'wl-summary-buffer-message-modified)
 142 (make-variable-buffer-local 'wl-summary-buffer-mark-modified)
 143 (make-variable-buffer-local 'wl-summary-buffer-thread-modified)
 144 (make-variable-buffer-local 'wl-summary-buffer-number-column)
 145 (make-variable-buffer-local 'wl-summary-buffer-number-regexp)
 146 (make-variable-buffer-local 'wl-summary-buffer-persistent)
 147 (make-variable-buffer-local 'wl-summary-buffer-thread-nodes)
 148 (make-variable-buffer-local 'wl-summary-buffer-prev-refile-destination)
 149 (make-variable-buffer-local 'wl-summary-buffer-saved-message)
 150 (make-variable-buffer-local 'wl-summary-scored)
 151 (make-variable-buffer-local 'wl-summary-default-score)
 152 (make-variable-buffer-local 'wl-summary-move-direction-downward)
 153 (make-variable-buffer-local 'wl-summary-important-above)
 154 (make-variable-buffer-local 'wl-summary-target-above)
 155 (make-variable-buffer-local 'wl-summary-mark-below)
 156 (make-variable-buffer-local 'wl-summary-expunge-below)
 157 (make-variable-buffer-local 'wl-thread-indent-level-internal)
 158 (make-variable-buffer-local 'wl-thread-have-younger-brother-str-internal)
 159 (make-variable-buffer-local 'wl-thread-youngest-child-str-internal)
 160 (make-variable-buffer-local 'wl-thread-vertical-str-internal)
 161 (make-variable-buffer-local 'wl-thread-horizontal-str-internal)
 162 (make-variable-buffer-local 'wl-thread-space-str-internal)
 163 (make-variable-buffer-local 'wl-summary-buffer-prev-folder-func)
 164 (make-variable-buffer-local 'wl-summary-buffer-next-folder-func)
 165 (make-variable-buffer-local 'wl-summary-buffer-exit-func)
 166
 167 ;; internal functions (dummy)
 168 (unless (fboundp 'wl-summary-append-message-func-internal)
 169   (defun wl-summary-append-message-func-internal (entity overview
 170                                                          mark-alist update
 171                                                          &optional force-insert)))
 172 (unless (fboundp 'wl-summary-from-func-internal)
 173   (defun wl-summary-from-func-internal (from)
 174     from))
 175 (unless (fboundp 'wl-summary-subject-func-internal)
 176   (defun wl-summary-subject-func-internal (subject)
 177     subject))
 178 (unless (fboundp 'wl-summary-subject-filter-func-internal)
 179   (defun wl-summary-subject-filter-func-internal (subject)
 180     subject))
 181
 182 (defmacro wl-summary-sticky-buffer-name (folder)
 183   (` (concat wl-summary-buffer-name ":" (, folder))))
 184
 185 (defun wl-summary-default-subject (subject-string)
 186   (if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string)
 187       (substring subject-string (match-end 0))
 188     subject-string))
 189
 190 (eval-when-compile (defvar-maybe entity nil)) ; silence byte compiler.
 191 (defun wl-summary-default-from (from)
 192   (let (retval tos ng)
 193     (unless
 194         (and (eq major-mode 'wl-summary-mode)
 195              (stringp wl-summary-showto-folder-regexp)
 196              (string-match wl-summary-showto-folder-regexp
 197                            wl-summary-buffer-folder-name)
 198              (wl-address-user-mail-address-p from)
 199              (cond
 200               ((and (setq tos (elmo-msgdb-overview-entity-get-to entity))
 201                     (not (string= "" tos)))
 202                (setq retval
 203                      (concat "To:"
 204                              (mapconcat
 205                               (function
 206                                (lambda (to)
 207                                  (eword-decode-string
 208                                   (if wl-use-petname
 209                                       (or
 210                                        (funcall wl-summary-get-petname-func to)
 211                                        (car
 212                                         (std11-extract-address-components to))
 213                                        to)
 214                                     to))))
 215                               (wl-parse-addresses tos)
 216                               ","))))
 217               ((setq ng (elmo-msgdb-overview-entity-get-extra-field
 218                          entity "newsgroups"))
 219                (setq retval (concat "Ng:" ng)))))
 220       (if wl-use-petname
 221           (setq retval (or (funcall wl-summary-get-petname-func from)
 222                            (car (std11-extract-address-components from))
 223                            from))
 224         (setq retval from)))
 225     retval))
 226
 227 (defun wl-summary-simple-from (string)
 228   (if wl-use-petname
 229       (or (funcall wl-summary-get-petname-func string)
 230           (car (std11-extract-address-components string))
 231           string)
 232     string))
 233
 234 (defvar wl-summary-mode-menu-spec
 235   '("Summary"
 236     ["Read" wl-summary-read t]
 237     ["Prev page" wl-summary-prev-page t]
 238     ["Next page" wl-summary-next-page t]
 239     ["Top"       wl-summary-display-top t]
 240     ["Bottom"    wl-summary-display-bottom t]
 241     ["Prev"      wl-summary-prev t]
 242     ["Next"      wl-summary-next t]
 243     ["Up"        wl-summary-up t]
 244     ["Down"      wl-summary-down t]
 245     ["Parent message" wl-summary-jump-to-parent-message t]
 246     "----"
 247     ["Sync"            wl-summary-sync t]
 248     ["Execute"         wl-summary-exec t]
 249     ["Go to other folder" wl-summary-goto-folder t]
 250     ["Pick" wl-summary-pick t]
 251     ["Mark as read all" wl-summary-mark-as-read-all t]
 252     ["Unmark all"      wl-summary-unmark-all t]
 253     ["Toggle display message" wl-summary-toggle-disp-msg t]
 254     ["Display folder" wl-summary-toggle-disp-folder t]
 255     ["Toggle threading" wl-summary-toggle-thread t]
 256     ["Stick" wl-summary-stick t]
 257     ("Sort"
 258      ["By Number" wl-summary-sort-by-number t]
 259      ["By Date" wl-summary-sort-by-date t]
 260      ["By From" wl-summary-sort-by-from t]
 261      ["By Subject" wl-summary-sort-by-subject t])
 262     "----"
 263     ("Message Operation"
 264      ["Mark as read"    wl-summary-mark-as-read t]
 265      ["Mark as important" wl-summary-mark-as-important t]
 266      ["Mark as unread"   wl-summary-mark-as-unread t]
 267      ["Set delete mark" wl-summary-delete t]
 268      ["Set refile mark" wl-summary-refile t]
 269      ["Set copy mark"   wl-summary-copy t]
 270      ["Prefetch"        wl-summary-prefetch t]
 271      ["Set target mark" wl-summary-target-mark t]
 272      ["Unmark"          wl-summary-unmark t]
 273      ["Save"            wl-summary-save t]
 274      ["Cancel posted news" wl-summary-cancel-message t]
 275      ["Supersedes message" wl-summary-supersedes-message t]
 276      ["Resend bounced mail" wl-summary-resend-bounced-mail t]
 277      ["Resend message" wl-summary-resend-message t]
 278      ["Enter the message" wl-summary-jump-to-current-message t]
 279      ["Pipe message" wl-summary-pipe-message t]
 280      ["Print message" wl-summary-print-message t])
 281     ("Thread Operation"
 282      ["Open or Close" wl-thread-open-close (eq wl-summary-buffer-view 'thread)]
 283      ["Open all"     wl-thread-open-all (eq wl-summary-buffer-view 'thread)]
 284      ["Close all"    wl-thread-close-all (eq wl-summary-buffer-view 'thread)]
 285      ["Mark as read" wl-thread-mark-as-read (eq wl-summary-buffer-view 'thread)]
 286      ["Mark as important"       wl-thread-mark-as-important (eq wl-summary-buffer-view 'thread)]
 287      ["Mark as unread"          wl-thread-mark-as-unread (eq wl-summary-buffer-view 'thread)]
 288      ["Set delete mark"  wl-thread-delete (eq wl-summary-buffer-view 'thread)]
 289      ["Set refile mark"  wl-thread-refile (eq wl-summary-buffer-view 'thread)]
 290      ["Set copy mark"    wl-thread-copy (eq wl-summary-buffer-view 'thread)]
 291      ["Prefetch"     wl-thread-prefetch (eq wl-summary-buffer-view 'thread)]
 292      ["Set target mark"        wl-thread-target-mark (eq wl-summary-buffer-view 'thread)]
 293      ["Unmark"      wl-thread-unmark (eq wl-summary-buffer-view 'thread)]
 294      ["Save"            wl-thread-save (eq wl-summary-buffer-view 'thread)]
 295      ["Execute"      wl-thread-exec (eq wl-summary-buffer-view 'thread)])
 296     ("Region Operation"
 297      ["Mark as read" wl-summary-mark-as-read-region t]
 298      ["Mark as important" wl-summary-mark-as-important-region t]
 299      ["Mark as unread" wl-summary-mark-as-unread-region t]
 300      ["Set delete mark" wl-summary-delete-region t]
 301      ["Set refile mark" wl-summary-refile-region t]
 302      ["Set copy mark" wl-summary-copy-region t]
 303      ["Prefetch" wl-summary-prefetch-region t]
 304      ["Set target mark" wl-summary-target-mark-region t]
 305      ["Unmark" wl-summary-unmark-region t]
 306      ["Save" wl-summary-save-region t]
 307      ["Execute" wl-summary-exec-region t])
 308     ("Mark Operation"
 309      ["Mark as read" wl-summary-target-mark-mark-as-read t]
 310      ["Mark as important" wl-summary-target-mark-mark-as-important t]
 311      ["Mark as unread" wl-summary-target-mark-mark-as-unread t]
 312      ["Set delete mark" wl-summary-target-mark-delete t]
 313      ["Set refile mark" wl-summary-target-mark-refile t]
 314      ["Set copy mark" wl-summary-target-mark-copy t]
 315      ["Prefetch" wl-summary-target-mark-prefetch t]
 316      ["Save" wl-summary-target-mark-save t]
 317      ["Reply with citation" wl-summary-target-mark-reply-with-citation t]
 318      ["Forward" wl-summary-target-mark-forward t]
 319      ["uudecode" wl-summary-target-mark-uudecode t])
 320     ("Score Operation"
 321      ["Switch current score file" wl-score-change-score-file t]
 322      ["Edit current score file" wl-score-edit-current-scores t]
 323      ["Edit score file" wl-score-edit-file t]
 324      ["Set mark below" wl-score-set-mark-below t]
 325      ["Set expunge below" wl-score-set-expunge-below t]
 326      ["Rescore buffer" wl-summary-rescore t]
 327      ["Increase score" wl-summary-increase-score t]
 328      ["Lower score" wl-summary-lower-score t])
 329     "----"
 330     ("Writing Messages"
 331      ["Write a message" wl-summary-write t]
 332      ["Reply" wl-summary-reply t]
 333      ["Reply with citation" wl-summary-reply-with-citation t]
 334      ["Forward" wl-summary-forward t])
 335     "----"
 336     ["Toggle Plug Status" wl-toggle-plugged t]
 337     ["Change Plug Status" wl-plugged-change t]
 338     "----"
 339     ["Exit Current Folder" wl-summary-exit t]))
 340
 341 (if wl-on-xemacs
 342     (defun wl-summary-setup-mouse ()
 343       (define-key wl-summary-mode-map 'button4 'wl-summary-prev)
 344       (define-key wl-summary-mode-map 'button5 'wl-summary-next)
 345       (define-key wl-summary-mode-map [(shift button4)]
 346         'wl-summary-up)
 347       (define-key wl-summary-mode-map [(shift button5)]
 348         'wl-summary-down)
 349       (define-key wl-summary-mode-map 'button2 'wl-summary-click))
 350   (if wl-on-nemacs
 351       (defun wl-summary-setup-mouse ())
 352     (defun wl-summary-setup-mouse ()
 353       (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev)
 354       (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next)
 355       (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up)
 356       (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down)
 357       (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click))))
 358
 359 (if wl-summary-mode-map
 360     ()
 361   (setq wl-summary-mode-map (make-sparse-keymap))
 362   (define-key wl-summary-mode-map " "    'wl-summary-read)
 363   (define-key wl-summary-mode-map "."    'wl-summary-redisplay)
 364   (define-key wl-summary-mode-map "<"    'wl-summary-display-top)
 365   (define-key wl-summary-mode-map ">"    'wl-summary-display-bottom)
 366   (define-key wl-summary-mode-map "\177" 'wl-summary-prev-page)
 367   (unless wl-on-nemacs
 368     (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page))
 369   (define-key wl-summary-mode-map "\r"   'wl-summary-next-line-content)
 370   (define-key wl-summary-mode-map "\C-m" 'wl-summary-next-line-content)
 371   (define-key wl-summary-mode-map "/"    'wl-thread-open-close)
 372   (define-key wl-summary-mode-map "["    'wl-thread-open-all)
 373   (define-key wl-summary-mode-map "]"    'wl-thread-close-all)
 374   (define-key wl-summary-mode-map "-"    'wl-summary-prev-line-content)
 375   (define-key wl-summary-mode-map "\e\r" 'wl-summary-prev-line-content)
 376   (define-key wl-summary-mode-map "g"    'wl-summary-goto-folder)
 377   (define-key wl-summary-mode-map "c"    'wl-summary-mark-as-read-all)
 378   (define-key wl-summary-mode-map "D"    'wl-summary-drop-unsync)
 379
 380   (define-key wl-summary-mode-map "a"    'wl-summary-reply)
 381   (define-key wl-summary-mode-map "A"    'wl-summary-reply-with-citation)
 382   (define-key wl-summary-mode-map "C"    'wl-summary-cancel-message)
 383   (define-key wl-summary-mode-map "E"    'wl-summary-reedit)
 384   (define-key wl-summary-mode-map "\eE"  'wl-summary-resend-bounced-mail)
 385   (define-key wl-summary-mode-map "f"    'wl-summary-forward)
 386   (define-key wl-summary-mode-map "$"    'wl-summary-mark-as-important)
 387   (define-key wl-summary-mode-map "@"    'wl-summary-edit-addresses)
 388
 389   (define-key wl-summary-mode-map "y"    'wl-summary-save)
 390   (define-key wl-summary-mode-map "n"    'wl-summary-next)
 391   (define-key wl-summary-mode-map "p"    'wl-summary-prev)
 392   (define-key wl-summary-mode-map "N"    'wl-summary-down)
 393   (define-key wl-summary-mode-map "P"    'wl-summary-up)
 394 ;;;(define-key wl-summary-mode-map "w"    'wl-draft)
 395   (define-key wl-summary-mode-map "w"    'wl-summary-write)
 396   (define-key wl-summary-mode-map "W"    'wl-summary-write-current-folder)
 397 ;;;(define-key wl-summary-mode-map "e"     'wl-draft-open-file)
 398   (define-key wl-summary-mode-map "e"     'wl-summary-save)
 399   (define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
 400   (define-key wl-summary-mode-map "H"    'wl-summary-redisplay-all-header)
 401   (define-key wl-summary-mode-map "M"    'wl-summary-redisplay-no-mime)
 402   (define-key wl-summary-mode-map "B"    'wl-summary-burst)
 403   (define-key wl-summary-mode-map "Z"    'wl-status-update)
 404   (define-key wl-summary-mode-map "#"    'wl-summary-print-message)
 405   (define-key wl-summary-mode-map "|"    'wl-summary-pipe-message)
 406   (define-key wl-summary-mode-map "q"    'wl-summary-exit)
 407   (define-key wl-summary-mode-map "Q"    'wl-summary-force-exit)
 408
 409   (define-key wl-summary-mode-map "j"    'wl-summary-jump-to-current-message)
 410   (define-key wl-summary-mode-map "J"    'wl-thread-jump-to-msg)
 411   (define-key wl-summary-mode-map "I"    'wl-summary-incorporate)
 412   (define-key wl-summary-mode-map "\M-j" 'wl-summary-jump-to-msg-by-message-id)
 413   (define-key wl-summary-mode-map "^"    'wl-summary-jump-to-parent-message)
 414   (define-key wl-summary-mode-map "!"    'wl-summary-mark-as-unread)
 415
 416   (define-key wl-summary-mode-map "s"    'wl-summary-sync)
 417   (define-key wl-summary-mode-map "S"    'wl-summary-sort)
 418   (define-key wl-summary-mode-map "\M-s"    'wl-summary-stick)
 419   (define-key wl-summary-mode-map "T"    'wl-summary-toggle-thread)
 420
 421   (define-key wl-summary-mode-map "l"    'wl-summary-toggle-disp-folder)
 422   (define-key wl-summary-mode-map "v"    'wl-summary-toggle-disp-msg)
 423   (define-key wl-summary-mode-map "V"    'wl-summary-virtual)
 424
 425   (define-key wl-summary-mode-map "\C-i"  'wl-summary-goto-last-displayed-msg)
 426   (define-key wl-summary-mode-map "?"    'wl-summary-pick)
 427   (define-key wl-summary-mode-map "\ee"  'wl-summary-expire)
 428
 429   ;; copy & paste.
 430   (define-key wl-summary-mode-map "\ew"  'wl-summary-save-current-message)
 431   (define-key wl-summary-mode-map "\C-y"  'wl-summary-yank-saved-message)
 432
 433   ;; line commands
 434   (define-key wl-summary-mode-map "R"    'wl-summary-mark-as-read)
 435   (define-key wl-summary-mode-map "i"    'wl-summary-prefetch)
 436   (define-key wl-summary-mode-map "x"    'wl-summary-exec)
 437   (define-key wl-summary-mode-map "*"    'wl-summary-target-mark)
 438   (define-key wl-summary-mode-map "o"    'wl-summary-refile)
 439   (define-key wl-summary-mode-map "O"    'wl-summary-copy)
 440   (define-key wl-summary-mode-map "\M-o" 'wl-summary-refile-prev-destination)
 441 ;  (define-key wl-summary-mode-map "\M-O" 'wl-summary-copy-prev-destination)
 442   (define-key wl-summary-mode-map "\C-o" 'wl-summary-auto-refile)
 443   (define-key wl-summary-mode-map "d"    'wl-summary-delete)
 444   (define-key wl-summary-mode-map "u"    'wl-summary-unmark)
 445   (define-key wl-summary-mode-map "U"    'wl-summary-unmark-all)
 446
 447   ;; thread commands
 448   (define-key wl-summary-mode-map "t"   (make-sparse-keymap))
 449   (define-key wl-summary-mode-map "tR" 'wl-thread-mark-as-read)
 450   (define-key wl-summary-mode-map "ti" 'wl-thread-prefetch)
 451   (define-key wl-summary-mode-map "tx" 'wl-thread-exec)
 452   (define-key wl-summary-mode-map "t*" 'wl-thread-target-mark)
 453   (define-key wl-summary-mode-map "to" 'wl-thread-refile)
 454   (define-key wl-summary-mode-map "tO" 'wl-thread-copy)
 455   (define-key wl-summary-mode-map "td" 'wl-thread-delete)
 456   (define-key wl-summary-mode-map "tu" 'wl-thread-unmark)
 457   (define-key wl-summary-mode-map "t!" 'wl-thread-mark-as-unread)
 458   (define-key wl-summary-mode-map "t$" 'wl-thread-mark-as-important)
 459   (define-key wl-summary-mode-map "ty" 'wl-thread-save)
 460   (define-key wl-summary-mode-map "ts" 'wl-thread-set-parent)
 461
 462   ;; target-mark commands
 463   (define-key wl-summary-mode-map "m"     (make-sparse-keymap))
 464   (define-key wl-summary-mode-map "mi"   'wl-summary-target-mark-prefetch)
 465   (define-key wl-summary-mode-map "mR"   'wl-summary-target-mark-mark-as-read)
 466   (define-key wl-summary-mode-map "mo"   'wl-summary-target-mark-refile)
 467   (define-key wl-summary-mode-map "mO"   'wl-summary-target-mark-copy)
 468   (define-key wl-summary-mode-map "md"   'wl-summary-target-mark-delete)
 469   (define-key wl-summary-mode-map "my"   'wl-summary-target-mark-save)
 470   (define-key wl-summary-mode-map "m!"   'wl-summary-target-mark-mark-as-unread)
 471   (define-key wl-summary-mode-map "m$"   'wl-summary-target-mark-mark-as-important)
 472   (define-key wl-summary-mode-map "mu"   'wl-summary-delete-all-temp-marks)
 473   (define-key wl-summary-mode-map "mU"   'wl-summary-target-mark-uudecode)
 474   (define-key wl-summary-mode-map "ma"   'wl-summary-target-mark-all)
 475   (define-key wl-summary-mode-map "mt"   'wl-summary-target-mark-thread)
 476   (define-key wl-summary-mode-map "mA"   'wl-summary-target-mark-reply-with-citation)
 477   (define-key wl-summary-mode-map "mf"   'wl-summary-target-mark-forward)
 478   (define-key wl-summary-mode-map "m?"   'wl-summary-target-mark-pick)
 479
 480   ;; region commands
 481   (define-key wl-summary-mode-map "r"    (make-sparse-keymap))
 482   (define-key wl-summary-mode-map "rR"   'wl-summary-mark-as-read-region)
 483   (define-key wl-summary-mode-map "ri"   'wl-summary-prefetch-region)
 484   (define-key wl-summary-mode-map "rx"   'wl-summary-exec-region)
 485   (define-key wl-summary-mode-map "mr"   'wl-summary-target-mark-region)
 486   (define-key wl-summary-mode-map "r*"   'wl-summary-target-mark-region)
 487   (define-key wl-summary-mode-map "ro"   'wl-summary-refile-region)
 488   (define-key wl-summary-mode-map "rO"   'wl-summary-copy-region)
 489   (define-key wl-summary-mode-map "rd"   'wl-summary-delete-region)
 490   (define-key wl-summary-mode-map "ru"   'wl-summary-unmark-region)
 491   (define-key wl-summary-mode-map "r!"   'wl-summary-mark-as-unread-region)
 492   (define-key wl-summary-mode-map "r$"   'wl-summary-mark-as-important-region)
 493   (define-key wl-summary-mode-map "ry"   'wl-summary-save-region)
 494
 495   ;; score commands
 496   (define-key wl-summary-mode-map "K"    'wl-summary-increase-score)
 497   (define-key wl-summary-mode-map "L"    'wl-summary-lower-score)
 498   (define-key wl-summary-mode-map "h"    (make-sparse-keymap))
 499   (define-key wl-summary-mode-map "hR"   'wl-summary-rescore)
 500   (define-key wl-summary-mode-map "hc"   'wl-score-change-score-file)
 501   (define-key wl-summary-mode-map "he"   'wl-score-edit-current-scores)
 502   (define-key wl-summary-mode-map "hf"   'wl-score-edit-file)
 503   (define-key wl-summary-mode-map "hF"   'wl-score-flush-cache)
 504   (define-key wl-summary-mode-map "hm"   'wl-score-set-mark-below)
 505   (define-key wl-summary-mode-map "hx"   'wl-score-set-expunge-below)
 506
 507   (define-key wl-summary-mode-map "\M-t" 'wl-toggle-plugged)
 508   (define-key wl-summary-mode-map "\C-t" 'wl-plugged-change)
 509   ;;
 510   (wl-summary-setup-mouse)
 511   (easy-menu-define
 512    wl-summary-mode-menu
 513    wl-summary-mode-map
 514    "Menu used in Summary mode."
 515    wl-summary-mode-menu-spec))
 516
 517 (defun wl-status-update ()
 518   (interactive)
 519   (wl-address-init))
 520
 521 (defun wl-summary-display-top ()
 522   (interactive)
 523   (goto-char (point-min))
 524   (if wl-summary-buffer-disp-msg
 525       (wl-summary-redisplay)))
 526
 527 (defun wl-summary-display-bottom ()
 528   (interactive)
 529   (goto-char (point-max))
 530   (forward-line -1)
 531   (if wl-summary-buffer-disp-msg
 532       (wl-summary-redisplay)))
 533
 534 (defun wl-summary-collect-unread (mark-alist &optional folder)
 535   (let (mark ret-val)
 536     (while mark-alist
 537       (setq mark (cadr (car mark-alist)))
 538       (and mark
 539            (or (string= mark wl-summary-new-mark)
 540                (string= mark wl-summary-unread-uncached-mark)
 541                (string= mark wl-summary-unread-cached-mark))
 542            (setq ret-val (cons (car (car mark-alist)) ret-val)))
 543       (setq mark-alist (cdr mark-alist)))
 544     ret-val))
 545
 546 (defun wl-summary-count-unread (mark-alist &optional folder)
 547   (let ((new 0)
 548         (unread 0)
 549         mark)
 550     (while mark-alist
 551       (setq mark (cadr (car mark-alist)))
 552       (and mark
 553            (cond
 554             ((string= mark wl-summary-new-mark)
 555              (setq new (+ 1 new)))
 556             ((or (string= mark wl-summary-unread-uncached-mark)
 557                  (string= mark wl-summary-unread-cached-mark))
 558              (setq unread (+ 1 unread)))))
 559       (setq mark-alist (cdr mark-alist)))
 560     (if (eq major-mode 'wl-summary-mode)
 561         (setq wl-summary-buffer-new-count new
 562               wl-summary-buffer-unread-count unread))
 563     (+ new unread)))
 564
 565 (defun wl-summary-reedit (&optional arg)
 566   "Re-edit current message.
 567 If ARG is non-nil, Supersedes message"
 568   (interactive "P")
 569   (if arg
 570       (wl-summary-supersedes-message)
 571     (if (string= wl-summary-buffer-folder-name wl-draft-folder)
 572         (if (wl-summary-message-number)
 573             (unwind-protect
 574                 (wl-draft-reedit (wl-summary-message-number))
 575               (if (wl-message-news-p)
 576                   (mail-position-on-field "Newsgroups")
 577                 (mail-position-on-field "To"))
 578               (delete-other-windows)))
 579       (save-excursion
 580         (let ((mmelmo-force-fetch-entire-message t))
 581           (if (null (wl-summary-message-number))
 582               (message "No message.")
 583             (wl-summary-set-message-buffer-or-redisplay)
 584             (set-buffer (wl-message-get-original-buffer))
 585             (wl-draft-edit-string (buffer-substring (point-min)
 586                                                     (point-max)))))))))
 587
 588 (defun wl-summary-resend-bounced-mail ()
 589   "Re-mail the current message.
 590 This only makes sense if the current message is a bounce message which
 591 contains some mail you have written but has been bounced back to
 592 you."
 593   (interactive)
 594   (save-excursion
 595     (let ((mmelmo-force-fetch-entire-message t))
 596       (wl-summary-set-message-buffer-or-redisplay)
 597       (set-buffer (wl-message-get-original-buffer))
 598       (goto-char (point-min))
 599       (let ((case-fold-search nil))
 600         (cond
 601          ((and
 602            (re-search-forward
 603             (concat "^\\($\\|[Cc]ontent-[Tt]ype:[ \t]+multipart/report\\)") nil t)
 604            (not (bolp))
 605            (re-search-forward "boundary=\"\\([^\"]+\\)\"" nil t))
 606           (let ((boundary (buffer-substring (match-beginning 1) (match-end 1)))
 607                 start)
 608             (cond
 609              ((and (setq start (re-search-forward
 610                            (concat "^--" boundary "\n"
 611                                    "[Cc]ontent-[Tt]ype:[ \t]+"
 612                                    "\\(message/rfc822\\|text/rfc822-headers\\)\n"
 613                                    "\\(.+\n\\)*\n") nil t))
 614                    (re-search-forward
 615                          (concat "\n\\(--" boundary "\\)--\n") nil t))
 616               (wl-draft-edit-string (buffer-substring start (match-beginning 1))))
 617              (t
 618               (message "Seems no message/rfc822 part.")))))
 619          ((let ((case-fold-search t))
 620             (re-search-forward wl-rejected-letter-start nil t))
 621           (skip-chars-forward " \t\n")
 622           (wl-draft-edit-string (buffer-substring (point) (point-max))))
 623          (t
 624           (message "Does not appear to be a rejected letter.")))))))
 625
 626 (defun wl-summary-resend-message (address)
 627   "Resend the current message to ADDRESS."
 628   (interactive "sResend message to: ")
 629   (if (or (null address) (string-match "^[ \t]*$" address))
 630       (message "No address specified.")
 631     (message "Resending message to %s..." address)
 632     (save-excursion
 633       (let ((mmelmo-force-fetch-entire-message t))
 634         (wl-summary-set-message-buffer-or-redisplay)
 635         ;; We first set up a normal mail buffer.
 636         (set-buffer (get-buffer-create " *wl-draft-resend*"))
 637         (buffer-disable-undo (current-buffer))
 638         (erase-buffer)
 639         (setq wl-sent-message-via nil)
 640         ;; Insert our usual headers.
 641         (wl-draft-insert-from-field)
 642         (wl-draft-insert-date-field)
 643         (insert "to: " address "\n")
 644         (goto-char (point-min))
 645         ;; Rename them all to "Resent-*".
 646         (while (re-search-forward "^[A-Za-z]" nil t)
 647           (forward-char -1)
 648           (insert "Resent-"))
 649         (widen)
 650         (forward-line)
 651         (delete-region (point) (point-max))
 652         (let ((beg  (point)))
 653           ;; Insert the message to be resent.
 654           (insert-buffer-substring (wl-message-get-original-buffer))
 655           (goto-char (point-min))
 656           (search-forward "\n\n")
 657           (forward-char -1)
 658           (save-restriction
 659             (narrow-to-region beg (point))
 660             (wl-draft-delete-fields wl-ignored-resent-headers)
 661             (goto-char (point-max)))
 662           (insert mail-header-separator)
 663           ;; Rename all old ("Previous-")Resent headers.
 664           (while (re-search-backward "^\\(Previous-\\)*Resent-" beg t)
 665             (beginning-of-line)
 666             (insert "Previous-"))
 667           ;; Quote any "From " lines at the beginning.
 668           (goto-char beg)
 669           (when (looking-at "From ")
 670             (replace-match "X-From-Line: ")))
 671         ;; Send it.
 672         (wl-draft-dispatch-message)
 673         (kill-buffer (current-buffer)))
 674       (message "Resending message to %s...done" address))))
 675
 676 (defun wl-summary-msgdb-load-async (folder)
 677   "Loading msgdb and selecting FOLDER is executed asynchronously in IMAP4."
 678   (if (and (elmo-folder-plugged-p folder)
 679            (eq (elmo-folder-get-type folder) 'imap4))
 680       (let ((spec (elmo-folder-get-spec folder))
 681             session mailbox
 682             msgdb response tag)
 683         (unwind-protect
 684             (progn
 685               (setq session (elmo-imap4-get-session spec)
 686                     mailbox (elmo-imap4-spec-mailbox spec)
 687                     tag (elmo-imap4-send-command session
 688                                                  (list "select "
 689                                                        (elmo-imap4-mailbox
 690                                                         mailbox))))
 691               (setq msgdb (elmo-msgdb-load (elmo-string folder)))
 692               (setq response (elmo-imap4-read-response session tag)))
 693           (if response
 694               (elmo-imap4-session-set-current-mailbox-internal session mailbox)
 695             (and session
 696                  (elmo-imap4-session-set-current-mailbox-internal session nil))
 697             (message "Select mailbox %s failed" mailbox)))
 698         msgdb)
 699     (elmo-msgdb-load (elmo-string folder))))
 700
 701 (defun wl-summary-buffer-set-folder (folder)
 702   (setq wl-summary-buffer-folder-name folder)
 703   (setq wl-summary-buffer-folder-indicator
 704         (if (memq 'modeline wl-use-folder-petname)
 705             (wl-folder-get-petname folder)
 706           folder))
 707   (when (wl-summary-sticky-p)
 708     (make-local-variable 'wl-message-buf-name)
 709     (setq wl-message-buf-name (format "%s:%s" wl-message-buf-name folder)))
 710   (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value
 711                                             wl-folder-mime-charset-alist
 712                                             folder)
 713                                            wl-mime-charset))
 714   (setq wl-summary-buffer-weekday-name-lang
 715         (or (wl-get-assoc-list-value
 716              wl-folder-weekday-name-lang-alist
 717              folder)
 718             wl-summary-weekday-name-lang))
 719   (setq wl-summary-buffer-thread-indent-set
 720         (wl-get-assoc-list-value
 721          wl-folder-thread-indent-set-alist
 722          folder))
 723   (setq wl-summary-buffer-persistent (wl-folder-persistent-p folder))
 724   (setq
 725    wl-thread-indent-level-internal
 726    (or (nth 0 wl-summary-buffer-thread-indent-set)
 727        wl-thread-indent-level)
 728    wl-thread-have-younger-brother-str-internal
 729    (or (nth 1 wl-summary-buffer-thread-indent-set)
 730        wl-thread-have-younger-brother-str)
 731    wl-thread-youngest-child-str-internal
 732    (or (nth 2 wl-summary-buffer-thread-indent-set)
 733        wl-thread-youngest-child-str)
 734    wl-thread-vertical-str-internal
 735    (or (nth 3 wl-summary-buffer-thread-indent-set)
 736        wl-thread-vertical-str)
 737    wl-thread-horizontal-str-internal
 738    (or (nth 4 wl-summary-buffer-thread-indent-set)
 739        wl-thread-horizontal-str)
 740    wl-thread-space-str-internal
 741    (or (nth 5 wl-summary-buffer-thread-indent-set)
 742        wl-thread-space-str))
 743   (setq wl-thread-indent-regexp
 744         (concat
 745          (regexp-quote wl-thread-have-younger-brother-str-internal) "\\|"
 746          (regexp-quote wl-thread-youngest-child-str-internal) "\\|"
 747          (regexp-quote wl-thread-vertical-str-internal) "\\|"
 748          (regexp-quote wl-thread-horizontal-str-internal) "\\|"
 749          (regexp-quote wl-thread-space-str-internal)))
 750   (run-hooks 'wl-summary-buffer-set-folder-hook))
 751
 752 (defun wl-summary-mode ()
 753   "Major mode for reading threaded messages.
 754 See Info under Wanderlust for full documentation.
 755
 756 Special commands:
 757 \\{wl-summary-mode-map}
 758
 759 Entering Folder mode calls the value of `wl-summary-mode-hook'."
 760   (interactive)
 761   (unless (interactive-p) (kill-all-local-variables))
 762   (setq major-mode 'wl-summary-mode)
 763   (setq mode-name "Summary")
 764   (use-local-map wl-summary-mode-map)
 765 ;;;(setq default-directory (or wl-tmp-dir (expand-file-name "~/")))
 766   (setq buffer-read-only t)
 767   (setq truncate-lines t)
 768 ;;;(make-local-variable 'tab-width)
 769 ;;;(setq tab-width 1)
 770   (buffer-disable-undo (current-buffer))
 771   (if wl-use-semi
 772       (setq wl-summary-buffer-message-redisplay-func
 773             'wl-mmelmo-message-redisplay)
 774     (setq wl-summary-buffer-message-redisplay-func
 775           'wl-normal-message-redisplay))
 776   (wl-mode-line-buffer-identification '("Wanderlust: "
 777                                         wl-summary-buffer-folder-indicator
 778                                         wl-summary-buffer-unread-status))
 779   (easy-menu-add wl-summary-mode-menu)
 780   ;; This hook may contain the function `wl-setup-summary' for reasons
 781   ;; of system internal to accord facilities for the Emacs variants.
 782   (run-hooks 'wl-summary-mode-hook))
 783
 784 (defun wl-summary-overview-entity-compare-by-date (x y)
 785   "Compare entity X and Y by date."
 786   (condition-case nil
 787       (string<
 788        (timezone-make-date-sortable
 789         (elmo-msgdb-overview-entity-get-date x))
 790        (timezone-make-date-sortable
 791         (elmo-msgdb-overview-entity-get-date y)))
 792     (error))) ;; ignore error.
 793
 794 (defun wl-summary-overview-entity-compare-by-number (x y)
 795    "Compare entity X and Y by number."
 796   (<
 797    (elmo-msgdb-overview-entity-get-number x)
 798    (elmo-msgdb-overview-entity-get-number y)))
 799
 800 (defun wl-summary-overview-entity-compare-by-from (x y)
 801   "Compare entity X and Y by from."
 802   (string<
 803    (wl-address-header-extract-address
 804     (or (elmo-msgdb-overview-entity-get-from-no-decode x)
 805         wl-summary-no-from-message))
 806    (wl-address-header-extract-address
 807     (or (elmo-msgdb-overview-entity-get-from-no-decode y)
 808         wl-summary-no-from-message))))
 809
 810 (defun wl-summary-overview-entity-compare-by-subject (x y)
 811   "Compare entity X and Y by subject."
 812   (string< (elmo-msgdb-overview-entity-get-subject-no-decode x)
 813            (elmo-msgdb-overview-entity-get-subject-no-decode y)))
 814
 815 (defun wl-summary-sort-by-date ()
 816   (interactive)
 817   (wl-summary-rescan "date"))
 818 (defun wl-summary-sort-by-number ()
 819   (interactive)
 820   (wl-summary-rescan "number"))
 821 (defun wl-summary-sort-by-subject ()
 822   (interactive)
 823   (wl-summary-rescan "subject"))
 824 (defun wl-summary-sort-by-from ()
 825   (interactive)
 826   (wl-summary-rescan "from"))
 827
 828 (defun wl-summary-rescan (&optional sort-by)
 829   "Rescan current folder without updating."
 830   (interactive)
 831   (let* ((cur-buf (current-buffer))
 832          (msgdb wl-summary-buffer-msgdb)
 833          (overview (elmo-msgdb-get-overview msgdb))
 834          (number-alist (elmo-msgdb-get-number-alist msgdb))
 835          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
 836          (elmo-mime-charset wl-summary-buffer-mime-charset)
 837          i percent num
 838          gc-message entity
 839          curp
 840          (inhibit-read-only t)
 841          (buffer-read-only nil)
 842          expunged)
 843     (fset 'wl-summary-append-message-func-internal
 844           (wl-summary-get-append-message-func))
 845     (wl-summary-buffer-number-column-detect nil)
 846     (erase-buffer)
 847     (message "Re-scanning...")
 848     (setq i 0)
 849     (setq num (length overview))
 850     (when sort-by
 851       (message "Sorting by %s..." sort-by)
 852       (setq overview
 853             (sort overview
 854                   (intern (format "wl-summary-overview-entity-compare-by-%s"
 855                                   sort-by))))
 856       (message "Sorting by %s...done" sort-by)
 857       (elmo-msgdb-set-overview wl-summary-buffer-msgdb
 858                                overview))
 859     (setq curp overview)
 860     (set-buffer cur-buf)
 861     (setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2)))
 862     (setq wl-thread-entity-list nil)
 863     (setq wl-thread-entities nil)
 864     (setq wl-summary-buffer-target-mark-list nil)
 865     (setq wl-summary-buffer-refile-list nil)
 866     (setq wl-summary-buffer-delete-list nil)
 867     (setq wl-summary-delayed-update nil)
 868     (elmo-kill-buffer wl-summary-search-buf-name)
 869     (message "Constructing summary structure...")
 870     (while curp
 871       (setq entity (car curp))
 872       (wl-summary-append-message-func-internal entity overview mark-alist
 873                                                nil)
 874       (setq curp (cdr curp))
 875       (when (> num elmo-display-progress-threshold)
 876         (setq i (+ i 1))
 877         (if (or (zerop (% i 5)) (= i num))
 878             (elmo-display-progress
 879              'wl-summary-rescan "Constructing summary structure..."
 880              (/ (* i 100) num)))))
 881     (when wl-summary-delayed-update
 882       (while wl-summary-delayed-update
 883         (message "Parent (%d) of message %d is no entity"
 884                  (caar wl-summary-delayed-update)
 885                  (elmo-msgdb-overview-entity-get-number
 886                   (cdar wl-summary-delayed-update)))
 887         (wl-summary-append-message-func-internal
 888          (cdar wl-summary-delayed-update)
 889          overview mark-alist nil t)
 890         (setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
 891     (message "Constructing summary structure...done")
 892     (set-buffer cur-buf)
 893     (when (eq wl-summary-buffer-view 'thread)
 894       (message "Inserting thread...")
 895       (wl-thread-insert-top)
 896       (message "Inserting thread...done"))
 897     (when wl-use-scoring
 898       (setq wl-summary-scored nil)
 899       (wl-summary-score-headers nil msgdb
 900                                 (wl-summary-rescore-msgs number-alist)
 901                                 t)
 902       (when (and wl-summary-scored
 903                  (setq expunged (wl-summary-score-update-all-lines)))
 904         (message "%d message(s) are expunged by scoring." (length expunged))))
 905     (wl-summary-set-message-modified)
 906     (wl-summary-count-unread mark-alist)
 907     (wl-summary-update-modeline)
 908     (goto-char (point-max))
 909     (forward-line -1)
 910     (set-buffer-modified-p nil)))
 911
 912 (defun wl-summary-next-folder-or-exit (&optional next-entity upward)
 913   (if (and next-entity
 914            wl-auto-select-next)
 915       (let (retval)
 916         (wl-summary-toggle-disp-msg 'off)
 917         (unwind-protect
 918             (setq retval
 919                   (wl-summary-goto-folder-subr next-entity
 920                                                'force-update
 921                                                nil
 922                                                nil ; not sticky
 923                                                t   ; interactive!
 924                                                ))
 925           (wl-folder-set-current-entity-id (wl-folder-get-entity-id next-entity))
 926           (if (and (eq retval 'more-next)
 927                    (memq wl-auto-select-next '(unread skip-no-unread))
 928                    (memq this-command wl-summary-next-no-unread-command))
 929               (if upward
 930                   (wl-summary-up
 931                    t (eq wl-auto-select-next 'skip-no-unread))
 932                 (goto-char (point-max))
 933                 (forward-line -1)
 934                 (wl-summary-down
 935                  t (eq wl-auto-select-next 'skip-no-unread))))))
 936     (wl-summary-exit)))
 937
 938 (defun wl-summary-entity-info-msg (entity finfo)
 939   (or (and entity
 940            (concat
 941             (elmo-replace-in-string
 942              (if (memq 'ask-folder wl-use-folder-petname)
 943                  (wl-folder-get-petname entity)
 944                entity)
 945              "%" "%%")
 946             (if (null (car finfo))
 947                 " (? new/? unread)"
 948               (format
 949                " (%d new/%d unread)"
 950                (nth 0 finfo)
 951                (+ (nth 0 finfo)
 952                   (nth 1 finfo))))))
 953       "folder mode"))
 954
 955 (defun wl-summary-set-message-modified ()
 956   (setq wl-summary-buffer-message-modified t))
 957 (defun wl-summary-message-modified-p ()
 958   wl-summary-buffer-message-modified)
 959 (defun wl-summary-set-mark-modified ()
 960   (setq wl-summary-buffer-mark-modified t))
 961 (defun wl-summary-mark-modified-p ()
 962   wl-summary-buffer-mark-modified)
 963 (defun wl-summary-set-thread-modified ()
 964   (setq wl-summary-buffer-thread-modified t))
 965 (defun wl-summary-thread-modified-p ()
 966   wl-summary-buffer-thread-modified)
 967
 968 (defun wl-summary-msgdb-save ()
 969   "Save msgdb if modified."
 970   (when wl-summary-buffer-msgdb
 971     (save-excursion
 972       (let (path)
 973         (when (wl-summary-message-modified-p)
 974           (setq path (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
 975           (elmo-msgdb-overview-save
 976            path
 977            (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
 978           (elmo-msgdb-number-save
 979            path
 980            (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
 981           (elmo-folder-set-info-max-by-numdb
 982            (elmo-string wl-summary-buffer-folder-name)
 983            (elmo-msgdb-get-number-alist
 984             wl-summary-buffer-msgdb))
 985           (setq wl-summary-buffer-message-modified nil)
 986           (run-hooks 'wl-summary-buffer-message-saved-hook))
 987         (when (wl-summary-mark-modified-p)
 988           (or path
 989               (setq path (elmo-msgdb-expand-path
 990                           wl-summary-buffer-folder-name)))
 991           (elmo-msgdb-mark-save
 992            path
 993            (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
 994 ;;;       (elmo-folder-set-info-hashtb
 995 ;;;        (elmo-string wl-summary-buffer-folder-name)
 996 ;;;        nil nil
 997 ;;;        0
 998 ;;;        (+ wl-summary-buffer-new-count wl-summary-buffer-unread-count))
 999 ;;;       (setq wl-folder-info-alist-modified t)
1000           (setq wl-summary-buffer-mark-modified nil)
1001           (run-hooks 'wl-summary-buffer-mark-saved-hook))))))
1002
1003 (defsubst wl-summary-cleanup-temp-marks (&optional sticky)
1004   (if (or wl-summary-buffer-refile-list
1005           wl-summary-buffer-copy-list
1006           wl-summary-buffer-delete-list)
1007       (if (y-or-n-p "Marks remain to be executed.  Execute them? ")
1008           (progn
1009             (wl-summary-exec)
1010             (if (or wl-summary-buffer-refile-list
1011                     wl-summary-buffer-copy-list
1012                     wl-summary-buffer-delete-list)
1013                 (error "Some execution was failed")))
1014         ;; delete temp-marks
1015         (message "")
1016         (wl-summary-delete-all-refile-marks)
1017         (wl-summary-delete-all-copy-marks)
1018         (wl-summary-delete-all-delete-marks)))
1019   (if wl-summary-buffer-target-mark-list
1020       (progn
1021         (wl-summary-delete-all-target-marks)
1022         (setq wl-summary-buffer-target-mark-list nil)))
1023   (wl-summary-delete-all-temp-marks-on-buffer sticky)
1024   (setq wl-summary-scored nil))
1025
1026 ;; a subroutine for wl-summary-exit/wl-save-status
1027 (defun wl-summary-save-status (&optional sticky)
1028   ;; already in summary buffer.
1029   (when wl-summary-buffer-persistent
1030     ;; save the current summary buffer view.
1031     (if (and wl-summary-cache-use
1032              (or (wl-summary-message-modified-p)
1033                  (wl-summary-mark-modified-p)
1034                  (wl-summary-thread-modified-p)))
1035         (wl-summary-save-view-cache))
1036     ;; save msgdb ...
1037     (wl-summary-msgdb-save)))
1038
1039 (defun wl-summary-force-exit ()
1040   "Exit current summary.  Buffer is deleted even the buffer is sticky."
1041   (interactive)
1042   (wl-summary-exit 'force-exit))
1043
1044 (defun wl-summary-exit (&optional force-exit)
1045   "Exit current summary.  if FORCE-EXIT, exits even the summary is sticky."
1046   (interactive "P")
1047   (let ((summary-buf (current-buffer))
1048         (sticky (wl-summary-sticky-p))
1049         (message-buf (get-buffer wl-message-buf-name))
1050         summary-win
1051         message-buf message-win
1052         folder-buf folder-win)
1053     (if wl-summary-buffer-exit-func
1054         (funcall wl-summary-buffer-exit-func)
1055       (wl-summary-cleanup-temp-marks sticky)
1056       (unwind-protect
1057           ;; save summary status
1058           (progn
1059             (wl-summary-save-status sticky)
1060             (elmo-commit wl-summary-buffer-folder-name)
1061             (if wl-use-scoring
1062                 (wl-score-save)))
1063         ;; for sticky summary
1064         (wl-delete-all-overlays)
1065         (setq wl-summary-buffer-disp-msg nil)
1066         (elmo-kill-buffer wl-summary-search-buf-name)
1067         ;; delete message window if displayed.
1068         (if (setq message-buf (get-buffer wl-message-buf-name))
1069             (if (setq message-win (get-buffer-window message-buf))
1070                 (delete-window message-win)))
1071         (if (setq folder-buf (get-buffer wl-folder-buffer-name))
1072             (if (setq folder-win (get-buffer-window folder-buf))
1073                 ;; folder win is already displayed.
1074                 (select-window folder-win)
1075               ;; folder win is not displayed.
1076               (switch-to-buffer folder-buf))
1077           ;; currently no folder buffer
1078           (wl-folder))
1079         (and wl-folder-move-cur-folder
1080              wl-folder-buffer-cur-point
1081              (goto-char wl-folder-buffer-cur-point))
1082         (setq wl-folder-buffer-cur-path nil)
1083         (setq wl-folder-buffer-cur-entity-id nil)
1084         (wl-delete-all-overlays)
1085         (if wl-summary-exit-next-move
1086             (wl-folder-next-unsync t)
1087           (beginning-of-line))
1088         (if (setq summary-win (get-buffer-window summary-buf))
1089             (delete-window summary-win))
1090         (if (or force-exit
1091                 (not sticky))
1092             (progn
1093               (set-buffer summary-buf)
1094               (and (get-buffer wl-message-buf-name)
1095                    (kill-buffer wl-message-buf-name))
1096               ;; kill buffers of mime-view-caesar
1097               (wl-kill-buffers
1098                (format "^%s-([0-9 ]+)$" (regexp-quote wl-message-buf-name)))
1099               (kill-buffer summary-buf)))
1100         (run-hooks 'wl-summary-exit-hook)))))
1101
1102 (defun wl-summary-sync-force-update (&optional unset-cursor)
1103   (interactive)
1104   (let ((msgdb-dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
1105         (type (elmo-folder-get-type wl-summary-buffer-folder-name))
1106         ret-val seen-list)
1107     (unwind-protect
1108         (progn
1109           (if wl-summary-buffer-persistent
1110               (setq seen-list (elmo-msgdb-seen-load msgdb-dir)))
1111           (setq ret-val (wl-summary-sync-update3 seen-list unset-cursor))
1112           (if wl-summary-buffer-persistent
1113               (progn
1114                 (if (and (eq type 'imap4)
1115                          (not (elmo-folder-plugged-p
1116                                wl-summary-buffer-folder-name)))
1117                     (let* ((msgdb wl-summary-buffer-msgdb)
1118                            (number-alist (elmo-msgdb-get-number-alist msgdb)))
1119                       (elmo-mark-as-read wl-summary-buffer-folder-name
1120                                          (mapcar
1121                                           (lambda (msgid)
1122                                             (car (rassoc msgid number-alist)))
1123                                           seen-list) msgdb)))
1124                 (elmo-msgdb-seen-save msgdb-dir nil))))
1125       (set-buffer (current-buffer)))
1126     (if (interactive-p)
1127         (message "%s" ret-val))
1128     ret-val))
1129
1130 (defsubst wl-summary-sync-all-init ()
1131   (wl-summary-cleanup-temp-marks)
1132   (erase-buffer)
1133   (wl-summary-set-message-modified)
1134   (wl-summary-set-mark-modified)
1135   (setq wl-thread-entity-hashtb (elmo-make-hash
1136                                  (* (length (elmo-msgdb-get-number-alist
1137                                              wl-summary-buffer-msgdb)) 2)))
1138   (setq wl-summary-buffer-msgdb (elmo-msgdb-clear)) ;;'(nil nil nil nil))
1139   (setq wl-thread-entity-list nil)
1140   (setq wl-thread-entities nil)
1141   (setq wl-summary-buffer-target-mark-list nil)
1142   (setq wl-summary-buffer-refile-list nil)
1143   (setq wl-summary-buffer-copy-list nil)
1144   (setq wl-summary-buffer-delete-list nil)
1145   (wl-summary-buffer-number-column-detect nil))
1146
1147 (defun wl-summary-sync (&optional unset-cursor force-range)
1148   (interactive)
1149   (let* ((folder wl-summary-buffer-folder-name)
1150          (inhibit-read-only t)
1151          (buffer-read-only nil)
1152          (msgdb-dir (elmo-msgdb-expand-path
1153                      folder))
1154          (range (or force-range (wl-summary-input-range folder)))
1155          mes seen-list killed-list)
1156     (cond ((or (string= range "all")
1157                (string= range "all-shown"))
1158            ;; initialize buffer local databases.
1159            (unless (elmo-folder-plugged-p folder) ; forbidden
1160              (error "Unplugged"))
1161            (setq seen-list
1162                  (nconc
1163                   (elmo-msgdb-mark-alist-to-seen-list
1164                    (elmo-msgdb-get-number-alist
1165                     wl-summary-buffer-msgdb)
1166                    (elmo-msgdb-get-mark-alist
1167                     wl-summary-buffer-msgdb)
1168                    (concat wl-summary-important-mark
1169                            wl-summary-read-uncached-mark))
1170                   (elmo-msgdb-seen-load msgdb-dir)))
1171            (setq killed-list (elmo-msgdb-killed-list-load msgdb-dir))
1172            (elmo-clear-killed wl-summary-buffer-folder-name)
1173            (condition-case nil
1174                (setq mes (wl-summary-sync-update3 seen-list unset-cursor
1175                                                   (string= range "all")))
1176              (quit
1177               ;; Resume killed-list if quit.
1178               (message "") ; clear minibuffer.
1179               (elmo-msgdb-killed-list-save msgdb-dir killed-list)))
1180            (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen.
1181            (if mes (message "%s" mes)))
1182 ;;;        (wl-summary-sync-all folder t))
1183           ((string= range "rescan")
1184            (let ((msg (wl-summary-message-number)))
1185              (wl-summary-rescan)
1186              (and msg (wl-summary-jump-to-msg msg))))
1187           ((string= range "rescan-noscore")
1188            (let ((msg (wl-summary-message-number))
1189                  wl-use-scoring)
1190              (wl-summary-rescan)
1191              (and msg (wl-summary-jump-to-msg msg))))
1192           ((or (string-match "last:" range)
1193                (string-match "first:" range))
1194            (wl-summary-goto-folder-subr (concat "/" range "/" folder)
1195                                         'force-update nil nil t))
1196           ((string= range "no-sync")
1197            ;; do nothing.
1198            )
1199           (t
1200            (setq seen-list (elmo-msgdb-seen-load msgdb-dir))
1201            (setq mes (wl-summary-sync-update3 seen-list unset-cursor))
1202            (elmo-msgdb-seen-save msgdb-dir nil) ; delete all seen.
1203            (if mes (message "%s" mes))))))
1204
1205 (defvar wl-summary-edit-addresses-candidate-fields
1206   ;; First element becomes default.
1207   '("from" "to" "cc"))
1208
1209 (defun wl-summary-edit-addresses-collect-candidate-fields (mime-charset)
1210   (let ((fields wl-summary-edit-addresses-candidate-fields)
1211         body candidates components)
1212     (while fields
1213       (setq body
1214             (mapconcat 'identity (elmo-multiple-field-body (car fields))
1215                        ","))
1216       (setq body (wl-parse-addresses body))
1217       (if body (setq candidates (append candidates body)))
1218       (setq fields (cdr fields)))
1219     (setq candidates (elmo-uniq-list candidates))
1220     (elmo-set-work-buf
1221      (elmo-set-buffer-multibyte default-enable-multibyte-characters)
1222      (mapcar (function
1223               (lambda (x)
1224                 (setq components (std11-extract-address-components x))
1225                 (cons (nth 1 components)
1226                       (and (car components)
1227                            (eword-decode-string
1228                             (decode-mime-charset-string
1229                              (car components)
1230                              mime-charset))))))
1231              candidates))))
1232
1233 (defun wl-summary-edit-addresses-subr (the-email name-in-addr)
1234   ;; returns nil if there's no change.
1235   (if (elmo-get-hash-val (downcase the-email) wl-address-petname-hash)
1236       (let (char)
1237         (message (format "'%s' already exists. (e)dit/(d)elete/(c)ancel?"
1238                          the-email))
1239         (while (not (or (eq (setq char (read-char)) ?\r)
1240                         (eq char ?\n)
1241                         (eq char ? )
1242                         (eq char ?e)
1243                         (eq char ?c)
1244                         (eq char ?d)))
1245           (message
1246            "Please answer `e' or `d' or `c'. (e)dit/(d)elete/(c)ancel?"))
1247         (cond
1248          ((or (eq char ?e)
1249               (eq char ?\n)
1250               (eq char ?\r)
1251               (eq char ? ))
1252           ;; Change Addresses
1253           (wl-address-petname-add-or-change
1254            the-email
1255            (elmo-get-hash-val the-email wl-address-petname-hash)
1256            (wl-address-header-extract-realname
1257             (cdr (assoc
1258                   (let ((completion-ignore-case t) comp)
1259                     (setq comp
1260                           (try-completion the-email wl-address-completion-list))
1261                     (if (equal comp t) the-email comp))
1262                   wl-address-completion-list))) t)
1263           "edited")
1264          ((eq char ?d)
1265           ;; Delete Addresses
1266           (if (y-or-n-p (format "Delete '%s'? "
1267                                 the-email))
1268               (progn
1269                 (wl-address-petname-delete the-email)
1270                 "deleted")
1271             (message "")
1272             nil))
1273          (t (message "")
1274             nil)))
1275     ;; Add Petname
1276     (wl-address-petname-add-or-change
1277      the-email name-in-addr name-in-addr)
1278     "added"))
1279
1280 (defun wl-summary-edit-addresses (&optional addr-str)
1281   "Edit address book interactively.
1282 Optional argument ADDR-STR is used as a target address if specified."
1283   (interactive (if current-prefix-arg
1284                    (list (read-from-minibuffer "Target address: "))))
1285   (if (null (wl-summary-message-number))
1286       (message "No message.")
1287     (save-excursion
1288       (wl-summary-set-message-buffer-or-redisplay))
1289     (let* ((charset wl-summary-buffer-mime-charset)
1290            (candidates
1291             (with-current-buffer (wl-message-get-original-buffer)
1292               (wl-summary-edit-addresses-collect-candidate-fields
1293                charset)))
1294            address pair result)
1295       (if addr-str
1296           (setq address addr-str)
1297         (when candidates
1298           (setq address (car (car candidates)))
1299           (setq address
1300                 (completing-read
1301                  (format "Target address (%s): " address)
1302                  (mapcar
1303                   (function (lambda (x) (cons (car x) (car x))))
1304                   candidates)
1305                  nil nil nil nil address))))
1306       (when address
1307         (setq pair (assoc address candidates))
1308         (unless pair
1309           (setq pair (cons address nil)))
1310         (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
1311           ;; update alias
1312           (wl-status-update)
1313           (setq address (assoc (car pair) wl-address-list))
1314           (if address
1315               (message "%s, %s, <%s> is %s."
1316                        (nth 2 address)
1317                        (nth 1 address)
1318                        (nth 0 address)
1319                        result)))
1320 ;;; i'd like to update summary-buffer, but...
1321 ;;;     (wl-summary-rescan)
1322         (run-hooks 'wl-summary-edit-addresses-hook)))))
1323
1324 (defun wl-summary-incorporate (&optional arg)
1325   "Check and prefetch all uncached messages.
1326 If ARG is non-nil, checking is omitted."
1327   (interactive "P")
1328   (unless arg
1329     (save-excursion
1330       (wl-summary-sync-force-update)))
1331   (wl-summary-prefetch-region (point-min) (point-max)
1332                               wl-summary-incorporate-marks))
1333
1334 (defun wl-summary-prefetch-msg (number &optional arg)
1335   "Returns status-mark. if skipped, returns nil."
1336   ;; prefetching procedure.
1337   (save-excursion
1338     (let* ((msgdb wl-summary-buffer-msgdb)
1339            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1340            (number-alist (elmo-msgdb-get-number-alist msgdb))
1341            (message-id (cdr (assq number number-alist)))
1342            (ov (assoc message-id
1343                       (elmo-msgdb-get-overview msgdb)))
1344            (entity ov)
1345            (size (elmo-msgdb-overview-entity-get-size ov))
1346            (inhibit-read-only t)
1347            (buffer-read-only nil)
1348            (force-read (and size
1349                             (or (null wl-prefetch-threshold)
1350                                 (< size wl-prefetch-threshold))))
1351            mark new-mark)
1352       (if (or arg
1353               (null (elmo-cache-exists-p message-id)))
1354           (unwind-protect
1355               (progn
1356                 (when (and size (not force-read) wl-prefetch-confirm)
1357                   (setq force-read
1358                         (save-restriction
1359                           (widen)
1360                           (y-or-n-p
1361                            (format
1362                             "Message from %s has %d bytes.  Prefetch it? "
1363                             (concat
1364                              "[ "
1365                              (save-match-data
1366                                (wl-set-string-width
1367                                 wl-from-width
1368                                 (wl-summary-from-func-internal
1369                                  (eword-decode-string
1370                                   (elmo-delete-char
1371                                    ?\"
1372                                    (or
1373                                     (elmo-msgdb-overview-entity-get-from ov)
1374                                     "??")))))) " ]")
1375                             size))))
1376                   (message ""))         ; flush.
1377                 (setq mark (cadr (assq number mark-alist)))
1378                 (if force-read
1379                     (save-excursion
1380                       (save-match-data
1381                         (if (and (null (elmo-folder-plugged-p
1382                                         wl-summary-buffer-folder-name))
1383                                  elmo-enable-disconnected-operation)
1384                             (progn;; append-queue for offline
1385                               (elmo-dop-prefetch-msgs
1386                                wl-summary-buffer-folder-name (list number))
1387                               (setq new-mark
1388                                     (cond
1389                                      ((string= mark
1390                                                wl-summary-unread-uncached-mark)
1391                                       wl-summary-unread-cached-mark)
1392                                      ((string= mark wl-summary-new-mark)
1393                                       (setq wl-summary-buffer-new-count
1394                                             (- wl-summary-buffer-new-count 1))
1395                                       (setq wl-summary-buffer-unread-count
1396                                             (+ wl-summary-buffer-unread-count 1))
1397                                       wl-summary-unread-cached-mark)
1398                                      ((or (null mark)
1399                                           (string= mark wl-summary-read-uncached-mark))
1400                                       (setq wl-summary-buffer-unread-count
1401                                             (+ wl-summary-buffer-unread-count 1))
1402                                       wl-summary-unread-cached-mark)
1403                                      (t mark))))
1404                           ;; online
1405                           (elmo-prefetch-msg wl-summary-buffer-folder-name
1406                                              number
1407                                              (wl-message-get-original-buffer)
1408                                              msgdb)
1409                           (setq new-mark
1410                                 (cond
1411                                  ((string= mark
1412                                            wl-summary-unread-uncached-mark)
1413                                   wl-summary-unread-cached-mark)
1414                                  ((string= mark wl-summary-new-mark)
1415                                   (setq wl-summary-buffer-new-count
1416                                         (- wl-summary-buffer-new-count 1))
1417                                   (setq wl-summary-buffer-unread-count
1418                                         (+ wl-summary-buffer-unread-count 1))
1419                                   wl-summary-unread-cached-mark)
1420                                  ((string= mark wl-summary-read-uncached-mark)
1421                                   nil)
1422                                  (t mark))))
1423                         (setq mark-alist (elmo-msgdb-mark-set
1424                                           mark-alist number new-mark))
1425                         (or new-mark (setq new-mark " "))
1426                         (elmo-msgdb-set-mark-alist msgdb mark-alist)
1427                         (wl-summary-set-mark-modified)
1428                         (wl-summary-update-modeline)
1429                         (wl-folder-update-unread
1430                          wl-summary-buffer-folder-name
1431                          (+ wl-summary-buffer-unread-count
1432                             wl-summary-buffer-new-count)))
1433                       new-mark))))))))
1434
1435 ;;(defvar wl-summary-message-uncached-marks
1436 ;;  (list wl-summary-new-mark
1437 ;;      wl-summary-unread-uncached-mark
1438 ;;      wl-summary-read-uncached-mark))
1439
1440 (defun wl-summary-prefetch-region (beg end &optional prefetch-marks)
1441   (interactive "r")
1442   (let ((count 0)
1443         targets
1444         mark length
1445         entity msg
1446         start-pos pos)
1447     (save-excursion
1448       (setq start-pos (point))
1449       (save-restriction
1450         (narrow-to-region beg end)
1451         ;; collect prefetch targets.
1452         (message "Collecting marks...")
1453         (goto-char (point-min))
1454         (while (not (eobp))
1455           (beginning-of-line)
1456           (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
1457             (setq mark (wl-match-buffer 2))
1458             (setq msg (string-to-int (wl-match-buffer 1)))
1459             (if (or (and (null prefetch-marks)
1460                          msg
1461                          (null (elmo-cache-exists-p
1462                                 (cdr (assq msg
1463                                            (elmo-msgdb-get-number-alist
1464                                             wl-summary-buffer-msgdb))))))
1465                     (member mark prefetch-marks))
1466                 (setq targets (nconc targets (list msg))))
1467             (setq entity (wl-thread-get-entity msg))
1468             (if (or (not (eq wl-summary-buffer-view 'thread))
1469                     (wl-thread-entity-get-opened entity))
1470                 (); opened. no hidden children.
1471               ;; hidden children!!
1472               (setq targets (nconc
1473                              targets
1474                              (wl-thread-get-children-msgs-uncached
1475                               msg prefetch-marks)))))
1476           (forward-line 1))
1477         (setq length (length targets))
1478         (message "Prefetching...")
1479         (while targets
1480           (setq mark (if (not (wl-thread-entity-parent-invisible-p
1481                                (wl-thread-get-entity (car targets))))
1482                          (progn
1483                            (wl-summary-jump-to-msg (car targets))
1484                            (wl-summary-prefetch))
1485                        (wl-summary-prefetch-msg (car targets))))
1486           (if (if prefetch-marks
1487                   (string= mark wl-summary-unread-cached-mark)
1488                 (or (string= mark wl-summary-unread-cached-mark)
1489                     (string= mark " ")))
1490               (message "Prefetching... %d/%d message(s)"
1491                        (setq count (+ 1 count)) length))
1492           ;; redisplay!
1493           (save-excursion
1494             (setq pos (point))
1495             (goto-char start-pos)
1496             (if (pos-visible-in-window-p pos)
1497                 (save-restriction
1498                   (widen)
1499                   (sit-for 0))))
1500           (setq targets (cdr targets)))
1501         (message "Prefetched %d/%d message(s)" count length)
1502         (cons count length)))))
1503
1504 (defun wl-summary-prefetch (&optional arg)
1505   "Prefetch current message."
1506   (interactive "P")
1507   (save-excursion
1508     (save-match-data
1509       (beginning-of-line)
1510       (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
1511         (goto-char (match-beginning 2))
1512         (let ((inhibit-read-only t)
1513               (buffer-read-only nil)
1514               mark)
1515           (setq mark (wl-summary-prefetch-msg
1516                       (string-to-int (wl-match-buffer 1)) arg))
1517           (when mark
1518             (delete-region (match-beginning 2)
1519                            (match-end 2))
1520             (insert mark)
1521             (if wl-summary-highlight
1522                 (wl-highlight-summary-current-line)))
1523           (set-buffer-modified-p nil)
1524           mark)))))
1525
1526 (defun wl-summary-delete-all-status-marks-on-buffer ()
1527   (interactive)
1528   (save-excursion
1529     (goto-char (point-min))
1530     (let ((inhibit-read-only t)
1531           (buffer-read-only nil)
1532           (case-fold-search nil))
1533       (while (re-search-forward
1534               (concat "^" wl-summary-buffer-number-regexp ".\\(.\\)") nil t)
1535         (delete-region (match-beginning 1) (match-end 1))
1536         (insert " ")))))
1537
1538 (defun wl-summary-delete-marks-on-buffer (marks)
1539   (while marks
1540     (wl-summary-unmark (pop marks))))
1541
1542 (defun wl-summary-delete-copy-marks-on-buffer (copies)
1543   (wl-summary-delete-marks-on-buffer copies))
1544
1545 (defun wl-summary-delete-all-refile-marks ()
1546   (let ((marks wl-summary-buffer-refile-list))
1547     (while marks
1548       (wl-summary-unmark (car (pop marks))))))
1549
1550 (defun wl-summary-delete-all-copy-marks ()
1551   (let ((marks wl-summary-buffer-copy-list))
1552     (while marks
1553       (wl-summary-unmark (car (pop marks))))))
1554
1555 (defun wl-summary-delete-all-delete-marks ()
1556   (wl-summary-delete-marks-on-buffer wl-summary-buffer-delete-list))
1557
1558 (defun wl-summary-delete-all-target-marks ()
1559   (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list))
1560
1561 (defun wl-summary-delete-all-temp-marks-on-buffer (&optional sticky)
1562   ;; for summary view cache saving.
1563   (interactive)
1564   (save-excursion
1565     (goto-char (point-min))
1566     (let ((inhibit-read-only t)
1567           (buffer-read-only nil)
1568           (case-fold-search nil)
1569           (regexp (concat "^" wl-summary-buffer-number-regexp "\\([^ ]\\)" )))
1570       (while (re-search-forward regexp nil t)
1571         (delete-region (match-beginning 1) (match-end 1))
1572         (insert " ")
1573         (if (and sticky wl-summary-highlight)
1574             (wl-highlight-summary-current-line))))))
1575
1576 (defun wl-summary-delete-all-marks (mark-alist mark)
1577   "Delete all MARKs in MARK-ALIST."
1578   (let ((malist mark-alist)
1579         (ret-val mark-alist)
1580         entity)
1581     (while malist
1582       (setq entity (car malist))
1583       (if (string= (cadr entity) mark)
1584           ;; delete this entity
1585           (setq ret-val (delete entity ret-val)))
1586       (setq malist (cdr malist)))
1587     ret-val))
1588
1589 ;; Does not work correctly...
1590 (defun wl-summary-mark-as-read-region (beg end)
1591   (interactive "r")
1592   (save-excursion
1593     (save-restriction
1594       (narrow-to-region beg end)
1595 ;;; use narrowing.
1596 ;;;   (save-excursion (goto-char end)
1597 ;;;                   (end-of-line) (point)))
1598       (goto-char (point-min))
1599       (if (eq wl-summary-buffer-view 'thread)
1600           (progn
1601             (while (not (eobp))
1602               (let* ((number (wl-summary-message-number))
1603                      (entity (wl-thread-get-entity number))
1604                      children)
1605                 (if (wl-thread-entity-get-opened entity)
1606                     ;; opened...mark line.
1607                     ;; Crossposts are not processed
1608                     (wl-summary-mark-as-read t)
1609                   ;; closed
1610                   (wl-summary-mark-as-read t) ; mark itself.
1611                   (setq children (wl-thread-get-children-msgs number))
1612                   (while children
1613                     (wl-summary-mark-as-read t nil nil (car children))
1614                     (setq children (cdr children))))
1615                 (forward-line 1))))
1616         (while (not (eobp))
1617           (wl-summary-mark-as-read t)
1618           (forward-line 1)))))
1619   (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
1620   (wl-summary-update-modeline))
1621
1622 (defun wl-summary-mark-as-unread-region (beg end)
1623   (interactive "r")
1624   (save-excursion
1625     (save-restriction
1626       (narrow-to-region beg end)
1627 ;;; use narrowing.
1628 ;;;      (save-excursion (goto-char end)
1629 ;;;                   (end-of-line) (point)))
1630       (goto-char (point-min))
1631       (if (eq wl-summary-buffer-view 'thread)
1632           (progn
1633             (while (not (eobp))
1634               (let* ((number (wl-summary-message-number))
1635                      (entity (wl-thread-get-entity number))
1636                      children)
1637                 (if (wl-thread-entity-get-opened entity)
1638                     ;; opened...mark line.
1639                     ;; Crossposts are not processed
1640                     (wl-summary-mark-as-unread)
1641                   ;; closed
1642                   (wl-summary-mark-as-unread) ; mark itself.
1643                   (setq children
1644                         (delq number (wl-thread-get-children-msgs number)))
1645                   (while children
1646                     (wl-summary-mark-as-unread (car children))
1647                     (setq children (cdr children))))
1648                 (forward-line 1))))
1649         (while (not (eobp))
1650           (wl-summary-mark-as-unread)
1651           (forward-line 1)))))
1652   (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
1653   (wl-summary-update-modeline))
1654
1655 (defun wl-summary-mark-as-important-region (beg end)
1656   (interactive "r")
1657   (save-excursion
1658     (save-restriction
1659       (narrow-to-region beg end);(save-excursion (goto-char end)
1660                                         ;    (end-of-line) (point)))
1661       (goto-char (point-min))
1662       (if (eq wl-summary-buffer-view 'thread)
1663           (progn
1664             (while (not (eobp))
1665               (let* ((number (wl-summary-message-number))
1666                      (entity (wl-thread-get-entity number))
1667                      children)
1668                 (if (wl-thread-entity-get-opened entity)
1669                     ;; opened...mark line.
1670                     ;; Crossposts are not processed
1671                     (wl-summary-mark-as-important)
1672                   ;; closed
1673                   (wl-summary-mark-as-important) ; mark itself.
1674                   (setq children
1675                         (delq number (wl-thread-get-children-msgs number)))
1676                   (while children
1677                     (wl-thread-msg-mark-as-important (car children))
1678                     (setq children (cdr children))))
1679                 (forward-line 1))))
1680         (while (not (eobp))
1681           (wl-summary-mark-as-important)
1682           (forward-line 1)))))
1683   (wl-summary-count-unread (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
1684   (wl-summary-update-modeline))
1685
1686 (defun wl-summary-mark-as-read-all ()
1687   (interactive)
1688   (if (or (not (interactive-p))
1689           (y-or-n-p "Mark all messages as read? "))
1690       (let* ((folder wl-summary-buffer-folder-name)
1691              (cur-buf (current-buffer))
1692              (msgdb wl-summary-buffer-msgdb)
1693 ;;;          (number-alist (elmo-msgdb-get-number-alist msgdb))
1694              (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1695              (malist mark-alist)
1696              (inhibit-read-only t)
1697              (buffer-read-only nil)
1698              (case-fold-search nil)
1699              msg mark)
1700         (message "Setting all msgs as read...")
1701         (elmo-mark-as-read folder (wl-summary-collect-unread mark-alist)
1702                            msgdb)
1703         (save-excursion
1704           (goto-char (point-min))
1705           (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9 ]\\)" nil t)
1706             (setq msg (string-to-int (wl-match-buffer 1)))
1707             (setq mark (wl-match-buffer 2))
1708             (when (and (not (string= mark wl-summary-important-mark))
1709                        (not (string= mark wl-summary-read-uncached-mark)))
1710               (delete-region (match-beginning 2) (match-end 2))
1711               (if (or (not (elmo-use-cache-p folder msg))
1712                       (string= mark wl-summary-unread-cached-mark))
1713                   (progn
1714                     (insert " ")
1715                     (setq mark-alist
1716                           (elmo-msgdb-mark-set
1717                            mark-alist
1718                            msg
1719 ;;; Use msg instead of (cdr (assq msg number-alist)).
1720 ;;;                        (cdr (assq msg number-alist))
1721                            nil)))
1722                 ;; New mark and unread-uncached mark
1723                 (insert wl-summary-read-uncached-mark)
1724                 (setq mark-alist
1725                       (elmo-msgdb-mark-set mark-alist
1726                                            msg
1727 ;;;                                        (cdr (assq msg number-alist))
1728                                            wl-summary-read-uncached-mark)))
1729               (if wl-summary-highlight
1730                   (wl-highlight-summary-current-line nil nil t)))))
1731         (setq mark-alist (wl-summary-set-as-read-mark-alist mark-alist))
1732         (wl-summary-set-mark-modified)
1733         (set-buffer cur-buf); why is this needed???
1734         (elmo-msgdb-set-mark-alist msgdb mark-alist)
1735         (wl-folder-update-unread wl-summary-buffer-folder-name 0)
1736         (setq wl-summary-buffer-unread-count 0)
1737         (setq wl-summary-buffer-new-count    0)
1738         (wl-summary-update-modeline)
1739         (message "Setting all msgs as read...done")
1740         (set-buffer-modified-p nil))))
1741
1742 (defun wl-summary-delete-cache ()
1743   "Delete cache of current message."
1744   (interactive)
1745   (save-excursion
1746     (let* ((inhibit-read-only t)
1747            (buffer-read-only nil)
1748            (folder wl-summary-buffer-folder-name)
1749            (msgdb wl-summary-buffer-msgdb)
1750            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1751            (number-alist (elmo-msgdb-get-number-alist msgdb))
1752            (case-fold-search nil)
1753            mark number unread new-mark)
1754 ;;;   (re-search-backward "^ *[0-9]+..[0-9]+/[0-9]+" nil t) ; set cursor line
1755       (beginning-of-line)
1756       (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
1757         (progn
1758           (setq mark (wl-match-buffer 2))
1759           (cond
1760            ((or (string= mark wl-summary-new-mark)
1761                 (string= mark wl-summary-unread-uncached-mark)
1762                 (string= mark wl-summary-important-mark))
1763             ;; noop
1764             )
1765            ((string= mark wl-summary-unread-cached-mark)
1766             (setq new-mark wl-summary-unread-uncached-mark))
1767            (t
1768             (setq new-mark wl-summary-read-uncached-mark)))
1769           (when new-mark
1770             (setq number (string-to-int (wl-match-buffer 1)))
1771             (delete-region (match-beginning 2) (match-end 2))
1772             (goto-char (match-beginning 2))
1773             (insert new-mark)
1774             (elmo-cache-delete (cdr (assq number number-alist))
1775                                wl-summary-buffer-folder-name
1776                                number)
1777             (setq mark-alist
1778                   (elmo-msgdb-mark-set mark-alist number new-mark))
1779             (elmo-msgdb-set-mark-alist msgdb mark-alist)
1780             (wl-summary-set-mark-modified)
1781             (if wl-summary-highlight
1782                 (wl-highlight-summary-current-line nil nil t))
1783             (set-buffer-modified-p nil)))))))
1784
1785 (defun wl-summary-resume-cache-status ()
1786   "Resume the cache status of all messages in the current folder."
1787   (interactive)
1788   (let* ((folder wl-summary-buffer-folder-name)
1789          (cur-buf (current-buffer))
1790          (msgdb wl-summary-buffer-msgdb)
1791          (number-alist (elmo-msgdb-get-number-alist msgdb))
1792          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1793          (inhibit-read-only t)
1794          (buffer-read-only nil)
1795          (case-fold-search nil)
1796          msg mark msgid set-mark)
1797     (message "Resuming cache status...")
1798     (save-excursion
1799       (goto-char (point-min))
1800       (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" nil t)
1801         (setq msg (string-to-int
1802                    (wl-match-buffer 1)))
1803         (setq mark (wl-match-buffer 2))
1804         (setq msgid (cdr (assq msg number-alist)))
1805         (setq set-mark nil)
1806         (if (elmo-cache-exists-p msgid folder msg)
1807             (if (or
1808                  (string= mark wl-summary-unread-uncached-mark) ; U -> !
1809                  (string= mark wl-summary-new-mark)             ; N -> !
1810                  )
1811                 (setq set-mark wl-summary-unread-cached-mark)
1812               (if (string= mark wl-summary-read-uncached-mark)  ; u -> ' '
1813                   (setq set-mark " ")))
1814           (if (string= mark " ")
1815               (setq set-mark wl-summary-read-uncached-mark)     ;' ' -> u
1816             (if (string= mark wl-summary-unread-cached-mark)
1817                 (setq set-mark wl-summary-unread-uncached-mark) ; !  -> U
1818               )))
1819         (when set-mark
1820           (delete-region (match-beginning 2) (match-end 2))
1821           (insert set-mark)
1822           (setq mark-alist
1823                 (elmo-msgdb-mark-set
1824                  mark-alist msg ; msgid
1825                  (if (string= set-mark " ") nil set-mark)))
1826           (if wl-summary-highlight
1827               (wl-highlight-summary-current-line))))
1828       (wl-summary-set-mark-modified)
1829       (set-buffer cur-buf); why is this needed???
1830       (elmo-msgdb-set-mark-alist msgdb mark-alist)
1831       (wl-summary-count-unread mark-alist)
1832       (wl-summary-update-modeline)
1833       (message "Resuming cache status...done")
1834       (set-buffer-modified-p nil))))
1835
1836 (defun wl-summary-resume-marks-and-highlight ()
1837   (let* ((msgdb wl-summary-buffer-msgdb)
1838          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1839 ;;;      (number-alist (elmo-msgdb-get-number-alist msgdb))
1840          (count (count-lines (point-min)(point-max)))
1841          (i 0)
1842          msg-num percent smark)
1843     (save-excursion
1844       (goto-char (point-min))
1845       (message "Resuming all marks...")
1846       (while (not (eobp))
1847         (setq msg-num (wl-summary-message-number))
1848         (setq smark (car (cdr (assq msg-num mark-alist))))
1849         (if (looking-at (format "^ *%s \\( \\)" msg-num))
1850             (progn
1851               (goto-char (match-end 1))
1852               (delete-region (match-beginning 1) (match-end 1))
1853               (insert (or smark " "))))
1854         (wl-highlight-summary-current-line smark)
1855         (when (> count elmo-display-progress-threshold)
1856           (setq i (+ i 1))
1857           (setq percent (/ (* i 100) count))
1858           (elmo-display-progress
1859            'wl-summary-resume-marks-and-highlight "Resuming all marks..."
1860            percent))
1861         (forward-line 1)))
1862     (message "Resuming all marks...done")))
1863
1864 (defun wl-summary-resume-marks ()
1865   (let* ((msgdb wl-summary-buffer-msgdb)
1866          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1867          (number-alist (elmo-msgdb-get-number-alist msgdb))
1868          (count (length mark-alist))
1869          (i 0)
1870          entity msg-num percent)
1871     (save-excursion
1872       (message "Resuming all marks...")
1873       (while mark-alist
1874         (setq entity (car mark-alist))
1875         (if (setq msg-num (car (rassoc (car entity) number-alist)))
1876             (progn
1877 ;;;           (goto-char (point-min))
1878               (if (re-search-forward (format "^ *%s \\( \\)" msg-num) nil t)
1879                   (progn
1880                     (delete-region (match-beginning 1) (match-end 1))
1881                     (insert (or (cadr entity)
1882                                 " ")))
1883                 (if (re-search-backward (format "^ *%s \\( \\)" msg-num) nil t)
1884                     (progn
1885                       (goto-char (match-end 1))
1886                       (delete-region (match-beginning 1) (match-end 1))
1887                       (insert (or (cadr entity)
1888                                   " ")))))))
1889         (when (> count elmo-display-progress-threshold)
1890           (setq i (+ i 1))
1891           (setq percent (/ (* i 100) count))
1892           (elmo-display-progress
1893            'wl-summary-resume-marks "Resuming all marks..."
1894            percent))
1895         (setq mark-alist (cdr mark-alist)))
1896       (message "Resuming all marks...done"))))
1897
1898 (defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info)
1899   (interactive)
1900   (save-excursion
1901     (let ((inhibit-read-only t)
1902           (buffer-read-only nil)
1903           (msgs2 msgs)
1904           (len (length msgs))
1905           (i 0)
1906           update-list)
1907       (elmo-kill-buffer wl-summary-search-buf-name)
1908       (while msgs
1909         (if (eq wl-summary-buffer-view 'thread)
1910             (progn
1911               ;; don't use wl-append(nconc), because list is broken. ...why?
1912               (setq update-list
1913                     (append update-list
1914                             (wl-thread-delete-message (car msgs))))
1915               (setq update-list (delq (car msgs) update-list)))
1916           (goto-char (point-min))
1917           (if (re-search-forward (format "^ *%d[^0-9]\\([^0-9]\\).*$"
1918                                          (car msgs)) nil t)
1919               (progn
1920                 (delete-region (match-beginning 0) (match-end 0))
1921                 (delete-char 1) ; delete '\n'
1922                 )))
1923         (when (and deleting-info
1924                    (> len elmo-display-progress-threshold))
1925           (setq i (1+ i))
1926           (if (or (zerop (% i 5)) (= i len))
1927               (elmo-display-progress
1928                'wl-summary-delete-messages-on-buffer deleting-info
1929                (/ (* i 100) len))))
1930         (setq msgs (cdr msgs)))
1931       (when (eq wl-summary-buffer-view 'thread)
1932         (wl-thread-update-line-msgs (elmo-uniq-list update-list)
1933                                     (unless deleting-info 'no-msg))
1934         (wl-thread-cleanup-symbols msgs2))
1935       (wl-summary-count-unread
1936        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
1937       (wl-summary-update-modeline)
1938       (wl-folder-update-unread
1939        wl-summary-buffer-folder-name
1940        (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count)))))
1941
1942 (defun wl-summary-set-as-read-mark-alist (mark-alist)
1943   (let ((marks (list (cons wl-summary-unread-cached-mark
1944                            nil)
1945                      (cons wl-summary-unread-uncached-mark
1946                            wl-summary-read-uncached-mark)
1947                      (cons wl-summary-new-mark
1948                            wl-summary-read-uncached-mark)))
1949         (ret-val mark-alist)
1950         entity pair)
1951     (while mark-alist
1952       (setq entity (car mark-alist))
1953       (when (setq pair (assoc (cadr entity) marks))
1954         (if (elmo-use-cache-p wl-summary-buffer-folder-name
1955                               (caar mark-alist))
1956             (if (cdr pair)
1957                 (setcar (cdr entity) (cdr pair))
1958                 (setq ret-val (delete entity ret-val)))
1959           (setq ret-val (delete entity ret-val))))
1960       (setq mark-alist (cdr mark-alist)))
1961     ret-val))
1962
1963 (defun wl-summary-set-status-marks (mark-alist before after)
1964   "Set the BEFORE marks to AFTER."
1965   (let ((ret-val mark-alist)
1966         entity)
1967     (while mark-alist
1968       (setq entity (car mark-alist))
1969       (when (string= (cadr entity) before)
1970         (if after
1971             (setcar (cdr entity) after)
1972           (setq ret-val (delete entity ret-val))))
1973       (setq mark-alist (cdr mark-alist)))
1974     ret-val))
1975
1976 (defun wl-summary-set-status-marks-on-buffer (before after)
1977   "Set the MARKS marks on buffer."
1978   (interactive)
1979   (save-excursion
1980     (goto-char (point-min))
1981     (let ((inhibit-read-only t)
1982           (buffer-read-only nil)
1983           (regexp (concat "^" wl-summary-buffer-number-regexp ".\\(\\%s\\)")))
1984       (while (re-search-forward
1985               (format regexp (regexp-quote before)) nil t)
1986         (delete-region (match-beginning 1) (match-end 1))
1987         (insert after)
1988         (if wl-summary-highlight
1989             (wl-highlight-summary-current-line))))))
1990
1991 (defun wl-summary-get-delete-folder (folder)
1992   (if (string= folder wl-trash-folder)
1993       'null
1994     (let* ((type (or (wl-get-assoc-list-value wl-delete-folder-alist folder)
1995                      'trash)))
1996       (cond ((stringp type)
1997              type)
1998             ((or (equal type 'remove) (equal type 'null))
1999              'null)
2000             (t;; (equal type 'trash)
2001              wl-trash-folder)))))
2002
2003 (defun wl-summary-delete-important-msgs-from-list (delete-list
2004                                                    mark-alist)
2005   (let ((dlist delete-list))
2006     (while dlist
2007       (if (string= wl-summary-important-mark
2008                    (car (cdr (assq (car dlist) mark-alist))))
2009           (setq delete-list (delete (car dlist) delete-list)))
2010       (setq dlist (cdr dlist)))
2011     delete-list))
2012
2013 (defun wl-summary-delete-canceled-msgs-from-list (delete-list msgdb)
2014   (let ((dlist delete-list))
2015     (while dlist
2016       (if (null (cdr (assq (car dlist) (cadr msgdb))))
2017           (setq delete-list (delete (car dlist) delete-list)))
2018       (setq dlist (cdr dlist)))
2019     delete-list))
2020
2021 (defun wl-summary-get-append-message-func ()
2022   (if (eq wl-summary-buffer-view 'thread)
2023       'wl-summary-insert-thread-entity
2024 ;;;   'wl-summary-insert-thread
2025     'wl-summary-insert-summary))
2026
2027 (defun wl-summary-sort ()
2028   (interactive)
2029   (let ((sort-by (let ((input-range-list '("number" "date" "subject" "from"))
2030                        (default "date")
2031                        in)
2032                    (setq in
2033                          (completing-read
2034                           (format "Sort by (%s): " default)
2035                           (mapcar
2036                            (function (lambda (x) (cons x x)))
2037                            input-range-list)))
2038                    (if (string= in "")
2039                        default
2040                      in))))
2041     (if (not (member sort-by '("number" "date" "subject" "from")))
2042         (error "Sort by %s is not implemented"  sort-by))
2043     (wl-summary-rescan sort-by)))
2044
2045 (defun wl-summary-sync-marks ()
2046   "Update marks in summary."
2047   (interactive)
2048   (let ((plugged (elmo-folder-plugged-p wl-summary-buffer-folder-name))
2049         (last-progress 0)
2050         (i 0)
2051         mark-alist unread-marks msgs mark importants unreads
2052         importants-in-db unreads-in-db has-imap4 diff diffs
2053         mes num-ma progress)
2054     ;; synchronize marks.
2055     (when (not (eq (elmo-folder-get-type
2056                     wl-summary-buffer-folder-name)
2057                    'internal))
2058       (message "Updating marks...")
2059       (setq unread-marks (list wl-summary-unread-cached-mark
2060                                wl-summary-unread-uncached-mark
2061                                wl-summary-new-mark)
2062             mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)
2063             num-ma (length mark-alist)
2064             importants (elmo-list-folder-important
2065                         wl-summary-buffer-folder-name
2066                         (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
2067             unreads (elmo-list-folder-unread
2068                      wl-summary-buffer-folder-name
2069                      (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
2070                      (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb)
2071                      unread-marks))
2072       (while mark-alist
2073         (if (string= (cadr (car mark-alist))
2074                      wl-summary-important-mark)
2075             (setq importants-in-db (cons (car (car mark-alist))
2076                                          importants-in-db))
2077           (if (member (cadr (car mark-alist)) unread-marks)
2078               (setq unreads-in-db (cons (car (car mark-alist))
2079                                         unreads-in-db))))
2080         (setq mark-alist (cdr mark-alist))
2081         (when (> num-ma elmo-display-progress-threshold)
2082           (setq i (1+ i)
2083                 progress (/ (* i 100) num-ma))
2084           (if (not (eq progress last-progress))
2085               (elmo-display-progress 'wl-summary-sync-marks
2086                                      "Updating marks..."
2087                                      progress))
2088           (setq last-progress progress)))
2089       (setq diff (elmo-list-diff importants importants-in-db))
2090       (setq diffs (cadr diff)) ; important-deletes
2091       (setq mes (format "Updated (-%d" (length diffs)))
2092       (while diffs
2093         (wl-summary-mark-as-important (car diffs)
2094                                       wl-summary-important-mark
2095                                       'no-server)
2096         (setq diffs (cdr diffs)))
2097       (setq diffs (car diff)) ; important-appends
2098       (setq mes (concat mes (format "/+%d) important," (length diffs))))
2099       (while diffs
2100         (wl-summary-mark-as-important (car diffs) " " 'no-server)
2101         (setq diffs (cdr diffs)))
2102       (setq diff (elmo-list-diff unreads unreads-in-db))
2103       (setq diffs (cadr diff))
2104       (setq mes (concat mes (format "(-%d" (length diffs))))
2105       (while diffs
2106         (wl-summary-mark-as-read t 'no-server nil (car diffs))
2107         (setq diffs (cdr diffs)))
2108       (setq diffs (car diff)) ; unread-appends
2109       (setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs))))
2110       (while diffs
2111         (wl-summary-mark-as-unread (car diffs) 'no-server 'no-modeline)
2112         (setq diffs (cdr diffs)))
2113       (if (interactive-p) (message mes)))))
2114
2115 (defun wl-summary-confirm-appends (appends)
2116   (let ((len (length appends))
2117         in)
2118     (if (> len wl-summary-update-confirm-threshold)
2119         (if (y-or-n-p (format "Too many messages(%d).  Continue? " len))
2120             appends
2121           (setq in wl-summary-update-confirm-threshold)
2122           (catch 'end
2123             (while t
2124               (setq in (read-from-minibuffer "Update number: "
2125                                              (int-to-string in))
2126                     in (string-to-int in))
2127               (if (< len in)
2128                   (throw 'end len))
2129               (if (y-or-n-p (format "%d messages are disappeared.  OK? "
2130                                     (max (- len in) 0)))
2131                   (throw 'end in))))
2132           (nthcdr (max (- len in) 0) appends))
2133       appends)))
2134
2135 (defun wl-summary-sync-update3 (&optional seen-list unset-cursor sync-all)
2136   "Update the summary view."
2137   (interactive)
2138   (let* ((folder wl-summary-buffer-folder-name)
2139          (cur-buf (current-buffer))
2140          (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
2141          (mark-alist (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
2142          (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
2143 ;;;      (location (elmo-msgdb-get-location msgdb))
2144          (case-fold-search nil)
2145          (elmo-mime-charset wl-summary-buffer-mime-charset)
2146          (inhibit-read-only t)
2147          (buffer-read-only nil)
2148          diff initial-append-list append-list delete-list has-nntp
2149          i num result
2150          gc-message
2151          in-folder
2152          in-db curp
2153          overview-append
2154          entity ret-val crossed crossed2
2155          update-thread update-top-list mark
2156          expunged msgs unreads importants)
2157 ;;; (setq seen-list nil) ;for debug.
2158     (fset 'wl-summary-append-message-func-internal
2159           (wl-summary-get-append-message-func))
2160     ;; Flush pending append operations (disconnected operation).
2161     (setq seen-list
2162           (wl-summary-flush-pending-append-operations seen-list))
2163     (goto-char (point-max))
2164     (wl-folder-confirm-existence folder 'force)
2165     (message "Checking folder diff...")
2166     (elmo-commit folder)
2167     (setq in-folder (elmo-list-folder folder sync-all))
2168     (setq in-db (unless sync-all (sort (mapcar 'car number-alist) '<)))
2169     (if (not elmo-use-killed-list)
2170         (setq diff (if (eq (elmo-folder-get-type folder) 'multi)
2171                        (elmo-multi-list-bigger-diff in-folder in-db)
2172                      (elmo-list-bigger-diff in-folder in-db)))
2173       (setq diff (elmo-list-diff in-folder in-db)))
2174     (setq initial-append-list (car diff))
2175     (setq delete-list (cadr diff))
2176     (message "Checking folder diff...done")
2177     ;; Confirm appended message number.
2178     (setq append-list (wl-summary-confirm-appends initial-append-list))
2179     (when (and elmo-use-killed-list
2180                (not (eq (length initial-append-list)
2181                         (length append-list)))
2182                (setq diff (elmo-list-diff initial-append-list append-list)))
2183       (elmo-msgdb-append-to-killed-list folder (car diff)))
2184     ;; Setup sync-all
2185     (if sync-all (wl-summary-sync-all-init))
2186     ;; Don't delete important-marked msgs other than 'internal.
2187     (unless (eq (elmo-folder-get-type folder) 'internal)
2188       (setq delete-list
2189             (wl-summary-delete-important-msgs-from-list delete-list
2190                                                         mark-alist)))
2191     (if (and has-nntp
2192              (elmo-nntp-max-number-precedes-list-active-p))
2193         ;; XXX this does not work correctly in rare case.
2194         (setq delete-list
2195               (wl-summary-delete-canceled-msgs-from-list
2196                delete-list
2197                wl-summary-buffer-msgdb)))
2198     (if (or (equal diff '(nil nil))
2199             (equal diff '(nil))
2200             (and (eq (length delete-list) 0)
2201                  (eq (length initial-append-list) 0)))
2202         (progn
2203           ;; For max-number update...
2204           (if (and (elmo-folder-contains-type folder 'nntp)
2205                    (elmo-nntp-max-number-precedes-list-active-p)
2206                    (elmo-update-number folder wl-summary-buffer-msgdb))
2207               (wl-summary-set-message-modified)
2208             (setq ret-val (format "No update is needed for \"%s\"" folder))))
2209       (when delete-list
2210         (message "Deleting...")
2211         (elmo-msgdb-delete-msgs folder delete-list
2212                                 wl-summary-buffer-msgdb t) ; reserve cache.
2213 ;;;     (set-buffer cur-buf)
2214         (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
2215         (message "Deleting...done"))
2216 ;;;   (set-buffer cur-buf)
2217       ;; Change "New" marks to "Uncached Unread" marks.
2218       (wl-summary-set-status-marks mark-alist
2219                                    wl-summary-new-mark
2220                                    wl-summary-unread-uncached-mark)
2221       (wl-summary-set-status-marks-on-buffer
2222        wl-summary-new-mark
2223        wl-summary-unread-uncached-mark)
2224       (setq num (length append-list))
2225       (if append-list
2226           (progn
2227             (setq i 0)
2228             (setq result (elmo-msgdb-create
2229                           folder
2230                           append-list
2231                           wl-summary-new-mark
2232                           wl-summary-unread-cached-mark ; !
2233                           wl-summary-read-uncached-mark ; u ;; XXXX
2234                           wl-summary-important-mark
2235                           seen-list))
2236             ;; delete duplicated messages.
2237             (when (elmo-folder-contains-multi folder)
2238               (setq crossed (elmo-multi-delete-crossposts
2239                              wl-summary-buffer-msgdb result))
2240               (setq result (cdr crossed))
2241               (setq crossed (car crossed)))
2242             (setq overview-append (car result))
2243             (setq wl-summary-buffer-msgdb
2244                   (elmo-msgdb-append wl-summary-buffer-msgdb result t))
2245             ;; set these value for append-message-func
2246             (setq overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
2247             (setq number-alist (elmo-msgdb-get-number-alist
2248                                 wl-summary-buffer-msgdb))
2249             (setq mark-alist (elmo-msgdb-get-mark-alist
2250                               wl-summary-buffer-msgdb))
2251 ;;;         (setq location (elmo-msgdb-get-location msgdb))
2252             (setq curp overview-append)
2253             (setq num (length curp))
2254             (setq wl-summary-delayed-update nil)
2255             (elmo-kill-buffer wl-summary-search-buf-name)
2256             (while curp
2257               (setq entity (car curp))
2258               (when (setq update-thread
2259                           (wl-summary-append-message-func-internal
2260                            entity overview mark-alist
2261                            (not sync-all)))
2262                 (wl-append update-top-list update-thread))
2263               (if elmo-use-database
2264                   (elmo-database-msgid-put
2265                    (car entity) folder
2266                    (elmo-msgdb-overview-entity-get-number entity)))
2267               (setq curp (cdr curp))
2268               (when (> num elmo-display-progress-threshold)
2269                 (setq i (+ i 1))
2270                 (if (or (zerop (% i 5)) (= i num))
2271                     (elmo-display-progress
2272                      'wl-summary-sync-update3 "Updating thread..."
2273                      (/ (* i 100) num)))))
2274             (when wl-summary-delayed-update
2275               (while wl-summary-delayed-update
2276                 (message "Parent (%d) of message %d is no entity"
2277                          (caar wl-summary-delayed-update)
2278                          (elmo-msgdb-overview-entity-get-number
2279                           (cdar wl-summary-delayed-update)))
2280                 (when (setq update-thread
2281                             (wl-summary-append-message-func-internal
2282                              (cdar wl-summary-delayed-update)
2283                              overview mark-alist (not sync-all) t))
2284                   (wl-append update-top-list update-thread))
2285                 (setq wl-summary-delayed-update
2286                       (cdr wl-summary-delayed-update))))
2287             (when (and (eq wl-summary-buffer-view 'thread)
2288                        update-top-list)
2289               (wl-thread-update-indent-string-thread
2290                (elmo-uniq-list update-top-list)))
2291             (message "Updating thread...done")
2292 ;;;         (set-buffer cur-buf)
2293             ))
2294       (wl-summary-set-message-modified)
2295       (wl-summary-set-mark-modified)
2296       (when (and sync-all (eq wl-summary-buffer-view 'thread))
2297         (elmo-kill-buffer wl-summary-search-buf-name)
2298         (message "Inserting thread...")
2299         (setq wl-thread-entity-cur 0)
2300         (wl-thread-insert-top)
2301         (message "Inserting thread...done"))
2302       (if elmo-use-database
2303           (elmo-database-close))
2304       (run-hooks 'wl-summary-sync-updated-hook)
2305       (setq ret-val (format "Updated (-%d/+%d) message(s)"
2306                             (length delete-list) num)))
2307     ;; synchronize marks.
2308     (if wl-summary-auto-sync-marks
2309         (wl-summary-sync-marks))
2310     ;; scoring
2311     (when wl-use-scoring
2312       (setq wl-summary-scored nil)
2313       (wl-summary-score-headers nil wl-summary-buffer-msgdb
2314                                 (and sync-all
2315                                      (wl-summary-rescore-msgs number-alist))
2316                                 sync-all)
2317       (when (and wl-summary-scored
2318                  (setq expunged (wl-summary-score-update-all-lines)))
2319         (setq ret-val (concat ret-val
2320                               (format " (%d expunged)"
2321                                       (length expunged))))))
2322     ;; crosspost
2323     (setq crossed2 (wl-summary-update-crosspost))
2324     (if (or crossed crossed2)
2325         (let ((crosses (+ (or crossed 0)
2326                           (or crossed2 0))))
2327           (setq ret-val
2328                 (if ret-val
2329                     (concat ret-val
2330                             (format " (%d crosspost)" crosses))
2331                   (format "%d crosspost message(s)" crosses))))
2332       (and ret-val
2333            (setq ret-val (concat ret-val "."))))
2334     ;; Update Folder mode
2335     (wl-folder-set-folder-updated folder (list 0
2336                                                (wl-summary-count-unread
2337                                                 (elmo-msgdb-get-mark-alist
2338                                                  wl-summary-buffer-msgdb))
2339                                                (length in-folder)))
2340     (wl-summary-update-modeline)
2341     (wl-summary-buffer-number-column-detect t)
2342     ;;
2343     (unless unset-cursor
2344       (goto-char (point-min))
2345       (if (not (wl-summary-cursor-down t))
2346           (progn
2347             (goto-char (point-max))
2348             (forward-line -1))
2349         (if (and wl-summary-highlight
2350                  (not (get-text-property (point) 'face)))
2351             (save-excursion
2352               (forward-line (- 0
2353                                (or
2354                                 wl-summary-partial-highlight-above-lines
2355                                 wl-summary-highlight-partial-threshold)))
2356               (wl-highlight-summary (point) (point-max))))))
2357     (wl-delete-all-overlays)
2358     (set-buffer-modified-p nil)
2359     ret-val))
2360
2361 (defun wl-summary-set-score-mark (mark)
2362   (save-excursion
2363     (beginning-of-line)
2364     (let ((inhibit-read-only t)
2365           (buffer-read-only nil)
2366           msg-num
2367           cur-mark)
2368       (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
2369         (setq msg-num  (string-to-int (wl-match-buffer 1)))
2370         (setq cur-mark (wl-match-buffer 2))
2371         (when (member cur-mark (list " "
2372                                      wl-summary-score-below-mark
2373                                      wl-summary-score-over-mark))
2374           (goto-char (match-end 1))
2375           (delete-region (match-beginning 2) (match-end 2))
2376           (insert mark)
2377           (if wl-summary-highlight
2378               (wl-highlight-summary-current-line nil nil t))
2379           (set-buffer-modified-p nil))))))
2380
2381 (defun wl-summary-get-score-mark (msg-num)
2382   (let ((score (cdr (assq msg-num wl-summary-scored))))
2383     (if score
2384         (cond ((< score wl-summary-default-score)
2385                "-")
2386               ((> score wl-summary-default-score)
2387                "+")))))
2388
2389 (defun wl-summary-update-modeline ()
2390   (setq wl-summary-buffer-unread-status
2391         (format " {%s}(%d new/%d unread)"
2392                 (if (eq wl-summary-buffer-view 'thread)
2393                     "T" "S")
2394                 wl-summary-buffer-new-count
2395                 (+ wl-summary-buffer-new-count
2396                    wl-summary-buffer-unread-count))))
2397
2398 (defsubst wl-summary-jump-to-msg (&optional number)
2399   (interactive)
2400   (let ((num (or number
2401                  (string-to-int
2402                   (read-from-minibuffer "Jump to Message(No.): ")))))
2403     (setq num (int-to-string num))
2404     (if (re-search-forward (concat "^[ \t]*" num "[^0-9]") nil t)
2405         (progn
2406           (beginning-of-line)
2407           t)
2408       (if (re-search-backward (concat "^[ \t]*" num "[^0-9]") nil t)
2409           (progn
2410             (beginning-of-line)
2411             t)
2412         nil))))
2413
2414 (defun wl-summary-highlight-msgs (msgs)
2415   (save-excursion
2416     (let ((len (length msgs))
2417           i)
2418       (message "Hilighting...")
2419       (setq i 0)
2420       (while msgs
2421         (if (wl-summary-jump-to-msg (car msgs))
2422             (wl-highlight-summary-current-line))
2423         (setq msgs (cdr msgs))
2424         (when (> len elmo-display-progress-threshold)
2425           (setq i (+ i 1))
2426           (if (or (zerop (% i 5)) (= i len))
2427               (elmo-display-progress
2428                'wl-summary-highlight-msgs "Highlighting..."
2429                (/ (* i 100) len)))))
2430       (message "Highlighting...done"))))
2431
2432 (defun wl-summary-message-number ()
2433   (save-excursion
2434     (beginning-of-line)
2435     (if (looking-at "^ *\\([0-9]+\\)")
2436         (string-to-int (wl-match-buffer 1))
2437       nil)))
2438
2439 (defun wl-summary-move (src dsts-msgs)
2440   (let* ((dsts (car dsts-msgs))         ; (+foo +bar)
2441 ;;;      (msgs (cdr dsts-msgs))         ; (1 2 3)
2442 ;;;      (msgdb wl-summary-buffer-msgdb)
2443 ;;;      result)
2444          )
2445     (while dsts
2446       (setq dsts (cdr dsts)))))
2447
2448 (defun wl-summary-flush-pending-append-operations (&optional seen-list)
2449   "Execute append operations that are done while offline status."
2450   (when (and (elmo-folder-plugged-p wl-summary-buffer-folder-name)
2451              elmo-enable-disconnected-operation)
2452     (let* ((resumed-list (elmo-dop-append-list-load
2453                           wl-summary-buffer-folder-name t))
2454            (append-list (elmo-dop-append-list-load
2455                          wl-summary-buffer-folder-name))
2456            (appends (append resumed-list append-list))
2457            (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
2458            dels pair)
2459       (when appends
2460         (while appends
2461           (if (setq pair (rassoc (car appends) number-alist))
2462               (setq dels (append dels (list (car pair)))))
2463           (setq appends (cdr appends)))
2464         (when dels
2465           (setq seen-list
2466                 (elmo-msgdb-add-msgs-to-seen-list-subr
2467                  dels
2468                  wl-summary-buffer-msgdb
2469                  (concat wl-summary-important-mark
2470                          wl-summary-read-uncached-mark)
2471                  seen-list))
2472           (message "Resuming summary status...")
2473           (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name
2474                                   dels wl-summary-buffer-msgdb t)
2475           (wl-summary-delete-messages-on-buffer dels)
2476           (message "Resuming summary status...done"))
2477         ;; delete resume-file
2478         (elmo-dop-append-list-save wl-summary-buffer-folder-name nil t)
2479         (when append-list
2480           (elmo-dop-flush-pending-append-operations
2481            wl-summary-buffer-folder-name append-list)))))
2482   seen-list)
2483
2484 (defun wl-summary-delete-all-msgs ()
2485   (interactive)
2486   (let ((cur-buf (current-buffer))
2487         (dels (elmo-list-folder wl-summary-buffer-folder-name)))
2488     (set-buffer cur-buf)
2489     (if (null dels)
2490         (message "No message to delete.")
2491       (if (y-or-n-p (format "%s has %d message(s).  Delete all? "
2492                             wl-summary-buffer-folder-name
2493                             (length dels)))
2494           (progn
2495             (message "Deleting...")
2496             (elmo-delete-msgs wl-summary-buffer-folder-name dels
2497                               wl-summary-buffer-msgdb)
2498             (elmo-msgdb-delete-msgs wl-summary-buffer-folder-name
2499                                     dels wl-summary-buffer-msgdb)
2500 ;;;         (elmo-msgdb-save wl-summary-buffer-folder-name nil)
2501             (wl-summary-set-message-modified)
2502             (wl-summary-set-mark-modified)
2503             (wl-folder-set-folder-updated wl-summary-buffer-folder-name
2504                                           (list 0 0 0))
2505 ;;; for thread.
2506 ;;;         (setq wl-thread-top-entity '(nil t nil nil))
2507             (setq wl-summary-buffer-unread-count 0)
2508             (setq wl-summary-buffer-new-count    0)
2509             (wl-summary-update-modeline)
2510             (set-buffer cur-buf)
2511             (let ((inhibit-read-only t)
2512                   (buffer-read-only nil))
2513               (erase-buffer))
2514 ;;;         (if wl-summary-cache-use (wl-summary-save-view-cache))
2515             (message "Deleting...done")
2516             t)
2517         nil))))
2518
2519 (defun wl-summary-toggle-thread (&optional arg)
2520   "Toggle thread status (T)hread and (S)equential.
2521 If ARG, without confirm."
2522   (interactive "P")
2523   (when (or arg
2524             (y-or-n-p (format "Toggle threading? (y=%s): "
2525                               (if (eq wl-summary-buffer-view 'thread)
2526                                   "\"off\"" "\"on\""))))
2527     (if (eq wl-summary-buffer-view 'thread)
2528         (setq wl-summary-buffer-view 'sequence)
2529       (setq wl-summary-buffer-view 'thread))
2530     (wl-summary-update-modeline)
2531     (force-mode-line-update)
2532     (wl-summary-rescan)))
2533
2534 (defun wl-summary-load-file-object (filename)
2535   "Load lisp object from dir."
2536   (save-excursion
2537     (let ((tmp-buffer (get-buffer-create " *wl-summary-load-file-object*"))
2538           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
2539           insert-file-contents-post-hook
2540           ret-val)
2541       (if (not (file-readable-p filename))
2542           ()
2543         (set-buffer tmp-buffer)
2544         (as-binary-input-file (insert-file-contents filename))
2545         (setq ret-val
2546               (condition-case nil
2547                   (read (current-buffer))
2548                 (error (error "Reading failed")))))
2549       (kill-buffer tmp-buffer)
2550       ret-val)))
2551
2552 (defun wl-summary-goto-folder (&optional arg)
2553   (interactive "P")
2554   (wl-summary-goto-folder-subr nil nil nil arg t))
2555
2556 (defun wl-summary-goto-last-visited-folder ()
2557   (interactive)
2558   (let ((entity
2559          (wl-folder-search-entity-by-name wl-summary-last-visited-folder
2560                                           wl-folder-entity
2561                                           'folder)))
2562     (if entity (wl-folder-set-current-entity-id
2563                 (wl-folder-get-entity-id entity))))
2564   (wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t))
2565
2566 (defun wl-summary-sticky-p (&optional fld)
2567   (if fld
2568       (get-buffer (wl-summary-sticky-buffer-name fld))
2569     (not (string= wl-summary-buffer-name (buffer-name)))))
2570
2571 (defun wl-summary-always-sticky-folder-p (fld)
2572   (or (eq t wl-summary-always-sticky-folder-list)
2573       (wl-string-match-member fld wl-summary-always-sticky-folder-list)))
2574
2575 (defun wl-summary-stick (&optional force)
2576   "Make current summary buffer sticky."
2577   (interactive "P")
2578   (if (wl-summary-sticky-p)
2579       (message "Current summary buffer is already sticky.")
2580     (when (or force (y-or-n-p "Stick current summary buffer? "))
2581       (wl-summary-toggle-disp-msg 'off)
2582       (wl-summary-switch-to-clone-buffer
2583        (wl-summary-sticky-buffer-name
2584         wl-summary-buffer-folder-name))
2585 ;;; ???hang up
2586 ;;;   (rename-buffer (wl-summary-sticky-buffer-name
2587 ;;;                   wl-summary-buffer-folder-name)))
2588       (message "Folder `%s' is now sticky." wl-summary-buffer-folder-name))))
2589
2590 (defun wl-summary-switch-to-clone-buffer (buffer-name)
2591   (let ((cur-buf (current-buffer))
2592         (msg (wl-summary-message-number))
2593         (buf (get-buffer-create buffer-name))
2594         (folder wl-summary-buffer-folder-name)
2595         (copy-variables
2596          (append '(wl-summary-buffer-view
2597                    wl-summary-buffer-refile-list
2598                    wl-summary-buffer-delete-list
2599                    wl-summary-buffer-copy-list
2600                    wl-summary-buffer-target-mark-list
2601                    wl-summary-buffer-msgdb
2602                    wl-summary-buffer-number-column
2603                    wl-summary-buffer-number-regexp
2604                    wl-summary-buffer-message-modified
2605                    wl-summary-buffer-mark-modified
2606                    wl-summary-buffer-thread-modified)
2607                  (and (eq wl-summary-buffer-view 'thread)
2608                       '(wl-thread-entity-hashtb
2609                         wl-thread-entities
2610                         wl-thread-entity-list))
2611                  (and wl-use-scoring
2612                       '(wl-summary-scored
2613                         wl-summary-default-score
2614                         wl-summary-important-above
2615                         wl-summary-temp-above
2616                         wl-summary-mark-below
2617                         wl-summary-expunge-below))
2618                  (and (featurep 'wl-score)
2619                       '(wl-current-score-file
2620                         wl-score-alist)))))
2621     (set-buffer buf)
2622     (wl-summary-mode)
2623     (wl-summary-buffer-set-folder folder)
2624     (let ((buffer-read-only nil))
2625       (insert-buffer cur-buf))
2626     (set-buffer-modified-p nil)
2627     (while copy-variables
2628       (set (car copy-variables)
2629            (save-excursion
2630              (set-buffer cur-buf)
2631              (symbol-value (car copy-variables))))
2632       (setq copy-variables (cdr copy-variables)))
2633     (switch-to-buffer buf)
2634     (kill-buffer cur-buf)
2635     (wl-summary-count-unread
2636      (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
2637     (wl-summary-update-modeline)
2638     (if msg
2639         (if (eq wl-summary-buffer-view 'thread)
2640             (wl-thread-jump-to-msg msg)
2641           (wl-summary-jump-to-msg msg))
2642       (goto-char (point-max))
2643       (beginning-of-line))))
2644
2645 (defun wl-summary-get-buffer (folder)
2646   (or (and folder
2647            (get-buffer (wl-summary-sticky-buffer-name folder)))
2648       (get-buffer wl-summary-buffer-name)))
2649
2650 (defun wl-summary-get-buffer-create (folder &optional force-sticky)
2651   (if force-sticky
2652       (get-buffer-create
2653        (wl-summary-sticky-buffer-name folder))
2654     (or (get-buffer (wl-summary-sticky-buffer-name folder))
2655         (get-buffer-create wl-summary-buffer-name))))
2656
2657 (defun wl-summary-disp-msg (folder disp-msg)
2658   (let (disp mes-win)
2659     (if (and disp-msg
2660              wl-summary-buffer-disp-msg)
2661         (let ((view-message-buffer (get-buffer wl-message-buf-name))
2662               (number (wl-summary-message-number))
2663               cur-folder cur-number sel-win)
2664           (when view-message-buffer
2665             (save-excursion
2666               (set-buffer view-message-buffer)
2667               (setq cur-folder wl-message-buffer-cur-folder
2668                     cur-number wl-message-buffer-cur-number))
2669             (when (and (string= folder cur-folder)
2670                        (eq number cur-number))
2671               (setq sel-win (selected-window))
2672               (wl-select-buffer view-message-buffer)
2673               (select-window sel-win)
2674               (setq disp t)))))
2675     (if (not disp)
2676         (setq wl-summary-buffer-disp-msg nil))
2677     (when (and (not disp)
2678                (setq mes-win (wl-message-buffer-window)))
2679       (delete-window mes-win)
2680       (run-hooks 'wl-summary-toggle-disp-off-hook))))
2681
2682 (defun wl-summary-goto-folder-subr (&optional folder scan-type other-window
2683                                               sticky interactive scoring)
2684   "Display target folder on summary."
2685   (interactive)
2686   (let* ((keep-cursor (memq this-command
2687                             wl-summary-keep-cursor-command))
2688          (fld (or folder (wl-summary-read-folder wl-default-folder)))
2689          (cur-fld wl-summary-buffer-folder-name)
2690          buf mes hilit reuse-buf
2691          retval entity)
2692     (if (string= fld "")
2693         (setq fld wl-default-folder))
2694     (when (and (not (string= cur-fld fld)) ; folder is moved.
2695                (eq major-mode 'wl-summary-mode)) ; called in summary.
2696       (setq wl-summary-last-visited-folder wl-summary-buffer-folder-name)
2697       (wl-summary-cleanup-temp-marks (wl-summary-sticky-p))
2698       (wl-summary-save-status 'keep)) ;; keep current buffer, anyway.
2699     (setq buf (wl-summary-get-buffer-create fld sticky))
2700     (setq reuse-buf
2701           (save-excursion
2702             (set-buffer buf)
2703             (string= fld wl-summary-buffer-folder-name)))
2704     (unwind-protect
2705         (if reuse-buf
2706             (if interactive
2707                 (switch-to-buffer buf)
2708               (set-buffer buf))
2709           (if other-window
2710               (delete-other-windows))
2711           (set-buffer buf)
2712           (unless (eq major-mode 'wl-summary-mode)
2713             (wl-summary-mode))
2714           (wl-summary-buffer-set-folder fld)
2715           (setq wl-summary-buffer-disp-msg nil)
2716           (setq wl-summary-buffer-last-displayed-msg nil)
2717           (setq wl-summary-buffer-current-msg nil)
2718           (let ((case-fold-search nil)
2719                 (inhibit-read-only t)
2720                 (buffer-read-only nil))
2721             (erase-buffer)
2722             ;; resume summary cache
2723             (if wl-summary-cache-use
2724                 (let* ((dir (elmo-msgdb-expand-path fld))
2725                        (cache (expand-file-name wl-summary-cache-file dir))
2726                        (view (expand-file-name wl-summary-view-file dir)))
2727                   (when (file-exists-p cache)
2728                     (as-binary-input-file
2729                      (insert-file-contents cache))
2730                     (elmo-set-buffer-multibyte
2731                      default-enable-multibyte-characters)
2732                     (decode-mime-charset-region
2733                      (point-min)(point-max)
2734                      wl-summary-buffer-mime-charset))
2735                   (when (file-exists-p view)
2736                     (setq wl-summary-buffer-view
2737                           (wl-summary-load-file-object view)))
2738                   (if (eq wl-summary-buffer-view 'thread)
2739                       (wl-thread-resume-entity fld))))
2740             ;; Load msgdb
2741             (setq wl-summary-buffer-msgdb nil) ; new msgdb
2742             (setq wl-summary-buffer-msgdb
2743                   (wl-summary-msgdb-load-async fld))
2744             (if (null wl-summary-buffer-msgdb)
2745                 (setq wl-summary-buffer-msgdb
2746                       (elmo-msgdb-load (elmo-string fld))))
2747             (wl-summary-count-unread
2748              (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
2749             (wl-summary-update-modeline)))
2750       (wl-summary-buffer-number-column-detect t)
2751       (wl-summary-disp-msg fld (and reuse-buf keep-cursor))
2752       (unless (and reuse-buf keep-cursor)
2753         (setq hilit wl-summary-highlight)
2754         (unwind-protect
2755             (let ((wl-summary-highlight (if reuse-buf wl-summary-highlight))
2756                   (wl-use-scoring
2757                    (if (or scoring interactive) wl-use-scoring)))
2758               (if (and (not scan-type)
2759                        interactive
2760                        (not wl-ask-range))
2761                   (setq scan-type (wl-summary-get-sync-range fld)))
2762               (cond
2763                ((eq scan-type nil)
2764                 (wl-summary-sync 'unset-cursor))
2765                ((eq scan-type 'all)
2766                 (wl-summary-sync 'unset-cursor "all"))
2767                ((eq scan-type 'no-sync))
2768                ((or (eq scan-type 'force-update)
2769                     (eq scan-type 'update))
2770                 (setq mes (wl-summary-sync-force-update 'unset-cursor)))))
2771           (if interactive
2772               (switch-to-buffer buf)
2773             (set-buffer buf))
2774           ;; stick always-sticky-folder
2775           (when (wl-summary-always-sticky-folder-p fld)
2776             (or (wl-summary-sticky-p) (wl-summary-stick t)))
2777           (run-hooks 'wl-summary-prepared-pre-hook)
2778           (set-buffer-modified-p nil)
2779           (goto-char (point-min))
2780           (if (wl-summary-cursor-down t)
2781               (let ((unreadp (wl-thread-next-mark-p
2782                               (wl-thread-entity-get-mark
2783                                (wl-summary-message-number))
2784                               wl-summary-move-order)))
2785                 (cond ((and wl-auto-select-first unreadp)
2786                        (setq retval 'disp-msg))
2787                       ((not unreadp)
2788                        (setq retval 'more-next))))
2789             (goto-char (point-max))
2790             (if (elmo-folder-plugged-p folder)
2791                 (forward-line -1)
2792               (wl-summary-prev))
2793             (setq retval 'more-next))
2794           (setq wl-summary-highlight hilit)
2795           (if (and wl-summary-highlight
2796                    (not reuse-buf))
2797               (if (and wl-summary-highlight-partial-threshold
2798                        (> (count-lines (point-min) (point-max))
2799                           wl-summary-highlight-partial-threshold))
2800                   (save-excursion
2801                     (forward-line (-
2802                                    0
2803                                    (or
2804                                     wl-summary-partial-highlight-above-lines
2805                                     wl-summary-highlight-partial-threshold)))
2806                     (wl-highlight-summary (point) (point-max)))
2807                 (wl-highlight-summary (point-min) (point-max))))
2808           (if (null wl-summary-buffer-msgdb) ;; one more try.
2809               (setq wl-summary-buffer-msgdb
2810                     (elmo-msgdb-load (elmo-string fld))))
2811           (if (eq retval 'disp-msg)
2812               (wl-summary-redisplay))
2813           (if mes (message "%s" mes))
2814           (if (and interactive wl-summary-recenter)
2815               (recenter (/ (- (window-height) 2) 2))))))
2816     ;; set current entity-id
2817     (if (and (not folder)
2818              (setq entity
2819                    (wl-folder-search-entity-by-name fld
2820                                                     wl-folder-entity
2821                                                     'folder)))
2822         ;; entity-id is unknown.
2823         (wl-folder-set-current-entity-id
2824          (wl-folder-get-entity-id entity)))
2825     (unwind-protect
2826         (run-hooks 'wl-summary-prepared-hook)
2827       (set-buffer-modified-p nil))
2828     retval))
2829
2830 (defun wl-summary-summary-line-already-exists-p (parent-number buffer)
2831   "Return the depth."
2832   (set-buffer buffer)
2833   (goto-char (point-max))
2834   (let ((depth 0))
2835     (when (re-search-backward (format "^ *%s..../..\(.*\)..:.. "
2836                                       parent-number) nil t)
2837       (goto-char (match-end 0))
2838       (while (string-match wl-thread-indent-regexp
2839                            (char-to-string
2840                             (char-after (point))))
2841         (setq depth (+ 1 depth))
2842         (forward-char))
2843       (/ depth wl-thread-indent-level-internal))))
2844
2845 (defun wl-summary-goto-bottom-of-current-thread ()
2846   (if (re-search-forward (concat "^" wl-summary-buffer-number-regexp
2847                                  "..../..\(.*\)..:.. [[<]") nil t)
2848       ()
2849     (goto-char (point-max))))
2850
2851 (defun wl-summary-goto-top-of-current-thread ()
2852   (wl-summary-jump-to-msg
2853    (wl-thread-entity-get-number
2854     (wl-thread-entity-get-top-entity (wl-thread-get-entity
2855                                       (wl-summary-message-number))))))
2856
2857 (defun wl-summary-goto-bottom-of-sub-thread (&optional depth)
2858   (interactive)
2859   (let ((depth (or depth
2860                    (wl-thread-get-depth-of-current-line))))
2861     (forward-line 1)
2862     (while (and (not (eobp))
2863                 (>= (wl-thread-get-depth-of-current-line)
2864                     depth))
2865       (forward-line 1))
2866     (beginning-of-line)))
2867
2868 (defun wl-summary-insert-line (line)
2869   "Insert LINE in the Summary."
2870   (if wl-use-highlight-mouse-line
2871       ;; remove 'mouse-face of current line.
2872       (put-text-property
2873        (save-excursion (beginning-of-line)(point))
2874        (save-excursion (end-of-line)(point))
2875        'mouse-face nil))
2876   (insert line "\n")
2877   (if wl-use-highlight-mouse-line
2878       ;; remove 'mouse-face of current line.
2879       (put-text-property
2880        (save-excursion (beginning-of-line)(point))
2881        (save-excursion (end-of-line)(point))
2882        'mouse-face nil))
2883   (condition-case nil ; it's dangerous, so ignore error.
2884       (run-hooks 'wl-summary-line-inserted-hook)
2885     (error (ding)
2886            (message "Error in wl-summary-line-inserted-hook"))))
2887
2888 (defun wl-summary-insert-summary (entity database mark-alist dummy &optional dummy)
2889   (let ((overview-entity entity)
2890         summary-line msg)
2891     (setq msg (elmo-msgdb-overview-entity-get-number entity))
2892     (when (setq summary-line
2893                 (wl-summary-overview-create-summary-line
2894                  msg entity nil 0 mark-alist))
2895       (let ((inhibit-read-only t)
2896             buffer-read-only)
2897         (goto-char (point-max))
2898         (wl-summary-insert-line summary-line)))))
2899
2900 (defun wl-summary-default-subject-filter (subject)
2901   (let ((case-fold-search t))
2902     (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\):" ""))
2903     (setq subject (elmo-replace-in-string subject "[ \t]" ""))
2904     (elmo-replace-in-string subject "^\\[.*\\]" "")))
2905
2906 (defun wl-summary-subject-equal (subject1 subject2)
2907   (string= (wl-summary-subject-filter-func-internal subject1)
2908            (wl-summary-subject-filter-func-internal subject2)))
2909
2910 (defmacro wl-summary-put-alike (alike)
2911   (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
2912                         (, alike)
2913                         wl-summary-alike-hashtb)))
2914
2915 (defmacro wl-summary-get-alike ()
2916   (` (elmo-get-hash-val (format "#%d" (wl-count-lines))
2917                         wl-summary-alike-hashtb)))
2918
2919 (defun wl-summary-insert-headers (overview func mime-decode)
2920   (let (ov this last alike)
2921     (buffer-disable-undo (current-buffer))
2922     (make-local-variable 'wl-summary-alike-hashtb)
2923     (setq wl-summary-alike-hashtb (elmo-make-hash (* (length overview) 2)))
2924     (when mime-decode
2925       (elmo-set-buffer-multibyte default-enable-multibyte-characters))
2926     (while (setq ov (pop overview))
2927       (setq this (funcall func ov))
2928       (and this (setq this (std11-unfold-string this)))
2929       (if (equal last this)
2930           (wl-append alike (list ov))
2931         (when last
2932           (wl-summary-put-alike alike)
2933           (insert last ?\n))
2934         (setq alike (list ov)
2935               last this)))
2936     (when last
2937       (wl-summary-put-alike alike)
2938       (insert last ?\n))
2939     (when mime-decode
2940       (decode-mime-charset-region (point-min) (point-max)
2941                                   elmo-mime-charset)
2942       (when (eq mime-decode 'mime)
2943         (eword-decode-region (point-min) (point-max))))
2944     (run-hooks 'wl-summary-insert-headers-hook)))
2945
2946 (defun wl-summary-search-by-subject (entity overview)
2947   (let ((buf (get-buffer-create wl-summary-search-buf-name))
2948         (folder-name wl-summary-buffer-folder-name)
2949         match founds found-entity)
2950     (save-excursion
2951       (set-buffer buf)
2952       (let ((case-fold-search t))
2953         (when (or (not (string= wl-summary-buffer-folder-name folder-name))
2954                   (zerop (buffer-size)))
2955           (setq wl-summary-buffer-folder-name folder-name)
2956           (wl-summary-insert-headers
2957            overview
2958            (function
2959             (lambda (x)
2960               (wl-summary-subject-filter-func-internal
2961                (elmo-msgdb-overview-entity-get-subject-no-decode x))))
2962            t))
2963         (setq match (wl-summary-subject-filter-func-internal
2964                      (elmo-msgdb-overview-entity-get-subject entity)))
2965         (if (string= match "")
2966             (setq match "\n"))
2967         (goto-char (point-max))
2968         (while (and (not founds)
2969                     (not (= (point) (point-min)))
2970                     (search-backward match nil t))
2971           ;; check exactly match
2972           (when (and (bolp)
2973                      (= (point-at-eol)
2974                         (match-end 0)))
2975             (setq found-entity (wl-summary-get-alike))
2976             (if (and found-entity
2977                      ;; Is founded entity myself or children?
2978                      (not (string=
2979                            (elmo-msgdb-overview-entity-get-id entity)
2980                            (elmo-msgdb-overview-entity-get-id (car found-entity))))
2981                      (not (wl-thread-descendant-p
2982                            (elmo-msgdb-overview-entity-get-number entity)
2983                            (elmo-msgdb-overview-entity-get-number (car found-entity)))))
2984                 ;; return matching entity
2985                 (setq founds found-entity))))
2986         (if founds
2987             (car founds))))))
2988
2989 (defun wl-summary-insert-thread-entity (entity overview mark-alist update
2990                                                &optional force-insert)
2991   (let (update-list entity-stack)
2992     (while entity
2993       (let* ((this-id (elmo-msgdb-overview-entity-get-id entity))
2994              (parent-entity
2995               (elmo-msgdb-overview-get-parent-entity entity overview));; temp
2996 ;;;          (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
2997              (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
2998              (case-fold-search t)
2999              msg overview2 cur-entity linked retval delayed-entity)
3000         (setq msg (elmo-msgdb-overview-entity-get-number entity))
3001         (if (and parent-number
3002                  (not (wl-thread-get-entity parent-number))
3003                  (not force-insert))
3004             ;; parent is exists in overview, but not exists in wl-thread-entities
3005             (progn
3006               (wl-append wl-summary-delayed-update
3007                          (list (cons parent-number entity)))
3008               (setq entity nil)) ;; exit loop
3009           ;; Search parent by subject.
3010           (when (and (null parent-number)
3011                      wl-summary-search-parent-by-subject-regexp
3012                      (string-match wl-summary-search-parent-by-subject-regexp
3013                                    (elmo-msgdb-overview-entity-get-subject entity)))
3014             (let ((found (wl-summary-search-by-subject entity overview)))
3015               (when (and found
3016                          (not (member found wl-summary-delayed-update)))
3017                 (setq parent-entity found)
3018                 (setq parent-number
3019                       (elmo-msgdb-overview-entity-get-number parent-entity))
3020                 (setq linked t))))
3021           ;; If subject is change, divide thread.
3022           (if (and parent-number
3023                    wl-summary-divide-thread-when-subject-changed
3024                    (not (wl-summary-subject-equal
3025                          (or (elmo-msgdb-overview-entity-get-subject
3026                               entity) "")
3027                          (or (elmo-msgdb-overview-entity-get-subject
3028                               parent-entity) ""))))
3029               (setq parent-number nil))
3030           ;;
3031           (setq retval
3032                 (wl-thread-insert-message entity overview mark-alist
3033                                           msg parent-number update linked))
3034           (and retval
3035                (wl-append update-list (list retval)))
3036           (setq entity nil) ; exit loop
3037           (while (setq delayed-entity (assq msg wl-summary-delayed-update))
3038             (setq wl-summary-delayed-update
3039                   (delete delayed-entity wl-summary-delayed-update))
3040             ;; update delayed message
3041             (wl-append entity-stack (list (cdr delayed-entity)))))
3042         (if (and (not entity)
3043                  entity-stack)
3044             (setq entity (pop entity-stack)))))
3045     update-list))
3046
3047 (defun wl-summary-update-thread (entity
3048                                  overview
3049                                  mark-alist
3050                                  thr-entity
3051                                  parent-entity)
3052   (let* ((depth 0)
3053          (this-id (elmo-msgdb-overview-entity-get-id entity))
3054          (overview-entity entity)
3055          (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
3056          (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
3057          summary-line msg subject-differ)
3058     (cond
3059      ((or (not parent-id)
3060           (string= this-id parent-id))
3061       (goto-char (point-max))
3062       (beginning-of-line))
3063      ;; parent already exists in buffer.
3064      ((setq depth (or (wl-summary-summary-line-already-exists-p
3065                        parent-number (current-buffer)) -1))
3066       (setq depth (+ 1 depth))
3067       (wl-thread-goto-bottom-of-sub-thread)))
3068     (if (and (setq msg (elmo-msgdb-overview-entity-get-number entity)))
3069         (if (setq summary-line
3070                   (wl-summary-overview-create-summary-line
3071                    msg entity parent-entity depth mark-alist
3072                    (wl-thread-maybe-get-children-num msg)
3073                    nil thr-entity))
3074             (let ((inhibit-read-only t)
3075                   (buffer-read-only nil))
3076               (wl-summary-insert-line summary-line))))))
3077
3078 (defun wl-summary-mark-as-unread (&optional number
3079                                             no-server-update
3080                                             no-modeline-update)
3081   (interactive)
3082   (save-excursion
3083     (let* (eol
3084           (inhibit-read-only t)
3085           (buffer-read-only nil)
3086           (folder wl-summary-buffer-folder-name)
3087           (msgdb wl-summary-buffer-msgdb)
3088           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
3089 ;;;       (number-alist (elmo-msgdb-get-number-alist msgdb))
3090           new-mark visible mark)
3091       (if number
3092           (progn
3093             (setq visible (wl-summary-jump-to-msg number))
3094             (unless (setq mark (cadr (assq number mark-alist)))
3095               (setq mark " ")))
3096         ;; interactive
3097         (setq visible t))
3098       (when visible
3099         (if (null (wl-summary-message-number))
3100             (message "No message.")
3101           (end-of-line)
3102           (setq eol (point))
3103           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
3104                                       "..../..")) ; set cursor line
3105           (beginning-of-line)))
3106       (if (or (and (not visible)
3107                    ;; already exists in msgdb.
3108                    (assq number (elmo-msgdb-get-number-alist msgdb)))
3109               (re-search-forward
3110                (format (concat "^ *\\("
3111                                (if number (int-to-string number)
3112                                  "[0-9]+")
3113                                "\\)[^0-9]\\(%s\\|%s\\)")
3114                        wl-summary-read-uncached-mark
3115                        " ") eol t))
3116           (progn
3117             (setq number (or number (string-to-int (wl-match-buffer 1))))
3118             (setq mark (or mark (elmo-match-buffer 2)))
3119             (save-match-data
3120               (setq new-mark (if (string= mark
3121                                           wl-summary-read-uncached-mark)
3122                                  wl-summary-unread-uncached-mark
3123                                (if (elmo-use-cache-p folder number)
3124                                    wl-summary-unread-mark
3125                                  wl-summary-unread-uncached-mark))))
3126             ;; server side mark
3127             (unless no-server-update
3128               (unless (elmo-mark-as-unread folder (list number)
3129                                            msgdb)
3130                 (error "Setting mark failed")))
3131             (when visible
3132               (delete-region (match-beginning 2) (match-end 2))
3133               (insert new-mark))
3134             (setq mark-alist
3135                   (elmo-msgdb-mark-set mark-alist
3136                                        number
3137                                        new-mark))
3138             (elmo-msgdb-set-mark-alist msgdb mark-alist)
3139             (unless no-modeline-update
3140               (setq wl-summary-buffer-unread-count
3141                     (+ 1 wl-summary-buffer-unread-count))
3142               (wl-summary-update-modeline)
3143               (wl-folder-update-unread
3144                folder
3145                (+ wl-summary-buffer-unread-count
3146                   wl-summary-buffer-new-count)))
3147             (wl-summary-set-mark-modified)
3148             (if (and visible wl-summary-highlight)
3149                 (wl-highlight-summary-current-line))))))
3150   (set-buffer-modified-p nil))
3151
3152 (defun wl-summary-delete (&optional number)
3153   "Mark Delete mark 'D'.
3154 If optional argument NUMBER is specified, mark message specified by NUMBER."
3155   (interactive)
3156   (let* ((buffer-num (wl-summary-message-number))
3157          (msg-num (or number buffer-num))
3158          mark)
3159     (catch 'done
3160       (when (null msg-num)
3161         (if (interactive-p)
3162             (message "No message."))
3163         (throw 'done nil))
3164       (when (setq mark (wl-summary-get-mark msg-num))
3165         (when (wl-summary-reserve-temp-mark-p mark)
3166           (if (interactive-p)
3167               (error "Already marked as `%s'" mark))
3168           (throw 'done nil))
3169         (wl-summary-unmark msg-num))
3170       (if (or (interactive-p)
3171               (eq number buffer-num))
3172           (wl-summary-mark-line "D"))
3173       (setq wl-summary-buffer-delete-list
3174             (cons msg-num wl-summary-buffer-delete-list))
3175       (if (interactive-p)
3176           (if (eq wl-summary-move-direction-downward nil)
3177               (wl-summary-prev)
3178             (wl-summary-next)))
3179       msg-num)))
3180
3181 (defun wl-summary-remove-destination ()
3182   (save-excursion
3183     (let ((inhibit-read-only t)
3184           (buffer-read-only nil)
3185           (buf (current-buffer))
3186           sol eol rs re)
3187       (beginning-of-line)
3188       (setq sol (point))
3189       (end-of-line)
3190       (setq eol (point))
3191       (setq rs (next-single-property-change sol 'wl-summary-destination
3192                                             buf eol))
3193       (setq re (next-single-property-change rs 'wl-summary-destination
3194                                             buf eol))
3195       (put-text-property rs re 'wl-summary-destination nil)
3196       (put-text-property rs re 'invisible nil)
3197       (goto-char re)
3198       (delete-char (- eol re)))))
3199
3200 (defun wl-summary-check-mark (msg mark)
3201   (let ((check-func (cond ((string= mark "o")
3202                            'wl-summary-msg-marked-as-refiled)
3203                           ((string= mark "O")
3204                            'wl-summary-msg-marked-as-copied)
3205                           ((string= mark "D")
3206                            'wl-summary-msg-marked-as-deleted)
3207                           ((string= mark "*")
3208                            'wl-summary-msg-marked-as-target))))
3209     (if check-func
3210         (funcall check-func msg))))
3211
3212 (defun wl-summary-mark-collect (mark &optional begin end)
3213   (save-excursion
3214     (save-restriction
3215       (let (msglist)
3216         (narrow-to-region (or begin (point-min))
3217                           (or end (point-max)))
3218         (goto-char (point-min))
3219         ;; for thread...
3220         (if (eq wl-summary-buffer-view 'thread)
3221             (progn
3222               (while (not (eobp))
3223                 (let* ((number (wl-summary-message-number))
3224                        (entity (wl-thread-get-entity number))
3225                        result)
3226                   ;; opened...only myself is checked.
3227                   (if (wl-summary-check-mark number mark)
3228                       (wl-append msglist (list number)))
3229                   (unless (wl-thread-entity-get-opened entity)
3230                     ;; closed...children is also checked.
3231                     (if (setq result (wl-thread-get-children-msgs-with-mark
3232                                       number
3233                                       mark))
3234                         (wl-append msglist result)))
3235                   (forward-line 1)))
3236               (elmo-uniq-list msglist))
3237           (let* ((case-fold-search nil)
3238                  (re (format (concat wl-summary-message-regexp "%s")
3239                              (regexp-quote mark))))
3240             (while (re-search-forward re nil t)
3241               (setq msglist (cons (wl-summary-message-number) msglist)))
3242             (nreverse msglist)))))))
3243
3244 (defun wl-summary-exec ()
3245   (interactive)
3246   (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list)
3247                         (reverse wl-summary-buffer-delete-list)
3248                         (mapcar 'car wl-summary-buffer-copy-list)))
3249
3250 (defun wl-summary-exec-region (beg end)
3251   (interactive "r")
3252   (message "Collecting marks ...")
3253   (save-excursion
3254     (goto-char beg)
3255     (beginning-of-line)
3256     (setq beg (point))
3257     (goto-char (1- end))
3258     (forward-line)
3259     (setq end (point))
3260     (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end)
3261                           (wl-summary-mark-collect "D" beg end)
3262                           (wl-summary-mark-collect "O" beg end))))
3263
3264 (defun wl-summary-exec-subr (moves dels copies)
3265   (if (not (or moves dels copies))
3266       (message "No marks")
3267     (save-excursion
3268       (let ((del-fld (wl-summary-get-delete-folder
3269                       wl-summary-buffer-folder-name))
3270             (start (point))
3271             (unread-marks (list wl-summary-unread-cached-mark
3272                                 wl-summary-unread-uncached-mark
3273                                 wl-summary-new-mark))
3274             (refiles (append moves dels))
3275             (refile-executed 0)
3276             (refile-failures 0)
3277             (copy-executed 0)
3278             (copy-failures 0)
3279             (copy-len (length copies))
3280             refile-len
3281             dst-msgs                    ; loop counter
3282             result)
3283         (message "Executing ...")
3284         (while dels
3285           (when (not (assq (car dels) wl-summary-buffer-refile-list))
3286             (wl-append wl-summary-buffer-refile-list
3287                        (list (cons (car dels) del-fld)))
3288             (setq wl-summary-buffer-delete-list
3289                   (delete (car dels) wl-summary-buffer-delete-list)))
3290           (setq dels (cdr dels)))
3291         ;; begin refile...
3292         (setq refile-len (length refiles))
3293         (setq dst-msgs
3294               (wl-inverse-alist refiles wl-summary-buffer-refile-list))
3295         (goto-char start)               ; avoid moving cursor to
3296                                         ; the bottom line.
3297         (while dst-msgs
3298 ;;;       (elmo-msgdb-add-msgs-to-seen-list
3299 ;;;        (car (car dst-msgs))         ;dst-folder
3300 ;;;        (cdr (car dst-msgs))         ;msgs
3301 ;;;        wl-summary-buffer-msgdb
3302 ;;;        (concat wl-summary-important-mark
3303 ;;;                wl-summary-read-uncached-mark))
3304           (setq result nil)
3305           (condition-case nil
3306               (setq result (elmo-move-msgs wl-summary-buffer-folder-name
3307                                            (cdr (car dst-msgs))
3308                                            (car (car dst-msgs))
3309                                            wl-summary-buffer-msgdb
3310                                            refile-len
3311                                            refile-executed
3312                                            (not (null (cdr dst-msgs)))
3313                                            nil ; no-delete
3314                                            nil ; same-number
3315                                            unread-marks))
3316             (error nil))
3317           (if result                    ; succeeded.
3318               (progn
3319                 ;; update buffer.
3320                 (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
3321                 ;; update refile-alist.
3322                 (setq wl-summary-buffer-refile-list
3323                       (wl-delete-associations (cdr (car dst-msgs))
3324                                              wl-summary-buffer-refile-list)))
3325             (setq refile-failures
3326                   (+ refile-failures (length (cdr (car dst-msgs))))))
3327           (setq refile-executed (+ refile-executed (length (cdr (car dst-msgs)))))
3328           (setq dst-msgs (cdr dst-msgs)))
3329         ;; end refile
3330         ;; begin cOpy...
3331         (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
3332         (while dst-msgs
3333 ;;;       (elmo-msgdb-add-msgs-to-seen-list
3334 ;;;        (car (car dst-msgs))         ;dst-folder
3335 ;;;        (cdr (car dst-msgs))         ;msgs
3336 ;;;        wl-summary-buffer-msgdb
3337 ;;;        (concat wl-summary-important-mark
3338 ;;;                wl-summary-read-uncached-mark))
3339           (setq result nil)
3340           (condition-case nil
3341               (setq result (elmo-move-msgs wl-summary-buffer-folder-name
3342                                            (cdr (car dst-msgs))
3343                                            (car (car dst-msgs))
3344                                            wl-summary-buffer-msgdb
3345                                            copy-len
3346                                            copy-executed
3347                                            (not (null (cdr dst-msgs)))
3348                                            t ; t is no-delete (copy)
3349                                            nil ; same number
3350                                            unread-marks))
3351             (error nil))
3352           (if result                    ; succeeded.
3353               (progn
3354                 ;; update buffer.
3355                 (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
3356                 ;; update copy-alist
3357                 (setq wl-summary-buffer-copy-list
3358                       (wl-delete-associations (cdr (car dst-msgs))
3359                                               wl-summary-buffer-copy-list)))
3360             (setq copy-failures
3361                   (+ copy-failures (length (cdr (car dst-msgs))))))
3362           (setq copy-executed (+ copy-executed (length (cdr (car dst-msgs)))))
3363           (setq dst-msgs (cdr dst-msgs)))
3364         ;; end cOpy
3365         (wl-summary-folder-info-update)
3366         (wl-summary-set-message-modified)
3367         (wl-summary-set-mark-modified)
3368         (run-hooks 'wl-summary-exec-hook)
3369         (set-buffer-modified-p nil)
3370         (message (concat "Executing ... done"
3371                          (if (> refile-failures 0)
3372                              (format " (%d refiling failed)" refile-failures)
3373                            "")
3374                          (if (> copy-failures 0)
3375                              (format " (%d copying failed)" copy-failures)
3376                            "")
3377                          "."))))))
3378
3379 (defun wl-summary-read-folder (default &optional purpose ignore-error
3380                                 no-create init)
3381   (let ((fld (completing-read
3382               (format "Folder name %s(%s): " (or purpose "")
3383                       default)
3384               (or wl-folder-completion-func
3385                   (if (memq 'read-folder wl-use-folder-petname)
3386                       (wl-folder-get-entity-with-petname)
3387                     wl-folder-entity-hashtb))
3388               nil nil (or init wl-default-spec)
3389               'wl-read-folder-hist)))
3390     (if (or (string= fld wl-default-spec)
3391             (string= fld ""))
3392         (setq fld default))
3393     (setq fld (elmo-string (wl-folder-get-realname fld)))
3394     (if (string-match "\n" fld)
3395         (error "Not supported folder name: %s" fld))
3396     (unless no-create
3397       (if ignore-error
3398           (ignore-errors (wl-folder-confirm-existence fld))
3399         (wl-folder-confirm-existence fld)))
3400     fld))
3401
3402 (defun wl-summary-print-destination (msg-num folder)
3403   "Print refile destination on line."
3404   (wl-summary-remove-destination)
3405   (let ((inhibit-read-only t)
3406         (folder (copy-sequence folder))
3407         (buffer-read-only nil)
3408         len rs re c)
3409     (setq len (string-width folder))
3410     (if (< len 1) ()
3411       (end-of-line)
3412       (setq re (point))
3413       (setq c 0)
3414       (while (< c len)
3415         (forward-char -1)
3416         (setq c (+ c (char-width (following-char)))))
3417       (and (> c len) (setq folder (concat " " folder)))
3418       (setq rs (point))
3419       (put-text-property rs re 'invisible t)
3420       (put-text-property rs re 'wl-summary-destination t)
3421       (goto-char re)
3422       (wl-highlight-refile-destination-string folder)
3423       (insert folder)
3424       (set-buffer-modified-p nil))))
3425
3426 ;; override.
3427 (when wl-on-nemacs
3428   (defun wl-summary-print-destination (msg-num &optional folder))
3429   (defun wl-summary-remove-destination ()))
3430
3431 (defsubst wl-summary-get-mark (number)
3432   "Return a temporal mark of message specified by NUMBER."
3433   (or (and (memq number wl-summary-buffer-delete-list) "D")
3434       (and (assq number wl-summary-buffer-copy-list) "O")
3435       (and (assq number wl-summary-buffer-refile-list) "o")
3436       (and (memq number wl-summary-buffer-target-mark-list) "*")))
3437
3438 (defsubst wl-summary-reserve-temp-mark-p (mark)
3439   "Return t if temporal MARK should be reserved."
3440   (member mark wl-summary-reserve-mark-list))
3441
3442 (defun wl-summary-refile (&optional dst number)
3443   "Put refile mark on current line message.
3444 If optional argument DST is specified, put mark without asking
3445 destination folder.
3446 If optional argument NUMBER is specified, mark message specified by NUMBER.
3447
3448 If folder is read-only, message should be copied.
3449 See `wl-refile-policy-alist' for more details."
3450   (interactive)
3451   (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
3452                                          wl-summary-buffer-folder-name)))
3453     (cond ((eq policy 'copy)
3454            (if (interactive-p)
3455                (call-interactively 'wl-summary-copy)
3456              (wl-summary-copy dst number)))
3457           (t
3458            (wl-summary-refile-subr 'refile (interactive-p) dst number)))))
3459
3460 (defun wl-summary-copy (&optional dst number)
3461   "Put copy mark on current line message.
3462 If optional argument DST is specified, put mark without asking
3463 destination folder.
3464 If optional argument NUMBER is specified, mark message specified by NUMBER."
3465   (interactive)
3466   (wl-summary-refile-subr 'copy (interactive-p) dst number))
3467
3468 (defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number)
3469   (interactive)
3470   (let* ((buffer-num (wl-summary-message-number))
3471          (msg-num (or number buffer-num))
3472          (msgid (and msg-num
3473                      (cdr (assq msg-num
3474                                 (elmo-msgdb-get-number-alist
3475                                  wl-summary-buffer-msgdb)))))
3476          (entity (and msg-num
3477                       (elmo-msgdb-overview-get-entity
3478                        msg-num wl-summary-buffer-msgdb)))
3479          (variable
3480           (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3481          folder mark already tmp-folder)
3482     (catch 'done
3483       (when (null entity)
3484         ;; msgdb is empty?
3485         (if interactive
3486             (message "Cannot refile."))
3487         (throw 'done nil))
3488       (when (null msg-num)
3489         (if interactive
3490             (message "No message."))
3491         (throw 'done nil))
3492       (when (setq mark (wl-summary-get-mark msg-num))
3493         (when (wl-summary-reserve-temp-mark-p mark)
3494           (if interactive
3495               (error "Already marked as `%s'" mark))
3496           (throw 'done nil)))
3497       (setq folder (and msg-num
3498                         (or dst (wl-summary-read-folder
3499                                  (or (wl-refile-guess entity) wl-trash-folder)
3500                                  (format "for %s" copy-or-refile)))))
3501       ;; Cache folder hack by okada@opaopa.org
3502       (if (and (eq (car (elmo-folder-get-spec
3503                          (wl-folder-get-realname folder))) 'cache)
3504                (not (string= folder
3505                              (setq tmp-folder
3506                                    (concat "'cache/"
3507                                            (elmo-cache-get-path-subr
3508                                             (elmo-msgid-to-cache msgid)))))))
3509           (progn
3510             (setq folder tmp-folder)
3511             (message "Force refile to %s." folder)))
3512       (if (string= folder wl-summary-buffer-folder-name)
3513           (error "Same folder"))
3514       (unless (or (elmo-folder-plugged-p wl-summary-buffer-folder-name)
3515                   (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) 'pipe)
3516                        (elmo-folder-plugged-p
3517                         (elmo-pipe-spec-dst (elmo-folder-get-spec wl-summary-buffer-folder-name))))
3518                   (elmo-cache-exists-p msgid))
3519         (error "Unplugged (no cache or msgid)"))
3520       (if (or (string= folder wl-queue-folder)
3521               (string= folder wl-draft-folder))
3522           (error "Don't %s messages to %s" copy-or-refile folder))
3523       ;; learn for refile.
3524       (if (eq copy-or-refile 'refile)
3525           (wl-refile-learn entity folder))
3526       (wl-summary-unmark msg-num)
3527       (set variable (append
3528                      (symbol-value variable)
3529                      (list (cons msg-num folder))))
3530       (when (or interactive
3531                 (eq number buffer-num))
3532         (wl-summary-mark-line (if (eq copy-or-refile 'refile)
3533                                   "o" "O"))
3534         ;; print refile destination
3535         (wl-summary-print-destination msg-num folder))
3536       (if interactive
3537           (if (eq wl-summary-move-direction-downward nil)
3538               (wl-summary-prev)
3539             (wl-summary-next)))
3540       (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile)))
3541       (setq wl-summary-buffer-prev-refile-destination folder)
3542       msg-num)))
3543
3544 (defun wl-summary-refile-prev-destination ()
3545   "Refile message to previously refiled destination."
3546   (interactive)
3547   (wl-summary-refile wl-summary-buffer-prev-refile-destination
3548                      (wl-summary-message-number))
3549   (if (eq wl-summary-move-direction-downward nil)
3550       (wl-summary-prev)
3551     (wl-summary-next)))
3552
3553 (defun wl-summary-copy-prev-destination ()
3554   "Refile message to previously refiled destination."
3555   (interactive)
3556   (wl-summary-copy wl-summary-buffer-prev-copy-destination
3557                    (wl-summary-message-number))
3558   (if (eq wl-summary-move-direction-downward nil)
3559       (wl-summary-prev)
3560     (wl-summary-next)))
3561
3562 (defsubst wl-summary-no-auto-refile-message-p (msg mark-alist)
3563   (member (cadr (assq msg mark-alist)) wl-summary-auto-refile-skip-marks))
3564
3565 (defun wl-summary-auto-refile (&optional open-all)
3566   "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
3567   (interactive "P")
3568   (message "Marking...")
3569   (save-excursion
3570     (if (and (eq wl-summary-buffer-view 'thread)
3571              open-all)
3572         (wl-thread-open-all))
3573     (let* ((spec wl-summary-buffer-folder-name)
3574            (overview (elmo-msgdb-get-overview
3575                       wl-summary-buffer-msgdb))
3576            (mark-alist (elmo-msgdb-get-mark-alist
3577                         wl-summary-buffer-msgdb))
3578            checked-dsts
3579            (count 0)
3580            number dst thr-entity)
3581       (goto-line 1)
3582       (while (not (eobp))
3583         (setq number (wl-summary-message-number))
3584         (when (and (not (wl-summary-no-auto-refile-message-p number
3585                                                              mark-alist))
3586                    (setq dst
3587                          (wl-folder-get-realname
3588                           (wl-refile-guess-by-rule
3589                            (elmo-msgdb-overview-get-entity
3590                             number wl-summary-buffer-msgdb))))
3591                    (not (equal dst spec)))
3592           (when (not (member dst checked-dsts))
3593             (wl-folder-confirm-existence dst)
3594             (setq checked-dsts (cons dst checked-dsts)))
3595           (if (wl-summary-refile dst number)
3596               (incf count))
3597           (message "Marking...%d message(s)." count))
3598         (if (eq wl-summary-buffer-view 'thread)
3599             ;; process invisible children.
3600             (unless (wl-thread-entity-get-opened
3601                      (setq thr-entity (wl-thread-get-entity number)))
3602               (let ((messages
3603                      (elmo-delete-if
3604                       (function
3605                        (lambda (x)
3606                          (wl-summary-no-auto-refile-message-p
3607                           x mark-alist)))
3608                       (wl-thread-entity-get-descendant thr-entity))))
3609                 (while messages
3610                   (when (and (setq dst
3611                                    (wl-refile-guess-by-rule
3612                                     (elmo-msgdb-overview-get-entity
3613                                      (car messages) wl-summary-buffer-msgdb)))
3614                              (not (equal dst spec)))
3615                     (if (wl-summary-refile dst (car messages))
3616                         (incf count))
3617                     (message "Marking...%d message(s)." count))
3618                   (setq messages (cdr messages))))))
3619         (forward-line))
3620       (if (eq count 0)
3621           (message "No message was marked.")
3622         (message "Marked %d message(s)." count)))))
3623
3624 (defun wl-summary-unmark (&optional number)
3625   "Unmark marks (temporary, refile, copy, delete)of current line.
3626 If optional argument NUMBER is specified, unmark message specified by NUMBER."
3627   (interactive)
3628   (save-excursion
3629     (beginning-of-line)
3630     (let ((inhibit-read-only t)
3631           (buffer-read-only nil)
3632           visible
3633           msg-num
3634           cur-mark
3635           score-mark)
3636       (if number
3637           (setq visible (wl-summary-jump-to-msg number))
3638         (setq visible t))
3639       ;; Delete mark on buffer.
3640       (when (and visible
3641                  (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)"))
3642         (goto-char (match-end 2))
3643         (or number
3644             (setq number (string-to-int (wl-match-buffer 1))))
3645         (setq cur-mark (wl-match-buffer 2))
3646         (if (string= cur-mark " ")
3647             ()
3648           (delete-region (match-beginning 2) (match-end 2))
3649           (if (setq score-mark (wl-summary-get-score-mark number))
3650               (insert score-mark)
3651             (insert " ")))
3652         (if (or (string= cur-mark "o")
3653                 (string= cur-mark "O"))
3654             (wl-summary-remove-destination))
3655         (if wl-summary-highlight
3656             (wl-highlight-summary-current-line nil nil score-mark))
3657         (set-buffer-modified-p nil))
3658       ;; Remove from temporary mark structure.
3659       (and number
3660            (wl-summary-delete-mark number)))))
3661
3662 (defun wl-summary-msg-marked-as-target (msg)
3663   (if (memq msg wl-summary-buffer-target-mark-list)
3664       t))
3665
3666 (defun wl-summary-msg-marked-as-copied (msg)
3667   (assq msg wl-summary-buffer-copy-list))
3668
3669 (defun wl-summary-msg-marked-as-deleted (msg)
3670   (if (memq msg wl-summary-buffer-delete-list)
3671       t))
3672
3673 (defun wl-summary-msg-marked-as-refiled (msg)
3674   (assq msg wl-summary-buffer-refile-list))
3675
3676 (defun wl-summary-target-mark (&optional number)
3677   "Put target mark '*' on current message.
3678 If optional argument NUMBER is specified, mark message specified by NUMBER."
3679   (interactive)
3680   (let* ((buffer-num (wl-summary-message-number))
3681          (msg-num (or number buffer-num))
3682          mark)
3683     (catch 'done
3684       (when (null msg-num)
3685         (if (interactive-p)
3686             (message "No message."))
3687         (throw 'done nil))
3688       (when (setq mark (wl-summary-get-mark msg-num))
3689         (when (wl-summary-reserve-temp-mark-p mark)
3690           (if (interactive-p)
3691               (error "Already marked as `%s'" mark))
3692           (throw 'done nil))
3693         (wl-summary-unmark msg-num))
3694       (if (or (interactive-p)
3695               (eq number buffer-num))
3696           (wl-summary-mark-line "*"))
3697       (setq wl-summary-buffer-target-mark-list
3698             (cons msg-num wl-summary-buffer-target-mark-list))
3699       (if (interactive-p)
3700           (if (eq wl-summary-move-direction-downward nil)
3701               (wl-summary-prev)
3702             (wl-summary-next)))
3703       msg-num)))
3704
3705
3706 (defun wl-summary-refile-region (beg end)
3707   "Put copy mark on messages in the region specified by BEG and END."
3708   (interactive "r")
3709   (wl-summary-refile-region-subr "refile" beg end))
3710
3711 (defun wl-summary-copy-region (beg end)
3712   "Put copy mark on messages in the region specified by BEG and END."
3713   (interactive "r")
3714   (wl-summary-refile-region-subr "copy" beg end))
3715
3716 (defun wl-summary-refile-region-subr (copy-or-refile beg end)
3717   (save-excursion
3718     (save-restriction
3719       (goto-char beg)
3720       ;; guess by first msg
3721       (let* ((msgid (cdr (assq (wl-summary-message-number)
3722                                (elmo-msgdb-get-number-alist
3723                                 wl-summary-buffer-msgdb))))
3724              (function (intern (format "wl-summary-%s" copy-or-refile)))
3725              (entity (assoc msgid (elmo-msgdb-get-overview
3726                                    wl-summary-buffer-msgdb)))
3727              folder)
3728         (if entity
3729             (setq folder (wl-summary-read-folder (wl-refile-guess entity)
3730                                                  (format "for %s"
3731                                                          copy-or-refile))))
3732         (narrow-to-region beg end)
3733         (if (eq wl-summary-buffer-view 'thread)
3734             (progn
3735               (while (not (eobp))
3736                 (let* ((number (wl-summary-message-number))
3737                        (entity (wl-thread-get-entity number))
3738                        children)
3739                   (if (wl-thread-entity-get-opened entity)
3740                       ;; opened...refile line.
3741                       (funcall function folder number)
3742                     ;; closed
3743                     (setq children (wl-thread-get-children-msgs number))
3744                     (while children
3745                       (funcall function folder (pop children))))
3746                   (forward-line 1))))
3747           (while (not (eobp))
3748             (funcall function folder (wl-summary-message-number))
3749             (forward-line 1)))))))
3750
3751 (defun wl-summary-unmark-region (beg end)
3752   (interactive "r")
3753   (save-excursion
3754     (save-restriction
3755       (narrow-to-region beg end)
3756       (goto-char (point-min))
3757       (if (eq wl-summary-buffer-view 'thread)
3758           (progn
3759             (while (not (eobp))
3760               (let* ((number (wl-summary-message-number))
3761                      (entity (wl-thread-get-entity number)))
3762                 (if (wl-thread-entity-get-opened entity)
3763                     ;; opened...unmark line.
3764                     (wl-summary-unmark)
3765                   ;; closed
3766                   (wl-summary-delete-marks-on-buffer
3767                    (wl-thread-get-children-msgs number))))
3768               (forward-line 1)))
3769         (while (not (eobp))
3770           (wl-summary-unmark)
3771           (forward-line 1))))))
3772
3773 (defun wl-summary-mark-region-subr (function beg end)
3774   (save-excursion
3775     (save-restriction
3776       (narrow-to-region beg end)
3777       (goto-char (point-min))
3778       (if (eq wl-summary-buffer-view 'thread)
3779           (progn
3780             (while (not (eobp))
3781               (let* ((number (wl-summary-message-number))
3782                      (entity (wl-thread-get-entity number))
3783                      (wl-summary-move-direction-downward t)
3784                      children)
3785                 (if (wl-thread-entity-get-opened entity)
3786                     ;; opened...delete line.
3787                     (funcall function number)
3788                   ;; closed
3789                   (setq children (wl-thread-get-children-msgs number))
3790                   (while children
3791                     (funcall function (pop children))))
3792                 (forward-line 1))))
3793         (while (not (eobp))
3794           (funcall function (wl-summary-message-number))
3795           (forward-line 1))))))
3796
3797 (defun wl-summary-delete-region (beg end)
3798   (interactive "r")
3799   (wl-summary-mark-region-subr 'wl-summary-delete beg end))
3800
3801 (defun wl-summary-target-mark-region (beg end)
3802   (interactive "r")
3803   (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
3804
3805 (defun wl-summary-target-mark-all ()
3806   (interactive)
3807   (wl-summary-target-mark-region (point-min) (point-max))
3808   (setq wl-summary-buffer-target-mark-list
3809         (mapcar 'car
3810                 (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))))
3811
3812 (defun wl-summary-delete-all-mark (mark)
3813   (goto-char (point-min))
3814   (let ((case-fold-search nil))
3815     (while (re-search-forward (format "^ *[0-9]+%s"
3816                                       (regexp-quote mark)) nil t)
3817       (wl-summary-unmark))
3818     (cond ((string= mark "*")
3819            (setq wl-summary-buffer-target-mark-list nil))
3820           ((string= mark "D")
3821            (setq wl-summary-buffer-delete-list nil))
3822           ((string= mark "O")
3823            (setq wl-summary-buffer-copy-list nil))
3824           ((string= mark "o")
3825            (setq wl-summary-buffer-refile-list nil)))))
3826
3827 (defun wl-summary-unmark-all ()
3828   "Unmark all according to what you input."
3829   (interactive)
3830   (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
3831         cur-mark)
3832     (save-excursion
3833       (while unmarks
3834         (setq cur-mark (char-to-string (car unmarks)))
3835         (wl-summary-delete-all-mark cur-mark)
3836         (setq unmarks (cdr unmarks))))))
3837
3838 (defun wl-summary-target-mark-thread ()
3839   (interactive)
3840   (let (beg end)
3841     (end-of-line)
3842     (wl-summary-goto-top-of-current-thread)
3843     (wl-thread-force-open)
3844     (setq beg (point))
3845     (end-of-line)
3846     (wl-summary-goto-bottom-of-current-thread)
3847 ;;; (forward-line -1)
3848     (beginning-of-line)
3849     (setq end (point))
3850     (wl-summary-target-mark-region beg end)))
3851
3852 (defun wl-summary-target-mark-msgs (msgs)
3853   (while msgs
3854     (if (eq wl-summary-buffer-view 'thread)
3855         (wl-thread-jump-to-msg (car msgs))
3856       (wl-summary-jump-to-msg (car msgs)))
3857     (wl-summary-target-mark (wl-summary-message-number))
3858     (setq msgs (cdr msgs))))
3859
3860 (defun wl-summary-pick (&optional from-list delete-marks)
3861   (interactive)
3862   (let ((result (elmo-msgdb-search
3863                  wl-summary-buffer-folder-name
3864                  (elmo-read-search-condition wl-summary-pick-field-default)
3865                  wl-summary-buffer-msgdb)))
3866     (if delete-marks
3867       (let ((mlist wl-summary-buffer-target-mark-list))
3868         (while mlist
3869           (when (wl-summary-jump-to-msg (car mlist))
3870             (wl-summary-unmark))
3871           (setq mlist (cdr mlist)))
3872         (setq wl-summary-buffer-target-mark-list nil)))
3873     (if from-list
3874         (setq result (elmo-list-filter from-list result)))
3875     (message "%d message(s) are picked." (length result))
3876     (if (null result)
3877         (message "No message was picked.")
3878       (wl-summary-target-mark-msgs result))))
3879
3880 (defun wl-summary-unvirtual ()
3881   "Exit from current virtual folder."
3882   (interactive)
3883   (if (eq 'filter
3884           (elmo-folder-get-type wl-summary-buffer-folder-name))
3885       (wl-summary-goto-folder-subr (nth 2 (elmo-folder-get-spec
3886                                            wl-summary-buffer-folder-name))
3887                                    'update nil nil t)
3888     (error "This folder is not filtered")))
3889
3890 (defun wl-summary-virtual (&optional arg)
3891   "Goto virtual folder.
3892 If ARG, exit virtual folder."
3893   (interactive "P")
3894   (if arg
3895       (wl-summary-unvirtual)
3896     (wl-summary-goto-folder-subr (concat "/"
3897                                          (elmo-read-search-condition
3898                                           wl-summary-pick-field-default)
3899                                          "/"
3900                                          wl-summary-buffer-folder-name)
3901                                  'update nil nil t)))
3902
3903 (defun wl-summary-delete-all-temp-marks ()
3904   (interactive)
3905   (save-excursion
3906     (goto-char (point-min))
3907     (message "Unmarking...")
3908     (while (not (eobp))
3909       (wl-summary-unmark)
3910       (forward-line))
3911     (message "Unmarking...done")
3912     (setq wl-summary-buffer-target-mark-list nil)
3913     (setq wl-summary-buffer-delete-list nil)
3914     (setq wl-summary-buffer-refile-list nil)
3915     (setq wl-summary-buffer-copy-list nil)))
3916
3917 (defun wl-summary-delete-mark (number)
3918   "Delete temporary mark of the message specified by NUMBER."
3919   (cond
3920    ((memq number wl-summary-buffer-target-mark-list)
3921     (setq wl-summary-buffer-target-mark-list
3922           (delq number wl-summary-buffer-target-mark-list)))
3923    ((memq number wl-summary-buffer-delete-list)
3924     (setq wl-summary-buffer-delete-list
3925           (delq number wl-summary-buffer-delete-list)))
3926    (t
3927     (let (pair)
3928       (cond
3929        ((setq pair (assq number wl-summary-buffer-copy-list))
3930         (setq wl-summary-buffer-copy-list
3931               (delq pair wl-summary-buffer-copy-list)))
3932        ((setq pair (assq number wl-summary-buffer-refile-list))
3933         (setq wl-summary-buffer-refile-list
3934               (delq pair wl-summary-buffer-refile-list))))))))
3935
3936 (defun wl-summary-mark-line (mark)
3937   "Put MARK on current line.  Return message number."
3938   (save-excursion
3939     (beginning-of-line)
3940     (let ((inhibit-read-only t)
3941           (buffer-read-only nil)
3942           msg-num
3943           cur-mark)
3944       (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
3945         (setq msg-num  (string-to-int (wl-match-buffer 1)))
3946         (setq cur-mark (wl-match-buffer 2))
3947         (goto-char (match-end 1))
3948         (delete-region (match-beginning 2) (match-end 2))
3949 ;;;     (wl-summary-delete-mark msg-num)
3950         (insert mark)
3951         (if wl-summary-highlight
3952             (wl-highlight-summary-current-line nil nil t))
3953         (set-buffer-modified-p nil)
3954         msg-num))))
3955
3956 (defun wl-summary-target-mark-delete ()
3957   (interactive)
3958   (save-excursion
3959     (goto-char (point-min))
3960     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3961           number mlist)
3962       (while (re-search-forward regexp nil t)
3963         (let (wl-summary-buffer-disp-msg)
3964           (when (setq number (wl-summary-message-number))
3965             (wl-summary-delete number)
3966             (setq wl-summary-buffer-target-mark-list
3967                   (delq number wl-summary-buffer-target-mark-list)))))
3968       (setq mlist wl-summary-buffer-target-mark-list)
3969       (while mlist
3970         (wl-append wl-summary-buffer-delete-list (list (car mlist)))
3971         (setq wl-summary-buffer-target-mark-list
3972               (delq (car mlist) wl-summary-buffer-target-mark-list))
3973         (setq mlist (cdr mlist))))))
3974
3975 (defun wl-summary-target-mark-prefetch ()
3976   (interactive)
3977   (save-excursion
3978     (let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
3979            (inhibit-read-only t)
3980            (buffer-read-only nil)
3981            (count 0)
3982            (length (length mlist))
3983            (pos (point))
3984            skipped
3985            new-mark)
3986       (while mlist
3987         (setq new-mark (wl-summary-prefetch-msg (car mlist)))
3988         (if new-mark
3989             (progn
3990               (message "Prefetching... %d/%d message(s)"
3991                        (setq count (+ 1 count)) length)
3992               (when (wl-summary-jump-to-msg (car mlist))
3993                 (wl-summary-unmark)
3994                 (when new-mark
3995                   (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)")
3996                     (delete-region (match-beginning 1) (match-end 1)))
3997                   (goto-char (match-beginning 1))
3998                   (insert new-mark)
3999                   (if wl-summary-highlight
4000                       (wl-highlight-summary-current-line))
4001                   (save-excursion
4002                     (goto-char pos)
4003                     (sit-for 0)))))
4004           (setq skipped (cons (car mlist) skipped)))
4005         (setq mlist (cdr mlist)))
4006       (setq wl-summary-buffer-target-mark-list skipped)
4007       (message "Prefetching... %d/%d message(s)." count length)
4008       (set-buffer-modified-p nil))))
4009
4010 (defun wl-summary-target-mark-refile-subr (copy-or-refile)
4011   (let ((variable
4012          (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
4013         (function
4014          (intern (format "wl-summary-%s" copy-or-refile)))
4015         regexp number msgid entity folder mlist)
4016     (save-excursion
4017       (goto-char (point-min))
4018       (setq regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4019       ;; guess by first mark
4020       (when (re-search-forward regexp nil t)
4021         (setq msgid (cdr (assq (setq number (wl-summary-message-number))
4022                                (elmo-msgdb-get-number-alist
4023                                 wl-summary-buffer-msgdb)))
4024               entity (assoc msgid
4025                             (elmo-msgdb-get-overview
4026                              wl-summary-buffer-msgdb)))
4027         (if (null entity)
4028             (error "Cannot %s" copy-or-refile))
4029         (funcall function
4030                  (setq folder (wl-summary-read-folder
4031                                (wl-refile-guess entity)
4032                                (format "for %s" copy-or-refile)))
4033                  number)
4034         (if number
4035             (setq wl-summary-buffer-target-mark-list
4036                   (delq number wl-summary-buffer-target-mark-list)))
4037         (while (re-search-forward regexp nil t)
4038           (let (wl-summary-buffer-disp-msg)
4039             (when (setq number (wl-summary-message-number))
4040               (funcall function folder number)
4041               (setq wl-summary-buffer-target-mark-list
4042                     (delq number wl-summary-buffer-target-mark-list)))))
4043         ;; process invisible messages.
4044         (setq mlist wl-summary-buffer-target-mark-list)
4045         (while mlist
4046           (set variable
4047                (append (symbol-value variable)
4048                        (list (cons (car mlist) folder))))
4049           (setq wl-summary-buffer-target-mark-list
4050                 (delq (car mlist) wl-summary-buffer-target-mark-list))
4051           (setq mlist (cdr mlist)))))))
4052
4053 (defun wl-summary-target-mark-copy ()
4054   (interactive)
4055   (wl-summary-target-mark-refile-subr "copy"))
4056
4057 (defun wl-summary-target-mark-refile ()
4058   (interactive)
4059   (wl-summary-target-mark-refile-subr "refile"))
4060
4061 (defun wl-summary-target-mark-mark-as-read ()
4062   (interactive)
4063   (save-excursion
4064     (goto-char (point-min))
4065     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4066           (inhibit-read-only t)
4067           (buffer-read-only nil)
4068           number mlist)
4069       (while (re-search-forward regexp nil t)
4070         (let (wl-summary-buffer-disp-msg)
4071           ;; delete target-mark from buffer.
4072           (delete-region (match-beginning 1) (match-end 1))
4073           (insert " ")
4074           (setq number (wl-summary-mark-as-read t))
4075           (if wl-summary-highlight
4076               (wl-highlight-summary-current-line))
4077           (if number
4078               (setq wl-summary-buffer-target-mark-list
4079                     (delq number wl-summary-buffer-target-mark-list)))))
4080       (setq mlist wl-summary-buffer-target-mark-list)
4081       (while mlist
4082         (wl-summary-mark-as-read t nil nil (car mlist))
4083         (setq wl-summary-buffer-target-mark-list
4084               (delq (car mlist) wl-summary-buffer-target-mark-list))
4085         (setq mlist (cdr mlist)))
4086       (wl-summary-count-unread
4087        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4088       (wl-summary-update-modeline))))
4089
4090 (defun wl-summary-target-mark-mark-as-unread ()
4091   (interactive)
4092   (save-excursion
4093     (goto-char (point-min))
4094     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4095           (inhibit-read-only t)
4096           (buffer-read-only nil)
4097           number mlist)
4098       (while (re-search-forward regexp nil t)
4099         (let (wl-summary-buffer-disp-msg)
4100           ;; delete target-mark from buffer.
4101           (delete-region (match-beginning 1) (match-end 1))
4102           (insert " ")
4103           (setq number (wl-summary-mark-as-unread))
4104           (if wl-summary-highlight
4105               (wl-highlight-summary-current-line))
4106           (if number
4107               (setq wl-summary-buffer-target-mark-list
4108                     (delq number wl-summary-buffer-target-mark-list)))))
4109       (setq mlist wl-summary-buffer-target-mark-list)
4110       (while mlist
4111         (wl-summary-mark-as-unread (car mlist))
4112 ;;;     (wl-thread-msg-mark-as-unread (car mlist))
4113         (setq wl-summary-buffer-target-mark-list
4114               (delq (car mlist) wl-summary-buffer-target-mark-list))
4115         (setq mlist (cdr mlist)))
4116       (wl-summary-count-unread
4117        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4118       (wl-summary-update-modeline))))
4119
4120 (defun wl-summary-target-mark-mark-as-important ()
4121   (interactive)
4122   (save-excursion
4123     (goto-char (point-min))
4124     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4125           (inhibit-read-only t)
4126           (buffer-read-only nil)
4127           number mlist)
4128       (while (re-search-forward regexp nil t)
4129         (let (wl-summary-buffer-disp-msg)
4130           ;; delete target-mark from buffer.
4131           (delete-region (match-beginning 1) (match-end 1))
4132           (insert " ")
4133           (setq number (wl-summary-mark-as-important))
4134           (if wl-summary-highlight
4135               (wl-highlight-summary-current-line))
4136           (if number
4137               (setq wl-summary-buffer-target-mark-list
4138                     (delq number wl-summary-buffer-target-mark-list)))))
4139       (setq mlist wl-summary-buffer-target-mark-list)
4140       (while mlist
4141         (wl-summary-mark-as-important (car mlist))
4142         (wl-thread-msg-mark-as-important (car mlist))
4143         (setq wl-summary-buffer-target-mark-list
4144               (delq (car mlist) wl-summary-buffer-target-mark-list))
4145         (setq mlist (cdr mlist)))
4146       (wl-summary-count-unread
4147        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4148       (wl-summary-update-modeline))))
4149
4150 (defun wl-summary-target-mark-save ()
4151   (interactive)
4152   (save-excursion
4153     (goto-char (point-min))
4154     (let ((wl-save-dir
4155            (wl-read-directory-name "Save to directory: " wl-tmp-dir))
4156           (regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4157           number mlist)
4158       (if (null (file-exists-p wl-save-dir))
4159           (make-directory wl-save-dir))
4160       (while (re-search-forward regexp nil t)
4161         (let (wl-summary-buffer-disp-msg)
4162           (setq number (wl-summary-save t wl-save-dir))
4163           (wl-summary-unmark)
4164           (if number
4165               (setq wl-summary-buffer-target-mark-list
4166                     (delq number wl-summary-buffer-target-mark-list))))))))
4167
4168 (defun wl-summary-target-mark-pick ()
4169   (interactive)
4170   (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
4171
4172 (defun wl-summary-mark-as-read (&optional notcrosses
4173                                           leave-server-side-mark-untouched
4174                                           displayed
4175                                           number
4176                                           cached)
4177   (interactive)
4178   (save-excursion
4179     (let* (eol
4180            (inhibit-read-only t)
4181            (buffer-read-only nil)
4182            (folder wl-summary-buffer-folder-name)
4183            (msgdb wl-summary-buffer-msgdb)
4184            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4185 ;;;        (number-alist (elmo-msgdb-get-number-alist msgdb))
4186            (case-fold-search nil)
4187            mark stat visible uncached new-mark marked)
4188       (if number
4189           (progn
4190             (setq visible (wl-summary-jump-to-msg number))
4191             (setq mark (cadr (assq number mark-alist))))
4192         (setq visible t))
4193       (beginning-of-line)
4194       (if (or (not visible)
4195               (looking-at
4196                (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
4197                        (regexp-quote wl-summary-read-uncached-mark)
4198                        (regexp-quote wl-summary-unread-uncached-mark)
4199                        (regexp-quote wl-summary-unread-cached-mark)
4200                        (regexp-quote wl-summary-new-mark))))
4201           (progn
4202             (setq mark (or mark (wl-match-buffer 2)))
4203             (when mark
4204               (cond
4205                ((string= mark wl-summary-new-mark) ; N
4206                 (setq stat 'new)
4207                 (setq uncached t))
4208                ((string= mark wl-summary-unread-uncached-mark) ; U
4209                 (setq stat 'unread)
4210                 (setq uncached t))
4211                ((string= mark wl-summary-unread-cached-mark)  ; !
4212                 (setq stat 'unread))
4213                (t
4214                 ;; no need to mark server.
4215                 (setq leave-server-side-mark-untouched t))))
4216             (setq number (or number (string-to-int (wl-match-buffer 1))))
4217             ;; set server side mark...
4218             (setq new-mark (if (and uncached
4219                                     (if (elmo-use-cache-p folder number)
4220                                         (not (elmo-folder-local-p folder)))
4221                                     (not cached))
4222                                wl-summary-read-uncached-mark
4223                              nil))
4224             (if (not leave-server-side-mark-untouched)
4225                 (setq marked (elmo-mark-as-read folder
4226                                                 (list number) msgdb)))
4227             (if (or leave-server-side-mark-untouched
4228                     marked)
4229                 (progn
4230                   (cond ((eq stat 'unread)
4231                          (setq wl-summary-buffer-unread-count
4232                                (1- wl-summary-buffer-unread-count)))
4233                         ((eq stat 'new)
4234                          (setq wl-summary-buffer-new-count
4235                                (1- wl-summary-buffer-new-count))))
4236                   (wl-summary-update-modeline)
4237                   (wl-folder-update-unread
4238                    folder
4239                    (+ wl-summary-buffer-unread-count
4240                       wl-summary-buffer-new-count))
4241                   (when (or stat cached)
4242                     (when visible
4243                       (goto-char (match-end 2))
4244                       (delete-region (match-beginning 2) (match-end 2))
4245                       (insert (or new-mark " ")))
4246                     (setq mark-alist
4247                           (elmo-msgdb-mark-set mark-alist number new-mark))
4248                     (elmo-msgdb-set-mark-alist msgdb mark-alist)
4249                     (wl-summary-set-mark-modified))
4250                   (if (and visible wl-summary-highlight)
4251                       (wl-highlight-summary-current-line nil nil t))
4252                   (if (not notcrosses)
4253                       (wl-summary-set-crosspost nil
4254                                                 (and wl-summary-buffer-disp-msg
4255                                                      (interactive-p)))))
4256               (if mark (message "Warning: Changing mark failed.")))))
4257       (set-buffer-modified-p nil)
4258       (if stat
4259           (run-hooks 'wl-summary-unread-message-hook))
4260       number ;return value
4261       )))
4262
4263 (defun wl-summary-mark-as-important (&optional number
4264                                                mark
4265                                                no-server-update)
4266   (interactive)
4267   (if (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
4268           'internal)
4269       (error "Cannot process mark in this folder"))
4270   (save-excursion
4271     (let* (eol
4272           (inhibit-read-only t)
4273           (buffer-read-only nil)
4274           (folder wl-summary-buffer-folder-name)
4275           (msgdb wl-summary-buffer-msgdb)
4276           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4277           (number-alist (elmo-msgdb-get-number-alist msgdb))
4278           message-id visible)
4279       (if number
4280           (progn
4281             (setq visible (wl-summary-jump-to-msg number))
4282             (setq mark (or mark (cadr (assq number mark-alist)))))
4283         (setq visible t))
4284       (when visible
4285         (if (null (wl-summary-message-number))
4286             (progn
4287               (message "No message.")
4288               (setq visible nil))
4289           (end-of-line)
4290           (setq eol (point))
4291           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
4292                                       "..../..") nil t)) ; set cursor line
4293         )
4294       (beginning-of-line)
4295       (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)
4296           (progn
4297             (setq number (or number (string-to-int (wl-match-buffer 1))))
4298             (setq mark (or mark (wl-match-buffer 2)))
4299             (setq message-id (cdr (assq number number-alist)))
4300             (if (string= mark wl-summary-important-mark)
4301                 (progn
4302                   ;; server side mark
4303                   (unless no-server-update
4304                     (elmo-unmark-important folder (list number) msgdb)
4305                     (elmo-msgdb-global-mark-delete message-id))
4306                   ;; Remove cache if local folder.
4307                   (if (elmo-folder-local-p folder)
4308                       (elmo-cache-delete message-id folder number))
4309                   (when visible
4310                     (delete-region (match-beginning 2) (match-end 2))
4311                     (insert " "))
4312                   (setq mark-alist
4313                         (elmo-msgdb-mark-set mark-alist
4314                                              number
4315                                              nil)))
4316               ;; server side mark
4317               (unless no-server-update
4318                 (elmo-mark-as-important folder (list number) msgdb))
4319               (when visible
4320                 (delete-region (match-beginning 2) (match-end 2))
4321                 (insert wl-summary-important-mark))
4322               (setq mark-alist
4323                     (elmo-msgdb-mark-set mark-alist
4324                                          (string-to-int (wl-match-buffer 1))
4325                                          wl-summary-important-mark))
4326               ;; Force cache message!!
4327               (save-match-data
4328                 (unless (elmo-cache-exists-p message-id)
4329                   (elmo-force-cache-msg folder number message-id
4330                                         (elmo-msgdb-get-location msgdb))))
4331               (unless no-server-update
4332                 (elmo-msgdb-global-mark-set message-id
4333                                             wl-summary-important-mark)))
4334             (elmo-msgdb-set-mark-alist msgdb mark-alist)
4335             (wl-summary-set-mark-modified)))
4336       (if (and visible wl-summary-highlight)
4337           (wl-highlight-summary-current-line nil nil t))))
4338   (set-buffer-modified-p nil)
4339   number)
4340
4341 (defsubst wl-summary-format-date (date-string)
4342   (condition-case nil
4343       (let ((datevec (timezone-fix-time date-string nil
4344                                         wl-summary-fix-timezone)))
4345         (format "%02d/%02d(%s)%02d:%02d"
4346                 (aref datevec 1)
4347                 (aref datevec 2)
4348                 (elmo-date-get-week (aref datevec 0)
4349                                     (aref datevec 1)
4350                                     (aref datevec 2))
4351                 (aref datevec 3)
4352                 (aref datevec 4)))
4353     (error "??/??(??)??:??")))
4354
4355 (defun wl-summary-overview-create-summary-line (msg
4356                                                 entity
4357                                                 parent-entity
4358                                                 depth
4359                                                 mark-alist
4360                                                 &optional
4361                                                 children-num
4362                                                 temp-mark thr-entity
4363                                                 subject-differ)
4364   (let ((wl-mime-charset wl-summary-buffer-mime-charset)
4365         (elmo-mime-charset wl-summary-buffer-mime-charset)
4366         no-parent before-indent
4367         from subject parent-raw-subject parent-subject
4368         mark line
4369         (elmo-lang wl-summary-buffer-weekday-name-lang)
4370         (children-num (if children-num (int-to-string children-num)))
4371         (thr-str "")
4372         linked)
4373     (when thr-entity
4374       (setq thr-str (wl-thread-make-indent-string thr-entity))
4375       (setq linked (wl-thread-entity-get-linked thr-entity)))
4376     (if (string= thr-str "")
4377         (setq no-parent t)) ; no parent
4378     (if (and wl-summary-width
4379              wl-summary-indent-length-limit
4380              (< wl-summary-indent-length-limit
4381                 (string-width thr-str)))
4382         (setq thr-str (wl-set-string-width
4383                        wl-summary-indent-length-limit
4384                        thr-str)))
4385     (setq from
4386           (wl-set-string-width
4387            (if children-num
4388                (- wl-from-width (length children-num) 2)
4389              wl-from-width)
4390            (elmo-delete-char ?\n
4391                              (wl-summary-from-func-internal
4392                               (elmo-msgdb-overview-entity-get-from entity)))))
4393     (setq subject
4394           (elmo-delete-char ?\n
4395                             (or (elmo-msgdb-overview-entity-get-subject
4396                                  entity)
4397                                 wl-summary-no-subject-message)))
4398     (setq parent-raw-subject
4399           (elmo-msgdb-overview-entity-get-subject parent-entity))
4400     (setq parent-subject
4401           (if parent-raw-subject
4402               (elmo-delete-char ?\n parent-raw-subject)))
4403     (setq mark (or (cadr (assq msg mark-alist)) " "))
4404     (setq line
4405           (concat
4406            (setq before-indent
4407                  (format (concat "%"
4408                                  (int-to-string
4409                                   wl-summary-buffer-number-column)
4410                                  "s%s%s%s %s")
4411                          msg
4412                          (or temp-mark " ")
4413                          mark
4414                          (wl-summary-format-date
4415                           (elmo-msgdb-overview-entity-get-date entity))
4416                          (if thr-str thr-str "")))
4417            (format (if linked
4418                        "<%s > %s"
4419                      "[%s ] %s")
4420                    (if children-num
4421                        (concat "+" children-num ": " from)
4422                      (concat " " from))
4423                    (progn
4424                      (setq subject
4425                            (if (or no-parent
4426                                    (null parent-subject)
4427                                    (not (wl-summary-subject-equal
4428                                          subject parent-subject)))
4429                                (wl-summary-subject-func-internal subject) ""))
4430                      (if (and (not wl-summary-width)
4431                               wl-subject-length-limit)
4432                          (truncate-string subject wl-subject-length-limit)
4433                        subject)))))
4434     (if wl-summary-width (setq line
4435                                (wl-set-string-width
4436                                 (- wl-summary-width 1) line)))
4437     (if wl-summary-highlight
4438         (wl-highlight-summary-line-string line
4439                                           mark
4440                                           temp-mark
4441                                           thr-str))
4442     line))
4443
4444 (defsubst wl-summary-buffer-number-column-detect (update)
4445   (let (end)
4446     (save-excursion
4447       (goto-char (point-min))
4448       (setq wl-summary-buffer-number-column
4449             (or
4450              (if (and update
4451                       (setq end (if (re-search-forward "^ *[0-9]+[^0-9]" nil t)
4452                                     (point))))
4453                  (- end (progn (beginning-of-line) (point)) 1))
4454              (wl-get-assoc-list-value wl-summary-number-column-alist
4455                                       wl-summary-buffer-folder-name)
4456              wl-summary-default-number-column))
4457       (setq wl-summary-buffer-number-regexp
4458             (wl-repeat-string "." wl-summary-buffer-number-column)))))
4459
4460 (defsubst wl-summary-proc-wday (wday-str year month mday)
4461   (save-match-data
4462     (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
4463         (wl-match-string 1 wday-str)
4464       (elmo-date-get-week year month mday))))
4465
4466 (defmacro wl-summary-cursor-move-regex ()
4467   (` (let ((mark-alist
4468             (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
4469                 (cond ((eq wl-summary-move-order 'new)
4470                        (list
4471                         (list
4472                          wl-summary-new-mark)
4473                         (list
4474                          wl-summary-unread-uncached-mark
4475                          wl-summary-unread-cached-mark
4476                          wl-summary-important-mark)))
4477                       ((eq wl-summary-move-order 'unread)
4478                        (list
4479                        (list
4480                         wl-summary-unread-uncached-mark
4481                         wl-summary-unread-cached-mark
4482                         wl-summary-new-mark)
4483                        (list
4484                         wl-summary-important-mark)))
4485                       (t
4486                        (list
4487                        (list
4488                         wl-summary-unread-uncached-mark
4489                         wl-summary-unread-cached-mark
4490                         wl-summary-new-mark
4491                         wl-summary-important-mark))))
4492               (cond ((eq wl-summary-move-order 'unread)
4493                      (list
4494                      (list
4495                       wl-summary-unread-cached-mark)
4496                      (list
4497                       wl-summary-important-mark)))
4498                     (t
4499                      (list
4500                      (list
4501                       wl-summary-unread-cached-mark
4502                       wl-summary-important-mark)))))))
4503        (mapcar
4504         (function
4505          (lambda (mark-list)
4506            (concat wl-summary-message-regexp
4507                    ".\\("
4508                    (mapconcat 'regexp-quote
4509                               mark-list
4510                               "\\|")
4511                    "\\)\\|"
4512                    wl-summary-message-regexp "\\*")))
4513         mark-alist))))
4514
4515 ;;
4516 ;; Goto unread or important
4517 ;;
4518 (defun wl-summary-cursor-up (&optional hereto)
4519   (interactive "P")
4520   (if (and (not wl-summary-buffer-target-mark-list)
4521            (eq wl-summary-buffer-view 'thread))
4522       (progn
4523         (if (eobp)
4524             (forward-line -1))
4525         (wl-thread-jump-to-prev-unread hereto))
4526     (if hereto
4527         (end-of-line)
4528       (beginning-of-line))
4529     (let ((case-fold-search nil)
4530           regex-list)
4531       (setq regex-list (wl-summary-cursor-move-regex))
4532       (catch 'done
4533         (while regex-list
4534           (when (re-search-backward
4535                  (car regex-list)
4536                  nil t nil)
4537             (beginning-of-line)
4538             (throw 'done t))
4539           (setq regex-list (cdr regex-list)))
4540         (beginning-of-line)
4541         (throw 'done nil)))))
4542
4543 ;;
4544 ;; Goto unread or important
4545 ;; returns t if next message exists in this folder.
4546 (defun wl-summary-cursor-down (&optional hereto)
4547   (interactive "P")
4548   (if (and (null wl-summary-buffer-target-mark-list)
4549            (eq wl-summary-buffer-view 'thread))
4550       (wl-thread-jump-to-next-unread hereto)
4551     (if hereto
4552         (beginning-of-line)
4553       (end-of-line))
4554     (let ((case-fold-search nil)
4555           regex-list)
4556       (setq regex-list (wl-summary-cursor-move-regex))
4557       (catch 'done
4558         (while regex-list
4559           (when (re-search-forward
4560                  (car regex-list)
4561                  nil t nil)
4562             (beginning-of-line)
4563             (throw 'done t))
4564           (setq regex-list (cdr regex-list)))
4565         (beginning-of-line)
4566         (throw 'done nil)))))
4567
4568 (defun wl-summary-save-view-cache ()
4569   (save-excursion
4570     (let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
4571            (cache (expand-file-name wl-summary-cache-file dir))
4572            (view (expand-file-name wl-summary-view-file dir))
4573            (save-view wl-summary-buffer-view)
4574            (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
4575            (charset wl-summary-buffer-mime-charset))
4576       (if (file-directory-p dir)
4577           (); ok.
4578         (if (file-exists-p dir)
4579             (error "File %s already exists" dir)
4580           (elmo-make-directory dir)))
4581       (if (eq save-view 'thread)
4582           (wl-thread-save-entity dir))
4583       (unwind-protect
4584           (progn
4585             (when (file-writable-p cache)
4586               (copy-to-buffer tmp-buffer (point-min) (point-max))
4587               (with-current-buffer tmp-buffer
4588                 (widen)
4589                 (encode-mime-charset-region
4590                  (point-min) (point-max) charset)
4591                 (write-region-as-binary (point-min)(point-max)
4592                                         cache nil 'no-msg)))
4593             (when (file-writable-p view) ; 'thread or 'sequence
4594               (save-excursion
4595                 (set-buffer tmp-buffer)
4596                 (erase-buffer)
4597                 (prin1 save-view tmp-buffer)
4598                 (princ "\n" tmp-buffer)
4599                 (write-region (point-min) (point-max) view nil 'no-msg))))
4600         ;; kill tmp buffer.
4601         (kill-buffer tmp-buffer)))))
4602
4603 (defsubst wl-summary-get-sync-range (folder)
4604   (intern (or (and
4605                (elmo-folder-plugged-p folder)
4606                (wl-get-assoc-list-value
4607                 wl-folder-sync-range-alist
4608                 folder))
4609               wl-default-sync-range)))
4610
4611 ;; redefined for wl-summary-sync-update
4612 (defun wl-summary-input-range (folder)
4613   "returns update or all or rescan."
4614   ;; for the case when parts are expanded in the bottom of the folder
4615   (let ((input-range-list '("update" "all" "rescan" "first:" "last:"
4616                             "no-sync" "rescan-noscore" "all-shown"))
4617         (default (or (wl-get-assoc-list-value
4618                       wl-folder-sync-range-alist
4619                       folder)
4620                      wl-default-sync-range))
4621         range)
4622     (setq range
4623           (completing-read (format "Range (%s): " default)
4624                            (mapcar
4625                             (function (lambda (x) (cons x x)))
4626                             input-range-list)))
4627     (if (string= range "")
4628         default
4629       range)))
4630
4631 (defun wl-summary-toggle-disp-folder (&optional arg)
4632   (interactive)
4633   (let (fld-buf fld-win
4634         (view-message-buffer (wl-message-get-buffer-create))
4635         (cur-buf (current-buffer))
4636         (summary-win (get-buffer-window (current-buffer))))
4637     (cond
4638      ((eq arg 'on)
4639       (setq wl-summary-buffer-disp-folder t)
4640       ;; hide your folder window
4641       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4642           (if (setq fld-win (get-buffer-window fld-buf))
4643               (delete-window fld-win))))
4644      ((eq arg 'off)
4645       (setq wl-summary-buffer-disp-folder nil)
4646       ;; hide your wl-message window!
4647       (wl-select-buffer view-message-buffer)
4648       (delete-window)
4649       (select-window (get-buffer-window cur-buf))
4650       ;; display wl-folder window!!
4651       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4652           (if (setq fld-win (get-buffer-window fld-buf))
4653               ;; folder win is already displayed.
4654               (select-window fld-win)
4655             ;; folder win is not displayed.
4656             (switch-to-buffer fld-buf))
4657         ;; no folder buf
4658         (wl-folder))
4659       ;; temporarily delete summary-win.
4660       (if summary-win
4661           (delete-window summary-win))
4662       (split-window-horizontally wl-folder-window-width)
4663       (other-window 1)
4664       (switch-to-buffer cur-buf))
4665      (t
4666       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4667           (if (setq fld-win (get-buffer-window fld-buf))
4668               (setq wl-summary-buffer-disp-folder nil)
4669             (setq wl-summary-buffer-disp-folder t)))
4670       (if (not wl-summary-buffer-disp-folder)
4671           ;; hide message window
4672           (let ((mes-win (get-buffer-window view-message-buffer))
4673                 (wl-stay-folder-window t))
4674             (if mes-win (delete-window mes-win))
4675             ;; hide your folder window
4676             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4677                 (if (setq fld-win (get-buffer-window fld-buf))
4678                     (progn
4679                       (delete-window (get-buffer-window cur-buf))
4680                       (select-window fld-win)
4681                       (switch-to-buffer cur-buf))))
4682             (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
4683             ;; resume message window.
4684             (when mes-win
4685               (wl-select-buffer view-message-buffer)
4686               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4687               (select-window (get-buffer-window cur-buf)))
4688             )
4689         ;; hide message window
4690         (let ((mes-win (get-buffer-window view-message-buffer))
4691               (wl-stay-folder-window t))
4692           (if mes-win (delete-window mes-win))
4693           (select-window (get-buffer-window cur-buf))
4694           ;; display wl-folder window!!
4695           (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4696               (if (setq fld-win (get-buffer-window fld-buf))
4697                   ;; folder win is already displayed.
4698                   (select-window fld-win)
4699                 ;; folder win is not displayed...occupy all.
4700                 (switch-to-buffer fld-buf))
4701             ;; no folder buf
4702             (wl-folder))
4703           (split-window-horizontally wl-folder-window-width)
4704           (other-window 1)
4705           (switch-to-buffer cur-buf)
4706           ;; resume message window.
4707           (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
4708           (when mes-win
4709             (wl-select-buffer view-message-buffer)
4710             (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4711             (select-window (get-buffer-window cur-buf))))
4712         ))))
4713   (run-hooks 'wl-summary-toggle-disp-folder-hook))
4714
4715 (defun wl-summary-toggle-disp-msg (&optional arg)
4716   (interactive)
4717   (let (fld-buf fld-win
4718         (view-message-buffer (wl-message-get-buffer-create))
4719         (cur-buf (current-buffer))
4720         summary-win)
4721     (cond
4722      ((eq arg 'on)
4723       (setq wl-summary-buffer-disp-msg t)
4724       ;; hide your folder window
4725       (if (and (not wl-stay-folder-window)
4726                (setq fld-buf (get-buffer wl-folder-buffer-name)))
4727           (if (setq fld-win (get-buffer-window fld-buf))
4728               (delete-window fld-win))))
4729      ((eq arg 'off)
4730       (wl-delete-all-overlays)
4731       (setq wl-summary-buffer-disp-msg nil)
4732       (save-excursion
4733         (wl-select-buffer view-message-buffer)
4734         (delete-window)
4735         (and (get-buffer-window cur-buf)
4736              (select-window (get-buffer-window cur-buf)))
4737         (run-hooks 'wl-summary-toggle-disp-off-hook)))
4738      (t
4739       (if (get-buffer-window view-message-buffer) ; already displayed
4740           (setq wl-summary-buffer-disp-msg nil)
4741         (setq wl-summary-buffer-disp-msg t))
4742       (if wl-summary-buffer-disp-msg
4743           (progn
4744             (wl-summary-redisplay)
4745 ;;; hide your folder window
4746 ;;;         (setq fld-buf (get-buffer wl-folder-buffer-name))
4747 ;;;         (if (setq fld-win (get-buffer-window fld-buf))
4748 ;;;             (delete-window fld-win)))
4749             (run-hooks 'wl-summary-toggle-disp-on-hook))
4750         (wl-delete-all-overlays)
4751         (save-excursion
4752           (wl-select-buffer view-message-buffer)
4753           (delete-window)
4754           (select-window (get-buffer-window cur-buf))
4755           (run-hooks 'wl-summary-toggle-disp-off-hook))
4756 ;;;     (switch-to-buffer cur-buf)
4757         )))))
4758
4759 (defun wl-summary-next-line-content ()
4760   (interactive)
4761   (let ((cur-buf (current-buffer)))
4762     (wl-summary-toggle-disp-msg 'on)
4763     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4764       (set-buffer cur-buf)
4765       (wl-message-next-page 1))))
4766
4767 (defun wl-summary-prev-line-content ()
4768   (interactive)
4769   (let ((cur-buf (current-buffer)))
4770     (wl-summary-toggle-disp-msg 'on)
4771     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4772       (set-buffer cur-buf)
4773       (wl-message-prev-page 1))))
4774
4775 (defun wl-summary-next-page ()
4776   (interactive)
4777   (wl-message-next-page))
4778
4779 (defun wl-summary-prev-page ()
4780   (interactive)
4781   (wl-message-prev-page))
4782
4783 (defsubst wl-summary-no-mime-p (folder)
4784   (wl-string-match-member folder wl-summary-no-mime-folder-list))
4785
4786 (defun wl-summary-set-message-buffer-or-redisplay (&optional ignore-original)
4787   ;; if current message is not displayed, display it.
4788   ;; return t if exists.
4789   (let ((folder wl-summary-buffer-folder-name)
4790         (number (wl-summary-message-number))
4791         cur-folder cur-number message-last-pos
4792         (view-message-buffer (wl-message-get-buffer-create)))
4793     (save-excursion
4794       (set-buffer view-message-buffer)
4795       (setq cur-folder wl-message-buffer-cur-folder)
4796       (setq cur-number wl-message-buffer-cur-number))
4797     (if (and (not ignore-original)
4798              (not
4799               (and (eq number (wl-message-original-buffer-number))
4800                    (string= folder (wl-message-original-buffer-folder)))))
4801         (progn
4802           (if (wl-summary-no-mime-p folder)
4803               (wl-summary-redisplay-no-mime folder number)
4804             (wl-summary-redisplay-internal folder number))
4805           nil)
4806       (if (and (string= folder (or cur-folder ""))
4807                (eq number (or cur-number 0)))
4808           (progn
4809             (set-buffer view-message-buffer)
4810             t)
4811         (if (wl-summary-no-mime-p folder)
4812             (wl-summary-redisplay-no-mime folder number)
4813           (wl-summary-redisplay-internal folder number))
4814         nil))))
4815
4816 (defun wl-summary-target-mark-forward (&optional arg)
4817   (interactive "P")
4818   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4819         (summary-buf (current-buffer))
4820         (wl-draft-forward t)
4821         start-point
4822         draft-buf)
4823     (wl-summary-jump-to-msg (car mlist))
4824     (wl-summary-forward t)
4825     (setq start-point (point))
4826     (setq draft-buf (current-buffer))
4827     (setq mlist (cdr mlist))
4828     (save-window-excursion
4829       (when mlist
4830         (while mlist
4831           (set-buffer summary-buf)
4832           (wl-summary-jump-to-msg (car mlist))
4833           (wl-summary-redisplay)
4834           (set-buffer draft-buf)
4835           (goto-char (point-max))
4836           (wl-draft-insert-message)
4837           (setq mlist (cdr mlist)))
4838         (wl-draft-body-goto-top)
4839         (wl-draft-enclose-digest-region (point) (point-max)))
4840       (goto-char start-point)
4841       (save-excursion
4842         (set-buffer summary-buf)
4843         (wl-summary-delete-all-temp-marks)))
4844     (run-hooks 'wl-mail-setup-hook)))
4845
4846 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
4847   (interactive "P")
4848   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4849         (summary-buf (current-buffer))
4850         change-major-mode-hook
4851         start-point
4852         draft-buf)
4853     (wl-summary-jump-to-msg (car mlist))
4854     (wl-summary-reply arg t)
4855     (goto-char (point-max))
4856     (setq start-point (point))
4857     (setq draft-buf (current-buffer))
4858     (save-window-excursion
4859       (while mlist
4860         (set-buffer summary-buf)
4861         (wl-summary-jump-to-msg (car mlist))
4862         (wl-summary-redisplay)
4863         (set-buffer draft-buf)
4864         (goto-char (point-max))
4865         (wl-draft-yank-original)
4866         (setq mlist (cdr mlist)))
4867       (goto-char start-point)
4868       (save-excursion
4869         (set-buffer summary-buf)
4870         (wl-summary-delete-all-temp-marks)))
4871     (run-hooks 'wl-mail-setup-hook)))
4872
4873 (defun wl-summary-reply-with-citation (&optional arg)
4874   (interactive "P")
4875   (when (wl-summary-reply arg t)
4876     (goto-char (point-max))
4877     (wl-draft-yank-original)
4878     (run-hooks 'wl-mail-setup-hook)))
4879
4880 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
4881   (interactive)
4882   (let* ((original (wl-summary-message-number))
4883          (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4884          (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
4885          msg otherfld schar
4886          (errmsg
4887           (format "No message with id \"%s\" in the folder." msgid)))
4888     (if (setq msg (car (rassoc msgid number-alist)))
4889 ;;;     (wl-summary-jump-to-msg-internal
4890 ;;;      wl-summary-buffer-folder-name msg 'no-sync)
4891         (progn
4892           (wl-thread-jump-to-msg msg)
4893           t)
4894       ;; for XEmacs!
4895       (if (and elmo-use-database
4896                (setq errmsg
4897                      (format
4898                       "No message with id \"%s\" in the database." msgid))
4899                (setq otherfld (elmo-database-msgid-get msgid)))
4900           (if (cdr (wl-summary-jump-to-msg-internal
4901                     (car otherfld) (nth 1 otherfld) 'no-sync))
4902               t ; succeed.
4903             ;; Back to original.
4904             (wl-summary-jump-to-msg-internal
4905              wl-summary-buffer-folder-name original 'no-sync))
4906         (cond ((eq wl-summary-search-via-nntp 'confirm)
4907                (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
4908                         elmo-default-nntp-server)
4909                (setq schar (read-char))
4910                (cond ((eq schar ?y)
4911                       (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4912                      ((eq schar ?s)
4913                       (wl-summary-jump-to-msg-by-message-id-via-nntp
4914                        msgid
4915                        (read-from-minibuffer "NNTP Server: ")))
4916                      (t
4917                       (message errmsg)
4918                       nil)))
4919               (wl-summary-search-via-nntp
4920                (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4921               (t
4922                (message errmsg)
4923                nil))))))
4924
4925 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4926   (interactive)
4927   (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4928          newsgroups folder ret
4929          user server port type spec)
4930     (if server-spec
4931         (if (string-match "^-" server-spec)
4932             (setq spec (elmo-nntp-get-spec server-spec)
4933                   user (nth 2 spec)
4934                   server (nth 3 spec)
4935                   port (nth 4 spec)
4936                   type (nth 5 spec))
4937           (setq server server-spec)))
4938     (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4939                      msgid
4940                      (or server elmo-default-nntp-server)
4941                      (or user elmo-default-nntp-user)
4942                      (or port elmo-default-nntp-port)
4943                      (or type elmo-default-nntp-stream-type)))
4944       (setq newsgroups (wl-parse-newsgroups ret))
4945       (setq folder (concat "-" (car newsgroups)
4946                            (elmo-nntp-folder-postfix user server port type)))
4947       (catch 'found
4948         (while newsgroups
4949           (if (wl-folder-entity-exists-p (car newsgroups)
4950                                          wl-folder-newsgroups-hashtb)
4951               (throw 'found
4952                      (setq folder (concat "-" (car newsgroups)
4953                                           (elmo-nntp-folder-postfix
4954                                            user server port type)))))
4955           (setq newsgroups (cdr newsgroups)))))
4956     (if ret
4957         (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4958       (message "No message id \"%s\" in nntp server \"%s\"."
4959                msgid (or server elmo-default-nntp-server))
4960       nil)))
4961
4962 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4963   (let (wl-auto-select-first entity)
4964     (if (or (string= folder wl-summary-buffer-folder-name)
4965             (y-or-n-p
4966              (format
4967               "Message was found in the folder \"%s\". Jump to it? "
4968               folder)))
4969         (progn
4970           (unwind-protect
4971               (wl-summary-goto-folder-subr
4972                folder scan-type nil nil t)
4973             (if msgid
4974                 (setq msg
4975                       (car (rassoc msgid
4976                                    (elmo-msgdb-get-number-alist
4977                                     wl-summary-buffer-msgdb)))))
4978             (setq entity (wl-folder-search-entity-by-name folder
4979                                                           wl-folder-entity
4980                                                           'folder))
4981             (if entity
4982                 (wl-folder-set-current-entity-id
4983                  (wl-folder-get-entity-id entity))))
4984           (if (null msg)
4985               (message "Message was not found currently in this folder.")
4986             (setq msg (and (wl-thread-jump-to-msg msg) msg)))
4987           (cons folder msg)))))
4988
4989 (defun wl-summary-jump-to-parent-message (arg)
4990   (interactive "P")
4991   (let ((cur-buf (current-buffer))
4992         (number (wl-summary-message-number))
4993         (regexp "\\(<[^<>]*>\\)[ \t]*$")
4994         (i -1) ;; xxx
4995         msg-id msg-num ref-list ref irt)
4996     (if (null number)
4997         (message "No message.")
4998       (when (eq wl-summary-buffer-view 'thread)
4999         (cond ((and arg (not (numberp arg)))
5000                (setq msg-num
5001                      (wl-thread-entity-get-number
5002                       (wl-thread-entity-get-top-entity
5003                        (wl-thread-get-entity number)))))
5004               ((and arg (numberp arg))
5005                (setq i 0)
5006                (setq msg-num number)
5007                (while (< i arg)
5008                  (setq msg-num
5009                        (wl-thread-entity-get-number
5010                         (wl-thread-entity-get-parent-entity
5011                          (wl-thread-get-entity msg-num))))
5012                  (setq i (1+ i))))
5013               (t (setq msg-num
5014                        (wl-thread-entity-get-number
5015                         (wl-thread-entity-get-parent-entity
5016                          (wl-thread-get-entity number)))))))
5017       (when (null msg-num)
5018         (wl-summary-set-message-buffer-or-redisplay)
5019         (set-buffer (wl-message-get-original-buffer))
5020         (message "Searching parent message...")
5021         (setq ref (std11-field-body "References")
5022               irt (std11-field-body "In-Reply-To"))
5023         (cond
5024          ((and arg (not (numberp arg)) ref (not (string= ref ""))
5025                (string-match regexp ref))
5026           ;; The first message of the thread.
5027           (setq msg-id (wl-match-string 1 ref)))
5028          ;; "In-Reply-To:" has only one msg-id.
5029          ((and (null arg) irt (not (string= irt ""))
5030                (string-match regexp irt))
5031           (setq msg-id (wl-match-string 1 irt)))
5032          ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
5033                (string-match regexp ref))
5034           ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
5035           (while (string-match regexp ref)
5036             (setq ref-list
5037                   (append (list
5038                            (wl-match-string 1 ref))
5039                           ref-list))
5040             (setq ref (substring ref (match-end 0)))
5041             (setq i (1+ i)))
5042           (setq msg-id
5043                 (if (null arg) (nth 0 ref-list) ;; previous
5044                   (if (<= arg i) (nth (1- arg) ref-list)
5045                     (nth i ref-list)))))))
5046       (set-buffer cur-buf)
5047       (cond ((and (null msg-id) (null msg-num))
5048              (message "No parent message!")
5049              nil)
5050             ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
5051              (wl-summary-redisplay)
5052              (message "Searching parent message...done")
5053              t)
5054             ((and msg-num (wl-summary-jump-to-msg msg-num))
5055              (wl-summary-redisplay)
5056              (message "Searching parent message...done")
5057              t)
5058             (t ; failed.
5059              (message "Parent message was not found.")
5060              nil)))))
5061
5062 (defun wl-summary-reply (&optional arg without-setup-hook)
5063   "Reply to current message. Default is \"wide\" reply.
5064 Reply to author if invoked with ARG."
5065   (interactive "P")
5066   (let ((folder wl-summary-buffer-folder-name)
5067         (number (wl-summary-message-number))
5068         (summary-buf (current-buffer))
5069         mes-buf)
5070     (if number
5071         (unwind-protect
5072             (progn
5073               (wl-summary-redisplay-internal folder number)
5074               (wl-select-buffer
5075                (get-buffer (setq mes-buf (wl-current-message-buffer))))
5076               (set-buffer mes-buf)
5077               (goto-char (point-min))
5078               (or wl-draft-use-frame
5079                   (split-window-vertically))
5080               (other-window 1)
5081               (when (setq mes-buf (wl-message-get-original-buffer))
5082                 (wl-draft-reply mes-buf arg summary-buf)
5083                 (unless without-setup-hook
5084                   (run-hooks 'wl-mail-setup-hook)))
5085               t)))))
5086
5087 (defun wl-summary-write ()
5088   "Write a new draft from Summary."
5089   (interactive)
5090   (wl-draft nil nil nil nil nil
5091             nil nil nil nil nil nil (current-buffer))
5092   (run-hooks 'wl-mail-setup-hook)
5093   (mail-position-on-field "To"))
5094
5095 (defvar wl-summary-write-current-folder-functions
5096   '(wl-folder-get-newsgroups
5097     wl-folder-guess-mailing-list-by-refile-rule
5098     wl-folder-guess-mailing-list-by-folder-name)
5099   "Newsgroups or Mailing List address guess functions list.
5100 Call from `wl-summary-write-current-folder'")
5101
5102 (defun wl-summary-write-current-folder (&optional folder)
5103   "Write message to current FOLDER's newsgroup or mailing-list.
5104 Use function list is `wl-summary-write-current-folder-functions'."
5105   (interactive)
5106   (let (newsgroups to cc)
5107     ;; default FOLDER is current buffer folder
5108     (setq folder (or folder wl-summary-buffer-folder-name))
5109     (let ((flist wl-summary-write-current-folder-functions)
5110           guess-list)
5111       (while flist
5112         (setq guess-list (funcall (car flist) folder))
5113         (if (or (nth 0 guess-list)      ; To:
5114 ;;;             (nth 1 guess-list)      ; Cc:
5115                 (nth 2 guess-list))     ; Newsgroups:
5116             (setq flist nil)
5117           (setq flist (cdr flist))))
5118       (if guess-list
5119           (progn
5120             (wl-draft (nth 0 guess-list) ; To:
5121                       nil nil
5122                       (nth 1 guess-list) ; Cc:
5123                       nil
5124                       (nth 2 guess-list)) ; Newsgroups:
5125             (run-hooks 'wl-mail-setup-hook))
5126 ;;;     (error "%s is not newsgroup" folder)
5127         (error "Can't guess by folder %s" folder)))))
5128
5129 (defun wl-summary-forward (&optional without-setup-hook)
5130   ""
5131   (interactive)
5132   (let ((folder wl-summary-buffer-folder-name)
5133         (number (wl-summary-message-number))
5134         (summary-buf (current-buffer))
5135         (wl-draft-forward t)
5136         entity subject num)
5137     (if (null number)
5138         (message "No message.")
5139       (wl-summary-redisplay-internal folder number)
5140       (wl-select-buffer (get-buffer wl-message-buf-name))
5141       (or wl-draft-use-frame
5142           (split-window-vertically))
5143       (other-window 1)
5144       ;; get original subject.
5145       (if summary-buf
5146           (save-excursion
5147             (set-buffer summary-buf)
5148             (setq num (wl-summary-message-number))
5149             (setq entity (assoc (cdr (assq num
5150                                            (elmo-msgdb-get-number-alist
5151                                             wl-summary-buffer-msgdb)))
5152                                 (elmo-msgdb-get-overview
5153                                  wl-summary-buffer-msgdb)))
5154             (and entity
5155                  (setq subject
5156                        (or (elmo-msgdb-overview-entity-get-subject entity)
5157                            "")))))
5158       (wl-draft-forward subject summary-buf)
5159       (unless without-setup-hook
5160         (run-hooks 'wl-mail-setup-hook)))))
5161
5162 (defun wl-summary-click (e)
5163   (interactive "e")
5164   (mouse-set-point e)
5165   (wl-summary-read))
5166
5167 (defun wl-summary-read ()
5168   ""
5169   (interactive)
5170   (let ((folder wl-summary-buffer-folder-name)
5171         (number (wl-summary-message-number))
5172         cur-folder cur-number message-last-pos
5173         (view-message-buffer (get-buffer-create wl-message-buf-name))
5174         (sticky-buf-name (and (wl-summary-sticky-p) wl-message-buf-name))
5175         (summary-buf-name (buffer-name)))
5176     (save-excursion
5177       (set-buffer view-message-buffer)
5178       (when (and sticky-buf-name
5179                  (not (wl-local-variable-p 'wl-message-buf-name
5180                                            (current-buffer))))
5181         (make-local-variable 'wl-message-buf-name)
5182         (setq wl-message-buf-name sticky-buf-name)
5183         (make-local-variable 'wl-message-buffer-cur-summary-buffer)
5184         (setq wl-message-buffer-cur-summary-buffer summary-buf-name))
5185       (setq cur-folder wl-message-buffer-cur-folder)
5186       (setq cur-number wl-message-buffer-cur-number))
5187     (wl-summary-toggle-disp-msg 'on)
5188     (if (and (string= folder cur-folder)
5189              (eq number cur-number))
5190         (progn
5191           (if (wl-summary-next-page)
5192               (wl-summary-down t)))
5193 ;;;         (wl-summary-scroll-up-content)))
5194       (if (wl-summary-no-mime-p folder)
5195           (wl-summary-redisplay-no-mime folder number)
5196         (wl-summary-redisplay-internal folder number)))))
5197
5198 (defun wl-summary-prev (&optional interactive)
5199   ""
5200   (interactive)
5201   (if wl-summary-move-direction-toggle
5202       (setq wl-summary-move-direction-downward nil))
5203   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5204         (skip-mark-regexp (mapconcat
5205                            'regexp-quote
5206                            wl-summary-skip-mark-list ""))
5207         goto-next regex-list regex next-entity finfo)
5208     (beginning-of-line)
5209     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5210         (setq regex (format "^%s[^%s]"
5211                             wl-summary-buffer-number-regexp
5212                             skip-mark-regexp))
5213       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5214                           wl-summary-buffer-number-regexp
5215                           skip-mark-regexp
5216                           (regexp-quote wl-summary-unread-cached-mark)
5217                           (regexp-quote wl-summary-important-mark))))
5218     (unless (re-search-backward regex nil t)
5219       (setq goto-next t))
5220     (beginning-of-line)
5221     (if (not goto-next)
5222         (progn
5223           (if wl-summary-buffer-disp-msg
5224               (wl-summary-redisplay)))
5225       (if (or interactive (interactive-p))
5226           (if wl-summary-buffer-prev-folder-func
5227               (funcall wl-summary-buffer-prev-folder-func)
5228             (when wl-auto-select-next
5229               (setq next-entity (wl-summary-get-prev-folder))
5230               (if next-entity
5231                   (setq finfo (wl-folder-get-entity-info next-entity))))
5232             (wl-ask-folder
5233              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5234              (format
5235               "No more messages. Type SPC to go to %s."
5236               (wl-summary-entity-info-msg next-entity finfo))))))))
5237
5238 (defun wl-summary-next (&optional interactive)
5239   ""
5240   (interactive)
5241   (if wl-summary-move-direction-toggle
5242       (setq wl-summary-move-direction-downward t))
5243   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5244         (skip-mark-regexp (mapconcat
5245                            'regexp-quote
5246                            wl-summary-skip-mark-list ""))
5247         goto-next regex regex-list next-entity finfo)
5248     (end-of-line)
5249     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5250         (setq regex (format "^%s[^%s]"
5251                             wl-summary-buffer-number-regexp
5252                             skip-mark-regexp))
5253       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5254                           wl-summary-buffer-number-regexp
5255                           skip-mark-regexp
5256                           (regexp-quote wl-summary-unread-cached-mark)
5257                           (regexp-quote wl-summary-important-mark))))
5258     (unless (re-search-forward regex nil t)
5259       (forward-line 1)
5260       (setq goto-next t))
5261     (beginning-of-line)
5262     (if (not goto-next)
5263         (if wl-summary-buffer-disp-msg
5264             (wl-summary-redisplay))
5265       (if (or interactive (interactive-p))
5266           (if wl-summary-buffer-next-folder-func
5267               (funcall wl-summary-buffer-next-folder-func)
5268             (when wl-auto-select-next
5269               (setq next-entity (wl-summary-get-next-folder))
5270               (if next-entity
5271                   (setq finfo (wl-folder-get-entity-info next-entity))))
5272             (wl-ask-folder
5273              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5274              (format
5275               "No more messages. Type SPC to go to %s."
5276               (wl-summary-entity-info-msg next-entity finfo))))))))
5277
5278 (defun wl-summary-up (&optional interactive skip-no-unread)
5279   ""
5280   (interactive)
5281   (if wl-summary-move-direction-toggle
5282       (setq wl-summary-move-direction-downward nil))
5283   (if (wl-summary-cursor-up)
5284       (if wl-summary-buffer-disp-msg
5285           (wl-summary-redisplay))
5286     (if (or interactive
5287             (interactive-p))
5288         (if wl-summary-buffer-prev-folder-func
5289             (funcall wl-summary-buffer-prev-folder-func)
5290           (let (next-entity finfo)
5291             (when wl-auto-select-next
5292               (progn
5293                 (setq next-entity (wl-summary-get-prev-unread-folder))
5294                 (if next-entity
5295                     (setq finfo (wl-folder-get-entity-info next-entity)))))
5296             (if (and skip-no-unread
5297                      (eq wl-auto-select-next 'skip-no-unread))
5298                 (wl-summary-next-folder-or-exit next-entity t)
5299               (wl-ask-folder
5300                '(lambda () (wl-summary-next-folder-or-exit next-entity t))
5301                (format
5302                 "No more unread messages. Type SPC to go to %s."
5303                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5304
5305 (defun wl-summary-get-prev-folder ()
5306   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5307         last-entity cur-id)
5308     (when folder-buf
5309       (setq cur-id (save-excursion (set-buffer folder-buf)
5310                                    wl-folder-buffer-cur-entity-id))
5311       (wl-folder-get-prev-folder cur-id))))
5312
5313 (defun wl-summary-get-next-folder ()
5314   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5315         cur-id)
5316     (when folder-buf
5317       (setq cur-id (save-excursion (set-buffer folder-buf)
5318                                    wl-folder-buffer-cur-entity-id))
5319       (wl-folder-get-next-folder cur-id))))
5320
5321 (defun wl-summary-get-next-unread-folder ()
5322   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5323         cur-id)
5324     (when folder-buf
5325       (setq cur-id (save-excursion (set-buffer folder-buf)
5326                                    wl-folder-buffer-cur-entity-id))
5327       (wl-folder-get-next-folder cur-id 'unread))))
5328
5329 (defun wl-summary-get-prev-unread-folder ()
5330   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5331         cur-id)
5332     (when folder-buf
5333       (setq cur-id (save-excursion (set-buffer folder-buf)
5334                                    wl-folder-buffer-cur-entity-id))
5335       (wl-folder-get-prev-folder cur-id 'unread))))
5336
5337 (defun wl-summary-down (&optional interactive skip-no-unread)
5338   (interactive)
5339   (if wl-summary-move-direction-toggle
5340       (setq wl-summary-move-direction-downward t))
5341   (if (wl-summary-cursor-down)
5342       (if wl-summary-buffer-disp-msg
5343           (wl-summary-redisplay))
5344     (if (or interactive
5345             (interactive-p))
5346         (if wl-summary-buffer-next-folder-func
5347             (funcall wl-summary-buffer-next-folder-func)
5348           (let (next-entity finfo)
5349             (when wl-auto-select-next
5350               (setq next-entity (wl-summary-get-next-unread-folder)))
5351             (if next-entity
5352                 (setq finfo (wl-folder-get-entity-info next-entity)))
5353             (if (and skip-no-unread
5354                      (eq wl-auto-select-next 'skip-no-unread))
5355                 (wl-summary-next-folder-or-exit next-entity)
5356               (wl-ask-folder
5357                '(lambda () (wl-summary-next-folder-or-exit next-entity))
5358                (format
5359                 "No more unread messages. Type SPC to go to %s."
5360                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5361
5362 (defun wl-summary-goto-last-displayed-msg ()
5363   (interactive)
5364   (unless wl-summary-buffer-last-displayed-msg
5365     (setq wl-summary-buffer-last-displayed-msg
5366           wl-summary-buffer-current-msg))
5367   (if wl-summary-buffer-last-displayed-msg
5368       (progn
5369         (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
5370         (if wl-summary-buffer-disp-msg
5371             (wl-summary-redisplay)))
5372     (message "No last message.")))
5373
5374 (defun wl-summary-redisplay (&optional arg)
5375   (interactive "P")
5376   (if (and (not arg)
5377            (wl-summary-no-mime-p wl-summary-buffer-folder-name))
5378       (wl-summary-redisplay-no-mime)
5379     (wl-summary-redisplay-internal nil nil arg)))
5380
5381 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
5382   (interactive)
5383   (let* ((msgdb wl-summary-buffer-msgdb)
5384          (fld (or folder wl-summary-buffer-folder-name))
5385          (num (or number (wl-summary-message-number)))
5386          (wl-mime-charset      wl-summary-buffer-mime-charset)
5387          (default-mime-charset wl-summary-buffer-mime-charset)
5388          (wl-message-redisplay-func
5389           wl-summary-buffer-message-redisplay-func)
5390          fld-buf fld-win thr-entity)
5391     (if (and wl-thread-open-reading-thread
5392              (eq wl-summary-buffer-view 'thread)
5393              (not (wl-thread-entity-get-opened
5394                    (setq thr-entity (wl-thread-get-entity
5395                                      num))))
5396              (wl-thread-entity-get-children thr-entity))
5397         (wl-thread-force-open))
5398     (if num
5399         (progn
5400           (setq wl-summary-buffer-disp-msg t)
5401           (setq wl-summary-buffer-last-displayed-msg
5402                 wl-summary-buffer-current-msg)
5403           ;; hide folder window
5404           (if (and (not wl-stay-folder-window)
5405                    (setq fld-buf (get-buffer wl-folder-buffer-name)))
5406               (if (setq fld-win (get-buffer-window fld-buf))
5407                   (delete-window fld-win)))
5408           (setq wl-current-summary-buffer (current-buffer))
5409           (if (wl-message-redisplay fld num 'mime msgdb force-reload)
5410               (wl-summary-mark-as-read nil
5411                                        ;; cached, then change server-mark.
5412                                        (if wl-message-cache-used
5413                                            nil
5414                                          ;; plugged, then leave server-mark.
5415                                          (if (and
5416                                               (not
5417                                                (elmo-folder-local-p
5418                                                 wl-summary-buffer-folder-name))
5419                                               (elmo-folder-plugged-p
5420                                                wl-summary-buffer-folder-name))
5421                                              'leave))
5422                                        t ; displayed
5423                                        nil
5424                                        'cached ; cached by reading.
5425                                        )
5426             )
5427           (setq wl-summary-buffer-current-msg num)
5428           (when wl-summary-recenter
5429             (recenter (/ (- (window-height) 2) 2))
5430             (if (not wl-summary-width)
5431                 (wl-horizontal-recenter)))
5432           (wl-highlight-summary-displaying)
5433           (wl-cache-prefetch-next fld num (current-buffer))
5434           (run-hooks 'wl-summary-redisplay-hook))
5435       (message "No message to display."))))
5436
5437 (defun wl-summary-redisplay-no-mime (&optional folder number)
5438   (interactive)
5439   (let* ((msgdb wl-summary-buffer-msgdb)
5440          (fld (or folder wl-summary-buffer-folder-name))
5441          (num (or number (wl-summary-message-number)))
5442          (wl-mime-charset      wl-summary-buffer-mime-charset)
5443          (default-mime-charset wl-summary-buffer-mime-charset)
5444          wl-break-pages)
5445     (if num
5446         (progn
5447           (setq wl-summary-buffer-disp-msg t)
5448           (setq wl-summary-buffer-last-displayed-msg
5449                 wl-summary-buffer-current-msg)
5450           (setq wl-current-summary-buffer (current-buffer))
5451           (wl-normal-message-redisplay fld num 'no-mime msgdb)
5452           (wl-summary-mark-as-read nil nil t)
5453           (setq wl-summary-buffer-current-msg num)
5454           (when wl-summary-recenter
5455             (recenter (/ (- (window-height) 2) 2))
5456             (if (not wl-summary-width)
5457                 (wl-horizontal-recenter)))
5458           (wl-highlight-summary-displaying)
5459           (run-hooks 'wl-summary-redisplay-hook))
5460       (message "No message to display.")
5461       (wl-ask-folder 'wl-summary-exit
5462                      "No more messages. Type SPC to go to folder mode."))))
5463
5464 (defun wl-summary-redisplay-all-header (&optional folder number)
5465   (interactive)
5466   (let* ((msgdb wl-summary-buffer-msgdb)
5467          (fld (or folder wl-summary-buffer-folder-name))
5468          (num (or number (wl-summary-message-number)))
5469          (wl-mime-charset      wl-summary-buffer-mime-charset)
5470          (default-mime-charset wl-summary-buffer-mime-charset)
5471          (wl-message-redisplay-func wl-summary-buffer-message-redisplay-func))
5472     (if num
5473         (progn
5474           (setq wl-summary-buffer-disp-msg t)
5475           (setq wl-summary-buffer-last-displayed-msg
5476                 wl-summary-buffer-current-msg)
5477           (setq wl-current-summary-buffer (current-buffer))
5478           (if (wl-message-redisplay fld num 'all-header msgdb); t if displayed.
5479               (wl-summary-mark-as-read nil nil t))
5480           (setq wl-summary-buffer-current-msg num)
5481           (when wl-summary-recenter
5482             (recenter (/ (- (window-height) 2) 2))
5483             (if (not wl-summary-width)
5484                 (wl-horizontal-recenter)))
5485           (wl-highlight-summary-displaying)
5486           (run-hooks 'wl-summary-redisplay-hook))
5487       (message "No message to display."))))
5488
5489 (defun wl-summary-jump-to-current-message ()
5490   (interactive)
5491   (let (message-buf message-win)
5492     (if (setq message-buf (get-buffer wl-message-buf-name))
5493         (if (setq message-win (get-buffer-window message-buf))
5494             (select-window message-win)
5495           (wl-select-buffer (get-buffer wl-message-buf-name)))
5496       (wl-summary-redisplay)
5497       (wl-select-buffer (get-buffer wl-message-buf-name)))
5498     (goto-char (point-min))))
5499
5500 (defun wl-summary-cancel-message ()
5501   "Cancel an article on news."
5502   (interactive)
5503   (if (null (wl-summary-message-number))
5504       (message "No message.")
5505     (let ((summary-buf (current-buffer))
5506           message-buf)
5507       (wl-summary-set-message-buffer-or-redisplay)
5508       (if (setq message-buf (wl-message-get-original-buffer))
5509           (set-buffer message-buf))
5510       (unless (wl-message-news-p)
5511         (set-buffer summary-buf)
5512         (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
5513                      'nntp)
5514                  (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5515             (progn
5516               (wl-summary-redisplay t)
5517               (wl-summary-supersedes-message))
5518           (error "This is not a news article; supersedes is impossible")))
5519       (when (yes-or-no-p "Do you really want to cancel this article? ")
5520         (let (from newsgroups message-id distribution buf)
5521           (save-excursion
5522             (setq from (std11-field-body "from")
5523                   newsgroups (std11-field-body "newsgroups")
5524                   message-id (std11-field-body "message-id")
5525                   distribution (std11-field-body "distribution"))
5526             ;; Make sure that this article was written by the user.
5527             (unless (wl-address-user-mail-address-p
5528                      (wl-address-header-extract-address
5529                       (car (wl-parse-addresses from))))
5530               (error "This article is not yours"))
5531             ;; Make control message.
5532             (setq buf (set-buffer (get-buffer-create " *message cancel*")))
5533             (setq wl-draft-buffer-cur-summary-buffer summary-buf)
5534             (buffer-disable-undo (current-buffer))
5535             (erase-buffer)
5536             (insert "Newsgroups: " newsgroups "\n"
5537                     "From: " (wl-address-header-extract-address
5538                               wl-from) "\n"
5539                               "Subject: cmsg cancel " message-id "\n"
5540                               "Control: cancel " message-id "\n"
5541                               (if distribution
5542                                   (concat "Distribution: " distribution "\n")
5543                                 "")
5544                               mail-header-separator "\n"
5545                               wl-summary-cancel-message)
5546             (message "Canceling your message...")
5547             (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
5548             (message "Canceling your message...done")))))))
5549
5550 (defun wl-summary-supersedes-message ()
5551   "Supersede current message."
5552   (interactive)
5553   (let ((summary-buf (current-buffer))
5554         (mmelmo-force-fetch-entire-message t)
5555         message-buf from)
5556     (wl-summary-set-message-buffer-or-redisplay)
5557     (if (setq message-buf (wl-message-get-original-buffer))
5558         (set-buffer message-buf))
5559     (unless (wl-message-news-p)
5560       (set-buffer summary-buf)
5561       (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
5562                    'nntp)
5563                (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5564           (progn
5565             (wl-summary-redisplay t)
5566             (wl-summary-supersedes-message))
5567         (error "This is not a news article; supersedes is impossible")))
5568     (save-excursion
5569       (setq from (std11-field-body "from"))
5570       ;; Make sure that this article was written by the user.
5571       (unless (wl-address-user-mail-address-p
5572                (wl-address-header-extract-address
5573                 (car (wl-parse-addresses from))))
5574         (error "This article is not yours"))
5575       (let* ((message-id (std11-field-body "message-id"))
5576              (followup-to (std11-field-body "followup-to"))
5577              (mail-default-headers
5578               (concat mail-default-headers
5579                       "Supersedes: " message-id "\n"
5580                       (and followup-to
5581                            (concat "Followup-To: " followup-to "\n")))))
5582         (set-buffer (wl-message-get-original-buffer))
5583         (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
5584
5585 (defun wl-summary-save (&optional arg wl-save-dir)
5586   (interactive)
5587   (let ((filename)
5588         (num (wl-summary-message-number))
5589         (mmelmo-force-fetch-entire-message t))
5590     (if (null wl-save-dir)
5591         (setq wl-save-dir wl-tmp-dir))
5592     (if num
5593         (save-excursion
5594           (setq filename (expand-file-name
5595                           (int-to-string num)
5596                           wl-save-dir))
5597           (if (null (and arg
5598                          (null (file-exists-p filename))))
5599               (setq filename
5600                     (read-file-name "Save to file: " filename)))
5601
5602           (wl-summary-set-message-buffer-or-redisplay)
5603           (set-buffer (wl-message-get-original-buffer))
5604           (if (and (null arg) (file-exists-p filename))
5605               (if (y-or-n-p "File already exists.  override it? ")
5606                   (write-region (point-min) (point-max) filename))
5607             (write-region (point-min) (point-max) filename)))
5608       (message "No message to save."))
5609     num))
5610
5611 (defun wl-summary-save-region (beg end)
5612   (interactive "r")
5613   (save-excursion
5614     (save-restriction
5615       (narrow-to-region beg end)
5616       (goto-char (point-min))
5617       (let ((wl-save-dir
5618              (wl-read-directory-name "Save to directory: " wl-tmp-dir)))
5619         (if (null (file-exists-p wl-save-dir))
5620             (make-directory wl-save-dir))
5621         (if (eq wl-summary-buffer-view 'thread)
5622             (progn
5623               (while (not (eobp))
5624                 (let* ((number (wl-summary-message-number))
5625                        (entity (wl-thread-get-entity number)))
5626                   (if (wl-thread-entity-get-opened entity)
5627                       (wl-summary-save t wl-save-dir)
5628                     ;; closed
5629                     (wl-summary-save t wl-save-dir))
5630                   (forward-line 1))))
5631           (while (not (eobp))
5632             (wl-summary-save t wl-save-dir)
5633             (forward-line 1)))))))
5634
5635 ;; mew-summary-pipe-message()
5636 (defun wl-summary-pipe-message (prefix command)
5637   "Send this message via pipe."
5638   (interactive (list current-prefix-arg nil))
5639   (if (null (wl-summary-message-number))
5640       (message "No message.")
5641     (setq command (read-string "Shell command on message: "
5642                                wl-summary-shell-command-last))
5643     (if (y-or-n-p "Send this message to pipe? ")
5644         (save-excursion
5645           (wl-summary-set-message-buffer-or-redisplay)
5646           (set-buffer (wl-message-get-original-buffer))
5647           (if (string= command "")
5648               (setq command wl-summary-shell-command-last))
5649           (goto-char (point-min)) ; perhaps this line won't be necessary
5650           (if prefix
5651               (search-forward "\n\n"))
5652           (shell-command-on-region (point) (point-max) command nil)
5653           (setq wl-summary-shell-command-last command)))))
5654
5655 (defun wl-summary-print-message (&optional arg)
5656   (interactive "P")
5657   (if (null (wl-summary-message-number))
5658       (message "No message.")
5659     (save-excursion
5660       (wl-summary-set-message-buffer-or-redisplay)
5661       (if (or (not (interactive-p))
5662               (y-or-n-p "Print ok? "))
5663           (progn
5664             (let* ((message-buffer (get-buffer wl-message-buf-name))
5665 ;;;                (summary-buffer (get-buffer wl-summary-buffer-name))
5666                    (buffer (generate-new-buffer " *print*")))
5667               (set-buffer message-buffer)
5668               (copy-to-buffer buffer (point-min) (point-max))
5669               (set-buffer buffer)
5670               (funcall wl-print-buffer-func)
5671               (kill-buffer buffer)))
5672         (message "")))))
5673
5674 (defun wl-summary-print-message-with-ps-print (&optional filename)
5675   (interactive)
5676   (if (null (wl-summary-message-number))
5677       (message "No message.")
5678     (setq filename (ps-print-preprint current-prefix-arg))
5679     (if (or (not (interactive-p))
5680             (y-or-n-p "Print ok? "))
5681         (let ((summary-buffer (current-buffer))
5682               wl-break-pages)
5683           (save-excursion
5684 ;;;         (wl-summary-set-message-buffer-or-redisplay)
5685             (wl-summary-redisplay-internal)
5686             (let* ((message-buffer (get-buffer wl-message-buf-name))
5687                    (buffer (generate-new-buffer " *print*"))
5688                    (entity (progn
5689                              (set-buffer summary-buffer)
5690                              (assoc (cdr (assq
5691                                           (wl-summary-message-number)
5692                                           (elmo-msgdb-get-number-alist
5693                                            wl-summary-buffer-msgdb)))
5694                                     (elmo-msgdb-get-overview
5695                                      wl-summary-buffer-msgdb))))
5696                    (wl-ps-subject
5697                     (and entity
5698                          (or (elmo-msgdb-overview-entity-get-subject entity)
5699                              "")))
5700                    (wl-ps-from
5701                     (and entity
5702                          (or (elmo-msgdb-overview-entity-get-from entity) "")))
5703                    (wl-ps-date
5704                     (and entity
5705                          (or (elmo-msgdb-overview-entity-get-date entity) ""))))
5706               (run-hooks 'wl-ps-preprint-hook)
5707               (set-buffer message-buffer)
5708               (copy-to-buffer buffer (point-min) (point-max))
5709               (set-buffer buffer)
5710               (unwind-protect
5711                   (let ((ps-left-header
5712                          (list (concat "(" wl-ps-subject ")")
5713                                (concat "(" wl-ps-from ")")))
5714                         (ps-right-header
5715                          (list "/pagenumberstring load"
5716                                (concat "(" wl-ps-date ")"))))
5717                     (run-hooks 'wl-ps-print-hook)
5718                     (funcall wl-ps-print-buffer-func filename))
5719                 (kill-buffer buffer)))))
5720       (message ""))))
5721
5722 (if (featurep 'ps-print) ; ps-print is available.
5723     (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
5724
5725 (defun wl-summary-folder-info-update ()
5726   (let ((folder (elmo-string wl-summary-buffer-folder-name))
5727         (num-db (elmo-msgdb-get-number-alist
5728                  wl-summary-buffer-msgdb)))
5729     (wl-folder-set-folder-updated folder
5730                                   (list 0
5731                                         (+ wl-summary-buffer-unread-count
5732                                            wl-summary-buffer-new-count)
5733                                         (length num-db)))))
5734
5735 (defun wl-summary-get-newsgroups ()
5736   (let ((spec-list (elmo-folder-get-primitive-spec-list
5737                     (elmo-string wl-summary-buffer-folder-name)))
5738         ng-list)
5739     (while spec-list
5740       (when (eq (caar spec-list) 'nntp)
5741         (wl-append ng-list (list (nth 1 (car spec-list)))))
5742       (setq spec-list (cdr spec-list)))
5743     ng-list))
5744
5745 (defun wl-summary-set-crosspost (&optional type redisplay)
5746   (let* ((number (wl-summary-message-number))
5747          (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name
5748                                             number))
5749          (folder (nth 1 spec))
5750          message-buf newsgroups)
5751     (when (eq (car spec) 'nntp)
5752       (if redisplay
5753           (wl-summary-redisplay))
5754       (save-excursion
5755         (if (setq message-buf (wl-message-get-original-buffer))
5756             (set-buffer message-buf))
5757         (setq newsgroups (std11-field-body "newsgroups")))
5758       (when newsgroups
5759         (let* ((msgdb wl-summary-buffer-msgdb)
5760                (num-db (elmo-msgdb-get-number-alist msgdb))
5761                (ng-list (wl-summary-get-newsgroups)) ;; for multi folder
5762                crosspost-folders)
5763           (when (setq crosspost-folders
5764                       (elmo-list-delete ng-list
5765                                         (wl-parse-newsgroups newsgroups t)))
5766             (elmo-crosspost-message-set (cdr (assq number num-db)) ;;message-id
5767                                         crosspost-folders
5768                                         type) ;;not used
5769             (setq wl-crosspost-alist-modified t)))))))
5770
5771 (defun wl-summary-is-crosspost-folder (spec-list fld-list)
5772   (let (fld flds)
5773     (while spec-list
5774       (if (and (eq (caar spec-list) 'nntp)
5775                (member (setq fld (nth 1 (car spec-list))) fld-list))
5776           (wl-append flds (list fld)))
5777       (setq spec-list (cdr spec-list)))
5778     flds))
5779
5780 (defun wl-summary-update-crosspost ()
5781   (let* ((msgdb wl-summary-buffer-msgdb)
5782          (number-alist (elmo-msgdb-get-number-alist msgdb))
5783          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
5784          (spec-list (elmo-folder-get-primitive-spec-list
5785                      (elmo-string wl-summary-buffer-folder-name)))
5786          (alist elmo-crosspost-message-alist)
5787          (crossed 0)
5788          mark ngs num)
5789     (when (assq 'nntp spec-list)
5790       (while alist
5791         (when (setq ngs
5792                     (wl-summary-is-crosspost-folder
5793                      spec-list
5794                      (nth 1 (car alist))))
5795           (when (setq num (car (rassoc (caar alist) number-alist)))
5796             (if (and (setq mark (cadr (assq num mark-alist)))
5797                      (member mark (list wl-summary-new-mark
5798                                         wl-summary-unread-uncached-mark
5799                                         wl-summary-unread-cached-mark)))
5800                 (setq crossed (1+ crossed)))
5801             (if (wl-summary-jump-to-msg num)
5802                 (wl-summary-mark-as-read t);; opened
5803               (wl-summary-mark-as-read t nil nil num)));; closed
5804           ;; delete if message does't exists.
5805           (elmo-crosspost-message-delete (caar alist) ngs)
5806           (setq wl-crosspost-alist-modified t))
5807         (setq alist (cdr alist))))
5808     (if (> crossed 0)
5809         crossed)))
5810
5811 (defun wl-crosspost-alist-load ()
5812   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
5813   (setq wl-crosspost-alist-modified nil))
5814
5815 (defun wl-crosspost-alist-save ()
5816   (when wl-crosspost-alist-modified
5817     ;; delete non-exists newsgroups
5818     (let ((alist elmo-crosspost-message-alist)
5819           newsgroups)
5820       (while alist
5821         (setq newsgroups
5822               (elmo-delete-if
5823                '(lambda (x)
5824                   (not (intern-soft x wl-folder-newsgroups-hashtb)))
5825                (nth 1 (car alist))))
5826         (if newsgroups
5827             (setcar (cdar alist) newsgroups)
5828           (setq elmo-crosspost-message-alist
5829                 (delete (car alist) elmo-crosspost-message-alist)))
5830         (setq alist (cdr alist)))
5831       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
5832       (setq wl-crosspost-alist-modified nil))))
5833
5834 (defun wl-summary-pack-number (&optional arg)
5835   (interactive "P")
5836   (setq wl-summary-buffer-msgdb
5837         (elmo-pack-number
5838          wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg))
5839   (let (wl-use-scoring)
5840     (wl-summary-rescan)))
5841
5842 (defun wl-summary-target-mark-uudecode ()
5843   (interactive)
5844   (let ((mlist (reverse wl-summary-buffer-target-mark-list))
5845         (summary-buf (current-buffer))
5846         (tmp-buf (get-buffer-create "*WL UUENCODE*"))
5847         orig-buf i k filename rc errmsg)
5848     (setq i 1)
5849     (setq k (length mlist))
5850     (set-buffer tmp-buf)
5851     (erase-buffer)
5852     (save-window-excursion
5853       (while mlist
5854         (set-buffer summary-buf)
5855         (wl-summary-jump-to-msg (car mlist))
5856         (wl-summary-redisplay)
5857         (set-buffer (setq orig-buf (wl-message-get-original-buffer)))
5858         (goto-char (point-min))
5859         (cond ((= i 1) ; first
5860                (if (setq filename (wl-message-uu-substring
5861                                    orig-buf tmp-buf t
5862                                    (= i k)))
5863                    nil
5864                  (error "Can't find begin line")))
5865               ((< i k)
5866                (wl-message-uu-substring orig-buf tmp-buf))
5867               (t ; last
5868                (wl-message-uu-substring orig-buf tmp-buf nil t)))
5869         (setq i (1+ i))
5870         (setq mlist (cdr mlist)))
5871       (set-buffer tmp-buf)
5872       (message "Exec %s..." wl-prog-uudecode)
5873       (unwind-protect
5874           (let ((decode-dir wl-tmp-dir))
5875             (if (not wl-prog-uudecode-no-stdout-option)
5876                 (setq filename (read-file-name "Save to file: "
5877                                                (expand-file-name
5878                                                 (elmo-safe-filename filename)
5879                                                 wl-tmp-dir)))
5880               (setq decode-dir
5881                     (wl-read-directory-name "Save to directory: "
5882                                             wl-tmp-dir))
5883               (setq filename (expand-file-name filename decode-dir)))
5884             (if (file-exists-p filename)
5885                 (or (yes-or-no-p (format "File %s exists. Save anyway? "
5886                                          filename))
5887                     (error "")))
5888             (elmo-bind-directory
5889              decode-dir
5890              (setq rc
5891                    (as-binary-process
5892                     (apply 'call-process-region (point-min) (point-max)
5893                            wl-prog-uudecode t (current-buffer) nil
5894                            wl-prog-uudecode-arg))))
5895             (when (not (= 0 rc))
5896               (setq errmsg (buffer-substring (point-min)(point-max)))
5897               (error "Uudecode error: %s" errmsg))
5898             (if (not wl-prog-uudecode-no-stdout-option)
5899                 (let (file-name-handler-alist) ;; void jka-compr
5900                   (as-binary-output-file
5901                    (write-region (point-min) (point-max)
5902                                  filename nil 'no-msg))))
5903             (save-excursion
5904               (set-buffer summary-buf)
5905               (wl-summary-delete-all-temp-marks))
5906             (if (file-exists-p filename)
5907                 (message "Saved as %s" filename)))
5908         (kill-buffer tmp-buf)))))
5909
5910 (defun wl-summary-drop-unsync ()
5911   "Drop all unsync messages."
5912   (interactive)
5913   (if (elmo-folder-pipe-p wl-summary-buffer-folder-name)
5914       (error "You cannot drop unsync messages in this folder"))
5915   (if (or (not (interactive-p))
5916           (y-or-n-p "Drop all unsync messages? "))
5917       (let* ((folder-list (elmo-folder-get-primitive-folder-list
5918                            wl-summary-buffer-folder-name))
5919              (is-multi (elmo-multi-p wl-summary-buffer-folder-name))
5920              (sum 0)
5921              (multi-num 0)
5922              pair)
5923         (message "Dropping...")
5924         (while folder-list
5925           (setq pair (elmo-max-of-folder (car folder-list)))
5926           (when is-multi ;; dirty hack...
5927             (incf multi-num)
5928             (setcar pair (+ (* multi-num elmo-multi-divide-number)
5929                             (car pair))))
5930           (elmo-msgdb-set-number-alist
5931            wl-summary-buffer-msgdb
5932            (nconc
5933             (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
5934             (list (cons (car pair) nil))))
5935           (setq sum (+ sum (cdr pair)))
5936           (setq folder-list (cdr folder-list)))
5937         (wl-summary-set-message-modified)
5938         (wl-folder-set-folder-updated wl-summary-buffer-folder-name
5939                                       (list 0
5940                                             (+ wl-summary-buffer-unread-count
5941                                                wl-summary-buffer-new-count)
5942                                             sum))
5943         (message "Dropping...done"))))
5944
5945 (defun wl-summary-default-get-next-msg (msg)
5946   (let (next)
5947     (if (and (not wl-summary-buffer-target-mark-list)
5948              (eq wl-summary-buffer-view 'thread)
5949              (if (eq wl-summary-move-direction-downward nil)
5950                  (setq next (wl-thread-get-prev-unread msg))
5951                (setq next (wl-thread-get-next-unread msg))))
5952         next
5953       (save-excursion
5954         (wl-summary-jump-to-msg msg)
5955         (let (wl-summary-buffer-disp-msg)
5956           (if (eq wl-summary-move-direction-downward nil)
5957               (unless (wl-summary-cursor-up)
5958                 (wl-summary-prev))
5959             (unless (wl-summary-cursor-down)
5960               (wl-summary-next)))
5961           (wl-summary-message-number))))))
5962
5963 (defsubst wl-cache-prefetch-p (fld &optional num)
5964   (cond ((and num wl-cache-prefetch-folder-type-list)
5965          (memq
5966           (elmo-folder-number-get-type fld num)
5967           wl-cache-prefetch-folder-type-list))
5968         (wl-cache-prefetch-folder-type-list
5969          (let ((list wl-cache-prefetch-folder-type-list)
5970                type)
5971            (catch 'done
5972              (while (setq type (pop list))
5973                (if (elmo-folder-contains-type fld type)
5974                    (throw 'done t))))))
5975         ((consp wl-cache-prefetch-folder-list)
5976          (wl-string-match-member fld wl-cache-prefetch-folder-list))
5977         (t
5978          wl-cache-prefetch-folder-list)))
5979
5980 (defconst wl-cache-prefetch-idle-time
5981   (if (featurep 'lisp-float-type) (/ (float 1) (float 10)) 1))
5982
5983 (defun wl-cache-prefetch-next (fld msg &optional summary)
5984   (if (wl-cache-prefetch-p fld)
5985       (if elmo-use-buffer-cache
5986 ;;;       (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.")
5987         (save-excursion
5988           (set-buffer (or summary (get-buffer wl-summary-buffer-name)))
5989           (let ((next (funcall wl-cache-prefetch-get-next-func msg)))
5990             (when (and next
5991                        (wl-cache-prefetch-p fld next))
5992               (if (not (fboundp 'run-with-idle-timer))
5993                   (when (sit-for wl-cache-prefetch-idle-time)
5994                     (wl-cache-prefetch-message fld next summary))
5995                 (run-with-idle-timer
5996                  wl-cache-prefetch-idle-time
5997                  nil
5998                  'wl-cache-prefetch-message fld next summary)
5999                 (sit-for 0))))))))
6000
6001 (defvar wl-cache-prefetch-debug nil)
6002 (defun wl-cache-prefetch-message (folder msg summary &optional next)
6003   (when (buffer-live-p summary)
6004     (save-excursion
6005       (set-buffer summary)
6006       (when (string= folder wl-summary-buffer-folder-name)
6007         (unless next
6008           (setq next msg))
6009         (let* ((msgdb wl-summary-buffer-msgdb)
6010                (message-id (cdr (assq next
6011                                       (elmo-msgdb-get-number-alist msgdb)))))
6012           (if (not (elmo-buffer-cache-hit (list folder next message-id)))
6013               (let* ((size (elmo-msgdb-overview-entity-get-size
6014                             (assoc message-id
6015                                    (elmo-msgdb-get-overview msgdb)))))
6016                 (when (or (elmo-local-file-p folder next)
6017                           (not (and (integerp size)
6018                                     wl-cache-prefetch-threshold
6019                                     (>= size wl-cache-prefetch-threshold)
6020                                     (not (elmo-cache-exists-p message-id
6021                                                               folder next)))))
6022                   (if wl-cache-prefetch-debug
6023                       (message "Reading %d..." msg))
6024                   (elmo-buffer-cache-message folder next msgdb nil 'unread)
6025                   (if wl-cache-prefetch-debug
6026                       (message "Reading %d... done" msg))))))))))
6027
6028 (defun wl-summary-save-current-message ()
6029   "Save current message for `wl-summary-yank-saved-message'."
6030   (interactive)
6031   (let ((number (wl-summary-message-number)))
6032     (setq wl-summary-buffer-saved-message number)
6033     (and number (message "No: %s is saved." number))))
6034
6035 (defun wl-summary-yank-saved-message ()
6036   "Set current message as a parent of the saved message."
6037   (interactive)
6038   (if wl-summary-buffer-saved-message
6039       (let ((number (wl-summary-message-number)))
6040         (if (eq wl-summary-buffer-saved-message number)
6041             (message "Cannot set itself as a parent.")
6042           (save-excursion
6043             (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
6044             (wl-thread-set-parent number)
6045             (wl-summary-set-thread-modified))
6046           (setq  wl-summary-buffer-saved-message nil)))
6047     (message "There's no saved message.")))
6048
6049 (require 'product)
6050 (product-provide (provide 'wl-summary) (require 'wl-version))
6051
6052 ;;; wl-summary.el ends here