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