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