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