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