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 folder)) 'cache)
3526                (not (string= folder
3527                              (setq tmp-folder
3528                                    (concat "'cache/"
3529                                            (elmo-cache-get-path-subr
3530                                             (elmo-msgid-to-cache msgid)))))))
3531           (progn
3532             (setq folder tmp-folder)
3533             (message "Force refile to %s." folder)))
3534       (if (string= folder wl-summary-buffer-folder-name)
3535           (error "Same folder"))
3536       (unless (or (elmo-folder-plugged-p wl-summary-buffer-folder-name)
3537                   (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) 'pipe)
3538                        (elmo-folder-plugged-p
3539                         (elmo-pipe-spec-dst (elmo-folder-get-spec wl-summary-buffer-folder-name))))
3540                   (elmo-cache-exists-p msgid))
3541         (error "Unplugged (no cache or msgid)"))
3542       (if (or (string= folder wl-queue-folder)
3543               (string= folder wl-draft-folder))
3544           (error "Don't %s messages to %s" copy-or-refile folder))
3545       ;; learn for refile.
3546       (if (eq copy-or-refile 'refile)
3547           (wl-refile-learn entity folder))
3548       (wl-summary-unmark msg-num)
3549       (set variable (append
3550                      (symbol-value variable)
3551                      (list (cons msg-num folder))))
3552       (when (or interactive
3553                 (eq number buffer-num))
3554         (wl-summary-mark-line (if (eq copy-or-refile 'refile)
3555                                   "o" "O"))
3556         ;; print refile destination
3557         (wl-summary-print-destination msg-num folder))
3558       (if interactive
3559           (if (eq wl-summary-move-direction-downward nil)
3560               (wl-summary-prev)
3561             (wl-summary-next)))
3562       (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile)))
3563       (setq wl-summary-buffer-prev-refile-destination folder)
3564       msg-num)))
3565
3566 (defun wl-summary-refile-prev-destination ()
3567   "Refile message to previously refiled destination."
3568   (interactive)
3569   (wl-summary-refile wl-summary-buffer-prev-refile-destination
3570                      (wl-summary-message-number))
3571   (if (eq wl-summary-move-direction-downward nil)
3572       (wl-summary-prev)
3573     (wl-summary-next)))
3574
3575 (defun wl-summary-copy-prev-destination ()
3576   "Refile message to previously refiled destination."
3577   (interactive)
3578   (wl-summary-copy wl-summary-buffer-prev-copy-destination
3579                    (wl-summary-message-number))
3580   (if (eq wl-summary-move-direction-downward nil)
3581       (wl-summary-prev)
3582     (wl-summary-next)))
3583
3584 (defsubst wl-summary-no-auto-refile-message-p (msg mark-alist)
3585   (member (cadr (assq msg mark-alist)) wl-summary-auto-refile-skip-marks))
3586
3587 (defun wl-summary-auto-refile (&optional open-all)
3588   "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
3589   (interactive "P")
3590   (message "Marking...")
3591   (save-excursion
3592     (if (and (eq wl-summary-buffer-view 'thread)
3593              open-all)
3594         (wl-thread-open-all))
3595     (let* ((spec wl-summary-buffer-folder-name)
3596            (overview (elmo-msgdb-get-overview
3597                       wl-summary-buffer-msgdb))
3598            (mark-alist (elmo-msgdb-get-mark-alist
3599                         wl-summary-buffer-msgdb))
3600            checked-dsts
3601            (count 0)
3602            number dst thr-entity)
3603       (goto-line 1)
3604       (while (not (eobp))
3605         (setq number (wl-summary-message-number))
3606         (when (and (not (wl-summary-no-auto-refile-message-p number
3607                                                              mark-alist))
3608                    (setq dst
3609                          (wl-folder-get-realname
3610                           (wl-refile-guess-by-rule
3611                            (elmo-msgdb-overview-get-entity
3612                             number wl-summary-buffer-msgdb))))
3613                    (not (equal dst spec)))
3614           (when (not (member dst checked-dsts))
3615             (wl-folder-confirm-existence dst)
3616             (setq checked-dsts (cons dst checked-dsts)))
3617           (if (wl-summary-refile dst number)
3618               (incf count))
3619           (message "Marking...%d message(s)." count))
3620         (if (eq wl-summary-buffer-view 'thread)
3621             ;; process invisible children.
3622             (unless (wl-thread-entity-get-opened
3623                      (setq thr-entity (wl-thread-get-entity number)))
3624               (let ((messages
3625                      (elmo-delete-if
3626                       (function
3627                        (lambda (x)
3628                          (wl-summary-no-auto-refile-message-p
3629                           x mark-alist)))
3630                       (wl-thread-entity-get-descendant thr-entity))))
3631                 (while messages
3632                   (when (and (setq dst
3633                                    (wl-refile-guess-by-rule
3634                                     (elmo-msgdb-overview-get-entity
3635                                      (car messages) wl-summary-buffer-msgdb)))
3636                              (not (equal dst spec)))
3637                     (if (wl-summary-refile dst (car messages))
3638                         (incf count))
3639                     (message "Marking...%d message(s)." count))
3640                   (setq messages (cdr messages))))))
3641         (forward-line))
3642       (if (eq count 0)
3643           (message "No message was marked.")
3644         (message "Marked %d message(s)." count)))))
3645
3646 (defun wl-summary-unmark (&optional number)
3647   "Unmark marks (temporary, refile, copy, delete)of current line.
3648 If optional argument NUMBER is specified, unmark message specified by NUMBER."
3649   (interactive)
3650   (save-excursion
3651     (beginning-of-line)
3652     (let ((inhibit-read-only t)
3653           (buffer-read-only nil)
3654           visible
3655           msg-num
3656           cur-mark
3657           score-mark)
3658       (if number
3659           (setq visible (wl-summary-jump-to-msg number))
3660         (setq visible t))
3661       ;; Delete mark on buffer.
3662       (when (and visible
3663                  (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)"))
3664         (goto-char (match-end 2))
3665         (or number
3666             (setq number (string-to-int (wl-match-buffer 1))))
3667         (setq cur-mark (wl-match-buffer 2))
3668         (if (string= cur-mark " ")
3669             ()
3670           (delete-region (match-beginning 2) (match-end 2))
3671           (if (setq score-mark (wl-summary-get-score-mark number))
3672               (insert score-mark)
3673             (insert " ")))
3674         (if (or (string= cur-mark "o")
3675                 (string= cur-mark "O"))
3676             (wl-summary-remove-destination))
3677         (if wl-summary-highlight
3678             (wl-highlight-summary-current-line nil nil score-mark))
3679         (set-buffer-modified-p nil))
3680       ;; Remove from temporary mark structure.
3681       (and number
3682            (wl-summary-delete-mark number)))))
3683
3684 (defun wl-summary-msg-marked-as-target (msg)
3685   (if (memq msg wl-summary-buffer-target-mark-list)
3686       t))
3687
3688 (defun wl-summary-msg-marked-as-copied (msg)
3689   (assq msg wl-summary-buffer-copy-list))
3690
3691 (defun wl-summary-msg-marked-as-deleted (msg)
3692   (if (memq msg wl-summary-buffer-delete-list)
3693       t))
3694
3695 (defun wl-summary-msg-marked-as-refiled (msg)
3696   (assq msg wl-summary-buffer-refile-list))
3697
3698 (defun wl-summary-target-mark (&optional number)
3699   "Put target mark '*' on current message.
3700 If optional argument NUMBER is specified, mark message specified by NUMBER."
3701   (interactive)
3702   (let* ((buffer-num (wl-summary-message-number))
3703          (msg-num (or number buffer-num))
3704          mark)
3705     (catch 'done
3706       (when (null msg-num)
3707         (if (interactive-p)
3708             (message "No message."))
3709         (throw 'done nil))
3710       (when (setq mark (wl-summary-get-mark msg-num))
3711         (when (wl-summary-reserve-temp-mark-p mark)
3712           (if (interactive-p)
3713               (error "Already marked as `%s'" mark))
3714           (throw 'done nil))
3715         (wl-summary-unmark msg-num))
3716       (if (or (interactive-p)
3717               (eq number buffer-num))
3718           (wl-summary-mark-line "*"))
3719       (setq wl-summary-buffer-target-mark-list
3720             (cons msg-num wl-summary-buffer-target-mark-list))
3721       (if (interactive-p)
3722           (if (eq wl-summary-move-direction-downward nil)
3723               (wl-summary-prev)
3724             (wl-summary-next)))
3725       msg-num)))
3726
3727
3728 (defun wl-summary-refile-region (beg end)
3729   "Put copy mark on messages in the region specified by BEG and END."
3730   (interactive "r")
3731   (wl-summary-refile-region-subr "refile" beg end))
3732
3733 (defun wl-summary-copy-region (beg end)
3734   "Put copy mark on messages in the region specified by BEG and END."
3735   (interactive "r")
3736   (wl-summary-refile-region-subr "copy" beg end))
3737
3738 (defun wl-summary-refile-region-subr (copy-or-refile beg end)
3739   (save-excursion
3740     (save-restriction
3741       (goto-char beg)
3742       ;; guess by first msg
3743       (let* ((msgid (cdr (assq (wl-summary-message-number)
3744                                (elmo-msgdb-get-number-alist
3745                                 wl-summary-buffer-msgdb))))
3746              (function (intern (format "wl-summary-%s" copy-or-refile)))
3747              (entity (assoc msgid (elmo-msgdb-get-overview
3748                                    wl-summary-buffer-msgdb)))
3749              folder)
3750         (if entity
3751             (setq folder (wl-summary-read-folder (wl-refile-guess entity)
3752                                                  (format "for %s"
3753                                                          copy-or-refile))))
3754         (narrow-to-region beg end)
3755         (if (eq wl-summary-buffer-view 'thread)
3756             (progn
3757               (while (not (eobp))
3758                 (let* ((number (wl-summary-message-number))
3759                        (entity (wl-thread-get-entity number))
3760                        children)
3761                   (if (wl-thread-entity-get-opened entity)
3762                       ;; opened...refile line.
3763                       (funcall function folder number)
3764                     ;; closed
3765                     (setq children (wl-thread-get-children-msgs number))
3766                     (while children
3767                       (funcall function folder (pop children))))
3768                   (forward-line 1))))
3769           (while (not (eobp))
3770             (funcall function folder (wl-summary-message-number))
3771             (forward-line 1)))))))
3772
3773 (defun wl-summary-unmark-region (beg end)
3774   (interactive "r")
3775   (save-excursion
3776     (save-restriction
3777       (narrow-to-region beg end)
3778       (goto-char (point-min))
3779       (if (eq wl-summary-buffer-view 'thread)
3780           (progn
3781             (while (not (eobp))
3782               (let* ((number (wl-summary-message-number))
3783                      (entity (wl-thread-get-entity number)))
3784                 (if (wl-thread-entity-get-opened entity)
3785                     ;; opened...unmark line.
3786                     (wl-summary-unmark)
3787                   ;; closed
3788                   (wl-summary-delete-marks-on-buffer
3789                    (wl-thread-get-children-msgs number))))
3790               (forward-line 1)))
3791         (while (not (eobp))
3792           (wl-summary-unmark)
3793           (forward-line 1))))))
3794
3795 (defun wl-summary-mark-region-subr (function beg end)
3796   (save-excursion
3797     (save-restriction
3798       (narrow-to-region beg end)
3799       (goto-char (point-min))
3800       (if (eq wl-summary-buffer-view 'thread)
3801           (progn
3802             (while (not (eobp))
3803               (let* ((number (wl-summary-message-number))
3804                      (entity (wl-thread-get-entity number))
3805                      (wl-summary-move-direction-downward t)
3806                      children)
3807                 (if (wl-thread-entity-get-opened entity)
3808                     ;; opened...delete line.
3809                     (funcall function number)
3810                   ;; closed
3811                   (setq children (wl-thread-get-children-msgs number))
3812                   (while children
3813                     (funcall function (pop children))))
3814                 (forward-line 1))))
3815         (while (not (eobp))
3816           (funcall function (wl-summary-message-number))
3817           (forward-line 1))))))
3818
3819 (defun wl-summary-delete-region (beg end)
3820   (interactive "r")
3821   (wl-summary-mark-region-subr 'wl-summary-delete beg end))
3822
3823 (defun wl-summary-target-mark-region (beg end)
3824   (interactive "r")
3825   (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
3826
3827 (defun wl-summary-target-mark-all ()
3828   (interactive)
3829   (wl-summary-target-mark-region (point-min) (point-max))
3830   (setq wl-summary-buffer-target-mark-list
3831         (mapcar 'car
3832                 (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))))
3833
3834 (defun wl-summary-delete-all-mark (mark)
3835   (goto-char (point-min))
3836   (let ((case-fold-search nil))
3837     (while (re-search-forward (format "^ *[0-9]+%s"
3838                                       (regexp-quote mark)) nil t)
3839       (wl-summary-unmark))
3840     (cond ((string= mark "*")
3841            (setq wl-summary-buffer-target-mark-list nil))
3842           ((string= mark "D")
3843            (setq wl-summary-buffer-delete-list nil))
3844           ((string= mark "O")
3845            (setq wl-summary-buffer-copy-list nil))
3846           ((string= mark "o")
3847            (setq wl-summary-buffer-refile-list nil)))))
3848
3849 (defun wl-summary-unmark-all ()
3850   "Unmark all according to what you input."
3851   (interactive)
3852   (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
3853         cur-mark)
3854     (save-excursion
3855       (while unmarks
3856         (setq cur-mark (char-to-string (car unmarks)))
3857         (wl-summary-delete-all-mark cur-mark)
3858         (setq unmarks (cdr unmarks))))))
3859
3860 (defun wl-summary-target-mark-thread ()
3861   (interactive)
3862   (let (beg end)
3863     (end-of-line)
3864     (wl-summary-goto-top-of-current-thread)
3865     (wl-thread-force-open)
3866     (setq beg (point))
3867     (end-of-line)
3868     (wl-summary-goto-bottom-of-current-thread)
3869 ;;; (forward-line -1)
3870     (beginning-of-line)
3871     (setq end (point))
3872     (wl-summary-target-mark-region beg end)))
3873
3874 (defun wl-summary-target-mark-msgs (msgs)
3875   (while msgs
3876     (if (eq wl-summary-buffer-view 'thread)
3877         (wl-thread-jump-to-msg (car msgs))
3878       (wl-summary-jump-to-msg (car msgs)))
3879     (wl-summary-target-mark (wl-summary-message-number))
3880     (setq msgs (cdr msgs))))
3881
3882 (defun wl-summary-pick (&optional from-list delete-marks)
3883   (interactive)
3884   (let ((result (elmo-msgdb-search
3885                  wl-summary-buffer-folder-name
3886                  (elmo-read-search-condition wl-summary-pick-field-default)
3887                  wl-summary-buffer-msgdb)))
3888     (if delete-marks
3889       (let ((mlist wl-summary-buffer-target-mark-list))
3890         (while mlist
3891           (when (wl-summary-jump-to-msg (car mlist))
3892             (wl-summary-unmark))
3893           (setq mlist (cdr mlist)))
3894         (setq wl-summary-buffer-target-mark-list nil)))
3895     (if from-list
3896         (setq result (elmo-list-filter from-list result)))
3897     (message "%d message(s) are picked." (length result))
3898     (if (null result)
3899         (message "No message was picked.")
3900       (wl-summary-target-mark-msgs result))))
3901
3902 (defun wl-summary-unvirtual ()
3903   "Exit from current virtual folder."
3904   (interactive)
3905   (if (eq 'filter
3906           (elmo-folder-get-type wl-summary-buffer-folder-name))
3907       (wl-summary-goto-folder-subr (nth 2 (elmo-folder-get-spec
3908                                            wl-summary-buffer-folder-name))
3909                                    'update nil nil t)
3910     (error "This folder is not filtered")))
3911
3912 (defun wl-summary-virtual (&optional arg)
3913   "Goto virtual folder.
3914 If ARG, exit virtual folder."
3915   (interactive "P")
3916   (if arg
3917       (wl-summary-unvirtual)
3918     (wl-summary-goto-folder-subr (concat "/"
3919                                          (elmo-read-search-condition
3920                                           wl-summary-pick-field-default)
3921                                          "/"
3922                                          wl-summary-buffer-folder-name)
3923                                  'update nil nil t)))
3924
3925 (defun wl-summary-delete-all-temp-marks ()
3926   (interactive)
3927   (save-excursion
3928     (goto-char (point-min))
3929     (message "Unmarking...")
3930     (while (not (eobp))
3931       (wl-summary-unmark)
3932       (forward-line))
3933     (message "Unmarking...done")
3934     (setq wl-summary-buffer-target-mark-list nil)
3935     (setq wl-summary-buffer-delete-list nil)
3936     (setq wl-summary-buffer-refile-list nil)
3937     (setq wl-summary-buffer-copy-list nil)))
3938
3939 (defun wl-summary-delete-mark (number)
3940   "Delete temporary mark of the message specified by NUMBER."
3941   (cond
3942    ((memq number wl-summary-buffer-target-mark-list)
3943     (setq wl-summary-buffer-target-mark-list
3944           (delq number wl-summary-buffer-target-mark-list)))
3945    ((memq number wl-summary-buffer-delete-list)
3946     (setq wl-summary-buffer-delete-list
3947           (delq number wl-summary-buffer-delete-list)))
3948    (t
3949     (let (pair)
3950       (cond
3951        ((setq pair (assq number wl-summary-buffer-copy-list))
3952         (setq wl-summary-buffer-copy-list
3953               (delq pair wl-summary-buffer-copy-list)))
3954        ((setq pair (assq number wl-summary-buffer-refile-list))
3955         (setq wl-summary-buffer-refile-list
3956               (delq pair wl-summary-buffer-refile-list))))))))
3957
3958 (defun wl-summary-mark-line (mark)
3959   "Put MARK on current line.  Return message number."
3960   (save-excursion
3961     (beginning-of-line)
3962     (let ((inhibit-read-only t)
3963           (buffer-read-only nil)
3964           msg-num
3965           cur-mark)
3966       (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
3967         (setq msg-num  (string-to-int (wl-match-buffer 1)))
3968         (setq cur-mark (wl-match-buffer 2))
3969         (goto-char (match-end 1))
3970         (delete-region (match-beginning 2) (match-end 2))
3971 ;;;     (wl-summary-delete-mark msg-num)
3972         (insert mark)
3973         (if wl-summary-highlight
3974             (wl-highlight-summary-current-line nil nil t))
3975         (set-buffer-modified-p nil)
3976         msg-num))))
3977
3978 (defun wl-summary-target-mark-delete ()
3979   (interactive)
3980   (save-excursion
3981     (goto-char (point-min))
3982     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3983           number mlist)
3984       (while (re-search-forward regexp nil t)
3985         (let (wl-summary-buffer-disp-msg)
3986           (when (setq number (wl-summary-message-number))
3987             (wl-summary-delete number)
3988             (setq wl-summary-buffer-target-mark-list
3989                   (delq number wl-summary-buffer-target-mark-list)))))
3990       (setq mlist wl-summary-buffer-target-mark-list)
3991       (while mlist
3992         (wl-append wl-summary-buffer-delete-list (list (car mlist)))
3993         (setq wl-summary-buffer-target-mark-list
3994               (delq (car mlist) wl-summary-buffer-target-mark-list))
3995         (setq mlist (cdr mlist))))))
3996
3997 (defun wl-summary-target-mark-prefetch ()
3998   (interactive)
3999   (save-excursion
4000     (let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
4001            (inhibit-read-only t)
4002            (buffer-read-only nil)
4003            (count 0)
4004            (length (length mlist))
4005            (pos (point))
4006            skipped
4007            new-mark)
4008       (while mlist
4009         (setq new-mark (wl-summary-prefetch-msg (car mlist)))
4010         (if new-mark
4011             (progn
4012               (message "Prefetching... %d/%d message(s)"
4013                        (setq count (+ 1 count)) length)
4014               (when (wl-summary-jump-to-msg (car mlist))
4015                 (wl-summary-unmark)
4016                 (when new-mark
4017                   (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)")
4018                     (delete-region (match-beginning 1) (match-end 1)))
4019                   (goto-char (match-beginning 1))
4020                   (insert new-mark)
4021                   (if wl-summary-highlight
4022                       (wl-highlight-summary-current-line))
4023                   (save-excursion
4024                     (goto-char pos)
4025                     (sit-for 0)))))
4026           (setq skipped (cons (car mlist) skipped)))
4027         (setq mlist (cdr mlist)))
4028       (setq wl-summary-buffer-target-mark-list skipped)
4029       (message "Prefetching... %d/%d message(s)." count length)
4030       (set-buffer-modified-p nil))))
4031
4032 (defun wl-summary-target-mark-refile-subr (copy-or-refile)
4033   (let ((variable
4034          (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
4035         (function
4036          (intern (format "wl-summary-%s" copy-or-refile)))
4037         regexp number msgid entity folder mlist)
4038     (save-excursion
4039       (goto-char (point-min))
4040       (setq regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4041       ;; guess by first mark
4042       (when (re-search-forward regexp nil t)
4043         (setq msgid (cdr (assq (setq number (wl-summary-message-number))
4044                                (elmo-msgdb-get-number-alist
4045                                 wl-summary-buffer-msgdb)))
4046               entity (assoc msgid
4047                             (elmo-msgdb-get-overview
4048                              wl-summary-buffer-msgdb)))
4049         (if (null entity)
4050             (error "Cannot %s" copy-or-refile))
4051         (funcall function
4052                  (setq folder (wl-summary-read-folder
4053                                (wl-refile-guess entity)
4054                                (format "for %s" copy-or-refile)))
4055                  number)
4056         (if number
4057             (setq wl-summary-buffer-target-mark-list
4058                   (delq number wl-summary-buffer-target-mark-list)))
4059         (while (re-search-forward regexp nil t)
4060           (let (wl-summary-buffer-disp-msg)
4061             (when (setq number (wl-summary-message-number))
4062               (funcall function folder number)
4063               (setq wl-summary-buffer-target-mark-list
4064                     (delq number wl-summary-buffer-target-mark-list)))))
4065         ;; process invisible messages.
4066         (setq mlist wl-summary-buffer-target-mark-list)
4067         (while mlist
4068           (set variable
4069                (append (symbol-value variable)
4070                        (list (cons (car mlist) folder))))
4071           (setq wl-summary-buffer-target-mark-list
4072                 (delq (car mlist) wl-summary-buffer-target-mark-list))
4073           (setq mlist (cdr mlist)))))))
4074
4075 (defun wl-summary-target-mark-copy ()
4076   (interactive)
4077   (wl-summary-target-mark-refile-subr "copy"))
4078
4079 (defun wl-summary-target-mark-refile ()
4080   (interactive)
4081   (wl-summary-target-mark-refile-subr "refile"))
4082
4083 (defun wl-summary-target-mark-mark-as-read ()
4084   (interactive)
4085   (save-excursion
4086     (goto-char (point-min))
4087     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4088           (inhibit-read-only t)
4089           (buffer-read-only nil)
4090           number mlist)
4091       (while (re-search-forward regexp nil t)
4092         (let (wl-summary-buffer-disp-msg)
4093           ;; delete target-mark from buffer.
4094           (delete-region (match-beginning 1) (match-end 1))
4095           (insert " ")
4096           (setq number (wl-summary-mark-as-read t))
4097           (if wl-summary-highlight
4098               (wl-highlight-summary-current-line))
4099           (if number
4100               (setq wl-summary-buffer-target-mark-list
4101                     (delq number wl-summary-buffer-target-mark-list)))))
4102       (setq mlist wl-summary-buffer-target-mark-list)
4103       (while mlist
4104         (wl-summary-mark-as-read t nil nil (car mlist))
4105         (setq wl-summary-buffer-target-mark-list
4106               (delq (car mlist) wl-summary-buffer-target-mark-list))
4107         (setq mlist (cdr mlist)))
4108       (wl-summary-count-unread
4109        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4110       (wl-summary-update-modeline))))
4111
4112 (defun wl-summary-target-mark-mark-as-unread ()
4113   (interactive)
4114   (save-excursion
4115     (goto-char (point-min))
4116     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4117           (inhibit-read-only t)
4118           (buffer-read-only nil)
4119           number mlist)
4120       (while (re-search-forward regexp nil t)
4121         (let (wl-summary-buffer-disp-msg)
4122           ;; delete target-mark from buffer.
4123           (delete-region (match-beginning 1) (match-end 1))
4124           (insert " ")
4125           (setq number (wl-summary-mark-as-unread))
4126           (if wl-summary-highlight
4127               (wl-highlight-summary-current-line))
4128           (if number
4129               (setq wl-summary-buffer-target-mark-list
4130                     (delq number wl-summary-buffer-target-mark-list)))))
4131       (setq mlist wl-summary-buffer-target-mark-list)
4132       (while mlist
4133         (wl-summary-mark-as-unread (car mlist))
4134 ;;;     (wl-thread-msg-mark-as-unread (car mlist))
4135         (setq wl-summary-buffer-target-mark-list
4136               (delq (car mlist) wl-summary-buffer-target-mark-list))
4137         (setq mlist (cdr mlist)))
4138       (wl-summary-count-unread
4139        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4140       (wl-summary-update-modeline))))
4141
4142 (defun wl-summary-target-mark-mark-as-important ()
4143   (interactive)
4144   (save-excursion
4145     (goto-char (point-min))
4146     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4147           (inhibit-read-only t)
4148           (buffer-read-only nil)
4149           number mlist)
4150       (while (re-search-forward regexp nil t)
4151         (let (wl-summary-buffer-disp-msg)
4152           ;; delete target-mark from buffer.
4153           (delete-region (match-beginning 1) (match-end 1))
4154           (insert " ")
4155           (setq number (wl-summary-mark-as-important))
4156           (if wl-summary-highlight
4157               (wl-highlight-summary-current-line))
4158           (if number
4159               (setq wl-summary-buffer-target-mark-list
4160                     (delq number wl-summary-buffer-target-mark-list)))))
4161       (setq mlist wl-summary-buffer-target-mark-list)
4162       (while mlist
4163         (wl-summary-mark-as-important (car mlist))
4164         (wl-thread-msg-mark-as-important (car mlist))
4165         (setq wl-summary-buffer-target-mark-list
4166               (delq (car mlist) wl-summary-buffer-target-mark-list))
4167         (setq mlist (cdr mlist)))
4168       (wl-summary-count-unread
4169        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4170       (wl-summary-update-modeline))))
4171
4172 (defun wl-summary-target-mark-save ()
4173   (interactive)
4174   (save-excursion
4175     (goto-char (point-min))
4176     (let ((wl-save-dir
4177            (wl-read-directory-name "Save to directory: " wl-tmp-dir))
4178           (regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4179           number mlist)
4180       (if (null (file-exists-p wl-save-dir))
4181           (make-directory wl-save-dir))
4182       (while (re-search-forward regexp nil t)
4183         (let (wl-summary-buffer-disp-msg)
4184           (setq number (wl-summary-save t wl-save-dir))
4185           (wl-summary-unmark)
4186           (if number
4187               (setq wl-summary-buffer-target-mark-list
4188                     (delq number wl-summary-buffer-target-mark-list))))))))
4189
4190 (defun wl-summary-target-mark-pick ()
4191   (interactive)
4192   (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
4193
4194 (defun wl-summary-mark-as-read (&optional notcrosses
4195                                           leave-server-side-mark-untouched
4196                                           displayed
4197                                           number
4198                                           cached)
4199   (interactive)
4200   (save-excursion
4201     (let* (eol
4202            (inhibit-read-only t)
4203            (buffer-read-only nil)
4204            (folder wl-summary-buffer-folder-name)
4205            (msgdb wl-summary-buffer-msgdb)
4206            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4207 ;;;        (number-alist (elmo-msgdb-get-number-alist msgdb))
4208            (case-fold-search nil)
4209            mark stat visible uncached new-mark marked)
4210       (if number
4211           (progn
4212             (setq visible (wl-summary-jump-to-msg number))
4213             (setq mark (cadr (assq number mark-alist))))
4214         (setq visible t))
4215       (beginning-of-line)
4216       (if (or (not visible)
4217               (looking-at
4218                (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
4219                        (regexp-quote wl-summary-read-uncached-mark)
4220                        (regexp-quote wl-summary-unread-uncached-mark)
4221                        (regexp-quote wl-summary-unread-cached-mark)
4222                        (regexp-quote wl-summary-new-mark))))
4223           (progn
4224             (setq mark (or mark (wl-match-buffer 2)))
4225             (when mark
4226               (cond
4227                ((string= mark wl-summary-new-mark) ; N
4228                 (setq stat 'new)
4229                 (setq uncached t))
4230                ((string= mark wl-summary-unread-uncached-mark) ; U
4231                 (setq stat 'unread)
4232                 (setq uncached t))
4233                ((string= mark wl-summary-unread-cached-mark)  ; !
4234                 (setq stat 'unread))
4235                (t
4236                 ;; no need to mark server.
4237                 (setq leave-server-side-mark-untouched t))))
4238             (setq number (or number (string-to-int (wl-match-buffer 1))))
4239             ;; set server side mark...
4240             (setq new-mark (if (and uncached
4241                                     (if (elmo-use-cache-p folder number)
4242                                         (not (elmo-folder-local-p folder)))
4243                                     (not cached))
4244                                wl-summary-read-uncached-mark
4245                              nil))
4246             (if (not leave-server-side-mark-untouched)
4247                 (setq marked (elmo-mark-as-read folder
4248                                                 (list number) msgdb)))
4249             (if (or leave-server-side-mark-untouched
4250                     marked)
4251                 (progn
4252                   (cond ((eq stat 'unread)
4253                          (setq wl-summary-buffer-unread-count
4254                                (1- wl-summary-buffer-unread-count)))
4255                         ((eq stat 'new)
4256                          (setq wl-summary-buffer-new-count
4257                                (1- wl-summary-buffer-new-count))))
4258                   (wl-summary-update-modeline)
4259                   (wl-folder-update-unread
4260                    folder
4261                    (+ wl-summary-buffer-unread-count
4262                       wl-summary-buffer-new-count))
4263                   (when (or stat cached)
4264                     (when visible
4265                       (goto-char (match-end 2))
4266                       (delete-region (match-beginning 2) (match-end 2))
4267                       (insert (or new-mark " ")))
4268                     (setq mark-alist
4269                           (elmo-msgdb-mark-set mark-alist number new-mark))
4270                     (elmo-msgdb-set-mark-alist msgdb mark-alist)
4271                     (wl-summary-set-mark-modified))
4272                   (if (and visible wl-summary-highlight)
4273                       (wl-highlight-summary-current-line nil nil t))
4274                   (if (not notcrosses)
4275                       (wl-summary-set-crosspost nil
4276                                                 (and wl-summary-buffer-disp-msg
4277                                                      (interactive-p)))))
4278               (if mark (message "Warning: Changing mark failed.")))))
4279       (set-buffer-modified-p nil)
4280       (if stat
4281           (run-hooks 'wl-summary-unread-message-hook))
4282       number ;return value
4283       )))
4284
4285 (defun wl-summary-mark-as-important (&optional number
4286                                                mark
4287                                                no-server-update)
4288   (interactive)
4289   (if (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
4290           'internal)
4291       (error "Cannot process mark in this folder"))
4292   (save-excursion
4293     (let* (eol
4294           (inhibit-read-only t)
4295           (buffer-read-only nil)
4296           (folder wl-summary-buffer-folder-name)
4297           (msgdb wl-summary-buffer-msgdb)
4298           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4299           (number-alist (elmo-msgdb-get-number-alist msgdb))
4300           message-id visible)
4301       (if number
4302           (progn
4303             (setq visible (wl-summary-jump-to-msg number))
4304             (setq mark (or mark (cadr (assq number mark-alist)))))
4305         (setq visible t))
4306       (when visible
4307         (if (null (wl-summary-message-number))
4308             (progn
4309               (message "No message.")
4310               (setq visible nil))
4311           (end-of-line)
4312           (setq eol (point))
4313           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
4314                                       "..../..") nil t)) ; set cursor line
4315         )
4316       (beginning-of-line)
4317       (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)
4318           (progn
4319             (setq number (or number (string-to-int (wl-match-buffer 1))))
4320             (setq mark (or mark (wl-match-buffer 2)))
4321             (setq message-id (cdr (assq number number-alist)))
4322             (if (string= mark wl-summary-important-mark)
4323                 (progn
4324                   ;; server side mark
4325                   (unless no-server-update
4326                     (elmo-unmark-important folder (list number) msgdb)
4327                     (elmo-msgdb-global-mark-delete message-id))
4328                   (when visible
4329                     (delete-region (match-beginning 2) (match-end 2))
4330                     (insert " "))
4331                   (setq mark-alist
4332                         (elmo-msgdb-mark-set mark-alist
4333                                              number
4334                                              nil)))
4335               ;; server side mark
4336               (unless no-server-update
4337                 (elmo-mark-as-important folder (list number) msgdb))
4338               (when visible
4339                 (delete-region (match-beginning 2) (match-end 2))
4340                 (insert wl-summary-important-mark))
4341               (setq mark-alist
4342                     (elmo-msgdb-mark-set mark-alist
4343                                          (string-to-int (wl-match-buffer 1))
4344                                          wl-summary-important-mark))
4345               ;; Force cache message!!
4346               (save-match-data
4347                 (unless (elmo-cache-exists-p message-id)
4348                   (elmo-force-cache-msg folder number message-id
4349                                         (elmo-msgdb-get-location msgdb))))
4350               (unless no-server-update
4351                 (elmo-msgdb-global-mark-set message-id
4352                                             wl-summary-important-mark)))
4353             (elmo-msgdb-set-mark-alist msgdb mark-alist)
4354             (wl-summary-set-mark-modified)))
4355       (if (and visible wl-summary-highlight)
4356           (wl-highlight-summary-current-line nil nil t))))
4357   (set-buffer-modified-p nil)
4358   number)
4359
4360 (defsubst wl-summary-format-date (date-string)
4361   (condition-case nil
4362       (let ((datevec (timezone-fix-time date-string nil
4363                                         wl-summary-fix-timezone)))
4364         (format "%02d/%02d(%s)%02d:%02d"
4365                 (aref datevec 1)
4366                 (aref datevec 2)
4367                 (elmo-date-get-week (aref datevec 0)
4368                                     (aref datevec 1)
4369                                     (aref datevec 2))
4370                 (aref datevec 3)
4371                 (aref datevec 4)))
4372     (error "??/??(??)??:??")))
4373
4374 (defun wl-summary-overview-create-summary-line (msg
4375                                                 entity
4376                                                 parent-entity
4377                                                 depth
4378                                                 mark-alist
4379                                                 &optional
4380                                                 children-num
4381                                                 temp-mark thr-entity
4382                                                 subject-differ)
4383   (let ((wl-mime-charset wl-summary-buffer-mime-charset)
4384         (elmo-mime-charset wl-summary-buffer-mime-charset)
4385         no-parent before-indent
4386         from subject parent-raw-subject parent-subject
4387         mark line
4388         (elmo-lang wl-summary-buffer-weekday-name-lang)
4389         (children-num (if children-num (int-to-string children-num)))
4390         (thr-str "")
4391         linked)
4392     (when thr-entity
4393       (setq thr-str (wl-thread-make-indent-string thr-entity))
4394       (setq linked (wl-thread-entity-get-linked thr-entity)))
4395     (if (string= thr-str "")
4396         (setq no-parent t)) ; no parent
4397     (if (and wl-summary-width
4398              wl-summary-indent-length-limit
4399              (< wl-summary-indent-length-limit
4400                 (string-width thr-str)))
4401         (setq thr-str (wl-set-string-width
4402                        wl-summary-indent-length-limit
4403                        thr-str)))
4404     (setq from
4405           (wl-set-string-width
4406            (if children-num
4407                (- wl-from-width (length children-num) 2)
4408              wl-from-width)
4409            (elmo-delete-char ?\n
4410                              (wl-summary-from-func-internal
4411                               (elmo-msgdb-overview-entity-get-from entity)))))
4412     (setq subject
4413           (elmo-delete-char ?\n
4414                             (or (elmo-msgdb-overview-entity-get-subject
4415                                  entity)
4416                                 wl-summary-no-subject-message)))
4417     (setq parent-raw-subject
4418           (elmo-msgdb-overview-entity-get-subject parent-entity))
4419     (setq parent-subject
4420           (if parent-raw-subject
4421               (elmo-delete-char ?\n parent-raw-subject)))
4422     (setq mark (or (cadr (assq msg mark-alist)) " "))
4423     (setq line
4424           (concat
4425            (setq before-indent
4426                  (format (concat "%"
4427                                  (int-to-string
4428                                   wl-summary-buffer-number-column)
4429                                  "s%s%s%s %s")
4430                          msg
4431                          (or temp-mark " ")
4432                          mark
4433                          (wl-summary-format-date
4434                           (elmo-msgdb-overview-entity-get-date entity))
4435                          (if thr-str thr-str "")))
4436            (format (if linked
4437                        "<%s > %s"
4438                      "[%s ] %s")
4439                    (if children-num
4440                        (concat "+" children-num ": " from)
4441                      (concat " " from))
4442                    (progn
4443                      (setq subject
4444                            (if (or no-parent
4445                                    (null parent-subject)
4446                                    (not (wl-summary-subject-equal
4447                                          subject parent-subject)))
4448                                (wl-summary-subject-func-internal subject) ""))
4449                      (if (and (not wl-summary-width)
4450                               wl-subject-length-limit)
4451                          (truncate-string subject wl-subject-length-limit)
4452                        subject)))))
4453     (if wl-summary-width (setq line
4454                                (wl-set-string-width
4455                                 (- wl-summary-width 1) line)))
4456     (if wl-summary-highlight
4457         (wl-highlight-summary-line-string line
4458                                           mark
4459                                           temp-mark
4460                                           thr-str))
4461     line))
4462
4463 (defsubst wl-summary-buffer-number-column-detect (update)
4464   (let (end)
4465     (save-excursion
4466       (goto-char (point-min))
4467       (setq wl-summary-buffer-number-column
4468             (or
4469              (if (and update
4470                       (setq end (if (re-search-forward "^ *[0-9]+[^0-9]" nil t)
4471                                     (point))))
4472                  (- end (progn (beginning-of-line) (point)) 1))
4473              (wl-get-assoc-list-value wl-summary-number-column-alist
4474                                       wl-summary-buffer-folder-name)
4475              wl-summary-default-number-column))
4476       (setq wl-summary-buffer-number-regexp
4477             (wl-repeat-string "." wl-summary-buffer-number-column)))))
4478
4479 (defsubst wl-summary-proc-wday (wday-str year month mday)
4480   (save-match-data
4481     (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
4482         (wl-match-string 1 wday-str)
4483       (elmo-date-get-week year month mday))))
4484
4485 (defmacro wl-summary-cursor-move-regex ()
4486   (` (let ((mark-alist
4487             (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
4488                 (cond ((eq wl-summary-move-order 'new)
4489                        (list
4490                         (list
4491                          wl-summary-new-mark)
4492                         (list
4493                          wl-summary-unread-uncached-mark
4494                          wl-summary-unread-cached-mark
4495                          wl-summary-important-mark)))
4496                       ((eq wl-summary-move-order 'unread)
4497                        (list
4498                        (list
4499                         wl-summary-unread-uncached-mark
4500                         wl-summary-unread-cached-mark
4501                         wl-summary-new-mark)
4502                        (list
4503                         wl-summary-important-mark)))
4504                       (t
4505                        (list
4506                        (list
4507                         wl-summary-unread-uncached-mark
4508                         wl-summary-unread-cached-mark
4509                         wl-summary-new-mark
4510                         wl-summary-important-mark))))
4511               (cond ((eq wl-summary-move-order 'unread)
4512                      (list
4513                      (list
4514                       wl-summary-unread-cached-mark)
4515                      (list
4516                       wl-summary-important-mark)))
4517                     (t
4518                      (list
4519                      (list
4520                       wl-summary-unread-cached-mark
4521                       wl-summary-important-mark)))))))
4522        (mapcar
4523         (function
4524          (lambda (mark-list)
4525            (concat wl-summary-message-regexp
4526                    ".\\("
4527                    (mapconcat 'regexp-quote
4528                               mark-list
4529                               "\\|")
4530                    "\\)\\|"
4531                    wl-summary-message-regexp "\\*")))
4532         mark-alist))))
4533
4534 ;;
4535 ;; Goto unread or important
4536 ;;
4537 (defun wl-summary-cursor-up (&optional hereto)
4538   (interactive "P")
4539   (if (and (not wl-summary-buffer-target-mark-list)
4540            (eq wl-summary-buffer-view 'thread))
4541       (progn
4542         (if (eobp)
4543             (forward-line -1))
4544         (wl-thread-jump-to-prev-unread hereto))
4545     (if hereto
4546         (end-of-line)
4547       (beginning-of-line))
4548     (let ((case-fold-search nil)
4549           regex-list)
4550       (setq regex-list (wl-summary-cursor-move-regex))
4551       (catch 'done
4552         (while regex-list
4553           (when (re-search-backward
4554                  (car regex-list)
4555                  nil t nil)
4556             (beginning-of-line)
4557             (throw 'done t))
4558           (setq regex-list (cdr regex-list)))
4559         (beginning-of-line)
4560         (throw 'done nil)))))
4561
4562 ;;
4563 ;; Goto unread or important
4564 ;; returns t if next message exists in this folder.
4565 (defun wl-summary-cursor-down (&optional hereto)
4566   (interactive "P")
4567   (if (and (null wl-summary-buffer-target-mark-list)
4568            (eq wl-summary-buffer-view 'thread))
4569       (wl-thread-jump-to-next-unread hereto)
4570     (if hereto
4571         (beginning-of-line)
4572       (end-of-line))
4573     (let ((case-fold-search nil)
4574           regex-list)
4575       (setq regex-list (wl-summary-cursor-move-regex))
4576       (catch 'done
4577         (while regex-list
4578           (when (re-search-forward
4579                  (car regex-list)
4580                  nil t nil)
4581             (beginning-of-line)
4582             (throw 'done t))
4583           (setq regex-list (cdr regex-list)))
4584         (beginning-of-line)
4585         (throw 'done nil)))))
4586
4587 (defun wl-summary-save-view-cache ()
4588   (save-excursion
4589     (let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
4590            (cache (expand-file-name wl-summary-cache-file dir))
4591            (view (expand-file-name wl-summary-view-file dir))
4592 ;;;        (coding-system-for-write wl-cs-cache)
4593 ;;;        (output-coding-system wl-cs-cache)
4594            (save-view wl-summary-buffer-view)
4595            (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
4596            (charset wl-summary-buffer-mime-charset))
4597       (if (file-directory-p dir)
4598           (); ok.
4599         (if (file-exists-p dir)
4600             (error "File %s already exists" dir)
4601           (elmo-make-directory dir)))
4602       (if (eq save-view 'thread)
4603           (wl-thread-save-entity dir))
4604       (unwind-protect
4605           (progn
4606             (when (file-writable-p cache)
4607               (copy-to-buffer tmp-buffer (point-min) (point-max))
4608               (with-current-buffer tmp-buffer
4609                 (widen)
4610                 (encode-mime-charset-region
4611                  (point-min) (point-max) charset)
4612                 (as-binary-output-file
4613                  (write-region (point-min)
4614                                (point-max) cache nil 'no-msg))
4615                 (write-region (point-min) (point-max) cache nil
4616                               'no-msg)))
4617             (when (file-writable-p view) ; 'thread or 'sequence
4618               (save-excursion
4619                 (set-buffer tmp-buffer)
4620                 (erase-buffer)
4621                 (prin1 save-view tmp-buffer)
4622                 (princ "\n" tmp-buffer)
4623                 (write-region (point-min) (point-max) view nil 'no-msg))))
4624         ;; kill tmp buffer.
4625         (kill-buffer tmp-buffer)))))
4626
4627 (defsubst wl-summary-get-sync-range (folder)
4628   (intern (or (and
4629                (elmo-folder-plugged-p folder)
4630                (wl-get-assoc-list-value
4631                 wl-folder-sync-range-alist
4632                 folder))
4633               wl-default-sync-range)))
4634
4635 ;; redefined for wl-summary-sync-update
4636 (defun wl-summary-input-range (folder)
4637   "returns update or all or rescan."
4638   ;; for the case when parts are expanded in the bottom of the folder
4639   (let ((input-range-list '("update" "all" "rescan" "first:" "last:"
4640                             "no-sync" "rescan-noscore"))
4641         (default (or (wl-get-assoc-list-value
4642                       wl-folder-sync-range-alist
4643                       folder)
4644                      wl-default-sync-range))
4645         range)
4646     (setq range
4647           (completing-read (format "Range (%s): " default)
4648                            (mapcar
4649                             (function (lambda (x) (cons x x)))
4650                             input-range-list)))
4651     (if (string= range "")
4652         default
4653       range)))
4654
4655 (defun wl-summary-toggle-disp-folder (&optional arg)
4656   (interactive)
4657   (let (fld-buf fld-win
4658         (view-message-buffer (wl-message-get-buffer-create))
4659         (cur-buf (current-buffer))
4660         (summary-win (get-buffer-window (current-buffer))))
4661     (cond
4662      ((eq arg 'on)
4663       (setq wl-summary-buffer-disp-folder t)
4664       ;; hide your folder window
4665       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4666           (if (setq fld-win (get-buffer-window fld-buf))
4667               (delete-window fld-win))))
4668      ((eq arg 'off)
4669       (setq wl-summary-buffer-disp-folder nil)
4670       ;; hide your wl-message window!
4671       (wl-select-buffer view-message-buffer)
4672       (delete-window)
4673       (select-window (get-buffer-window cur-buf))
4674       ;; display wl-folder window!!
4675       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4676           (if (setq fld-win (get-buffer-window fld-buf))
4677               ;; folder win is already displayed.
4678               (select-window fld-win)
4679             ;; folder win is not displayed.
4680             (switch-to-buffer fld-buf))
4681         ;; no folder buf
4682         (wl-folder))
4683       ;; temporarily delete summary-win.
4684       (if summary-win
4685           (delete-window summary-win))
4686       (split-window-horizontally wl-folder-window-width)
4687       (other-window 1)
4688       (switch-to-buffer cur-buf))
4689      (t
4690       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4691           (if (setq fld-win (get-buffer-window fld-buf))
4692               (setq wl-summary-buffer-disp-folder nil)
4693             (setq wl-summary-buffer-disp-folder t)))
4694       (if (not wl-summary-buffer-disp-folder)
4695           ;; hide message window
4696           (let ((mes-win (get-buffer-window view-message-buffer))
4697                 (wl-stay-folder-window t))
4698             (if mes-win (delete-window mes-win))
4699             ;; hide your folder window
4700             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4701                 (if (setq fld-win (get-buffer-window fld-buf))
4702                     (progn
4703                       (delete-window (get-buffer-window cur-buf))
4704                       (select-window fld-win)
4705                       (switch-to-buffer cur-buf))))
4706             (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
4707             ;; resume message window.
4708             (when mes-win
4709               (wl-select-buffer view-message-buffer)
4710               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4711               (select-window (get-buffer-window cur-buf)))
4712             )
4713         (save-excursion
4714           ;; hide message window
4715           (let ((mes-win (get-buffer-window view-message-buffer))
4716                 (wl-stay-folder-window t))
4717             (if mes-win (delete-window mes-win))
4718             (select-window (get-buffer-window cur-buf))
4719             ;; display wl-folder window!!
4720             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4721                 (if (setq fld-win (get-buffer-window fld-buf))
4722                     ;; folder win is already displayed.
4723                     (select-window fld-win)
4724                   ;; folder win is not displayed...occupy all.
4725                   (switch-to-buffer fld-buf))
4726               ;; no folder buf
4727               (wl-folder))
4728             (split-window-horizontally wl-folder-window-width)
4729             (other-window 1)
4730             (switch-to-buffer cur-buf)
4731             ;; resume message window.
4732             (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
4733             (when mes-win
4734               (wl-select-buffer view-message-buffer)
4735               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4736               (select-window (get-buffer-window cur-buf))))
4737           )))))
4738   (run-hooks 'wl-summary-toggle-disp-folder-hook))
4739
4740 (defun wl-summary-toggle-disp-msg (&optional arg)
4741   (interactive)
4742   (let (fld-buf fld-win
4743         (view-message-buffer (wl-message-get-buffer-create))
4744         (cur-buf (current-buffer))
4745         summary-win)
4746     (cond
4747      ((eq arg 'on)
4748       (setq wl-summary-buffer-disp-msg t)
4749       ;; hide your folder window
4750       (if (and (not wl-stay-folder-window)
4751                (setq fld-buf (get-buffer wl-folder-buffer-name)))
4752           (if (setq fld-win (get-buffer-window fld-buf))
4753               (delete-window fld-win))))
4754      ((eq arg 'off)
4755       (wl-delete-all-overlays)
4756       (setq wl-summary-buffer-disp-msg nil)
4757       (save-excursion
4758         (wl-select-buffer view-message-buffer)
4759         (delete-window)
4760         (and (get-buffer-window cur-buf)
4761              (select-window (get-buffer-window cur-buf)))
4762         (run-hooks 'wl-summary-toggle-disp-off-hook)))
4763      (t
4764       (if (get-buffer-window view-message-buffer) ; already displayed
4765           (setq wl-summary-buffer-disp-msg nil)
4766         (setq wl-summary-buffer-disp-msg t))
4767       (if wl-summary-buffer-disp-msg
4768           (progn
4769             (wl-summary-redisplay)
4770 ;;; hide your folder window
4771 ;;;         (setq fld-buf (get-buffer wl-folder-buffer-name))
4772 ;;;         (if (setq fld-win (get-buffer-window fld-buf))
4773 ;;;             (delete-window fld-win)))
4774             (run-hooks 'wl-summary-toggle-disp-on-hook))
4775         (wl-delete-all-overlays)
4776         (save-excursion
4777           (wl-select-buffer view-message-buffer)
4778           (delete-window)
4779           (select-window (get-buffer-window cur-buf))
4780           (run-hooks 'wl-summary-toggle-disp-off-hook))
4781 ;;;     (switch-to-buffer cur-buf)
4782         )))))
4783
4784 (defun wl-summary-next-line-content ()
4785   (interactive)
4786   (let ((cur-buf (current-buffer)))
4787     (wl-summary-toggle-disp-msg 'on)
4788     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4789       (set-buffer cur-buf)
4790       (wl-message-next-page 1))))
4791
4792 (defun wl-summary-prev-line-content ()
4793   (interactive)
4794   (let ((cur-buf (current-buffer)))
4795     (wl-summary-toggle-disp-msg 'on)
4796     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4797       (set-buffer cur-buf)
4798       (wl-message-prev-page 1))))
4799
4800 (defun wl-summary-next-page ()
4801   (interactive)
4802   (wl-message-next-page))
4803
4804 (defun wl-summary-prev-page ()
4805   (interactive)
4806   (wl-message-prev-page))
4807
4808 (defsubst wl-summary-no-mime-p (folder)
4809   (wl-string-match-member folder wl-summary-no-mime-folder-list))
4810
4811 (defun wl-summary-set-message-buffer-or-redisplay (&optional ignore-original)
4812   ;; if current message is not displayed, display it.
4813   ;; return t if exists.
4814   (let ((folder wl-summary-buffer-folder-name)
4815         (number (wl-summary-message-number))
4816         cur-folder cur-number message-last-pos
4817         (view-message-buffer (wl-message-get-buffer-create)))
4818     (save-excursion
4819       (set-buffer view-message-buffer)
4820       (setq cur-folder wl-message-buffer-cur-folder)
4821       (setq cur-number wl-message-buffer-cur-number))
4822     (if (and (not ignore-original)
4823              (not
4824               (and (eq number (wl-message-original-buffer-number))
4825                    (string= folder (wl-message-original-buffer-folder)))))
4826         (progn
4827           (if (wl-summary-no-mime-p folder)
4828               (wl-summary-redisplay-no-mime folder number)
4829             (wl-summary-redisplay-internal folder number))
4830           nil)
4831       (if (and (string= folder (or cur-folder ""))
4832                (eq number (or cur-number 0)))
4833           (progn
4834             (set-buffer view-message-buffer)
4835             t)
4836         (if (wl-summary-no-mime-p folder)
4837             (wl-summary-redisplay-no-mime folder number)
4838           (wl-summary-redisplay-internal folder number))
4839         nil))))
4840
4841 (defun wl-summary-target-mark-forward (&optional arg)
4842   (interactive "P")
4843   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4844         (summary-buf (current-buffer))
4845         (wl-draft-forward t)
4846         start-point
4847         draft-buf)
4848     (wl-summary-jump-to-msg (car mlist))
4849     (wl-summary-forward t)
4850     (setq start-point (point))
4851     (setq draft-buf (current-buffer))
4852     (setq mlist (cdr mlist))
4853     (save-window-excursion
4854       (when mlist
4855         (while mlist
4856           (set-buffer summary-buf)
4857           (wl-summary-jump-to-msg (car mlist))
4858           (wl-summary-redisplay)
4859           (set-buffer draft-buf)
4860           (goto-char (point-max))
4861           (wl-draft-insert-message)
4862           (setq mlist (cdr mlist)))
4863         (wl-draft-body-goto-top)
4864         (wl-draft-enclose-digest-region (point) (point-max)))
4865       (goto-char start-point)
4866       (save-excursion
4867         (set-buffer summary-buf)
4868         (wl-summary-delete-all-temp-marks)))
4869     (run-hooks 'wl-mail-setup-hook)))
4870
4871 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
4872   (interactive "P")
4873   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4874         (summary-buf (current-buffer))
4875         change-major-mode-hook
4876         start-point
4877         draft-buf)
4878     (wl-summary-jump-to-msg (car mlist))
4879     (wl-summary-reply arg t)
4880     (goto-char (point-max))
4881     (setq start-point (point))
4882     (setq draft-buf (current-buffer))
4883     (save-window-excursion
4884       (while mlist
4885         (set-buffer summary-buf)
4886         (wl-summary-jump-to-msg (car mlist))
4887         (wl-summary-redisplay)
4888         (set-buffer draft-buf)
4889         (goto-char (point-max))
4890         (wl-draft-yank-original)
4891         (setq mlist (cdr mlist)))
4892       (goto-char start-point)
4893       (save-excursion
4894         (set-buffer summary-buf)
4895         (wl-summary-delete-all-temp-marks)))
4896     (run-hooks 'wl-mail-setup-hook)))
4897
4898 (defun wl-summary-reply-with-citation (&optional arg)
4899   (interactive "P")
4900   (when (wl-summary-reply arg t)
4901     (goto-char (point-max))
4902     (wl-draft-yank-original)
4903     (run-hooks 'wl-mail-setup-hook)))
4904
4905 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
4906   (interactive)
4907   (let* ((original (wl-summary-message-number))
4908          (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4909          (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
4910          msg otherfld schar
4911          (errmsg
4912           (format "No message with id \"%s\" in the folder." msgid)))
4913     (if (setq msg (car (rassoc msgid number-alist)))
4914 ;;;     (wl-summary-jump-to-msg-internal
4915 ;;;      wl-summary-buffer-folder-name msg 'no-sync)
4916         (progn
4917           (wl-thread-jump-to-msg msg)
4918           t)
4919       ;; for XEmacs!
4920       (if (and elmo-use-database
4921                (setq errmsg
4922                      (format
4923                       "No message with id \"%s\" in the database." msgid))
4924                (setq otherfld (elmo-database-msgid-get msgid)))
4925           (if (cdr (wl-summary-jump-to-msg-internal
4926                     (car otherfld) (nth 1 otherfld) 'no-sync))
4927               t ; succeed.
4928             ;; Back to original.
4929             (wl-summary-jump-to-msg-internal
4930              wl-summary-buffer-folder-name original 'no-sync))
4931         (cond ((eq wl-summary-search-via-nntp 'confirm)
4932                (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
4933                         elmo-default-nntp-server)
4934                (setq schar (read-char))
4935                (cond ((eq schar ?y)
4936                       (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4937                      ((eq schar ?s)
4938                       (wl-summary-jump-to-msg-by-message-id-via-nntp
4939                        msgid
4940                        (read-from-minibuffer "NNTP Server: ")))
4941                      (t
4942                       (message errmsg)
4943                       nil)))
4944               (wl-summary-search-via-nntp
4945                (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4946               (t
4947                (message errmsg)
4948                nil))))))
4949
4950 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4951   (interactive)
4952   (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4953          newsgroups folder ret
4954          user server port type spec)
4955     (if server-spec
4956         (if (string-match "^-" server-spec)
4957             (setq spec (elmo-nntp-get-spec server-spec)
4958                   user (nth 2 spec)
4959                   server (nth 3 spec)
4960                   port (nth 4 spec)
4961                   type (nth 5 spec))
4962           (setq server server-spec)))
4963     (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4964                      msgid
4965                      (or server elmo-default-nntp-server)
4966                      (or user elmo-default-nntp-user)
4967                      (or port elmo-default-nntp-port)
4968                      (or type elmo-default-nntp-stream-type)))
4969       (setq newsgroups (wl-parse-newsgroups ret))
4970       (setq folder (concat "-" (car newsgroups)
4971                            (elmo-nntp-folder-postfix user server port type)))
4972       (catch 'found
4973         (while newsgroups
4974           (if (wl-folder-entity-exists-p (car newsgroups)
4975                                          wl-folder-newsgroups-hashtb)
4976               (throw 'found
4977                      (setq folder (concat "-" (car newsgroups)
4978                                           (elmo-nntp-folder-postfix
4979                                            user server port type)))))
4980           (setq newsgroups (cdr newsgroups)))))
4981     (if ret
4982         (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4983       (message "No message id \"%s\" in nntp server \"%s\"."
4984                msgid (or server elmo-default-nntp-server))
4985       nil)))
4986
4987 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4988   (let (wl-auto-select-first entity)
4989     (if (or (string= folder wl-summary-buffer-folder-name)
4990             (y-or-n-p
4991              (format
4992               "Message was found in the folder \"%s\". Jump to it? "
4993               folder)))
4994         (progn
4995           (unwind-protect
4996               (wl-summary-goto-folder-subr
4997                folder scan-type nil nil t)
4998             (if msgid
4999                 (setq msg
5000                       (car (rassoc msgid
5001                                    (elmo-msgdb-get-number-alist
5002                                     wl-summary-buffer-msgdb)))))
5003             (setq entity (wl-folder-search-entity-by-name folder
5004                                                           wl-folder-entity
5005                                                           'folder))
5006             (if entity
5007                 (wl-folder-set-current-entity-id
5008                  (wl-folder-get-entity-id entity))))
5009           (if (null msg)
5010               (message "Message was not found currently in this folder.")
5011             (setq msg (and (wl-thread-jump-to-msg msg) msg)))
5012           (cons folder msg)))))
5013
5014 (defun wl-summary-jump-to-parent-message (arg)
5015   (interactive "P")
5016   (let ((cur-buf (current-buffer))
5017         (number (wl-summary-message-number))
5018         (regexp "\\(<[^<>]*>\\)[ \t]*$")
5019         (i -1) ;; xxx
5020         msg-id msg-num ref-list ref irt)
5021     (if (null number)
5022         (message "No message.")
5023       (when (eq wl-summary-buffer-view 'thread)
5024         (cond ((and arg (not (numberp arg)))
5025                (setq msg-num
5026                      (wl-thread-entity-get-number
5027                       (wl-thread-entity-get-top-entity
5028                        (wl-thread-get-entity number)))))
5029               ((and arg (numberp arg))
5030                (setq i 0)
5031                (setq msg-num number)
5032                (while (< i arg)
5033                  (setq msg-num
5034                        (wl-thread-entity-get-number
5035                         (wl-thread-entity-get-parent-entity
5036                          (wl-thread-get-entity msg-num))))
5037                  (setq i (1+ i))))
5038               (t (setq msg-num
5039                        (wl-thread-entity-get-number
5040                         (wl-thread-entity-get-parent-entity
5041                          (wl-thread-get-entity number)))))))
5042       (when (null msg-num)
5043         (wl-summary-set-message-buffer-or-redisplay)
5044         (set-buffer (wl-message-get-original-buffer))
5045         (message "Searching parent message...")
5046         (setq ref (std11-field-body "References")
5047               irt (std11-field-body "In-Reply-To"))
5048         (cond
5049          ((and arg (not (numberp arg)) ref (not (string= ref ""))
5050                (string-match regexp ref))
5051           ;; The first message of the thread.
5052           (setq msg-id (wl-match-string 1 ref)))
5053          ;; "In-Reply-To:" has only one msg-id.
5054          ((and (null arg) irt (not (string= irt ""))
5055                (string-match regexp irt))
5056           (setq msg-id (wl-match-string 1 irt)))
5057          ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
5058                (string-match regexp ref))
5059           ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
5060           (while (string-match regexp ref)
5061             (setq ref-list
5062                   (append (list
5063                            (wl-match-string 1 ref))
5064                           ref-list))
5065             (setq ref (substring ref (match-end 0)))
5066             (setq i (1+ i)))
5067           (setq msg-id
5068                 (if (null arg) (nth 0 ref-list) ;; previous
5069                   (if (<= arg i) (nth (1- arg) ref-list)
5070                     (nth i ref-list)))))))
5071       (set-buffer cur-buf)
5072       (cond ((and (null msg-id) (null msg-num))
5073              (message "No parent message!")
5074              nil)
5075             ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
5076              (wl-summary-redisplay)
5077              (message "Searching parent message...done")
5078              t)
5079             ((and msg-num (wl-summary-jump-to-msg msg-num))
5080              (wl-summary-redisplay)
5081              (message "Searching parent message...done")
5082              t)
5083             (t ; failed.
5084              (message "Parent message was not found.")
5085              nil)))))
5086
5087 (defun wl-summary-reply (&optional arg without-setup-hook)
5088   "Reply to current message. Default is \"wide\" reply.
5089 Reply to author if invoked with ARG."
5090   (interactive "P")
5091   (let ((folder wl-summary-buffer-folder-name)
5092         (number (wl-summary-message-number))
5093         (summary-buf (current-buffer))
5094         mes-buf)
5095     (if number
5096         (unwind-protect
5097             (progn
5098               (wl-summary-redisplay-internal folder number)
5099               (wl-select-buffer
5100                (get-buffer (setq mes-buf (wl-current-message-buffer))))
5101               (set-buffer mes-buf)
5102               (goto-char (point-min))
5103               (or wl-draft-use-frame
5104                   (split-window-vertically))
5105               (other-window 1)
5106               (when (setq mes-buf (wl-message-get-original-buffer))
5107                 (wl-draft-reply mes-buf (not arg) summary-buf)
5108                 (unless without-setup-hook
5109                   (run-hooks 'wl-mail-setup-hook)))
5110               t)))))
5111
5112 (defun wl-summary-write ()
5113   "Write a new draft from Summary."
5114   (interactive)
5115   (wl-draft nil nil nil nil nil
5116             nil nil nil nil nil nil (current-buffer))
5117   (run-hooks 'wl-mail-setup-hook)
5118   (mail-position-on-field "To"))
5119
5120 (defvar wl-summary-write-current-folder-functions
5121   '(wl-folder-get-newsgroups
5122     wl-folder-guess-mailing-list-by-refile-rule
5123     wl-folder-guess-mailing-list-by-folder-name)
5124   "Newsgroups or Mailing List address guess functions list.
5125 Call from `wl-summary-write-current-folder'")
5126
5127 (defun wl-summary-write-current-folder (&optional folder)
5128   "Write message to current FOLDER's newsgroup or mailing-list.
5129 Use function list is `wl-summary-write-current-folder-functions'."
5130   (interactive)
5131   (let (newsgroups to cc)
5132     ;; default FOLDER is current buffer folder
5133     (setq folder (or folder wl-summary-buffer-folder-name))
5134     (let ((flist wl-summary-write-current-folder-functions)
5135           guess-list)
5136       (while flist
5137         (setq guess-list (funcall (car flist) folder))
5138         (if (or (nth 0 guess-list)      ; To:
5139 ;;;             (nth 1 guess-list)      ; Cc:
5140                 (nth 2 guess-list))     ; Newsgroups:
5141             (setq flist nil)
5142           (setq flist (cdr flist))))
5143       (if guess-list
5144           (progn
5145             (wl-draft (nth 0 guess-list) ; To:
5146                       nil nil
5147                       (nth 1 guess-list) ; Cc:
5148                       nil
5149                       (nth 2 guess-list)) ; Newsgroups:
5150             (run-hooks 'wl-mail-setup-hook))
5151 ;;;     (error "%s is not newsgroup" folder)
5152         (error "Can't guess by folder %s" folder)))))
5153
5154 (defun wl-summary-forward (&optional without-setup-hook)
5155   ""
5156   (interactive)
5157   (let ((folder wl-summary-buffer-folder-name)
5158         (number (wl-summary-message-number))
5159         (summary-buf (current-buffer))
5160         (wl-draft-forward t)
5161         entity subject num)
5162     (if (null number)
5163         (message "No message.")
5164       (wl-summary-redisplay-internal folder number)
5165       (wl-select-buffer (get-buffer wl-message-buf-name))
5166       (or wl-draft-use-frame
5167           (split-window-vertically))
5168       (other-window 1)
5169       ;; get original subject.
5170       (if summary-buf
5171           (save-excursion
5172             (set-buffer summary-buf)
5173             (setq num (wl-summary-message-number))
5174             (setq entity (assoc (cdr (assq num
5175                                            (elmo-msgdb-get-number-alist
5176                                             wl-summary-buffer-msgdb)))
5177                                 (elmo-msgdb-get-overview
5178                                  wl-summary-buffer-msgdb)))
5179             (and entity
5180                  (setq subject
5181                        (or (elmo-msgdb-overview-entity-get-subject entity)
5182                            "")))))
5183       (wl-draft-forward subject summary-buf)
5184       (unless without-setup-hook
5185         (run-hooks 'wl-mail-setup-hook)))))
5186
5187 (defun wl-summary-click (e)
5188   (interactive "e")
5189   (mouse-set-point e)
5190   (wl-summary-read))
5191
5192 (defun wl-summary-read ()
5193   ""
5194   (interactive)
5195   (let ((folder wl-summary-buffer-folder-name)
5196         (number (wl-summary-message-number))
5197         cur-folder cur-number message-last-pos
5198         (view-message-buffer (get-buffer-create wl-message-buf-name))
5199         (sticky-buf-name (and (wl-summary-sticky-p) wl-message-buf-name))
5200         (summary-buf-name (buffer-name)))
5201     (save-excursion
5202       (set-buffer view-message-buffer)
5203       (when (and sticky-buf-name
5204                  (not (wl-local-variable-p 'wl-message-buf-name
5205                                            (current-buffer))))
5206         (make-local-variable 'wl-message-buf-name)
5207         (setq wl-message-buf-name sticky-buf-name)
5208         (make-local-variable 'wl-message-buffer-cur-summary-buffer)
5209         (setq wl-message-buffer-cur-summary-buffer summary-buf-name))
5210       (setq cur-folder wl-message-buffer-cur-folder)
5211       (setq cur-number wl-message-buffer-cur-number))
5212     (wl-summary-toggle-disp-msg 'on)
5213     (if (and (string= folder cur-folder)
5214              (eq number cur-number))
5215         (progn
5216           (if (wl-summary-next-page)
5217               (wl-summary-down t)))
5218 ;;;         (wl-summary-scroll-up-content)))
5219       (if (wl-summary-no-mime-p folder)
5220           (wl-summary-redisplay-no-mime folder number)
5221         (wl-summary-redisplay-internal folder number)))))
5222
5223 (defun wl-summary-prev (&optional interactive)
5224   ""
5225   (interactive)
5226   (if wl-summary-move-direction-toggle
5227       (setq wl-summary-move-direction-downward nil))
5228   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5229         (skip-mark-regexp (mapconcat
5230                            'regexp-quote
5231                            wl-summary-skip-mark-list ""))
5232         goto-next regex-list regex next-entity finfo)
5233     (beginning-of-line)
5234     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5235         (setq regex (format "^%s[^%s]"
5236                             wl-summary-buffer-number-regexp
5237                             skip-mark-regexp))
5238       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5239                           wl-summary-buffer-number-regexp
5240                           skip-mark-regexp
5241                           (regexp-quote wl-summary-unread-cached-mark)
5242                           (regexp-quote wl-summary-important-mark))))
5243     (unless (re-search-backward regex nil t)
5244       (setq goto-next t))
5245     (beginning-of-line)
5246     (if (not goto-next)
5247         (progn
5248           (if wl-summary-buffer-disp-msg
5249               (wl-summary-redisplay)))
5250       (if (or interactive (interactive-p))
5251           (if wl-summary-buffer-prev-folder-func
5252               (funcall wl-summary-buffer-prev-folder-func)
5253             (when wl-auto-select-next
5254               (setq next-entity (wl-summary-get-prev-folder))
5255               (if next-entity
5256                   (setq finfo (wl-folder-get-entity-info next-entity))))
5257             (wl-ask-folder
5258              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5259              (format
5260               "No more messages. Type SPC to go to %s."
5261               (wl-summary-entity-info-msg next-entity finfo))))))))
5262
5263 (defun wl-summary-next (&optional interactive)
5264   ""
5265   (interactive)
5266   (if wl-summary-move-direction-toggle
5267       (setq wl-summary-move-direction-downward t))
5268   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5269         (skip-mark-regexp (mapconcat
5270                            'regexp-quote
5271                            wl-summary-skip-mark-list ""))
5272         goto-next regex regex-list next-entity finfo)
5273     (end-of-line)
5274     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5275         (setq regex (format "^%s[^%s]"
5276                             wl-summary-buffer-number-regexp
5277                             skip-mark-regexp))
5278       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5279                           wl-summary-buffer-number-regexp
5280                           skip-mark-regexp
5281                           (regexp-quote wl-summary-unread-cached-mark)
5282                           (regexp-quote wl-summary-important-mark))))
5283     (unless (re-search-forward regex nil t)
5284       (forward-line 1)
5285       (setq goto-next t))
5286     (beginning-of-line)
5287     (if (not goto-next)
5288         (if wl-summary-buffer-disp-msg
5289             (wl-summary-redisplay))
5290       (if (or interactive (interactive-p))
5291           (if wl-summary-buffer-next-folder-func
5292               (funcall wl-summary-buffer-next-folder-func)
5293             (when wl-auto-select-next
5294               (setq next-entity (wl-summary-get-next-folder))
5295               (if next-entity
5296                   (setq finfo (wl-folder-get-entity-info next-entity))))
5297             (wl-ask-folder
5298              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5299              (format
5300               "No more messages. Type SPC to go to %s."
5301               (wl-summary-entity-info-msg next-entity finfo))))))))
5302
5303 (defun wl-summary-up (&optional interactive skip-no-unread)
5304   ""
5305   (interactive)
5306   (if wl-summary-move-direction-toggle
5307       (setq wl-summary-move-direction-downward nil))
5308   (if (wl-summary-cursor-up)
5309       (if wl-summary-buffer-disp-msg
5310           (wl-summary-redisplay))
5311     (if (or interactive
5312             (interactive-p))
5313         (if wl-summary-buffer-prev-folder-func
5314             (funcall wl-summary-buffer-prev-folder-func)
5315           (let (next-entity finfo)
5316             (when wl-auto-select-next
5317               (progn
5318                 (setq next-entity (wl-summary-get-prev-unread-folder))
5319                 (if next-entity
5320                     (setq finfo (wl-folder-get-entity-info next-entity)))))
5321             (if (and skip-no-unread
5322                      (eq wl-auto-select-next 'skip-no-unread))
5323                 (wl-summary-next-folder-or-exit next-entity t)
5324               (wl-ask-folder
5325                '(lambda () (wl-summary-next-folder-or-exit next-entity t))
5326                (format
5327                 "No more unread messages. Type SPC to go to %s."
5328                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5329
5330 (defun wl-summary-get-prev-folder ()
5331   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5332         last-entity cur-id)
5333     (when folder-buf
5334       (setq cur-id (save-excursion (set-buffer folder-buf)
5335                                    wl-folder-buffer-cur-entity-id))
5336       (wl-folder-get-prev-folder cur-id))))
5337
5338 (defun wl-summary-get-next-folder ()
5339   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5340         cur-id)
5341     (when folder-buf
5342       (setq cur-id (save-excursion (set-buffer folder-buf)
5343                                    wl-folder-buffer-cur-entity-id))
5344       (wl-folder-get-next-folder cur-id))))
5345
5346 (defun wl-summary-get-next-unread-folder ()
5347   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5348         cur-id)
5349     (when folder-buf
5350       (setq cur-id (save-excursion (set-buffer folder-buf)
5351                                    wl-folder-buffer-cur-entity-id))
5352       (wl-folder-get-next-folder cur-id 'unread))))
5353
5354 (defun wl-summary-get-prev-unread-folder ()
5355   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5356         cur-id)
5357     (when folder-buf
5358       (setq cur-id (save-excursion (set-buffer folder-buf)
5359                                    wl-folder-buffer-cur-entity-id))
5360       (wl-folder-get-prev-folder cur-id 'unread))))
5361
5362 (defun wl-summary-down (&optional interactive skip-no-unread)
5363   (interactive)
5364   (if wl-summary-move-direction-toggle
5365       (setq wl-summary-move-direction-downward t))
5366   (if (wl-summary-cursor-down)
5367       (if wl-summary-buffer-disp-msg
5368           (wl-summary-redisplay))
5369     (if (or interactive
5370             (interactive-p))
5371         (if wl-summary-buffer-next-folder-func
5372             (funcall wl-summary-buffer-next-folder-func)
5373           (let (next-entity finfo)
5374             (when wl-auto-select-next
5375               (setq next-entity (wl-summary-get-next-unread-folder)))
5376             (if next-entity
5377                 (setq finfo (wl-folder-get-entity-info next-entity)))
5378             (if (and skip-no-unread
5379                      (eq wl-auto-select-next 'skip-no-unread))
5380                 (wl-summary-next-folder-or-exit next-entity)
5381               (wl-ask-folder
5382                '(lambda () (wl-summary-next-folder-or-exit next-entity))
5383                (format
5384                 "No more unread messages. Type SPC to go to %s."
5385                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5386
5387 (defun wl-summary-goto-last-displayed-msg ()
5388   (interactive)
5389   (unless wl-summary-buffer-last-displayed-msg
5390     (setq wl-summary-buffer-last-displayed-msg
5391           wl-summary-buffer-current-msg))
5392   (if wl-summary-buffer-last-displayed-msg
5393       (progn
5394         (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
5395         (if wl-summary-buffer-disp-msg
5396             (wl-summary-redisplay)))
5397     (message "No last message.")))
5398
5399 (defun wl-summary-redisplay (&optional arg)
5400   (interactive "P")
5401   (if (and (not arg)
5402            (wl-summary-no-mime-p wl-summary-buffer-folder-name))
5403       (wl-summary-redisplay-no-mime)
5404     (wl-summary-redisplay-internal nil nil arg)))
5405
5406 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
5407   (interactive)
5408   (let* ((msgdb wl-summary-buffer-msgdb)
5409          (fld (or folder wl-summary-buffer-folder-name))
5410          (num (or number (wl-summary-message-number)))
5411          (wl-mime-charset      wl-summary-buffer-mime-charset)
5412          (default-mime-charset wl-summary-buffer-mime-charset)
5413          (wl-message-redisplay-func
5414           wl-summary-buffer-message-redisplay-func)
5415          fld-buf fld-win thr-entity)
5416     (if (and wl-thread-open-reading-thread
5417              (eq wl-summary-buffer-view 'thread)
5418              (not (wl-thread-entity-get-opened
5419                    (setq thr-entity (wl-thread-get-entity
5420                                      num))))
5421              (wl-thread-entity-get-children thr-entity))
5422         (wl-thread-force-open))
5423     (if num
5424         (progn
5425           (setq wl-summary-buffer-disp-msg t)
5426           (setq wl-summary-buffer-last-displayed-msg
5427                 wl-summary-buffer-current-msg)
5428           ;; hide folder window
5429           (if (and (not wl-stay-folder-window)
5430                    (setq fld-buf (get-buffer wl-folder-buffer-name)))
5431               (if (setq fld-win (get-buffer-window fld-buf))
5432                   (delete-window fld-win)))
5433           (setq wl-current-summary-buffer (current-buffer))
5434           (if (wl-message-redisplay fld num 'mime msgdb force-reload)
5435               (wl-summary-mark-as-read nil
5436                                        ;; cached, then change server-mark.
5437                                        (if wl-message-cache-used
5438                                            nil
5439                                          ;; plugged, then leave server-mark.
5440                                          (if (and
5441                                               (not
5442                                                (elmo-folder-local-p
5443                                                 wl-summary-buffer-folder-name))
5444                                               (elmo-folder-plugged-p
5445                                                wl-summary-buffer-folder-name))
5446                                              'leave))
5447                                        t ; displayed
5448                                        nil
5449                                        'cached ; cached by reading.
5450                                        )
5451             )
5452           (setq wl-summary-buffer-current-msg num)
5453           (when wl-summary-recenter
5454             (recenter (/ (- (window-height) 2) 2))
5455             (if (not wl-summary-width)
5456                 (wl-horizontal-recenter)))
5457           (wl-highlight-summary-displaying)
5458           (wl-cache-prefetch-next fld num (current-buffer))
5459           (run-hooks 'wl-summary-redisplay-hook))
5460       (message "No message to display."))))
5461
5462 (defun wl-summary-redisplay-no-mime (&optional folder number)
5463   (interactive)
5464   (let* ((msgdb wl-summary-buffer-msgdb)
5465          (fld (or folder wl-summary-buffer-folder-name))
5466          (num (or number (wl-summary-message-number)))
5467          (wl-mime-charset      wl-summary-buffer-mime-charset)
5468          (default-mime-charset wl-summary-buffer-mime-charset)
5469          wl-break-pages)
5470     (if num
5471         (progn
5472           (setq wl-summary-buffer-disp-msg t)
5473           (setq wl-summary-buffer-last-displayed-msg
5474                 wl-summary-buffer-current-msg)
5475           (setq wl-current-summary-buffer (current-buffer))
5476           (wl-normal-message-redisplay fld num 'no-mime msgdb)
5477           (wl-summary-mark-as-read nil nil t)
5478           (setq wl-summary-buffer-current-msg num)
5479           (when wl-summary-recenter
5480             (recenter (/ (- (window-height) 2) 2))
5481             (if (not wl-summary-width)
5482                 (wl-horizontal-recenter)))
5483           (wl-highlight-summary-displaying)
5484           (run-hooks 'wl-summary-redisplay-hook))
5485       (message "No message to display.")
5486       (wl-ask-folder 'wl-summary-exit
5487                      "No more messages. Type SPC to go to folder mode."))))
5488
5489 (defun wl-summary-redisplay-all-header (&optional folder number)
5490   (interactive)
5491   (let* ((msgdb wl-summary-buffer-msgdb)
5492          (fld (or folder wl-summary-buffer-folder-name))
5493          (num (or number (wl-summary-message-number)))
5494          (wl-mime-charset      wl-summary-buffer-mime-charset)
5495          (default-mime-charset wl-summary-buffer-mime-charset)
5496          (wl-message-redisplay-func wl-summary-buffer-message-redisplay-func))
5497     (if num
5498         (progn
5499           (setq wl-summary-buffer-disp-msg t)
5500           (setq wl-summary-buffer-last-displayed-msg
5501                 wl-summary-buffer-current-msg)
5502           (setq wl-current-summary-buffer (current-buffer))
5503           (if (wl-message-redisplay fld num 'all-header msgdb); t if displayed.
5504               (wl-summary-mark-as-read nil nil t))
5505           (setq wl-summary-buffer-current-msg num)
5506           (when wl-summary-recenter
5507             (recenter (/ (- (window-height) 2) 2))
5508             (if (not wl-summary-width)
5509                 (wl-horizontal-recenter)))
5510           (wl-highlight-summary-displaying)
5511           (run-hooks 'wl-summary-redisplay-hook))
5512       (message "No message to display."))))
5513
5514 (defun wl-summary-jump-to-current-message ()
5515   (interactive)
5516   (let (message-buf message-win)
5517     (if (setq message-buf (get-buffer wl-message-buf-name))
5518         (if (setq message-win (get-buffer-window message-buf))
5519             (select-window message-win)
5520           (wl-select-buffer (get-buffer wl-message-buf-name)))
5521       (wl-summary-redisplay)
5522       (wl-select-buffer (get-buffer wl-message-buf-name)))
5523     (goto-char (point-min))))
5524
5525 (defun wl-summary-cancel-message ()
5526   "Cancel an article on news."
5527   (interactive)
5528   (if (null (wl-summary-message-number))
5529       (message "No message.")
5530     (let ((summary-buf (current-buffer))
5531           message-buf)
5532       (wl-summary-set-message-buffer-or-redisplay)
5533       (if (setq message-buf (wl-message-get-original-buffer))
5534           (set-buffer message-buf))
5535       (unless (wl-message-news-p)
5536         (set-buffer summary-buf)
5537         (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
5538                      'nntp)
5539                  (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5540             (progn
5541               (wl-summary-redisplay t)
5542               (wl-summary-supersedes-message))
5543           (error "This is not a news article; supersedes is impossible")))
5544       (when (yes-or-no-p "Do you really want to cancel this article? ")
5545         (let (from newsgroups message-id distribution buf)
5546           (save-excursion
5547             (setq from (std11-field-body "from")
5548                   newsgroups (std11-field-body "newsgroups")
5549                   message-id (std11-field-body "message-id")
5550                   distribution (std11-field-body "distribution"))
5551             ;; Make sure that this article was written by the user.
5552             (unless (wl-address-user-mail-address-p
5553                      (wl-address-header-extract-address
5554                       (car (wl-parse-addresses from))))
5555               (error "This article is not yours"))
5556             ;; Make control message.
5557             (setq buf (set-buffer (get-buffer-create " *message cancel*")))
5558             (setq wl-draft-buffer-cur-summary-buffer summary-buf)
5559             (buffer-disable-undo (current-buffer))
5560             (erase-buffer)
5561             (insert "Newsgroups: " newsgroups "\n"
5562                     "From: " (wl-address-header-extract-address
5563                               wl-from) "\n"
5564                               "Subject: cmsg cancel " message-id "\n"
5565                               "Control: cancel " message-id "\n"
5566                               (if distribution
5567                                   (concat "Distribution: " distribution "\n")
5568                                 "")
5569                               mail-header-separator "\n"
5570                               wl-summary-cancel-message)
5571             (message "Canceling your message...")
5572             (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
5573             (message "Canceling your message...done")))))))
5574
5575 (defun wl-summary-supersedes-message ()
5576   "Supersede current message."
5577   (interactive)
5578   (let ((summary-buf (current-buffer))
5579         (mmelmo-force-fetch-entire-message t)
5580         message-buf from)
5581     (wl-summary-set-message-buffer-or-redisplay)
5582     (if (setq message-buf (wl-message-get-original-buffer))
5583         (set-buffer message-buf))
5584     (unless (wl-message-news-p)
5585       (set-buffer summary-buf)
5586       (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
5587                    'nntp)
5588                (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5589           (progn
5590             (wl-summary-redisplay t)
5591             (wl-summary-supersedes-message))
5592         (error "This is not a news article; supersedes is impossible")))
5593     (save-excursion
5594       (setq from (std11-field-body "from"))
5595       ;; Make sure that this article was written by the user.
5596       (unless (wl-address-user-mail-address-p
5597                (wl-address-header-extract-address
5598                 (car (wl-parse-addresses from))))
5599         (error "This article is not yours"))
5600       (let* ((message-id (std11-field-body "message-id"))
5601              (followup-to (std11-field-body "followup-to"))
5602              (mail-default-headers
5603               (concat mail-default-headers
5604                       "Supersedes: " message-id "\n"
5605                       (and followup-to
5606                            (concat "Followup-To: " followup-to "\n")))))
5607         (set-buffer (wl-message-get-original-buffer))
5608         (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
5609
5610 (defun wl-summary-save (&optional arg wl-save-dir)
5611   (interactive)
5612   (let ((filename)
5613         (num (wl-summary-message-number))
5614         (mmelmo-force-fetch-entire-message t))
5615     (if (null wl-save-dir)
5616         (setq wl-save-dir wl-tmp-dir))
5617     (if num
5618         (save-excursion
5619           (setq filename (expand-file-name
5620                           (int-to-string num)
5621                           wl-save-dir))
5622           (if (null (and arg
5623                          (null (file-exists-p filename))))
5624               (setq filename
5625                     (read-file-name "Save to file: " filename)))
5626
5627           (wl-summary-set-message-buffer-or-redisplay)
5628           (set-buffer (wl-message-get-original-buffer))
5629           (if (and (null arg) (file-exists-p filename))
5630               (if (y-or-n-p "File already exists.  override it? ")
5631                   (write-region (point-min) (point-max) filename))
5632             (write-region (point-min) (point-max) filename)))
5633       (message "No message to save."))
5634     num))
5635
5636 (defun wl-summary-save-region (beg end)
5637   (interactive "r")
5638   (save-excursion
5639     (save-restriction
5640       (narrow-to-region beg end)
5641       (goto-char (point-min))
5642       (let ((wl-save-dir
5643              (wl-read-directory-name "Save to directory: " wl-tmp-dir)))
5644         (if (null (file-exists-p wl-save-dir))
5645             (make-directory wl-save-dir))
5646         (if (eq wl-summary-buffer-view 'thread)
5647             (progn
5648               (while (not (eobp))
5649                 (let* ((number (wl-summary-message-number))
5650                        (entity (wl-thread-get-entity number)))
5651                   (if (wl-thread-entity-get-opened entity)
5652                       (wl-summary-save t wl-save-dir)
5653                     ;; closed
5654                     (wl-summary-save t wl-save-dir))
5655                   (forward-line 1))))
5656           (while (not (eobp))
5657             (wl-summary-save t wl-save-dir)
5658             (forward-line 1)))))))
5659
5660 ;; mew-summary-pipe-message()
5661 (defun wl-summary-pipe-message (prefix command)
5662   "Send this message via pipe."
5663   (interactive (list current-prefix-arg nil))
5664   (if (null (wl-summary-message-number))
5665       (message "No message.")
5666     (setq command (read-string "Shell command on message: "
5667                                wl-summary-shell-command-last))
5668     (if (y-or-n-p "Send this message to pipe? ")
5669         (save-excursion
5670           (wl-summary-set-message-buffer-or-redisplay)
5671           (set-buffer (wl-message-get-original-buffer))
5672           (if (string= command "")
5673               (setq command wl-summary-shell-command-last))
5674           (goto-char (point-min)) ; perhaps this line won't be necessary
5675           (if prefix
5676               (search-forward "\n\n"))
5677           (shell-command-on-region (point) (point-max) command nil)
5678           (setq wl-summary-shell-command-last command)))))
5679
5680 (defun wl-summary-print-message (&optional arg)
5681   (interactive "P")
5682   (if (null (wl-summary-message-number))
5683       (message "No message.")
5684     (save-excursion
5685       (wl-summary-set-message-buffer-or-redisplay)
5686       (if (or (not (interactive-p))
5687               (y-or-n-p "Print ok? "))
5688           (progn
5689             (let* ((message-buffer (get-buffer wl-message-buf-name))
5690 ;;;                (summary-buffer (get-buffer wl-summary-buffer-name))
5691                    (buffer (generate-new-buffer " *print*")))
5692               (set-buffer message-buffer)
5693               (copy-to-buffer buffer (point-min) (point-max))
5694               (set-buffer buffer)
5695               (funcall wl-print-buffer-func)
5696               (kill-buffer buffer)))
5697         (message "")))))
5698
5699 (defun wl-summary-print-message-with-ps-print (&optional filename)
5700   (interactive)
5701   (if (null (wl-summary-message-number))
5702       (message "No message.")
5703     (setq filename (ps-print-preprint current-prefix-arg))
5704     (if (or (not (interactive-p))
5705             (y-or-n-p "Print ok? "))
5706         (let ((summary-buffer (current-buffer))
5707               wl-break-pages)
5708           (save-excursion
5709 ;;;         (wl-summary-set-message-buffer-or-redisplay)
5710             (wl-summary-redisplay-internal)
5711             (let* ((message-buffer (get-buffer wl-message-buf-name))
5712                    (buffer (generate-new-buffer " *print*"))
5713                    (entity (progn
5714                              (set-buffer summary-buffer)
5715                              (assoc (cdr (assq
5716                                           (wl-summary-message-number)
5717                                           (elmo-msgdb-get-number-alist
5718                                            wl-summary-buffer-msgdb)))
5719                                     (elmo-msgdb-get-overview
5720                                      wl-summary-buffer-msgdb))))
5721                    (wl-ps-subject
5722                     (and entity
5723                          (or (elmo-msgdb-overview-entity-get-subject entity)
5724                              "")))
5725                    (wl-ps-from
5726                     (and entity
5727                          (or (elmo-msgdb-overview-entity-get-from entity) "")))
5728                    (wl-ps-date
5729                     (and entity
5730                          (or (elmo-msgdb-overview-entity-get-date entity) ""))))
5731               (run-hooks 'wl-ps-preprint-hook)
5732               (set-buffer message-buffer)
5733               (copy-to-buffer buffer (point-min) (point-max))
5734               (set-buffer buffer)
5735               (unwind-protect
5736                   (let ((ps-left-header
5737                          (list (concat "(" wl-ps-subject ")")
5738                                (concat "(" wl-ps-from ")")))
5739                         (ps-right-header
5740                          (list "/pagenumberstring load"
5741                                (concat "(" wl-ps-date ")"))))
5742                     (run-hooks 'wl-ps-print-hook)
5743                     (funcall wl-ps-print-buffer-func filename))
5744                 (kill-buffer buffer)))))
5745       (message ""))))
5746
5747 (if (featurep 'ps-print) ; ps-print is available.
5748     (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
5749
5750 (defun wl-summary-folder-info-update ()
5751   (let ((folder (elmo-string wl-summary-buffer-folder-name))
5752         (num-db (elmo-msgdb-get-number-alist
5753                  wl-summary-buffer-msgdb)))
5754     (wl-folder-set-folder-updated folder
5755                                   (list 0
5756                                         (+ wl-summary-buffer-unread-count
5757                                            wl-summary-buffer-new-count)
5758                                         (length num-db)))))
5759
5760 (defun wl-summary-get-newsgroups ()
5761   (let ((spec-list (elmo-folder-get-primitive-spec-list
5762                     (elmo-string wl-summary-buffer-folder-name)))
5763         ng-list)
5764     (while spec-list
5765       (when (eq (caar spec-list) 'nntp)
5766         (wl-append ng-list (list (nth 1 (car spec-list)))))
5767       (setq spec-list (cdr spec-list)))
5768     ng-list))
5769
5770 (defun wl-summary-set-crosspost (&optional type redisplay)
5771   (let* ((number (wl-summary-message-number))
5772          (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name
5773                                             number))
5774          (folder (nth 1 spec))
5775          message-buf newsgroups)
5776     (when (eq (car spec) 'nntp)
5777       (if redisplay
5778           (wl-summary-redisplay))
5779       (save-excursion
5780         (if (setq message-buf (wl-message-get-original-buffer))
5781             (set-buffer message-buf))
5782         (setq newsgroups (std11-field-body "newsgroups")))
5783       (when newsgroups
5784         (let* ((msgdb wl-summary-buffer-msgdb)
5785                (num-db (elmo-msgdb-get-number-alist msgdb))
5786                (ng-list (wl-summary-get-newsgroups)) ;; for multi folder
5787                crosspost-folders)
5788           (when (setq crosspost-folders
5789                       (elmo-list-delete ng-list
5790                                         (wl-parse-newsgroups newsgroups t)))
5791             (elmo-crosspost-message-set (cdr (assq number num-db)) ;;message-id
5792                                         crosspost-folders
5793                                         type) ;;not used
5794             (setq wl-crosspost-alist-modified t)))))))
5795
5796 (defun wl-summary-is-crosspost-folder (spec-list fld-list)
5797   (let (fld flds)
5798     (while spec-list
5799       (if (and (eq (caar spec-list) 'nntp)
5800                (member (setq fld (nth 1 (car spec-list))) fld-list))
5801           (wl-append flds (list fld)))
5802       (setq spec-list (cdr spec-list)))
5803     flds))
5804
5805 (defun wl-summary-update-crosspost ()
5806   (let* ((msgdb wl-summary-buffer-msgdb)
5807          (number-alist (elmo-msgdb-get-number-alist msgdb))
5808          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
5809          (spec-list (elmo-folder-get-primitive-spec-list
5810                      (elmo-string wl-summary-buffer-folder-name)))
5811          (alist elmo-crosspost-message-alist)
5812          (crossed 0)
5813          mark ngs num)
5814     (when (assq 'nntp spec-list)
5815       (while alist
5816         (when (setq ngs
5817                     (wl-summary-is-crosspost-folder
5818                      spec-list
5819                      (nth 1 (car alist))))
5820           (when (setq num (car (rassoc (caar alist) number-alist)))
5821             (if (and (setq mark (cadr (assq num mark-alist)))
5822                      (member mark (list wl-summary-new-mark
5823                                         wl-summary-unread-uncached-mark
5824                                         wl-summary-unread-cached-mark)))
5825                 (setq crossed (1+ crossed)))
5826             (if (wl-summary-jump-to-msg num)
5827                 (wl-summary-mark-as-read t);; opened
5828               (wl-summary-mark-as-read t nil nil num)));; closed
5829           ;; delete if message does't exists.
5830           (elmo-crosspost-message-delete (caar alist) ngs)
5831           (setq wl-crosspost-alist-modified t))
5832         (setq alist (cdr alist))))
5833     (if (> crossed 0)
5834         crossed)))
5835
5836 (defun wl-crosspost-alist-load ()
5837   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
5838   (setq wl-crosspost-alist-modified nil))
5839
5840 (defun wl-crosspost-alist-save ()
5841   (when wl-crosspost-alist-modified
5842     ;; delete non-exists newsgroups
5843     (let ((alist elmo-crosspost-message-alist)
5844           newsgroups)
5845       (while alist
5846         (setq newsgroups
5847               (elmo-delete-if
5848                '(lambda (x)
5849                   (not (intern-soft x wl-folder-newsgroups-hashtb)))
5850                (nth 1 (car alist))))
5851         (if newsgroups
5852             (setcar (cdar alist) newsgroups)
5853           (setq elmo-crosspost-message-alist
5854                 (delete (car alist) elmo-crosspost-message-alist)))
5855         (setq alist (cdr alist)))
5856       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
5857       (setq wl-crosspost-alist-modified nil))))
5858
5859 (defun wl-summary-pack-number (&optional arg)
5860   (interactive "P")
5861   (setq wl-summary-buffer-msgdb
5862         (elmo-pack-number
5863          wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg))
5864   (let (wl-use-scoring)
5865     (wl-summary-rescan)))
5866
5867 (defun wl-summary-target-mark-uudecode ()
5868   (interactive)
5869   (let ((mlist (reverse wl-summary-buffer-target-mark-list))
5870         (summary-buf (current-buffer))
5871         (tmp-buf (get-buffer-create "*WL UUENCODE*"))
5872         orig-buf i k filename rc errmsg)
5873     (setq i 1)
5874     (setq k (length mlist))
5875     (set-buffer tmp-buf)
5876     (erase-buffer)
5877     (save-window-excursion
5878       (while mlist
5879         (set-buffer summary-buf)
5880         (wl-summary-jump-to-msg (car mlist))
5881         (wl-summary-redisplay)
5882         (set-buffer (setq orig-buf (wl-message-get-original-buffer)))
5883         (goto-char (point-min))
5884         (cond ((= i 1) ; first
5885                (if (setq filename (wl-message-uu-substring
5886                                    orig-buf tmp-buf t
5887                                    (= i k)))
5888                    nil
5889                  (error "Can't find begin line")))
5890               ((< i k)
5891                (wl-message-uu-substring orig-buf tmp-buf))
5892               (t ; last
5893                (wl-message-uu-substring orig-buf tmp-buf nil t)))
5894         (setq i (1+ i))
5895         (setq mlist (cdr mlist)))
5896       (set-buffer tmp-buf)
5897       (message "Exec %s..." wl-prog-uudecode)
5898       (unwind-protect
5899           (let ((decode-dir wl-tmp-dir))
5900             (if (not wl-prog-uudecode-no-stdout-option)
5901                 (setq filename (read-file-name "Save to file: "
5902                                                (expand-file-name
5903                                                 (elmo-safe-filename filename)
5904                                                 wl-tmp-dir)))
5905               (setq decode-dir
5906                     (wl-read-directory-name "Save to directory: "
5907                                             wl-tmp-dir))
5908               (setq filename (expand-file-name filename decode-dir)))
5909             (if (file-exists-p filename)
5910                 (or (yes-or-no-p (format "File %s exists. Save anyway? "
5911                                          filename))
5912                     (error "")))
5913             (elmo-bind-directory
5914              decode-dir
5915              (setq rc
5916                    (as-binary-process
5917                     (apply 'call-process-region (point-min) (point-max)
5918                            wl-prog-uudecode t (current-buffer) nil
5919                            wl-prog-uudecode-arg))))
5920             (when (not (= 0 rc))
5921               (setq errmsg (buffer-substring (point-min)(point-max)))
5922               (error "Uudecode error: %s" errmsg))
5923             (if (not wl-prog-uudecode-no-stdout-option)
5924                 (let (file-name-handler-alist) ;; void jka-compr
5925                   (as-binary-output-file
5926                    (write-region (point-min) (point-max)
5927                                  filename nil 'no-msg))))
5928             (save-excursion
5929               (set-buffer summary-buf)
5930               (wl-summary-delete-all-temp-marks))
5931             (if (file-exists-p filename)
5932                 (message "Saved as %s" filename)))
5933         (kill-buffer tmp-buf)))))
5934
5935 (defun wl-summary-drop-unsync ()
5936   "Drop all unsync messages."
5937   (interactive)
5938   (if (elmo-folder-pipe-p wl-summary-buffer-folder-name)
5939       (error "You cannot drop unsync messages in this folder"))
5940   (if (or (not (interactive-p))
5941           (y-or-n-p "Drop all unsync messages? "))
5942       (let* ((folder-list (elmo-folder-get-primitive-folder-list
5943                            wl-summary-buffer-folder-name))
5944              (is-multi (elmo-multi-p wl-summary-buffer-folder-name))
5945              (sum 0)
5946              (multi-num 0)
5947              pair)
5948         (message "Dropping...")
5949         (while folder-list
5950           (setq pair (elmo-max-of-folder (car folder-list)))
5951           (when is-multi ;; dirty hack...
5952             (incf multi-num)
5953             (setcar pair (+ (* multi-num elmo-multi-divide-number)
5954                             (car pair))))
5955           (elmo-msgdb-set-number-alist
5956            wl-summary-buffer-msgdb
5957            (nconc
5958             (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
5959             (list (cons (car pair) nil))))
5960           (setq sum (+ sum (cdr pair)))
5961           (setq folder-list (cdr folder-list)))
5962         (wl-summary-set-message-modified)
5963         (wl-folder-set-folder-updated wl-summary-buffer-folder-name
5964                                       (list 0
5965                                             (+ wl-summary-buffer-unread-count
5966                                                wl-summary-buffer-new-count)
5967                                             sum))
5968         (message "Dropping...done"))))
5969
5970 (defun wl-summary-default-get-next-msg (msg)
5971   (let (next)
5972     (if (and (not wl-summary-buffer-target-mark-list)
5973              (eq wl-summary-buffer-view 'thread)
5974              (if (eq wl-summary-move-direction-downward nil)
5975                  (setq next (wl-thread-get-prev-unread msg))
5976                (setq next (wl-thread-get-next-unread msg))))
5977         next
5978       (save-excursion
5979         (wl-summary-jump-to-msg msg)
5980         (let (wl-summary-buffer-disp-msg)
5981           (if (eq wl-summary-move-direction-downward nil)
5982               (unless (wl-summary-cursor-up)
5983                 (wl-summary-prev))
5984             (unless (wl-summary-cursor-down)
5985               (wl-summary-next)))
5986           (wl-summary-message-number))))))
5987
5988 (defsubst wl-cache-prefetch-p (fld &optional num)
5989   (cond ((and num wl-cache-prefetch-folder-type-list)
5990          (memq
5991           (elmo-folder-number-get-type fld num)
5992           wl-cache-prefetch-folder-type-list))
5993         (wl-cache-prefetch-folder-type-list
5994          (let ((list wl-cache-prefetch-folder-type-list)
5995                type)
5996            (catch 'done
5997              (while (setq type (pop list))
5998                (if (elmo-folder-contains-type fld type)
5999                    (throw 'done t))))))
6000         ((consp wl-cache-prefetch-folder-list)
6001          (wl-string-match-member fld wl-cache-prefetch-folder-list))
6002         (t
6003          wl-cache-prefetch-folder-list)))
6004
6005 (defconst wl-cache-prefetch-idle-time
6006   (if (featurep 'lisp-float-type) (/ (float 1) (float 10)) 1))
6007
6008 (defun wl-cache-prefetch-next (fld msg &optional summary)
6009   (if (wl-cache-prefetch-p fld)
6010       (if (not elmo-use-buffer-cache)
6011 ;;;       (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.")
6012         (save-excursion
6013           (set-buffer (or summary (get-buffer wl-summary-buffer-name)))
6014           (let ((next (funcall wl-cache-prefetch-get-next-func msg)))
6015             (when (and next
6016                        (wl-cache-prefetch-p fld next))
6017               (if (not (fboundp 'run-with-idle-timer))
6018                   (when (sit-for wl-cache-prefetch-idle-time)
6019                     (wl-cache-prefetch-message fld next summary))
6020                 (run-with-idle-timer
6021                  wl-cache-prefetch-idle-time
6022                  nil
6023                  'wl-cache-prefetch-message fld next summary)
6024                 (sit-for 0))))))))
6025
6026 (defvar wl-cache-prefetch-debug nil)
6027 (defun wl-cache-prefetch-message (folder msg summary &optional next)
6028   (when (buffer-live-p summary)
6029     (save-excursion
6030       (set-buffer summary)
6031       (when (string= folder wl-summary-buffer-folder-name)
6032         (unless next
6033           (setq next msg))
6034         (let* ((msgdb wl-summary-buffer-msgdb)
6035                (message-id (cdr (assq next
6036                                       (elmo-msgdb-get-number-alist msgdb)))))
6037           (if (not (elmo-buffer-cache-hit (list folder next message-id)))
6038               (let* ((size (elmo-msgdb-overview-entity-get-size
6039                             (assoc message-id
6040                                    (elmo-msgdb-get-overview msgdb)))))
6041                 (when (or (elmo-local-file-p folder next)
6042                           (not (and (integerp size)
6043                                     wl-cache-prefetch-threshold
6044                                     (>= size wl-cache-prefetch-threshold)
6045                                     (not (elmo-cache-exists-p message-id
6046                                                               folder next)))))
6047                   (if wl-cache-prefetch-debug
6048                       (message "Reading %d..." msg))
6049                   (elmo-buffer-cache-message folder next msgdb)
6050                   (if wl-cache-prefetch-debug
6051                       (message "Reading %d... done" msg))))))))))
6052
6053 (defun wl-summary-save-current-message ()
6054   "Save current message for `wl-summary-yank-saved-message'."
6055   (interactive)
6056   (let ((number (wl-summary-message-number)))
6057     (setq wl-summary-buffer-saved-message number)
6058     (and number (message "No: %s is saved." number))))
6059
6060 (defun wl-summary-yank-saved-message ()
6061   "Set current message as a parent of the saved message."
6062   (interactive)
6063   (if wl-summary-buffer-saved-message
6064       (let ((number (wl-summary-message-number)))
6065         (if (eq wl-summary-buffer-saved-message number)
6066             (message "Cannot set itself as a parent.")
6067           (save-excursion
6068             (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
6069             (wl-thread-set-parent number)
6070             (wl-summary-set-thread-modified))
6071           (setq  wl-summary-buffer-saved-message nil)))
6072     (message "There's no saved message.")))
6073
6074 (require 'product)
6075 (product-provide (provide 'wl-summary) (require 'wl-version))
6076
6077 ;;; wl-summary.el ends here