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-hook 'window-scroll-functions)
 785     (add-hook 'window-scroll-functions 'wl-highlight-summary-window nil t))
 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-auto-select-msg-p (unread-msg)
2703   (and unread-msg
2704        (not (string=
2705              (cadr (assoc unread-msg
2706                           (elmo-msgdb-get-mark-alist
2707                            wl-summary-buffer-msgdb)))
2708              wl-summary-important-mark))))
2709
2710 (defun wl-summary-goto-folder-subr (&optional folder scan-type other-window
2711                                               sticky interactive scoring)
2712   "Display target folder on summary."
2713   (interactive)
2714   (let* ((keep-cursor (memq this-command
2715                             wl-summary-keep-cursor-command))
2716          (fld (or folder (wl-summary-read-folder wl-default-folder)))
2717          (cur-fld wl-summary-buffer-folder-name)
2718          buf mes hilit reuse-buf
2719          retval entity)
2720     (if (string= fld "")
2721         (setq fld wl-default-folder))
2722     (when (and (not (string= cur-fld fld)) ; folder is moved.
2723                (eq major-mode 'wl-summary-mode)) ; called in summary.
2724       (setq wl-summary-last-visited-folder wl-summary-buffer-folder-name)
2725       (wl-summary-cleanup-temp-marks (wl-summary-sticky-p))
2726       (wl-summary-save-status 'keep)) ;; keep current buffer, anyway.
2727     (setq buf (wl-summary-get-buffer-create fld sticky))
2728     (setq reuse-buf
2729           (save-excursion
2730             (set-buffer buf)
2731             (string= fld wl-summary-buffer-folder-name)))
2732     (unwind-protect
2733         (if reuse-buf
2734             (if interactive
2735                 (switch-to-buffer buf)
2736               (set-buffer buf))
2737           (if other-window
2738               (delete-other-windows))
2739           (set-buffer buf)
2740           (unless (eq major-mode 'wl-summary-mode)
2741             (wl-summary-mode))
2742           (wl-summary-buffer-set-folder fld)
2743           (setq wl-summary-buffer-disp-msg nil)
2744           (setq wl-summary-buffer-last-displayed-msg nil)
2745           (setq wl-summary-buffer-current-msg nil)
2746           (let ((case-fold-search nil)
2747                 (inhibit-read-only t)
2748                 (buffer-read-only nil))
2749             ;; Load msgdb
2750             (setq wl-summary-buffer-msgdb nil) ; new msgdb
2751             (setq wl-summary-buffer-msgdb
2752                   (wl-summary-msgdb-load-async fld))
2753             (if (null wl-summary-buffer-msgdb)
2754                 (setq wl-summary-buffer-msgdb
2755                       (elmo-msgdb-load (elmo-string fld))))
2756             (erase-buffer)
2757             ;; Resume summary view
2758             (if wl-summary-cache-use
2759                 (let* ((dir (elmo-msgdb-expand-path fld))
2760                        (cache (expand-file-name wl-summary-cache-file dir))
2761                        (view (expand-file-name wl-summary-view-file dir)))
2762                   (when (file-exists-p cache)
2763                     (insert-file-contents-as-binary cache)
2764                     (elmo-set-buffer-multibyte
2765                      default-enable-multibyte-characters)
2766                     (decode-mime-charset-region
2767                      (point-min)(point-max)
2768                      wl-summary-buffer-mime-charset))
2769                   (when (file-exists-p view)
2770                     (setq wl-summary-buffer-view
2771                           (wl-summary-load-file-object view)))
2772                   (if (eq wl-summary-buffer-view 'thread)
2773                       (wl-thread-resume-entity fld)
2774                     (wl-summary-make-number-list)))
2775               (setq wl-summary-buffer-view
2776                     (wl-summary-load-file-object
2777                      (expand-file-name wl-summary-view-file
2778                                        (elmo-msgdb-expand-path fld))))
2779               (wl-summary-rescan))
2780             (wl-summary-count-unread
2781              (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
2782             (wl-summary-update-modeline)))
2783       (wl-summary-buffer-number-column-detect t)
2784       (wl-summary-disp-msg fld (and reuse-buf keep-cursor))
2785       (unless (and reuse-buf keep-cursor)
2786         ;(setq hilit wl-summary-highlight)
2787         (unwind-protect
2788             (let ((wl-summary-highlight (if reuse-buf wl-summary-highlight))
2789                   (wl-use-scoring
2790                    (if (or scoring interactive) wl-use-scoring)))
2791               (if (and (not scan-type)
2792                        interactive
2793                        (not wl-ask-range))
2794                   (setq scan-type (wl-summary-get-sync-range fld)))
2795               (cond
2796                ((eq scan-type nil)
2797                 (wl-summary-sync 'unset-cursor))
2798                ((eq scan-type 'all)
2799                 (wl-summary-sync 'unset-cursor "all"))
2800                ((eq scan-type 'no-sync))
2801                ((or (eq scan-type 'force-update)
2802                     (eq scan-type 'update))
2803                 (setq mes (wl-summary-sync-force-update 'unset-cursor)))))
2804           (if interactive
2805               (switch-to-buffer buf)
2806             (set-buffer buf))
2807           ;; stick always-sticky-folder
2808           (when (wl-summary-always-sticky-folder-p fld)
2809             (or (wl-summary-sticky-p) (wl-summary-stick t)))
2810           (run-hooks 'wl-summary-prepared-pre-hook)
2811           (set-buffer-modified-p nil)
2812           (goto-char (point-min))
2813           (if (wl-summary-cursor-down t)
2814               (let ((unreadp (wl-summary-next-message
2815                               (wl-summary-message-number)
2816                               'down t)))
2817                 (cond ((and wl-auto-select-first
2818                             (wl-summary-auto-select-msg-p unreadp))
2819                        ;; wl-auto-select-first is non-nil and
2820                        ;; unreadp is non-nil but not important
2821                        (setq retval 'disp-msg))
2822                       ((not (wl-summary-auto-select-msg-p unreadp))
2823                        ;; unreadp is nil or important
2824                        (setq retval 'more-next))))
2825             (goto-char (point-max))
2826             (if (elmo-folder-plugged-p folder)
2827                 (forward-line -1)
2828               (wl-summary-prev))
2829             (setq retval 'more-next))
2830           ;(setq wl-summary-highlight hilit)
2831           (if (and wl-summary-highlight
2832                    (not wl-summary-lazy-highlight)
2833                    (not reuse-buf))
2834               (if (and wl-summary-highlight-partial-threshold
2835                        (> (count-lines (point-min) (point-max))
2836                           wl-summary-highlight-partial-threshold))
2837                   (save-excursion
2838                     (forward-line (-
2839                                    0
2840                                    (or
2841                                     wl-summary-partial-highlight-above-lines
2842                                     wl-summary-highlight-partial-threshold)))
2843                     (wl-highlight-summary (point) (point-max)))
2844                 (wl-highlight-summary (point-min) (point-max))))
2845           (if (null wl-summary-buffer-msgdb) ;; one more try.
2846               (setq wl-summary-buffer-msgdb
2847                     (elmo-msgdb-load (elmo-string fld))))
2848           (if (eq retval 'disp-msg)
2849               (wl-summary-redisplay))
2850           (if mes (message "%s" mes))
2851           (if (and interactive wl-summary-recenter)
2852               (recenter (/ (- (window-height) 2) 2))))))
2853     ;; set current entity-id
2854     (if (and (not folder)
2855              (setq entity
2856                    (wl-folder-search-entity-by-name fld
2857                                                     wl-folder-entity
2858                                                     'folder)))
2859         ;; entity-id is unknown.
2860         (wl-folder-set-current-entity-id
2861          (wl-folder-get-entity-id entity)))
2862     (unwind-protect
2863         (run-hooks 'wl-summary-prepared-hook)
2864       (set-buffer-modified-p nil))
2865     retval))
2866
2867 (defun wl-summary-summary-line-already-exists-p (parent-number buffer)
2868   "Return the depth."
2869   (set-buffer buffer)
2870   (goto-char (point-max))
2871   (let ((depth 0))
2872     (when (re-search-backward (format "^ *%s..../..\(.*\)..:.. "
2873                                       parent-number) nil t)
2874       (goto-char (match-end 0))
2875       (while (string-match wl-thread-indent-regexp
2876                            (char-to-string
2877                             (char-after (point))))
2878         (setq depth (+ 1 depth))
2879         (forward-char))
2880       (/ depth wl-thread-indent-level-internal))))
2881
2882 (defun wl-summary-goto-bottom-of-current-thread ()
2883   (if (re-search-forward (concat "^" wl-summary-buffer-number-regexp
2884                                  "..../..\(.*\)..:.. [[<]") nil t)
2885       ()
2886     (goto-char (point-max))))
2887
2888 (defun wl-summary-goto-top-of-current-thread ()
2889   (wl-summary-jump-to-msg
2890    (wl-thread-entity-get-number
2891     (wl-thread-entity-get-top-entity (wl-thread-get-entity
2892                                       (wl-summary-message-number))))))
2893
2894 (defun wl-summary-goto-bottom-of-sub-thread (&optional depth)
2895   (interactive)
2896   (let ((depth (or depth
2897                    (wl-thread-get-depth-of-current-line))))
2898     (forward-line 1)
2899     (while (and (not (eobp))
2900                 (>= (wl-thread-get-depth-of-current-line)
2901                     depth))
2902       (forward-line 1))
2903     (beginning-of-line)))
2904
2905 (defun wl-summary-insert-line (line)
2906   "Insert LINE in the Summary."
2907   (if wl-use-highlight-mouse-line
2908       ;; remove 'mouse-face of current line.
2909       (put-text-property
2910        (save-excursion (beginning-of-line)(point))
2911        (save-excursion (end-of-line)(point))
2912        'mouse-face nil))
2913   (insert line "\n")
2914   (if wl-use-highlight-mouse-line
2915       ;; remove 'mouse-face of current line.
2916       (put-text-property
2917        (save-excursion (beginning-of-line)(point))
2918        (save-excursion (end-of-line)(point))
2919        'mouse-face nil))
2920   (condition-case nil ; it's dangerous, so ignore error.
2921       (run-hooks 'wl-summary-line-inserted-hook)
2922     (error (ding)
2923            (message "Error in wl-summary-line-inserted-hook"))))
2924
2925 (defun wl-summary-insert-summary (entity database mark-alist dummy &optional dummy)
2926   (let ((overview-entity entity)
2927         summary-line msg)
2928     (setq msg (elmo-msgdb-overview-entity-get-number entity))
2929     (when (setq summary-line
2930                 (wl-summary-overview-create-summary-line
2931                  msg entity nil 0 mark-alist))
2932       (let ((inhibit-read-only t)
2933             buffer-read-only)
2934         (goto-char (point-max))
2935         (wl-summary-insert-line summary-line)))))
2936
2937 (defun wl-summary-default-subject-filter (subject)
2938   (let ((case-fold-search t))
2939     (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" ""))
2940     (setq subject (elmo-replace-in-string subject "[ \t]" ""))
2941     (elmo-replace-in-string subject "^\\[.*\\]" "")))
2942
2943 (defun wl-summary-subject-equal (subject1 subject2)
2944   (string= (wl-summary-subject-filter-func-internal subject1)
2945            (wl-summary-subject-filter-func-internal subject2)))
2946
2947 (defmacro wl-summary-put-alike (alike)
2948   (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
2949                         (, alike)
2950                         wl-summary-alike-hashtb)))
2951
2952 (defmacro wl-summary-get-alike ()
2953   (` (elmo-get-hash-val (format "#%d" (wl-count-lines))
2954                         wl-summary-alike-hashtb)))
2955
2956 (defun wl-summary-insert-headers (overview func mime-decode)
2957   (let (ov this last alike)
2958     (buffer-disable-undo (current-buffer))
2959     (make-local-variable 'wl-summary-alike-hashtb)
2960     (setq wl-summary-alike-hashtb (elmo-make-hash (* (length overview) 2)))
2961     (when mime-decode
2962       (elmo-set-buffer-multibyte default-enable-multibyte-characters))
2963     (while (setq ov (pop overview))
2964       (setq this (funcall func ov))
2965       (and this (setq this (std11-unfold-string this)))
2966       (if (equal last this)
2967           (wl-append alike (list ov))
2968         (when last
2969           (wl-summary-put-alike alike)
2970           (insert last ?\n))
2971         (setq alike (list ov)
2972               last this)))
2973     (when last
2974       (wl-summary-put-alike alike)
2975       (insert last ?\n))
2976     (when mime-decode
2977       (decode-mime-charset-region (point-min) (point-max)
2978                                   elmo-mime-charset)
2979       (when (eq mime-decode 'mime)
2980         (eword-decode-region (point-min) (point-max))))
2981     (run-hooks 'wl-summary-insert-headers-hook)))
2982
2983 (defun wl-summary-search-by-subject (entity overview)
2984   (let ((buf (get-buffer-create wl-summary-search-buf-name))
2985         (folder-name wl-summary-buffer-folder-name)
2986         match founds found-entity)
2987     (save-excursion
2988       (set-buffer buf)
2989       (let ((case-fold-search t))
2990         (when (or (not (string= wl-summary-buffer-folder-name folder-name))
2991                   (zerop (buffer-size)))
2992           (setq wl-summary-buffer-folder-name folder-name)
2993           (wl-summary-insert-headers
2994            overview
2995            (function
2996             (lambda (x)
2997               (wl-summary-subject-filter-func-internal
2998                (elmo-msgdb-overview-entity-get-subject-no-decode x))))
2999            t))
3000         (setq match (wl-summary-subject-filter-func-internal
3001                      (elmo-msgdb-overview-entity-get-subject entity)))
3002         (if (string= match "")
3003             (setq match "\n"))
3004         (goto-char (point-max))
3005         (while (and (not founds)
3006                     (not (= (point) (point-min)))
3007                     (search-backward match nil t))
3008           ;; check exactly match
3009           (when (and (bolp)
3010                      (= (point-at-eol)
3011                         (match-end 0)))
3012             (setq found-entity (wl-summary-get-alike))
3013             (if (and found-entity
3014                      ;; Is founded entity myself or children?
3015                      (not (string=
3016                            (elmo-msgdb-overview-entity-get-id entity)
3017                            (elmo-msgdb-overview-entity-get-id (car found-entity))))
3018                      (not (wl-thread-descendant-p
3019                            (elmo-msgdb-overview-entity-get-number entity)
3020                            (elmo-msgdb-overview-entity-get-number (car found-entity)))))
3021                 ;; return matching entity
3022                 (setq founds found-entity))))
3023         (if founds
3024             (car founds))))))
3025
3026 (defun wl-summary-insert-thread-entity (entity overview mark-alist update
3027                                                &optional force-insert)
3028   (let (update-list entity-stack)
3029     (while entity
3030       (let* ((this-id (elmo-msgdb-overview-entity-get-id entity))
3031              (parent-entity
3032               (elmo-msgdb-overview-get-parent-entity entity overview));; temp
3033 ;;;          (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
3034              (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
3035              (case-fold-search t)
3036              msg overview2 cur-entity linked retval delayed-entity)
3037         (setq msg (elmo-msgdb-overview-entity-get-number entity))
3038         (if (and parent-number
3039                  (not (wl-thread-get-entity parent-number))
3040                  (not force-insert))
3041             ;; parent is exists in overview, but not exists in wl-thread-entities
3042             (progn
3043               (wl-append wl-summary-delayed-update
3044                          (list (cons parent-number entity)))
3045               (setq entity nil)) ;; exit loop
3046           ;; Search parent by subject.
3047           (when (and (null parent-number)
3048                      wl-summary-search-parent-by-subject-regexp
3049                      (string-match wl-summary-search-parent-by-subject-regexp
3050                                    (elmo-msgdb-overview-entity-get-subject entity)))
3051             (let ((found (wl-summary-search-by-subject entity overview)))
3052               (when (and found
3053                          (not (member found wl-summary-delayed-update)))
3054                 (setq parent-entity found)
3055                 (setq parent-number
3056                       (elmo-msgdb-overview-entity-get-number parent-entity))
3057                 (setq linked t))))
3058           ;; If subject is change, divide thread.
3059           (if (and parent-number
3060                    wl-summary-divide-thread-when-subject-changed
3061                    (not (wl-summary-subject-equal
3062                          (or (elmo-msgdb-overview-entity-get-subject
3063                               entity) "")
3064                          (or (elmo-msgdb-overview-entity-get-subject
3065                               parent-entity) ""))))
3066               (setq parent-number nil))
3067           ;;
3068           (setq retval
3069                 (wl-thread-insert-message entity overview mark-alist
3070                                           msg parent-number update linked))
3071           (and retval
3072                (wl-append update-list (list retval)))
3073           (setq entity nil) ; exit loop
3074           (while (setq delayed-entity (assq msg wl-summary-delayed-update))
3075             (setq wl-summary-delayed-update
3076                   (delete delayed-entity wl-summary-delayed-update))
3077             ;; update delayed message
3078             (wl-append entity-stack (list (cdr delayed-entity)))))
3079         (if (and (not entity)
3080                  entity-stack)
3081             (setq entity (pop entity-stack)))))
3082     update-list))
3083
3084 (defun wl-summary-update-thread (entity
3085                                  overview
3086                                  mark-alist
3087                                  thr-entity
3088                                  parent-entity)
3089   (let* ((depth 0)
3090          (this-id (elmo-msgdb-overview-entity-get-id entity))
3091          (overview-entity entity)
3092          (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
3093          (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
3094          summary-line msg subject-differ)
3095     (cond
3096      ((or (not parent-id)
3097           (string= this-id parent-id))
3098       (goto-char (point-max))
3099       (beginning-of-line))
3100      ;; parent already exists in buffer.
3101      ((setq depth (or (wl-summary-summary-line-already-exists-p
3102                        parent-number (current-buffer)) -1))
3103       (setq depth (+ 1 depth))
3104       (wl-thread-goto-bottom-of-sub-thread)))
3105     (if (and (setq msg (elmo-msgdb-overview-entity-get-number entity)))
3106         (if (setq summary-line
3107                   (wl-summary-overview-create-summary-line
3108                    msg entity parent-entity depth mark-alist
3109                    (wl-thread-maybe-get-children-num msg)
3110                    nil thr-entity))
3111             (let ((inhibit-read-only t)
3112                   (buffer-read-only nil))
3113               (wl-summary-insert-line summary-line))))))
3114
3115 (defun wl-summary-mark-as-unread (&optional number
3116                                             no-server-update
3117                                             no-modeline-update)
3118   (interactive)
3119   (save-excursion
3120     (let* (eol
3121           (inhibit-read-only t)
3122           (buffer-read-only nil)
3123           (folder wl-summary-buffer-folder-name)
3124           (msgdb wl-summary-buffer-msgdb)
3125           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
3126 ;;;       (number-alist (elmo-msgdb-get-number-alist msgdb))
3127           new-mark visible mark)
3128       (if number
3129           (progn
3130             (setq visible (wl-summary-jump-to-msg number))
3131             (unless (setq mark (cadr (assq number mark-alist)))
3132               (setq mark " ")))
3133         ;; interactive
3134         (setq visible t))
3135       (when visible
3136         (if (null (wl-summary-message-number))
3137             (message "No message.")
3138           (end-of-line)
3139           (setq eol (point))
3140           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
3141                                       "..../..")) ; set cursor line
3142           (beginning-of-line)))
3143       (if (or (and (not visible)
3144                    ;; already exists in msgdb.
3145                    (assq number (elmo-msgdb-get-number-alist msgdb)))
3146               (re-search-forward
3147                (format (concat "^ *\\("
3148                                (if number (int-to-string number)
3149                                  "[0-9]+")
3150                                "\\)[^0-9]\\(%s\\|%s\\)")
3151                        wl-summary-read-uncached-mark
3152                        " ") eol t))
3153           (progn
3154             (setq number (or number (string-to-int (wl-match-buffer 1))))
3155             (setq mark (or mark (elmo-match-buffer 2)))
3156             (save-match-data
3157               (setq new-mark (if (string= mark
3158                                           wl-summary-read-uncached-mark)
3159                                  wl-summary-unread-uncached-mark
3160                                (if (elmo-use-cache-p folder number)
3161                                    wl-summary-unread-mark
3162                                  wl-summary-unread-uncached-mark))))
3163             ;; server side mark
3164             (unless no-server-update
3165               (unless (elmo-mark-as-unread folder (list number)
3166                                            msgdb)
3167                 (error "Setting mark failed")))
3168             (when visible
3169               (delete-region (match-beginning 2) (match-end 2))
3170               (insert new-mark))
3171             (setq mark-alist
3172                   (elmo-msgdb-mark-set mark-alist
3173                                        number
3174                                        new-mark))
3175             (elmo-msgdb-set-mark-alist msgdb mark-alist)
3176             (unless no-modeline-update
3177               (setq wl-summary-buffer-unread-count
3178                     (+ 1 wl-summary-buffer-unread-count))
3179               (wl-summary-update-modeline)
3180               (wl-folder-update-unread
3181                folder
3182                (+ wl-summary-buffer-unread-count
3183                   wl-summary-buffer-new-count)))
3184             (wl-summary-set-mark-modified)
3185             (if (and visible wl-summary-highlight)
3186                 (wl-highlight-summary-current-line))))))
3187   (set-buffer-modified-p nil))
3188
3189 (defun wl-summary-delete (&optional number)
3190   "Mark Delete mark 'D'.
3191 If optional argument NUMBER is specified, mark message specified by NUMBER."
3192   (interactive)
3193   (let* ((buffer-num (wl-summary-message-number))
3194          (msg-num (or number buffer-num))
3195          mark)
3196     (catch 'done
3197       (when (null msg-num)
3198         (if (interactive-p)
3199             (message "No message."))
3200         (throw 'done nil))
3201       (when (setq mark (wl-summary-get-mark msg-num))
3202         (when (wl-summary-reserve-temp-mark-p mark)
3203           (if (interactive-p)
3204               (error "Already marked as `%s'" mark))
3205           (throw 'done nil))
3206         (wl-summary-unmark msg-num))
3207       (if (or (interactive-p)
3208               (eq number buffer-num))
3209           (wl-summary-mark-line "D"))
3210       (setq wl-summary-buffer-delete-list
3211             (cons msg-num wl-summary-buffer-delete-list))
3212       (if (interactive-p)
3213           (if (eq wl-summary-move-direction-downward nil)
3214               (wl-summary-prev)
3215             (wl-summary-next)))
3216       msg-num)))
3217
3218 (defun wl-summary-remove-destination ()
3219   (save-excursion
3220     (let ((inhibit-read-only t)
3221           (buffer-read-only nil)
3222           (buf (current-buffer))
3223           sol eol rs re)
3224       (beginning-of-line)
3225       (setq sol (point))
3226       (end-of-line)
3227       (setq eol (point))
3228       (setq rs (next-single-property-change sol 'wl-summary-destination
3229                                             buf eol))
3230       (setq re (next-single-property-change rs 'wl-summary-destination
3231                                             buf eol))
3232       (put-text-property rs re 'wl-summary-destination nil)
3233       (put-text-property rs re 'invisible nil)
3234       (goto-char re)
3235       (delete-char (- eol re)))))
3236
3237 (defun wl-summary-check-mark (msg mark)
3238   (let ((check-func (cond ((string= mark "o")
3239                            'wl-summary-msg-marked-as-refiled)
3240                           ((string= mark "O")
3241                            'wl-summary-msg-marked-as-copied)
3242                           ((string= mark "D")
3243                            'wl-summary-msg-marked-as-deleted)
3244                           ((string= mark "*")
3245                            'wl-summary-msg-marked-as-target))))
3246     (if check-func
3247         (funcall check-func msg))))
3248
3249 (defun wl-summary-mark-collect (mark &optional begin end)
3250   (save-excursion
3251     (save-restriction
3252       (let (msglist)
3253         (narrow-to-region (or begin (point-min))
3254                           (or end (point-max)))
3255         (goto-char (point-min))
3256         ;; for thread...
3257         (if (eq wl-summary-buffer-view 'thread)
3258             (progn
3259               (while (not (eobp))
3260                 (let* ((number (wl-summary-message-number))
3261                        (entity (wl-thread-get-entity number))
3262                        result)
3263                   ;; opened...only myself is checked.
3264                   (if (wl-summary-check-mark number mark)
3265                       (wl-append msglist (list number)))
3266                   (unless (wl-thread-entity-get-opened entity)
3267                     ;; closed...children is also checked.
3268                     (if (setq result (wl-thread-get-children-msgs-with-mark
3269                                       number
3270                                       mark))
3271                         (wl-append msglist result)))
3272                   (forward-line 1)))
3273               (elmo-uniq-list msglist))
3274           (let* ((case-fold-search nil)
3275                  (re (format (concat wl-summary-message-regexp "%s")
3276                              (regexp-quote mark))))
3277             (while (re-search-forward re nil t)
3278               (setq msglist (cons (wl-summary-message-number) msglist)))
3279             (nreverse msglist)))))))
3280
3281 (defun wl-summary-exec ()
3282   (interactive)
3283   (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list)
3284                         (reverse wl-summary-buffer-delete-list)
3285                         (mapcar 'car wl-summary-buffer-copy-list)))
3286
3287 (defun wl-summary-exec-region (beg end)
3288   (interactive "r")
3289   (message "Collecting marks ...")
3290   (save-excursion
3291     (goto-char beg)
3292     (beginning-of-line)
3293     (setq beg (point))
3294     (goto-char (1- end))
3295     (forward-line)
3296     (setq end (point))
3297     (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end)
3298                           (wl-summary-mark-collect "D" beg end)
3299                           (wl-summary-mark-collect "O" beg end))))
3300
3301 (defun wl-summary-exec-subr (moves dels copies)
3302   (if (not (or moves dels copies))
3303       (message "No marks")
3304     (save-excursion
3305       (let ((del-fld (wl-summary-get-delete-folder
3306                       wl-summary-buffer-folder-name))
3307             (start (point))
3308             (unread-marks (list wl-summary-unread-cached-mark
3309                                 wl-summary-unread-uncached-mark
3310                                 wl-summary-new-mark))
3311             (refiles (append moves dels))
3312             (refile-executed 0)
3313             (refile-failures 0)
3314             (copy-executed 0)
3315             (copy-failures 0)
3316             (copy-len (length copies))
3317             refile-len
3318             dst-msgs                    ; loop counter
3319             result)
3320         (message "Executing ...")
3321         (while dels
3322           (when (not (assq (car dels) wl-summary-buffer-refile-list))
3323             (wl-append wl-summary-buffer-refile-list
3324                        (list (cons (car dels) del-fld)))
3325             (setq wl-summary-buffer-delete-list
3326                   (delete (car dels) wl-summary-buffer-delete-list)))
3327           (setq dels (cdr dels)))
3328         ;; begin refile...
3329         (setq refile-len (length refiles))
3330         (setq dst-msgs
3331               (wl-inverse-alist refiles wl-summary-buffer-refile-list))
3332         (goto-char start)               ; avoid moving cursor to
3333                                         ; the bottom line.
3334         (while dst-msgs
3335 ;;;       (elmo-msgdb-add-msgs-to-seen-list
3336 ;;;        (car (car dst-msgs))         ;dst-folder
3337 ;;;        (cdr (car dst-msgs))         ;msgs
3338 ;;;        wl-summary-buffer-msgdb
3339 ;;;        (concat wl-summary-important-mark
3340 ;;;                wl-summary-read-uncached-mark))
3341           (setq result nil)
3342           (condition-case nil
3343               (setq result (elmo-move-msgs wl-summary-buffer-folder-name
3344                                            (cdr (car dst-msgs))
3345                                            (car (car dst-msgs))
3346                                            wl-summary-buffer-msgdb
3347                                            refile-len
3348                                            refile-executed
3349                                            (not (null (cdr dst-msgs)))
3350                                            nil ; no-delete
3351                                            nil ; same-number
3352                                            unread-marks))
3353             (error nil))
3354           (if result                    ; succeeded.
3355               (progn
3356                 ;; update buffer.
3357                 (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
3358                 ;; update refile-alist.
3359                 (setq wl-summary-buffer-refile-list
3360                       (wl-delete-associations (cdr (car dst-msgs))
3361                                              wl-summary-buffer-refile-list)))
3362             (setq refile-failures
3363                   (+ refile-failures (length (cdr (car dst-msgs))))))
3364           (setq refile-executed (+ refile-executed (length (cdr (car dst-msgs)))))
3365           (setq dst-msgs (cdr dst-msgs)))
3366         ;; end refile
3367         ;; begin cOpy...
3368         (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
3369         (while dst-msgs
3370 ;;;       (elmo-msgdb-add-msgs-to-seen-list
3371 ;;;        (car (car dst-msgs))         ;dst-folder
3372 ;;;        (cdr (car dst-msgs))         ;msgs
3373 ;;;        wl-summary-buffer-msgdb
3374 ;;;        (concat wl-summary-important-mark
3375 ;;;                wl-summary-read-uncached-mark))
3376           (setq result nil)
3377           (condition-case nil
3378               (setq result (elmo-move-msgs wl-summary-buffer-folder-name
3379                                            (cdr (car dst-msgs))
3380                                            (car (car dst-msgs))
3381                                            wl-summary-buffer-msgdb
3382                                            copy-len
3383                                            copy-executed
3384                                            (not (null (cdr dst-msgs)))
3385                                            t ; t is no-delete (copy)
3386                                            nil ; same number
3387                                            unread-marks))
3388             (error nil))
3389           (if result                    ; succeeded.
3390               (progn
3391                 ;; update buffer.
3392                 (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
3393                 ;; update copy-alist
3394                 (setq wl-summary-buffer-copy-list
3395                       (wl-delete-associations (cdr (car dst-msgs))
3396                                               wl-summary-buffer-copy-list)))
3397             (setq copy-failures
3398                   (+ copy-failures (length (cdr (car dst-msgs))))))
3399           (setq copy-executed (+ copy-executed (length (cdr (car dst-msgs)))))
3400           (setq dst-msgs (cdr dst-msgs)))
3401         ;; end cOpy
3402         (wl-summary-folder-info-update)
3403         (wl-summary-set-message-modified)
3404         (wl-summary-set-mark-modified)
3405         (run-hooks 'wl-summary-exec-hook)
3406         (set-buffer-modified-p nil)
3407         (message (concat "Executing ... done"
3408                          (if (> refile-failures 0)
3409                              (format " (%d refiling failed)" refile-failures)
3410                            "")
3411                          (if (> copy-failures 0)
3412                              (format " (%d copying failed)" copy-failures)
3413                            "")
3414                          "."))))))
3415
3416 (defun wl-summary-read-folder (default &optional purpose ignore-error
3417                                 no-create init)
3418   (let ((fld (completing-read
3419               (format "Folder name %s(%s): " (or purpose "")
3420                       default)
3421               (or wl-folder-completion-func
3422                   (if (memq 'read-folder wl-use-folder-petname)
3423                       (wl-folder-get-entity-with-petname)
3424                     wl-folder-entity-hashtb))
3425               nil nil (or init wl-default-spec)
3426               'wl-read-folder-hist)))
3427     (if (or (string= fld wl-default-spec)
3428             (string= fld ""))
3429         (setq fld default))
3430     (setq fld (elmo-string (wl-folder-get-realname fld)))
3431     (if (string-match "\n" fld)
3432         (error "Not supported folder name: %s" fld))
3433     (unless no-create
3434       (if ignore-error
3435           (ignore-errors (wl-folder-confirm-existence fld))
3436         (wl-folder-confirm-existence fld)))
3437     fld))
3438
3439 (defun wl-summary-print-destination (msg-num folder)
3440   "Print refile destination on line."
3441   (wl-summary-remove-destination)
3442   (let ((inhibit-read-only t)
3443         (folder (copy-sequence folder))
3444         (buffer-read-only nil)
3445         len rs re c)
3446     (setq len (string-width folder))
3447     (if (< len 1) ()
3448       (end-of-line)
3449       (setq re (point))
3450       (setq c 0)
3451       (while (< c len)
3452         (forward-char -1)
3453         (setq c (+ c (char-width (following-char)))))
3454       (and (> c len) (setq folder (concat " " folder)))
3455       (setq rs (point))
3456       (put-text-property rs re 'invisible t)
3457       (put-text-property rs re 'wl-summary-destination t)
3458       (goto-char re)
3459       (wl-highlight-refile-destination-string folder)
3460       (insert folder)
3461       (set-buffer-modified-p nil))))
3462
3463 ;; override.
3464 (when wl-on-nemacs
3465   (defun wl-summary-print-destination (msg-num &optional folder))
3466   (defun wl-summary-remove-destination ()))
3467
3468 (defsubst wl-summary-get-mark (number)
3469   "Return a temporal mark of message specified by NUMBER."
3470   (or (and (memq number wl-summary-buffer-delete-list) "D")
3471       (and (assq number wl-summary-buffer-copy-list) "O")
3472       (and (assq number wl-summary-buffer-refile-list) "o")
3473       (and (memq number wl-summary-buffer-target-mark-list) "*")))
3474
3475 (defsubst wl-summary-reserve-temp-mark-p (mark)
3476   "Return t if temporal MARK should be reserved."
3477   (member mark wl-summary-reserve-mark-list))
3478
3479 (defun wl-summary-refile (&optional dst number)
3480   "Put refile mark on current line message.
3481 If optional argument DST is specified, put mark without asking
3482 destination folder.
3483 If optional argument NUMBER is specified, mark message specified by NUMBER.
3484
3485 If folder is read-only, message should be copied.
3486 See `wl-refile-policy-alist' for more details."
3487   (interactive)
3488   (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
3489                                          wl-summary-buffer-folder-name)))
3490     (cond ((eq policy 'copy)
3491            (if (interactive-p)
3492                (call-interactively 'wl-summary-copy)
3493              (wl-summary-copy dst number)))
3494           (t
3495            (wl-summary-refile-subr 'refile (interactive-p) dst number)))))
3496
3497 (defun wl-summary-copy (&optional dst number)
3498   "Put copy mark on current line message.
3499 If optional argument DST is specified, put mark without asking
3500 destination folder.
3501 If optional argument NUMBER is specified, mark message specified by NUMBER."
3502   (interactive)
3503   (wl-summary-refile-subr 'copy (interactive-p) dst number))
3504
3505 (defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number)
3506   (interactive)
3507   (let* ((buffer-num (wl-summary-message-number))
3508          (msg-num (or number buffer-num))
3509          (msgid (and msg-num
3510                      (cdr (assq msg-num
3511                                 (elmo-msgdb-get-number-alist
3512                                  wl-summary-buffer-msgdb)))))
3513          (entity (and msg-num
3514                       (elmo-msgdb-overview-get-entity
3515                        msg-num wl-summary-buffer-msgdb)))
3516          (variable
3517           (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3518          folder mark already tmp-folder)
3519     (catch 'done
3520       (when (null entity)
3521         ;; msgdb is empty?
3522         (if interactive
3523             (message "Cannot refile."))
3524         (throw 'done nil))
3525       (when (null msg-num)
3526         (if interactive
3527             (message "No message."))
3528         (throw 'done nil))
3529       (when (setq mark (wl-summary-get-mark msg-num))
3530         (when (wl-summary-reserve-temp-mark-p mark)
3531           (if interactive
3532               (error "Already marked as `%s'" mark))
3533           (throw 'done nil)))
3534       (setq folder (and msg-num
3535                         (or dst (wl-summary-read-folder
3536                                  (or (wl-refile-guess entity) wl-trash-folder)
3537                                  (format "for %s" copy-or-refile)))))
3538       ;; Cache folder hack by okada@opaopa.org
3539       (if (and (eq (car (elmo-folder-get-spec
3540                          (wl-folder-get-realname folder))) 'cache)
3541                (not (string= folder
3542                              (setq tmp-folder
3543                                    (concat "'cache/"
3544                                            (elmo-cache-get-path-subr
3545                                             (elmo-msgid-to-cache msgid)))))))
3546           (progn
3547             (setq folder tmp-folder)
3548             (message "Force refile to %s." folder)))
3549       (if (string= folder wl-summary-buffer-folder-name)
3550           (error "Same folder"))
3551       (unless (or (elmo-folder-plugged-p wl-summary-buffer-folder-name)
3552                   (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name) 'pipe)
3553                        (elmo-folder-plugged-p
3554                         (elmo-pipe-spec-dst (elmo-folder-get-spec wl-summary-buffer-folder-name))))
3555                   (elmo-cache-exists-p msgid))
3556         (error "Unplugged (no cache or msgid)"))
3557       (if (or (string= folder wl-queue-folder)
3558               (string= folder wl-draft-folder))
3559           (error "Don't %s messages to %s" copy-or-refile folder))
3560       ;; learn for refile.
3561       (if (eq copy-or-refile 'refile)
3562           (wl-refile-learn entity folder))
3563       (wl-summary-unmark msg-num)
3564       (set variable (append
3565                      (symbol-value variable)
3566                      (list (cons msg-num folder))))
3567       (when (or interactive
3568                 (eq number buffer-num))
3569         (wl-summary-mark-line (if (eq copy-or-refile 'refile)
3570                                   "o" "O"))
3571         ;; print refile destination
3572         (wl-summary-print-destination msg-num folder))
3573       (if interactive
3574           (if (eq wl-summary-move-direction-downward nil)
3575               (wl-summary-prev)
3576             (wl-summary-next)))
3577       (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile)))
3578       (setq wl-summary-buffer-prev-refile-destination folder)
3579       msg-num)))
3580
3581 (defun wl-summary-refile-prev-destination ()
3582   "Refile message to previously refiled destination."
3583   (interactive)
3584   (wl-summary-refile wl-summary-buffer-prev-refile-destination
3585                      (wl-summary-message-number))
3586   (if (eq wl-summary-move-direction-downward nil)
3587       (wl-summary-prev)
3588     (wl-summary-next)))
3589
3590 (defun wl-summary-copy-prev-destination ()
3591   "Refile message to previously refiled destination."
3592   (interactive)
3593   (wl-summary-copy wl-summary-buffer-prev-copy-destination
3594                    (wl-summary-message-number))
3595   (if (eq wl-summary-move-direction-downward nil)
3596       (wl-summary-prev)
3597     (wl-summary-next)))
3598
3599 (defsubst wl-summary-no-auto-refile-message-p (msg mark-alist)
3600   (member (cadr (assq msg mark-alist)) wl-summary-auto-refile-skip-marks))
3601
3602 (defun wl-summary-auto-refile (&optional open-all)
3603   "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
3604   (interactive "P")
3605   (message "Marking...")
3606   (save-excursion
3607     (if (and (eq wl-summary-buffer-view 'thread)
3608              open-all)
3609         (wl-thread-open-all))
3610     (let* ((spec wl-summary-buffer-folder-name)
3611            (overview (elmo-msgdb-get-overview
3612                       wl-summary-buffer-msgdb))
3613            (mark-alist (elmo-msgdb-get-mark-alist
3614                         wl-summary-buffer-msgdb))
3615            checked-dsts
3616            (count 0)
3617            number dst thr-entity)
3618       (goto-line 1)
3619       (while (not (eobp))
3620         (setq number (wl-summary-message-number))
3621         (when (and (not (wl-summary-no-auto-refile-message-p number
3622                                                              mark-alist))
3623                    (setq dst
3624                          (wl-folder-get-realname
3625                           (wl-refile-guess-by-rule
3626                            (elmo-msgdb-overview-get-entity
3627                             number wl-summary-buffer-msgdb))))
3628                    (not (equal dst spec)))
3629           (when (not (member dst checked-dsts))
3630             (wl-folder-confirm-existence dst)
3631             (setq checked-dsts (cons dst checked-dsts)))
3632           (if (wl-summary-refile dst number)
3633               (incf count))
3634           (message "Marking...%d message(s)." count))
3635         (if (eq wl-summary-buffer-view 'thread)
3636             ;; process invisible children.
3637             (unless (wl-thread-entity-get-opened
3638                      (setq thr-entity (wl-thread-get-entity number)))
3639               (let ((messages
3640                      (elmo-delete-if
3641                       (function
3642                        (lambda (x)
3643                          (wl-summary-no-auto-refile-message-p
3644                           x mark-alist)))
3645                       (wl-thread-entity-get-descendant thr-entity))))
3646                 (while messages
3647                   (when (and (setq dst
3648                                    (wl-refile-guess-by-rule
3649                                     (elmo-msgdb-overview-get-entity
3650                                      (car messages) wl-summary-buffer-msgdb)))
3651                              (not (equal dst spec)))
3652                     (if (wl-summary-refile dst (car messages))
3653                         (incf count))
3654                     (message "Marking...%d message(s)." count))
3655                   (setq messages (cdr messages))))))
3656         (forward-line))
3657       (if (eq count 0)
3658           (message "No message was marked.")
3659         (message "Marked %d message(s)." count)))))
3660
3661 (defun wl-summary-unmark (&optional number)
3662   "Unmark marks (temporary, refile, copy, delete)of current line.
3663 If optional argument NUMBER is specified, unmark message specified by NUMBER."
3664   (interactive)
3665   (save-excursion
3666     (beginning-of-line)
3667     (let ((inhibit-read-only t)
3668           (buffer-read-only nil)
3669           visible
3670           msg-num
3671           cur-mark
3672           score-mark)
3673       (if number
3674           (setq visible (wl-summary-jump-to-msg number))
3675         (setq visible t))
3676       ;; Delete mark on buffer.
3677       (when (and visible
3678                  (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)"))
3679         (goto-char (match-end 2))
3680         (or number
3681             (setq number (string-to-int (wl-match-buffer 1))))
3682         (setq cur-mark (wl-match-buffer 2))
3683         (if (string= cur-mark " ")
3684             ()
3685           (delete-region (match-beginning 2) (match-end 2))
3686           (if (setq score-mark (wl-summary-get-score-mark number))
3687               (insert score-mark)
3688             (insert " ")))
3689         (if (or (string= cur-mark "o")
3690                 (string= cur-mark "O"))
3691             (wl-summary-remove-destination))
3692         (if wl-summary-highlight
3693             (wl-highlight-summary-current-line nil nil score-mark))
3694         (set-buffer-modified-p nil))
3695       ;; Remove from temporary mark structure.
3696       (and number
3697            (wl-summary-delete-mark number)))))
3698
3699 (defun wl-summary-msg-marked-as-target (msg)
3700   (if (memq msg wl-summary-buffer-target-mark-list)
3701       t))
3702
3703 (defun wl-summary-msg-marked-as-copied (msg)
3704   (assq msg wl-summary-buffer-copy-list))
3705
3706 (defun wl-summary-msg-marked-as-deleted (msg)
3707   (if (memq msg wl-summary-buffer-delete-list)
3708       t))
3709
3710 (defun wl-summary-msg-marked-as-refiled (msg)
3711   (assq msg wl-summary-buffer-refile-list))
3712
3713 (defun wl-summary-target-mark (&optional number)
3714   "Put target mark '*' on current message.
3715 If optional argument NUMBER is specified, mark message specified by NUMBER."
3716   (interactive)
3717   (let* ((buffer-num (wl-summary-message-number))
3718          (msg-num (or number buffer-num))
3719          mark)
3720     (catch 'done
3721       (when (null msg-num)
3722         (if (interactive-p)
3723             (message "No message."))
3724         (throw 'done nil))
3725       (when (setq mark (wl-summary-get-mark msg-num))
3726         (when (wl-summary-reserve-temp-mark-p mark)
3727           (if (interactive-p)
3728               (error "Already marked as `%s'" mark))
3729           (throw 'done nil))
3730         (wl-summary-unmark msg-num))
3731       (if (or (interactive-p)
3732               (eq number buffer-num))
3733           (wl-summary-mark-line "*"))
3734       (setq wl-summary-buffer-target-mark-list
3735             (cons msg-num wl-summary-buffer-target-mark-list))
3736       (if (interactive-p)
3737           (if (eq wl-summary-move-direction-downward nil)
3738               (wl-summary-prev)
3739             (wl-summary-next)))
3740       msg-num)))
3741
3742
3743 (defun wl-summary-refile-region (beg end)
3744   "Put copy mark on messages in the region specified by BEG and END."
3745   (interactive "r")
3746   (wl-summary-refile-region-subr "refile" beg end))
3747
3748 (defun wl-summary-copy-region (beg end)
3749   "Put copy mark on messages in the region specified by BEG and END."
3750   (interactive "r")
3751   (wl-summary-refile-region-subr "copy" beg end))
3752
3753 (defun wl-summary-refile-region-subr (copy-or-refile beg end)
3754   (save-excursion
3755     (save-restriction
3756       (goto-char beg)
3757       ;; guess by first msg
3758       (let* ((msgid (cdr (assq (wl-summary-message-number)
3759                                (elmo-msgdb-get-number-alist
3760                                 wl-summary-buffer-msgdb))))
3761              (function (intern (format "wl-summary-%s" copy-or-refile)))
3762              (entity (assoc msgid (elmo-msgdb-get-overview
3763                                    wl-summary-buffer-msgdb)))
3764              folder)
3765         (if entity
3766             (setq folder (wl-summary-read-folder (wl-refile-guess entity)
3767                                                  (format "for %s"
3768                                                          copy-or-refile))))
3769         (narrow-to-region beg end)
3770         (if (eq wl-summary-buffer-view 'thread)
3771             (progn
3772               (while (not (eobp))
3773                 (let* ((number (wl-summary-message-number))
3774                        (entity (wl-thread-get-entity number))
3775                        children)
3776                   (if (wl-thread-entity-get-opened entity)
3777                       ;; opened...refile line.
3778                       (funcall function folder number)
3779                     ;; closed
3780                     (setq children (wl-thread-get-children-msgs number))
3781                     (while children
3782                       (funcall function folder (pop children))))
3783                   (forward-line 1))))
3784           (while (not (eobp))
3785             (funcall function folder (wl-summary-message-number))
3786             (forward-line 1)))))))
3787
3788 (defun wl-summary-unmark-region (beg end)
3789   (interactive "r")
3790   (save-excursion
3791     (save-restriction
3792       (narrow-to-region beg end)
3793       (goto-char (point-min))
3794       (if (eq wl-summary-buffer-view 'thread)
3795           (progn
3796             (while (not (eobp))
3797               (let* ((number (wl-summary-message-number))
3798                      (entity (wl-thread-get-entity number)))
3799                 (if (wl-thread-entity-get-opened entity)
3800                     ;; opened...unmark line.
3801                     (wl-summary-unmark)
3802                   ;; closed
3803                   (wl-summary-delete-marks-on-buffer
3804                    (wl-thread-get-children-msgs number))))
3805               (forward-line 1)))
3806         (while (not (eobp))
3807           (wl-summary-unmark)
3808           (forward-line 1))))))
3809
3810 (defun wl-summary-mark-region-subr (function beg end)
3811   (save-excursion
3812     (save-restriction
3813       (narrow-to-region beg end)
3814       (goto-char (point-min))
3815       (if (eq wl-summary-buffer-view 'thread)
3816           (progn
3817             (while (not (eobp))
3818               (let* ((number (wl-summary-message-number))
3819                      (entity (wl-thread-get-entity number))
3820                      (wl-summary-move-direction-downward t)
3821                      children)
3822                 (if (wl-thread-entity-get-opened entity)
3823                     ;; opened...delete line.
3824                     (funcall function number)
3825                   ;; closed
3826                   (setq children (wl-thread-get-children-msgs number))
3827                   (while children
3828                     (funcall function (pop children))))
3829                 (forward-line 1))))
3830         (while (not (eobp))
3831           (funcall function (wl-summary-message-number))
3832           (forward-line 1))))))
3833
3834 (defun wl-summary-delete-region (beg end)
3835   (interactive "r")
3836   (wl-summary-mark-region-subr 'wl-summary-delete beg end))
3837
3838 (defun wl-summary-target-mark-region (beg end)
3839   (interactive "r")
3840   (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
3841
3842 (defun wl-summary-target-mark-all ()
3843   (interactive)
3844   (wl-summary-target-mark-region (point-min) (point-max))
3845   (setq wl-summary-buffer-target-mark-list
3846         (mapcar 'car
3847                 (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))))
3848
3849 (defun wl-summary-delete-all-mark (mark)
3850   (goto-char (point-min))
3851   (let ((case-fold-search nil))
3852     (while (re-search-forward (format "^ *[0-9]+%s"
3853                                       (regexp-quote mark)) nil t)
3854       (wl-summary-unmark))
3855     (cond ((string= mark "*")
3856            (setq wl-summary-buffer-target-mark-list nil))
3857           ((string= mark "D")
3858            (setq wl-summary-buffer-delete-list nil))
3859           ((string= mark "O")
3860            (setq wl-summary-buffer-copy-list nil))
3861           ((string= mark "o")
3862            (setq wl-summary-buffer-refile-list nil)))))
3863
3864 (defun wl-summary-unmark-all ()
3865   "Unmark all according to what you input."
3866   (interactive)
3867   (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
3868         cur-mark)
3869     (save-excursion
3870       (while unmarks
3871         (setq cur-mark (char-to-string (car unmarks)))
3872         (wl-summary-delete-all-mark cur-mark)
3873         (setq unmarks (cdr unmarks))))))
3874
3875 (defun wl-summary-target-mark-thread ()
3876   (interactive)
3877   (let (beg end)
3878     (end-of-line)
3879     (wl-summary-goto-top-of-current-thread)
3880     (wl-thread-force-open)
3881     (setq beg (point))
3882     (end-of-line)
3883     (wl-summary-goto-bottom-of-current-thread)
3884 ;;; (forward-line -1)
3885     (beginning-of-line)
3886     (setq end (point))
3887     (wl-summary-target-mark-region beg end)))
3888
3889 (defun wl-summary-target-mark-msgs (msgs)
3890   (while msgs
3891     (if (eq wl-summary-buffer-view 'thread)
3892         (wl-thread-jump-to-msg (car msgs))
3893       (wl-summary-jump-to-msg (car msgs)))
3894     (wl-summary-target-mark (wl-summary-message-number))
3895     (setq msgs (cdr msgs))))
3896
3897 (defun wl-summary-pick (&optional from-list delete-marks)
3898   (interactive)
3899   (let ((result (elmo-msgdb-search
3900                  wl-summary-buffer-folder-name
3901                  (elmo-read-search-condition wl-summary-pick-field-default)
3902                  wl-summary-buffer-msgdb)))
3903     (if delete-marks
3904       (let ((mlist wl-summary-buffer-target-mark-list))
3905         (while mlist
3906           (when (wl-summary-jump-to-msg (car mlist))
3907             (wl-summary-unmark))
3908           (setq mlist (cdr mlist)))
3909         (setq wl-summary-buffer-target-mark-list nil)))
3910     (if from-list
3911         (setq result (elmo-list-filter from-list result)))
3912     (message "%d message(s) are picked." (length result))
3913     (if (null result)
3914         (message "No message was picked.")
3915       (wl-summary-target-mark-msgs result))))
3916
3917 (defun wl-summary-unvirtual ()
3918   "Exit from current virtual folder."
3919   (interactive)
3920   (if (eq 'filter
3921           (elmo-folder-get-type wl-summary-buffer-folder-name))
3922       (wl-summary-goto-folder-subr (nth 2 (elmo-folder-get-spec
3923                                            wl-summary-buffer-folder-name))
3924                                    'update nil nil t)
3925     (error "This folder is not filtered")))
3926
3927 (defun wl-summary-virtual (&optional arg)
3928   "Goto virtual folder.
3929 If ARG, exit virtual folder."
3930   (interactive "P")
3931   (if arg
3932       (wl-summary-unvirtual)
3933     (wl-summary-goto-folder-subr (concat "/"
3934                                          (elmo-read-search-condition
3935                                           wl-summary-pick-field-default)
3936                                          "/"
3937                                          wl-summary-buffer-folder-name)
3938                                  'update nil nil t)))
3939
3940 (defun wl-summary-delete-all-temp-marks ()
3941   (interactive)
3942   (save-excursion
3943     (goto-char (point-min))
3944     (message "Unmarking...")
3945     (while (not (eobp))
3946       (wl-summary-unmark)
3947       (forward-line))
3948     (message "Unmarking...done")
3949     (setq wl-summary-buffer-target-mark-list nil)
3950     (setq wl-summary-buffer-delete-list nil)
3951     (setq wl-summary-buffer-refile-list nil)
3952     (setq wl-summary-buffer-copy-list nil)))
3953
3954 (defun wl-summary-delete-mark (number)
3955   "Delete temporary mark of the message specified by NUMBER."
3956   (cond
3957    ((memq number wl-summary-buffer-target-mark-list)
3958     (setq wl-summary-buffer-target-mark-list
3959           (delq number wl-summary-buffer-target-mark-list)))
3960    ((memq number wl-summary-buffer-delete-list)
3961     (setq wl-summary-buffer-delete-list
3962           (delq number wl-summary-buffer-delete-list)))
3963    (t
3964     (let (pair)
3965       (cond
3966        ((setq pair (assq number wl-summary-buffer-copy-list))
3967         (setq wl-summary-buffer-copy-list
3968               (delq pair wl-summary-buffer-copy-list)))
3969        ((setq pair (assq number wl-summary-buffer-refile-list))
3970         (setq wl-summary-buffer-refile-list
3971               (delq pair wl-summary-buffer-refile-list))))))))
3972
3973 (defun wl-summary-mark-line (mark)
3974   "Put MARK on current line.  Return message number."
3975   (save-excursion
3976     (beginning-of-line)
3977     (let ((inhibit-read-only t)
3978           (buffer-read-only nil)
3979           msg-num
3980           cur-mark)
3981       (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
3982         (setq msg-num  (string-to-int (wl-match-buffer 1)))
3983         (setq cur-mark (wl-match-buffer 2))
3984         (goto-char (match-end 1))
3985         (delete-region (match-beginning 2) (match-end 2))
3986 ;;;     (wl-summary-delete-mark msg-num)
3987         (insert mark)
3988         (if wl-summary-highlight
3989             (wl-highlight-summary-current-line nil nil t))
3990         (set-buffer-modified-p nil)
3991         msg-num))))
3992
3993 (defun wl-summary-target-mark-delete ()
3994   (interactive)
3995   (save-excursion
3996     (goto-char (point-min))
3997     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3998           number mlist)
3999       (while (re-search-forward regexp nil t)
4000         (let (wl-summary-buffer-disp-msg)
4001           (when (setq number (wl-summary-message-number))
4002             (wl-summary-delete number)
4003             (setq wl-summary-buffer-target-mark-list
4004                   (delq number wl-summary-buffer-target-mark-list)))))
4005       (setq mlist wl-summary-buffer-target-mark-list)
4006       (while mlist
4007         (wl-append wl-summary-buffer-delete-list (list (car mlist)))
4008         (setq wl-summary-buffer-target-mark-list
4009               (delq (car mlist) wl-summary-buffer-target-mark-list))
4010         (setq mlist (cdr mlist))))))
4011
4012 (defun wl-summary-target-mark-prefetch ()
4013   (interactive)
4014   (save-excursion
4015     (let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
4016            (inhibit-read-only t)
4017            (buffer-read-only nil)
4018            (count 0)
4019            (length (length mlist))
4020            (pos (point))
4021            skipped
4022            new-mark)
4023       (while mlist
4024         (setq new-mark (wl-summary-prefetch-msg (car mlist)))
4025         (if new-mark
4026             (progn
4027               (message "Prefetching... %d/%d message(s)"
4028                        (setq count (+ 1 count)) length)
4029               (when (wl-summary-jump-to-msg (car mlist))
4030                 (wl-summary-unmark)
4031                 (when new-mark
4032                   (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)")
4033                     (delete-region (match-beginning 1) (match-end 1)))
4034                   (goto-char (match-beginning 1))
4035                   (insert new-mark)
4036                   (if wl-summary-highlight
4037                       (wl-highlight-summary-current-line))
4038                   (save-excursion
4039                     (goto-char pos)
4040                     (sit-for 0)))))
4041           (setq skipped (cons (car mlist) skipped)))
4042         (setq mlist (cdr mlist)))
4043       (setq wl-summary-buffer-target-mark-list skipped)
4044       (message "Prefetching... %d/%d message(s)." count length)
4045       (set-buffer-modified-p nil))))
4046
4047 (defun wl-summary-target-mark-refile-subr (copy-or-refile)
4048   (let ((variable
4049          (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
4050         (function
4051          (intern (format "wl-summary-%s" copy-or-refile)))
4052         regexp number msgid entity folder mlist)
4053     (save-excursion
4054       (goto-char (point-min))
4055       (setq regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4056       ;; guess by first mark
4057       (when (re-search-forward regexp nil t)
4058         (setq msgid (cdr (assq (setq number (wl-summary-message-number))
4059                                (elmo-msgdb-get-number-alist
4060                                 wl-summary-buffer-msgdb)))
4061               entity (assoc msgid
4062                             (elmo-msgdb-get-overview
4063                              wl-summary-buffer-msgdb)))
4064         (if (null entity)
4065             (error "Cannot %s" copy-or-refile))
4066         (funcall function
4067                  (setq folder (wl-summary-read-folder
4068                                (wl-refile-guess entity)
4069                                (format "for %s" copy-or-refile)))
4070                  number)
4071         (if number
4072             (setq wl-summary-buffer-target-mark-list
4073                   (delq number wl-summary-buffer-target-mark-list)))
4074         (while (re-search-forward regexp nil t)
4075           (let (wl-summary-buffer-disp-msg)
4076             (when (setq number (wl-summary-message-number))
4077               (funcall function folder number)
4078               (setq wl-summary-buffer-target-mark-list
4079                     (delq number wl-summary-buffer-target-mark-list)))))
4080         ;; process invisible messages.
4081         (setq mlist wl-summary-buffer-target-mark-list)
4082         (while mlist
4083           (set variable
4084                (append (symbol-value variable)
4085                        (list (cons (car mlist) folder))))
4086           (setq wl-summary-buffer-target-mark-list
4087                 (delq (car mlist) wl-summary-buffer-target-mark-list))
4088           (setq mlist (cdr mlist)))))))
4089
4090 (defun wl-summary-target-mark-copy ()
4091   (interactive)
4092   (wl-summary-target-mark-refile-subr "copy"))
4093
4094 (defun wl-summary-target-mark-refile ()
4095   (interactive)
4096   (wl-summary-target-mark-refile-subr "refile"))
4097
4098 (defun wl-summary-target-mark-mark-as-read ()
4099   (interactive)
4100   (save-excursion
4101     (goto-char (point-min))
4102     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4103           (inhibit-read-only t)
4104           (buffer-read-only nil)
4105           number mlist)
4106       (while (re-search-forward regexp nil t)
4107         (let (wl-summary-buffer-disp-msg)
4108           ;; delete target-mark from buffer.
4109           (delete-region (match-beginning 1) (match-end 1))
4110           (insert " ")
4111           (setq number (wl-summary-mark-as-read t))
4112           (if wl-summary-highlight
4113               (wl-highlight-summary-current-line))
4114           (if number
4115               (setq wl-summary-buffer-target-mark-list
4116                     (delq number wl-summary-buffer-target-mark-list)))))
4117       (setq mlist wl-summary-buffer-target-mark-list)
4118       (while mlist
4119         (wl-summary-mark-as-read t nil nil (car mlist))
4120         (setq wl-summary-buffer-target-mark-list
4121               (delq (car mlist) wl-summary-buffer-target-mark-list))
4122         (setq mlist (cdr mlist)))
4123       (wl-summary-count-unread
4124        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4125       (wl-summary-update-modeline))))
4126
4127 (defun wl-summary-target-mark-mark-as-unread ()
4128   (interactive)
4129   (save-excursion
4130     (goto-char (point-min))
4131     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4132           (inhibit-read-only t)
4133           (buffer-read-only nil)
4134           number mlist)
4135       (while (re-search-forward regexp nil t)
4136         (let (wl-summary-buffer-disp-msg)
4137           ;; delete target-mark from buffer.
4138           (delete-region (match-beginning 1) (match-end 1))
4139           (insert " ")
4140           (setq number (wl-summary-mark-as-unread))
4141           (if wl-summary-highlight
4142               (wl-highlight-summary-current-line))
4143           (if number
4144               (setq wl-summary-buffer-target-mark-list
4145                     (delq number wl-summary-buffer-target-mark-list)))))
4146       (setq mlist wl-summary-buffer-target-mark-list)
4147       (while mlist
4148         (wl-summary-mark-as-unread (car mlist))
4149 ;;;     (wl-thread-msg-mark-as-unread (car mlist))
4150         (setq wl-summary-buffer-target-mark-list
4151               (delq (car mlist) wl-summary-buffer-target-mark-list))
4152         (setq mlist (cdr mlist)))
4153       (wl-summary-count-unread
4154        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4155       (wl-summary-update-modeline))))
4156
4157 (defun wl-summary-target-mark-mark-as-important ()
4158   (interactive)
4159   (save-excursion
4160     (goto-char (point-min))
4161     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4162           (inhibit-read-only t)
4163           (buffer-read-only nil)
4164           number mlist)
4165       (while (re-search-forward regexp nil t)
4166         (let (wl-summary-buffer-disp-msg)
4167           ;; delete target-mark from buffer.
4168           (delete-region (match-beginning 1) (match-end 1))
4169           (insert " ")
4170           (setq number (wl-summary-mark-as-important))
4171           (if wl-summary-highlight
4172               (wl-highlight-summary-current-line))
4173           (if number
4174               (setq wl-summary-buffer-target-mark-list
4175                     (delq number wl-summary-buffer-target-mark-list)))))
4176       (setq mlist wl-summary-buffer-target-mark-list)
4177       (while mlist
4178         (wl-summary-mark-as-important (car mlist))
4179         (wl-thread-msg-mark-as-important (car mlist))
4180         (setq wl-summary-buffer-target-mark-list
4181               (delq (car mlist) wl-summary-buffer-target-mark-list))
4182         (setq mlist (cdr mlist)))
4183       (wl-summary-count-unread
4184        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4185       (wl-summary-update-modeline))))
4186
4187 (defun wl-summary-target-mark-save ()
4188   (interactive)
4189   (save-excursion
4190     (goto-char (point-min))
4191     (let ((wl-save-dir
4192            (wl-read-directory-name "Save to directory: " wl-tmp-dir))
4193           (regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4194           number mlist)
4195       (if (null (file-exists-p wl-save-dir))
4196           (make-directory wl-save-dir))
4197       (while (re-search-forward regexp nil t)
4198         (let (wl-summary-buffer-disp-msg)
4199           (setq number (wl-summary-save t wl-save-dir))
4200           (wl-summary-unmark)
4201           (if number
4202               (setq wl-summary-buffer-target-mark-list
4203                     (delq number wl-summary-buffer-target-mark-list))))))))
4204
4205 (defun wl-summary-target-mark-pick ()
4206   (interactive)
4207   (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
4208
4209 (defun wl-summary-mark-as-read (&optional notcrosses
4210                                           leave-server-side-mark-untouched
4211                                           displayed
4212                                           number
4213                                           cached)
4214   (interactive)
4215   (save-excursion
4216     (let* (eol
4217            (inhibit-read-only t)
4218            (buffer-read-only nil)
4219            (folder wl-summary-buffer-folder-name)
4220            (msgdb wl-summary-buffer-msgdb)
4221            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4222 ;;;        (number-alist (elmo-msgdb-get-number-alist msgdb))
4223            (case-fold-search nil)
4224            mark stat visible uncached new-mark marked)
4225       (if number
4226           (progn
4227             (setq visible (wl-summary-jump-to-msg number))
4228             (setq mark (cadr (assq number mark-alist))))
4229         (setq visible t))
4230       (beginning-of-line)
4231       (if (or (not visible)
4232               (looking-at
4233                (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
4234                        (regexp-quote wl-summary-read-uncached-mark)
4235                        (regexp-quote wl-summary-unread-uncached-mark)
4236                        (regexp-quote wl-summary-unread-cached-mark)
4237                        (regexp-quote wl-summary-new-mark))))
4238           (progn
4239             (setq mark (or mark (wl-match-buffer 2)))
4240             (when mark
4241               (cond
4242                ((string= mark wl-summary-new-mark) ; N
4243                 (setq stat 'new)
4244                 (setq uncached t))
4245                ((string= mark wl-summary-unread-uncached-mark) ; U
4246                 (setq stat 'unread)
4247                 (setq uncached t))
4248                ((string= mark wl-summary-unread-cached-mark)  ; !
4249                 (setq stat 'unread))
4250                (t
4251                 ;; no need to mark server.
4252                 (setq leave-server-side-mark-untouched t))))
4253             (setq number (or number (string-to-int (wl-match-buffer 1))))
4254             ;; set server side mark...
4255             (setq new-mark (if (and uncached
4256                                     (if (elmo-use-cache-p folder number)
4257                                         (not (elmo-folder-local-p folder)))
4258                                     (not cached))
4259                                wl-summary-read-uncached-mark
4260                              nil))
4261             (if (not leave-server-side-mark-untouched)
4262                 (setq marked (elmo-mark-as-read folder
4263                                                 (list number) msgdb)))
4264             (if (or leave-server-side-mark-untouched
4265                     marked)
4266                 (progn
4267                   (cond ((eq stat 'unread)
4268                          (setq wl-summary-buffer-unread-count
4269                                (1- wl-summary-buffer-unread-count)))
4270                         ((eq stat 'new)
4271                          (setq wl-summary-buffer-new-count
4272                                (1- wl-summary-buffer-new-count))))
4273                   (wl-summary-update-modeline)
4274                   (wl-folder-update-unread
4275                    folder
4276                    (+ wl-summary-buffer-unread-count
4277                       wl-summary-buffer-new-count))
4278                   (when (or stat cached)
4279                     (when visible
4280                       (goto-char (match-end 2))
4281                       (delete-region (match-beginning 2) (match-end 2))
4282                       (insert (or new-mark " ")))
4283                     (setq mark-alist
4284                           (elmo-msgdb-mark-set mark-alist number new-mark))
4285                     (elmo-msgdb-set-mark-alist msgdb mark-alist)
4286                     (wl-summary-set-mark-modified))
4287                   (if (and visible wl-summary-highlight)
4288                       (wl-highlight-summary-current-line nil nil t))
4289                   (if (not notcrosses)
4290                       (wl-summary-set-crosspost nil
4291                                                 (and wl-summary-buffer-disp-msg
4292                                                      (interactive-p)))))
4293               (if mark (message "Warning: Changing mark failed.")))))
4294       (set-buffer-modified-p nil)
4295       (if stat
4296           (run-hooks 'wl-summary-unread-message-hook))
4297       number ;return value
4298       )))
4299
4300 (defun wl-summary-mark-as-important (&optional number
4301                                                mark
4302                                                no-server-update)
4303   (interactive)
4304   (if (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
4305           'internal)
4306       (error "Cannot process mark in this folder"))
4307   (save-excursion
4308     (let* (eol
4309           (inhibit-read-only t)
4310           (buffer-read-only nil)
4311           (folder wl-summary-buffer-folder-name)
4312           (msgdb wl-summary-buffer-msgdb)
4313           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4314           (number-alist (elmo-msgdb-get-number-alist msgdb))
4315           message-id visible)
4316       (if number
4317           (progn
4318             (setq visible (wl-summary-jump-to-msg number))
4319             (setq mark (or mark (cadr (assq number mark-alist)))))
4320         (setq visible t))
4321       (when visible
4322         (if (null (wl-summary-message-number))
4323             (progn
4324               (message "No message.")
4325               (setq visible nil))
4326           (end-of-line)
4327           (setq eol (point))
4328           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
4329                                       "..../..") nil t)) ; set cursor line
4330         )
4331       (beginning-of-line)
4332       (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)
4333           (progn
4334             (setq number (or number (string-to-int (wl-match-buffer 1))))
4335             (setq mark (or mark (wl-match-buffer 2)))
4336             (setq message-id (cdr (assq number number-alist)))
4337             (if (string= mark wl-summary-important-mark)
4338                 (progn
4339                   ;; server side mark
4340                   (unless no-server-update
4341                     (elmo-unmark-important folder (list number) msgdb)
4342                     (elmo-msgdb-global-mark-delete message-id))
4343                   ;; Remove cache if local folder.
4344                   (if (elmo-folder-local-p folder)
4345                       (elmo-cache-delete message-id folder number))
4346                   (when visible
4347                     (delete-region (match-beginning 2) (match-end 2))
4348                     (insert " "))
4349                   (setq mark-alist
4350                         (elmo-msgdb-mark-set mark-alist
4351                                              number
4352                                              nil)))
4353               ;; server side mark
4354               (unless no-server-update
4355                 (elmo-mark-as-important folder (list number) msgdb))
4356               (when visible
4357                 (delete-region (match-beginning 2) (match-end 2))
4358                 (insert wl-summary-important-mark))
4359               (setq mark-alist
4360                     (elmo-msgdb-mark-set mark-alist
4361                                          (string-to-int (wl-match-buffer 1))
4362                                          wl-summary-important-mark))
4363               ;; Force cache message!!
4364               (save-match-data
4365                 (unless (elmo-cache-exists-p message-id)
4366                   (elmo-force-cache-msg folder number message-id
4367                                         (elmo-msgdb-get-location msgdb))))
4368               (unless no-server-update
4369                 (elmo-msgdb-global-mark-set message-id
4370                                             wl-summary-important-mark)))
4371             (elmo-msgdb-set-mark-alist msgdb mark-alist)
4372             (wl-summary-set-mark-modified)))
4373       (if (and visible wl-summary-highlight)
4374           (wl-highlight-summary-current-line nil nil t))))
4375   (set-buffer-modified-p nil)
4376   number)
4377
4378 (defsubst wl-summary-format-date (date-string)
4379   (condition-case nil
4380       (let ((datevec (timezone-fix-time date-string nil
4381                                         wl-summary-fix-timezone)))
4382         (format "%02d/%02d(%s)%02d:%02d"
4383                 (aref datevec 1)
4384                 (aref datevec 2)
4385                 (elmo-date-get-week (aref datevec 0)
4386                                     (aref datevec 1)
4387                                     (aref datevec 2))
4388                 (aref datevec 3)
4389                 (aref datevec 4)))
4390     (error "??/??(??)??:??")))
4391
4392 (defun wl-summary-overview-create-summary-line (msg
4393                                                 entity
4394                                                 parent-entity
4395                                                 depth
4396                                                 mark-alist
4397                                                 &optional
4398                                                 children-num
4399                                                 temp-mark thr-entity
4400                                                 subject-differ)
4401   (let ((wl-mime-charset wl-summary-buffer-mime-charset)
4402         (elmo-mime-charset wl-summary-buffer-mime-charset)
4403         no-parent before-indent
4404         from subject parent-raw-subject parent-subject
4405         mark line
4406         (elmo-lang wl-summary-buffer-weekday-name-lang)
4407         (children-num (if children-num (int-to-string children-num)))
4408         (thr-str "")
4409         linked)
4410     (when thr-entity
4411       (setq thr-str (wl-thread-make-indent-string thr-entity))
4412       (setq linked (wl-thread-entity-get-linked thr-entity)))
4413     (if (string= thr-str "")
4414         (setq no-parent t)) ; no parent
4415     (if (and wl-summary-width
4416              wl-summary-indent-length-limit
4417              (< wl-summary-indent-length-limit
4418                 (string-width thr-str)))
4419         (setq thr-str (wl-set-string-width
4420                        wl-summary-indent-length-limit
4421                        thr-str)))
4422     (setq from
4423           (wl-set-string-width
4424            (if children-num
4425                (- wl-from-width (length children-num) 2)
4426              wl-from-width)
4427            (elmo-delete-char ?\n
4428                              (wl-summary-from-func-internal
4429                               (elmo-msgdb-overview-entity-get-from entity)))))
4430     (setq subject
4431           (elmo-delete-char ?\n
4432                             (or (elmo-msgdb-overview-entity-get-subject
4433                                  entity)
4434                                 wl-summary-no-subject-message)))
4435     (setq parent-raw-subject
4436           (elmo-msgdb-overview-entity-get-subject parent-entity))
4437     (setq parent-subject
4438           (if parent-raw-subject
4439               (elmo-delete-char ?\n parent-raw-subject)))
4440     (setq mark (or (cadr (assq msg mark-alist)) " "))
4441     (setq line
4442           (concat
4443            (setq before-indent
4444                  (format (concat "%"
4445                                  (int-to-string
4446                                   wl-summary-buffer-number-column)
4447                                  "s%s%s%s %s")
4448                          msg
4449                          (or temp-mark " ")
4450                          mark
4451                          (wl-summary-format-date
4452                           (elmo-msgdb-overview-entity-get-date entity))
4453                          (if thr-str thr-str "")))
4454            (format (if linked
4455                        "<%s > %s"
4456                      "[%s ] %s")
4457                    (if children-num
4458                        (concat "+" children-num ": " from)
4459                      (concat " " from))
4460                    (progn
4461                      (setq subject
4462                            (if (or no-parent
4463                                    (null parent-subject)
4464                                    (not (wl-summary-subject-equal
4465                                          subject parent-subject)))
4466                                (wl-summary-subject-func-internal subject) ""))
4467                      (if (and (not wl-summary-width)
4468                               wl-subject-length-limit)
4469                          (truncate-string subject wl-subject-length-limit)
4470                        subject)))))
4471     (if wl-summary-width (setq line
4472                                (wl-set-string-width
4473                                 (- wl-summary-width 1) line)))
4474     (if wl-summary-highlight
4475         (wl-highlight-summary-line-string line
4476                                           mark
4477                                           temp-mark
4478                                           thr-str))
4479     line))
4480
4481 (defsubst wl-summary-buffer-number-column-detect (update)
4482   (let (end)
4483     (save-excursion
4484       (goto-char (point-min))
4485       (setq wl-summary-buffer-number-column
4486             (or
4487              (if (and update
4488                       (setq end (if (re-search-forward "^ *[0-9]+[^0-9]" nil t)
4489                                     (point))))
4490                  (- end (progn (beginning-of-line) (point)) 1))
4491              (wl-get-assoc-list-value wl-summary-number-column-alist
4492                                       wl-summary-buffer-folder-name)
4493              wl-summary-default-number-column))
4494       (setq wl-summary-buffer-number-regexp
4495             (wl-repeat-string "." wl-summary-buffer-number-column)))))
4496
4497 (defsubst wl-summary-proc-wday (wday-str year month mday)
4498   (save-match-data
4499     (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
4500         (wl-match-string 1 wday-str)
4501       (elmo-date-get-week year month mday))))
4502
4503 (defvar wl-summary-move-spec-plugged-alist
4504   (list (cons 'new (list (cons 't nil)
4505                          (cons 'p wl-summary-new-mark)
4506                          (cons 'p (wl-regexp-opt
4507                                    (list wl-summary-unread-uncached-mark
4508                                          wl-summary-unread-cached-mark)))
4509                          (cons 'p (regexp-quote wl-summary-important-mark))))
4510         (cons 'unread (list (cons 't nil)
4511                             (cons 'p (wl-regexp-opt
4512                                       (list wl-summary-new-mark
4513                                             wl-summary-unread-uncached-mark
4514                                             wl-summary-unread-cached-mark)))
4515                             (cons 'p (regexp-quote
4516                                       wl-summary-important-mark))))))
4517
4518 (defvar wl-summary-move-spec-unplugged-alist
4519   (list (cons 'new (list (cons 't nil)
4520                          (cons 'p wl-summary-unread-cached-mark)
4521                          (cons 'p (regexp-quote wl-summary-important-mark))))
4522         (cons 'unread (list (cons 't nil)
4523                             (cons 'p wl-summary-unread-cached-mark)
4524                             (cons 'p (regexp-quote
4525                                       wl-summary-important-mark))))))
4526
4527 (defsubst wl-summary-next-message (num direction hereto)
4528   (let ((cur-spec (cdr (assq wl-summary-move-order
4529                              (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
4530                                  wl-summary-move-spec-plugged-alist
4531                                wl-summary-move-spec-unplugged-alist))))
4532         (nums (memq num (if (eq direction 'up)
4533                             (reverse wl-summary-buffer-number-list)
4534                           wl-summary-buffer-number-list)))
4535         marked-list nums2)
4536     (unless hereto (setq nums (cdr nums)))
4537     (setq nums2 nums)
4538     (if cur-spec
4539         (catch 'done
4540           (while cur-spec
4541             (setq nums nums2)
4542             (cond ((eq (car (car cur-spec)) 'p)
4543                    (if (setq marked-list (elmo-msgdb-list-messages-mark-match
4544                                           wl-summary-buffer-msgdb
4545                                           (cdr (car cur-spec))))
4546                        (while nums
4547                          (if (memq (car nums) marked-list)
4548                              (throw 'done (car nums)))
4549                          (setq nums (cdr nums)))))
4550                   ((eq (car (car cur-spec)) 't)
4551                    (while nums
4552                      (if (and wl-summary-buffer-target-mark-list
4553                               (memq (car nums)
4554                                     wl-summary-buffer-target-mark-list))
4555                          (throw 'done (car nums)))
4556                      (setq nums (cdr nums)))))
4557             (setq cur-spec (cdr cur-spec))))
4558       (car nums))))
4559
4560 (defsubst wl-summary-cursor-move (direction hereto)
4561   (when (and (eq direction 'up)
4562              (eobp))
4563     (forward-line -1)
4564     (setq hereto t))
4565   (let (num)
4566     (when (setq num (wl-summary-next-message (wl-summary-message-number)
4567                                              direction hereto))
4568       (wl-thread-jump-to-msg num)
4569       t)))
4570 ;;
4571 ;; Goto unread or important
4572 ;; returns t if next message exists in this folder.
4573 (defun wl-summary-cursor-down (&optional hereto)
4574   (interactive "P")
4575   (wl-summary-cursor-move 'down hereto))
4576
4577 (defun wl-summary-cursor-up (&optional hereto)
4578   (interactive "P")
4579   (wl-summary-cursor-move 'up hereto))
4580
4581 (defun wl-summary-save-view-cache ()
4582   (save-excursion
4583     (let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
4584            (cache (expand-file-name wl-summary-cache-file dir))
4585            (view (expand-file-name wl-summary-view-file dir))
4586            (save-view wl-summary-buffer-view)
4587            (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
4588            (charset wl-summary-buffer-mime-charset))
4589       (if (file-directory-p dir)
4590           (); ok.
4591         (if (file-exists-p dir)
4592             (error "File %s already exists" dir)
4593           (elmo-make-directory dir)))
4594       (if (eq save-view 'thread)
4595           (wl-thread-save-entity dir))
4596       (unwind-protect
4597           (progn
4598             (when (file-writable-p cache)
4599               (copy-to-buffer tmp-buffer (point-min) (point-max))
4600               (with-current-buffer tmp-buffer
4601                 (widen)
4602                 (encode-mime-charset-region
4603                  (point-min) (point-max) charset)
4604                 (write-region-as-binary (point-min)(point-max)
4605                                         cache nil 'no-msg)))
4606             (when (file-writable-p view) ; 'thread or 'sequence
4607               (save-excursion
4608                 (set-buffer tmp-buffer)
4609                 (erase-buffer)
4610                 (prin1 save-view tmp-buffer)
4611                 (princ "\n" tmp-buffer)
4612                 (write-region (point-min) (point-max) view nil 'no-msg))))
4613         ;; kill tmp buffer.
4614         (kill-buffer tmp-buffer)))))
4615
4616 (defsubst wl-summary-get-sync-range (folder)
4617   (intern (or (and
4618                (elmo-folder-plugged-p folder)
4619                (wl-get-assoc-list-value
4620                 wl-folder-sync-range-alist
4621                 folder))
4622               wl-default-sync-range)))
4623
4624 ;; redefined for wl-summary-sync-update
4625 (defun wl-summary-input-range (folder)
4626   "returns update or all or rescan."
4627   ;; for the case when parts are expanded in the bottom of the folder
4628   (let ((input-range-list '("update" "all" "rescan" "first:" "last:"
4629                             "no-sync" "rescan-noscore" "all-visible"))
4630         (default (or (wl-get-assoc-list-value
4631                       wl-folder-sync-range-alist
4632                       folder)
4633                      wl-default-sync-range))
4634         range)
4635     (setq range
4636           (completing-read (format "Range (%s): " default)
4637                            (mapcar
4638                             (function (lambda (x) (cons x x)))
4639                             input-range-list)))
4640     (if (string= range "")
4641         default
4642       range)))
4643
4644 (defun wl-summary-toggle-disp-folder (&optional arg)
4645   (interactive)
4646   (let (fld-buf fld-win
4647         (view-message-buffer (wl-message-get-buffer-create))
4648         (cur-buf (current-buffer))
4649         (summary-win (get-buffer-window (current-buffer))))
4650     (cond
4651      ((eq arg 'on)
4652       (setq wl-summary-buffer-disp-folder t)
4653       ;; hide your folder window
4654       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4655           (if (setq fld-win (get-buffer-window fld-buf))
4656               (delete-window fld-win))))
4657      ((eq arg 'off)
4658       (setq wl-summary-buffer-disp-folder nil)
4659       ;; hide your wl-message window!
4660       (wl-select-buffer view-message-buffer)
4661       (delete-window)
4662       (select-window (get-buffer-window cur-buf))
4663       ;; display wl-folder window!!
4664       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4665           (if (setq fld-win (get-buffer-window fld-buf))
4666               ;; folder win is already displayed.
4667               (select-window fld-win)
4668             ;; folder win is not displayed.
4669             (switch-to-buffer fld-buf))
4670         ;; no folder buf
4671         (wl-folder))
4672       ;; temporarily delete summary-win.
4673       (if summary-win
4674           (delete-window summary-win))
4675       (split-window-horizontally wl-folder-window-width)
4676       (other-window 1)
4677       (switch-to-buffer cur-buf))
4678      (t
4679       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4680           (if (setq fld-win (get-buffer-window fld-buf))
4681               (setq wl-summary-buffer-disp-folder nil)
4682             (setq wl-summary-buffer-disp-folder t)))
4683       (if (not wl-summary-buffer-disp-folder)
4684           ;; hide message window
4685           (let ((mes-win (get-buffer-window view-message-buffer))
4686                 (wl-stay-folder-window t))
4687             (if mes-win (delete-window mes-win))
4688             ;; hide your folder window
4689             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4690                 (if (setq fld-win (get-buffer-window fld-buf))
4691                     (progn
4692                       (delete-window (get-buffer-window cur-buf))
4693                       (select-window fld-win)
4694                       (switch-to-buffer cur-buf))))
4695             (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
4696             ;; resume message window.
4697             (when mes-win
4698               (wl-select-buffer view-message-buffer)
4699               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4700               (select-window (get-buffer-window cur-buf)))
4701             )
4702         ;; hide message window
4703         (let ((mes-win (get-buffer-window view-message-buffer))
4704               (wl-stay-folder-window t))
4705           (if mes-win (delete-window mes-win))
4706           (select-window (get-buffer-window cur-buf))
4707           ;; display wl-folder window!!
4708           (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4709               (if (setq fld-win (get-buffer-window fld-buf))
4710                   ;; folder win is already displayed.
4711                   (select-window fld-win)
4712                 ;; folder win is not displayed...occupy all.
4713                 (switch-to-buffer fld-buf))
4714             ;; no folder buf
4715             (wl-folder))
4716           (split-window-horizontally wl-folder-window-width)
4717           (other-window 1)
4718           (switch-to-buffer cur-buf)
4719           ;; resume message window.
4720           (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
4721           (when mes-win
4722             (wl-select-buffer view-message-buffer)
4723             (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4724             (select-window (get-buffer-window cur-buf))))
4725         ))))
4726   (run-hooks 'wl-summary-toggle-disp-folder-hook))
4727
4728 (defun wl-summary-toggle-disp-msg (&optional arg)
4729   (interactive)
4730   (let (fld-buf fld-win
4731         (view-message-buffer (wl-message-get-buffer-create))
4732         (cur-buf (current-buffer))
4733         summary-win)
4734     (cond
4735      ((eq arg 'on)
4736       (setq wl-summary-buffer-disp-msg t)
4737       ;; hide your folder window
4738       (if (and (not wl-stay-folder-window)
4739                (setq fld-buf (get-buffer wl-folder-buffer-name)))
4740           (if (setq fld-win (get-buffer-window fld-buf))
4741               (delete-window fld-win))))
4742      ((eq arg 'off)
4743       (wl-delete-all-overlays)
4744       (setq wl-summary-buffer-disp-msg nil)
4745       (save-excursion
4746         (wl-select-buffer view-message-buffer)
4747         (delete-window)
4748         (and (get-buffer-window cur-buf)
4749              (select-window (get-buffer-window cur-buf)))
4750         (run-hooks 'wl-summary-toggle-disp-off-hook)))
4751      (t
4752       (if (get-buffer-window view-message-buffer) ; already displayed
4753           (setq wl-summary-buffer-disp-msg nil)
4754         (setq wl-summary-buffer-disp-msg t))
4755       (if wl-summary-buffer-disp-msg
4756           (progn
4757             (wl-summary-redisplay)
4758 ;;; hide your folder window
4759 ;;;         (setq fld-buf (get-buffer wl-folder-buffer-name))
4760 ;;;         (if (setq fld-win (get-buffer-window fld-buf))
4761 ;;;             (delete-window fld-win)))
4762             (run-hooks 'wl-summary-toggle-disp-on-hook))
4763         (wl-delete-all-overlays)
4764         (save-excursion
4765           (wl-select-buffer view-message-buffer)
4766           (delete-window)
4767           (select-window (get-buffer-window cur-buf))
4768           (run-hooks 'wl-summary-toggle-disp-off-hook))
4769 ;;;     (switch-to-buffer cur-buf)
4770         )))))
4771
4772 (defun wl-summary-next-line-content ()
4773   (interactive)
4774   (let ((cur-buf (current-buffer)))
4775     (wl-summary-toggle-disp-msg 'on)
4776     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4777       (set-buffer cur-buf)
4778       (wl-message-next-page 1))))
4779
4780 (defun wl-summary-prev-line-content ()
4781   (interactive)
4782   (let ((cur-buf (current-buffer)))
4783     (wl-summary-toggle-disp-msg 'on)
4784     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4785       (set-buffer cur-buf)
4786       (wl-message-prev-page 1))))
4787
4788 (defun wl-summary-next-page ()
4789   (interactive)
4790   (wl-message-next-page))
4791
4792 (defun wl-summary-prev-page ()
4793   (interactive)
4794   (wl-message-prev-page))
4795
4796 (defsubst wl-summary-no-mime-p (folder)
4797   (wl-string-match-member folder wl-summary-no-mime-folder-list))
4798
4799 (defun wl-summary-set-message-buffer-or-redisplay (&optional ignore-original)
4800   ;; if current message is not displayed, display it.
4801   ;; return t if exists.
4802   (let ((folder wl-summary-buffer-folder-name)
4803         (number (wl-summary-message-number))
4804         cur-folder cur-number message-last-pos
4805         (view-message-buffer (wl-message-get-buffer-create)))
4806     (save-excursion
4807       (set-buffer view-message-buffer)
4808       (setq cur-folder wl-message-buffer-cur-folder)
4809       (setq cur-number wl-message-buffer-cur-number))
4810     (if (and (not ignore-original)
4811              (not
4812               (and (eq number (wl-message-original-buffer-number))
4813                    (string= folder (wl-message-original-buffer-folder)))))
4814         (progn
4815           (if (wl-summary-no-mime-p folder)
4816               (wl-summary-redisplay-no-mime folder number)
4817             (wl-summary-redisplay-internal folder number))
4818           nil)
4819       (if (and (string= folder (or cur-folder ""))
4820                (eq number (or cur-number 0)))
4821           (progn
4822             (set-buffer view-message-buffer)
4823             t)
4824         (if (wl-summary-no-mime-p folder)
4825             (wl-summary-redisplay-no-mime folder number)
4826           (wl-summary-redisplay-internal folder number))
4827         nil))))
4828
4829 (defun wl-summary-target-mark-forward (&optional arg)
4830   (interactive "P")
4831   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4832         (summary-buf (current-buffer))
4833         (wl-draft-forward t)
4834         start-point
4835         draft-buf)
4836     (wl-summary-jump-to-msg (car mlist))
4837     (wl-summary-forward t)
4838     (setq start-point (point))
4839     (setq draft-buf (current-buffer))
4840     (setq mlist (cdr mlist))
4841     (save-window-excursion
4842       (when mlist
4843         (while mlist
4844           (set-buffer summary-buf)
4845           (wl-summary-jump-to-msg (car mlist))
4846           (wl-summary-redisplay)
4847           (set-buffer draft-buf)
4848           (goto-char (point-max))
4849           (wl-draft-insert-message)
4850           (setq mlist (cdr mlist)))
4851         (wl-draft-body-goto-top)
4852         (wl-draft-enclose-digest-region (point) (point-max)))
4853       (goto-char start-point)
4854       (save-excursion
4855         (set-buffer summary-buf)
4856         (wl-summary-delete-all-temp-marks)))
4857     (run-hooks 'wl-mail-setup-hook)))
4858
4859 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
4860   (interactive "P")
4861   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4862         (summary-buf (current-buffer))
4863         change-major-mode-hook
4864         start-point
4865         draft-buf)
4866     (wl-summary-jump-to-msg (car mlist))
4867     (wl-summary-reply arg t)
4868     (goto-char (point-max))
4869     (setq start-point (point))
4870     (setq draft-buf (current-buffer))
4871     (save-window-excursion
4872       (while mlist
4873         (set-buffer summary-buf)
4874         (wl-summary-jump-to-msg (car mlist))
4875         (wl-summary-redisplay)
4876         (set-buffer draft-buf)
4877         (goto-char (point-max))
4878         (wl-draft-yank-original)
4879         (setq mlist (cdr mlist)))
4880       (goto-char start-point)
4881       (save-excursion
4882         (set-buffer summary-buf)
4883         (wl-summary-delete-all-temp-marks)))
4884     (run-hooks 'wl-mail-setup-hook)))
4885
4886 (defun wl-summary-reply-with-citation (&optional arg)
4887   (interactive "P")
4888   (when (wl-summary-reply arg t)
4889     (goto-char (point-max))
4890     (wl-draft-yank-original)
4891     (run-hooks 'wl-mail-setup-hook)))
4892
4893 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
4894   (interactive)
4895   (let* ((original (wl-summary-message-number))
4896          (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4897          (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
4898          msg otherfld schar
4899          (errmsg
4900           (format "No message with id \"%s\" in the folder." msgid)))
4901     (if (setq msg (car (rassoc msgid number-alist)))
4902 ;;;     (wl-summary-jump-to-msg-internal
4903 ;;;      wl-summary-buffer-folder-name msg 'no-sync)
4904         (progn
4905           (wl-thread-jump-to-msg msg)
4906           t)
4907       ;; for XEmacs!
4908       (if (and elmo-use-database
4909                (setq errmsg
4910                      (format
4911                       "No message with id \"%s\" in the database." msgid))
4912                (setq otherfld (elmo-database-msgid-get msgid)))
4913           (if (cdr (wl-summary-jump-to-msg-internal
4914                     (car otherfld) (nth 1 otherfld) 'no-sync))
4915               t ; succeed.
4916             ;; Back to original.
4917             (wl-summary-jump-to-msg-internal
4918              wl-summary-buffer-folder-name original 'no-sync))
4919         (cond ((eq wl-summary-search-via-nntp 'confirm)
4920                (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
4921                         elmo-default-nntp-server)
4922                (setq schar (read-char))
4923                (cond ((eq schar ?y)
4924                       (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4925                      ((eq schar ?s)
4926                       (wl-summary-jump-to-msg-by-message-id-via-nntp
4927                        msgid
4928                        (read-from-minibuffer "NNTP Server: ")))
4929                      (t
4930                       (message errmsg)
4931                       nil)))
4932               (wl-summary-search-via-nntp
4933                (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4934               (t
4935                (message errmsg)
4936                nil))))))
4937
4938 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4939   (interactive)
4940   (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4941          newsgroups folder ret
4942          user server port type spec)
4943     (if server-spec
4944         (if (string-match "^-" server-spec)
4945             (setq spec (elmo-nntp-get-spec server-spec)
4946                   user (nth 2 spec)
4947                   server (nth 3 spec)
4948                   port (nth 4 spec)
4949                   type (nth 5 spec))
4950           (setq server server-spec)))
4951     (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4952                      msgid
4953                      (or server elmo-default-nntp-server)
4954                      (or user elmo-default-nntp-user)
4955                      (or port elmo-default-nntp-port)
4956                      (or type elmo-default-nntp-stream-type)))
4957       (setq newsgroups (wl-parse-newsgroups ret))
4958       (setq folder (concat "-" (car newsgroups)
4959                            (elmo-nntp-folder-postfix user server port type)))
4960       (catch 'found
4961         (while newsgroups
4962           (if (wl-folder-entity-exists-p (car newsgroups)
4963                                          wl-folder-newsgroups-hashtb)
4964               (throw 'found
4965                      (setq folder (concat "-" (car newsgroups)
4966                                           (elmo-nntp-folder-postfix
4967                                            user server port type)))))
4968           (setq newsgroups (cdr newsgroups)))))
4969     (if ret
4970         (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4971       (message "No message id \"%s\" in nntp server \"%s\"."
4972                msgid (or server elmo-default-nntp-server))
4973       nil)))
4974
4975 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4976   (let (wl-auto-select-first entity)
4977     (if (or (string= folder wl-summary-buffer-folder-name)
4978             (y-or-n-p
4979              (format
4980               "Message was found in the folder \"%s\". Jump to it? "
4981               folder)))
4982         (progn
4983           (unwind-protect
4984               (wl-summary-goto-folder-subr
4985                folder scan-type nil nil t)
4986             (if msgid
4987                 (setq msg
4988                       (car (rassoc msgid
4989                                    (elmo-msgdb-get-number-alist
4990                                     wl-summary-buffer-msgdb)))))
4991             (setq entity (wl-folder-search-entity-by-name folder
4992                                                           wl-folder-entity
4993                                                           'folder))
4994             (if entity
4995                 (wl-folder-set-current-entity-id
4996                  (wl-folder-get-entity-id entity))))
4997           (if (null msg)
4998               (message "Message was not found currently in this folder.")
4999             (setq msg (and (wl-thread-jump-to-msg msg) msg)))
5000           (cons folder msg)))))
5001
5002 (defun wl-summary-jump-to-parent-message (arg)
5003   (interactive "P")
5004   (let ((cur-buf (current-buffer))
5005         (number (wl-summary-message-number))
5006         (regexp "\\(<[^<>]*>\\)[ \t]*$")
5007         (i -1) ;; xxx
5008         msg-id msg-num ref-list ref irt)
5009     (if (null number)
5010         (message "No message.")
5011       (when (eq wl-summary-buffer-view 'thread)
5012         (cond ((and arg (not (numberp arg)))
5013                (setq msg-num
5014                      (wl-thread-entity-get-number
5015                       (wl-thread-entity-get-top-entity
5016                        (wl-thread-get-entity number)))))
5017               ((and arg (numberp arg))
5018                (setq i 0)
5019                (setq msg-num number)
5020                (while (< i arg)
5021                  (setq msg-num
5022                        (wl-thread-entity-get-number
5023                         (wl-thread-entity-get-parent-entity
5024                          (wl-thread-get-entity msg-num))))
5025                  (setq i (1+ i))))
5026               (t (setq msg-num
5027                        (wl-thread-entity-get-number
5028                         (wl-thread-entity-get-parent-entity
5029                          (wl-thread-get-entity number)))))))
5030       (when (null msg-num)
5031         (wl-summary-set-message-buffer-or-redisplay)
5032         (set-buffer (wl-message-get-original-buffer))
5033         (message "Searching parent message...")
5034         (setq ref (std11-field-body "References")
5035               irt (std11-field-body "In-Reply-To"))
5036         (cond
5037          ((and arg (not (numberp arg)) ref (not (string= ref ""))
5038                (string-match regexp ref))
5039           ;; The first message of the thread.
5040           (setq msg-id (wl-match-string 1 ref)))
5041          ;; "In-Reply-To:" has only one msg-id.
5042          ((and (null arg) irt (not (string= irt ""))
5043                (string-match regexp irt))
5044           (setq msg-id (wl-match-string 1 irt)))
5045          ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
5046                (string-match regexp ref))
5047           ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
5048           (while (string-match regexp ref)
5049             (setq ref-list
5050                   (append (list
5051                            (wl-match-string 1 ref))
5052                           ref-list))
5053             (setq ref (substring ref (match-end 0)))
5054             (setq i (1+ i)))
5055           (setq msg-id
5056                 (if (null arg) (nth 0 ref-list) ;; previous
5057                   (if (<= arg i) (nth (1- arg) ref-list)
5058                     (nth i ref-list)))))))
5059       (set-buffer cur-buf)
5060       (cond ((and (null msg-id) (null msg-num))
5061              (message "No parent message!")
5062              nil)
5063             ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
5064              (wl-summary-redisplay)
5065              (message "Searching parent message...done")
5066              t)
5067             ((and msg-num (wl-summary-jump-to-msg msg-num))
5068              (wl-summary-redisplay)
5069              (message "Searching parent message...done")
5070              t)
5071             (t ; failed.
5072              (message "Parent message was not found.")
5073              nil)))))
5074
5075 (defun wl-summary-reply (&optional arg without-setup-hook)
5076   "Reply to current message. Default is \"wide\" reply.
5077 Reply to author if invoked with ARG."
5078   (interactive "P")
5079   (let ((folder wl-summary-buffer-folder-name)
5080         (number (wl-summary-message-number))
5081         (summary-buf (current-buffer))
5082         mes-buf)
5083     (if number
5084         (unwind-protect
5085             (progn
5086               (wl-summary-redisplay-internal folder number)
5087               (wl-select-buffer
5088                (get-buffer (setq mes-buf (wl-current-message-buffer))))
5089               (set-buffer mes-buf)
5090               (goto-char (point-min))
5091               (or wl-draft-use-frame
5092                   (split-window-vertically))
5093               (other-window 1)
5094               (when (setq mes-buf (wl-message-get-original-buffer))
5095                 (wl-draft-reply mes-buf arg summary-buf)
5096                 (unless without-setup-hook
5097                   (run-hooks 'wl-mail-setup-hook)))
5098               t)))))
5099
5100 (defun wl-summary-write ()
5101   "Write a new draft from Summary."
5102   (interactive)
5103   (wl-draft nil nil nil nil nil
5104             nil nil nil nil nil nil (current-buffer))
5105   (run-hooks 'wl-mail-setup-hook)
5106   (mail-position-on-field "To"))
5107
5108 (defvar wl-summary-write-current-folder-functions
5109   '(wl-folder-get-newsgroups
5110     wl-folder-guess-mailing-list-by-refile-rule
5111     wl-folder-guess-mailing-list-by-folder-name)
5112   "Newsgroups or Mailing List address guess functions list.
5113 Call from `wl-summary-write-current-folder'")
5114
5115 (defun wl-summary-write-current-folder (&optional folder)
5116   "Write message to current FOLDER's newsgroup or mailing-list.
5117 Use function list is `wl-summary-write-current-folder-functions'."
5118   (interactive)
5119   (let (newsgroups to cc)
5120     ;; default FOLDER is current buffer folder
5121     (setq folder (or folder wl-summary-buffer-folder-name))
5122     (let ((flist wl-summary-write-current-folder-functions)
5123           guess-list)
5124       (while flist
5125         (setq guess-list (funcall (car flist) folder))
5126         (if (or (nth 0 guess-list)      ; To:
5127 ;;;             (nth 1 guess-list)      ; Cc:
5128                 (nth 2 guess-list))     ; Newsgroups:
5129             (setq flist nil)
5130           (setq flist (cdr flist))))
5131       (when (null guess-list)
5132         (error "Can't guess by folder %s" folder))
5133       (wl-draft (nth 0 guess-list) nil nil ; To:
5134                 (nth 1 guess-list) nil  ; Cc:
5135                 (nth 2 guess-list))     ; Newsgroups:
5136       (run-hooks 'wl-mail-setup-hook)
5137       (mail-position-on-field "Subject"))))
5138
5139 (defun wl-summary-forward (&optional without-setup-hook)
5140   ""
5141   (interactive)
5142   (let ((folder wl-summary-buffer-folder-name)
5143         (number (wl-summary-message-number))
5144         (summary-buf (current-buffer))
5145         (wl-draft-forward t)
5146         entity subject num)
5147     (if (null number)
5148         (message "No message.")
5149       (wl-summary-redisplay-internal folder number)
5150       (wl-select-buffer (get-buffer wl-message-buf-name))
5151       (or wl-draft-use-frame
5152           (split-window-vertically))
5153       (other-window 1)
5154       ;; get original subject.
5155       (if summary-buf
5156           (save-excursion
5157             (set-buffer summary-buf)
5158             (setq num (wl-summary-message-number))
5159             (setq entity (assoc (cdr (assq num
5160                                            (elmo-msgdb-get-number-alist
5161                                             wl-summary-buffer-msgdb)))
5162                                 (elmo-msgdb-get-overview
5163                                  wl-summary-buffer-msgdb)))
5164             (and entity
5165                  (setq subject
5166                        (or (elmo-msgdb-overview-entity-get-subject entity)
5167                            "")))))
5168       (wl-draft-forward subject summary-buf)
5169       (unless without-setup-hook
5170         (run-hooks 'wl-mail-setup-hook)))))
5171
5172 (defun wl-summary-click (e)
5173   (interactive "e")
5174   (mouse-set-point e)
5175   (wl-summary-read))
5176
5177 (defun wl-summary-read ()
5178   ""
5179   (interactive)
5180   (let ((folder wl-summary-buffer-folder-name)
5181         (number (wl-summary-message-number))
5182         cur-folder cur-number message-last-pos
5183         (view-message-buffer (get-buffer-create wl-message-buf-name))
5184         (sticky-buf-name (and (wl-summary-sticky-p) wl-message-buf-name))
5185         (summary-buf-name (buffer-name)))
5186     (save-excursion
5187       (set-buffer view-message-buffer)
5188       (when (and sticky-buf-name
5189                  (not (wl-local-variable-p 'wl-message-buf-name
5190                                            (current-buffer))))
5191         (make-local-variable 'wl-message-buf-name)
5192         (setq wl-message-buf-name sticky-buf-name)
5193         (make-local-variable 'wl-message-buffer-cur-summary-buffer)
5194         (setq wl-message-buffer-cur-summary-buffer summary-buf-name))
5195       (setq cur-folder wl-message-buffer-cur-folder)
5196       (setq cur-number wl-message-buffer-cur-number))
5197     (wl-summary-toggle-disp-msg 'on)
5198     (if (and (string= folder cur-folder)
5199              (eq number cur-number))
5200         (progn
5201           (if (wl-summary-next-page)
5202               (wl-summary-down t)))
5203 ;;;         (wl-summary-scroll-up-content)))
5204       (if (wl-summary-no-mime-p folder)
5205           (wl-summary-redisplay-no-mime folder number)
5206         (wl-summary-redisplay-internal folder number)))))
5207
5208 (defun wl-summary-prev (&optional interactive)
5209   ""
5210   (interactive)
5211   (if wl-summary-move-direction-toggle
5212       (setq wl-summary-move-direction-downward nil))
5213   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5214         (skip-mark-regexp (mapconcat
5215                            'regexp-quote
5216                            wl-summary-skip-mark-list ""))
5217         goto-next regex-list regex next-entity finfo)
5218     (beginning-of-line)
5219     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5220         (setq regex (format "^%s[^%s]"
5221                             wl-summary-buffer-number-regexp
5222                             skip-mark-regexp))
5223       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5224                           wl-summary-buffer-number-regexp
5225                           skip-mark-regexp
5226                           (regexp-quote wl-summary-unread-cached-mark)
5227                           (regexp-quote wl-summary-important-mark))))
5228     (unless (re-search-backward regex nil t)
5229       (setq goto-next t))
5230     (beginning-of-line)
5231     (if (not goto-next)
5232         (progn
5233           (if wl-summary-buffer-disp-msg
5234               (wl-summary-redisplay)))
5235       (if (or interactive (interactive-p))
5236           (if wl-summary-buffer-prev-folder-func
5237               (funcall wl-summary-buffer-prev-folder-func)
5238             (when wl-auto-select-next
5239               (setq next-entity (wl-summary-get-prev-folder))
5240               (if next-entity
5241                   (setq finfo (wl-folder-get-entity-info next-entity))))
5242             (wl-ask-folder
5243              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5244              (format
5245               "No more messages. Type SPC to go to %s."
5246               (wl-summary-entity-info-msg next-entity finfo))))))))
5247
5248 (defun wl-summary-next (&optional interactive)
5249   ""
5250   (interactive)
5251   (if wl-summary-move-direction-toggle
5252       (setq wl-summary-move-direction-downward t))
5253   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5254         (skip-mark-regexp (mapconcat
5255                            'regexp-quote
5256                            wl-summary-skip-mark-list ""))
5257         goto-next regex regex-list next-entity finfo)
5258     (end-of-line)
5259     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5260         (setq regex (format "^%s[^%s]"
5261                             wl-summary-buffer-number-regexp
5262                             skip-mark-regexp))
5263       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5264                           wl-summary-buffer-number-regexp
5265                           skip-mark-regexp
5266                           (regexp-quote wl-summary-unread-cached-mark)
5267                           (regexp-quote wl-summary-important-mark))))
5268     (unless (re-search-forward regex nil t)
5269       (forward-line 1)
5270       (setq goto-next t))
5271     (beginning-of-line)
5272     (if (not goto-next)
5273         (if wl-summary-buffer-disp-msg
5274             (wl-summary-redisplay))
5275       (if (or interactive (interactive-p))
5276           (if wl-summary-buffer-next-folder-func
5277               (funcall wl-summary-buffer-next-folder-func)
5278             (when wl-auto-select-next
5279               (setq next-entity (wl-summary-get-next-folder))
5280               (if next-entity
5281                   (setq finfo (wl-folder-get-entity-info next-entity))))
5282             (wl-ask-folder
5283              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5284              (format
5285               "No more messages. Type SPC to go to %s."
5286               (wl-summary-entity-info-msg next-entity finfo))))))))
5287
5288 (defun wl-summary-up (&optional interactive skip-no-unread)
5289   ""
5290   (interactive)
5291   (if wl-summary-move-direction-toggle
5292       (setq wl-summary-move-direction-downward nil))
5293   (if (wl-summary-cursor-up)
5294       (if wl-summary-buffer-disp-msg
5295           (wl-summary-redisplay))
5296     (if (or interactive
5297             (interactive-p))
5298         (if wl-summary-buffer-prev-folder-func
5299             (funcall wl-summary-buffer-prev-folder-func)
5300           (let (next-entity finfo)
5301             (when wl-auto-select-next
5302               (progn
5303                 (setq next-entity (wl-summary-get-prev-unread-folder))
5304                 (if next-entity
5305                     (setq finfo (wl-folder-get-entity-info next-entity)))))
5306             (if (and skip-no-unread
5307                      (eq wl-auto-select-next 'skip-no-unread))
5308                 (wl-summary-next-folder-or-exit next-entity t)
5309               (wl-ask-folder
5310                '(lambda () (wl-summary-next-folder-or-exit next-entity t))
5311                (format
5312                 "No more unread messages. Type SPC to go to %s."
5313                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5314
5315 (defun wl-summary-get-prev-folder ()
5316   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5317         last-entity cur-id)
5318     (when folder-buf
5319       (setq cur-id (save-excursion (set-buffer folder-buf)
5320                                    wl-folder-buffer-cur-entity-id))
5321       (wl-folder-get-prev-folder cur-id))))
5322
5323 (defun wl-summary-get-next-folder ()
5324   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5325         cur-id)
5326     (when folder-buf
5327       (setq cur-id (save-excursion (set-buffer folder-buf)
5328                                    wl-folder-buffer-cur-entity-id))
5329       (wl-folder-get-next-folder cur-id))))
5330
5331 (defun wl-summary-get-next-unread-folder ()
5332   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5333         cur-id)
5334     (when folder-buf
5335       (setq cur-id (save-excursion (set-buffer folder-buf)
5336                                    wl-folder-buffer-cur-entity-id))
5337       (wl-folder-get-next-folder cur-id 'unread))))
5338
5339 (defun wl-summary-get-prev-unread-folder ()
5340   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5341         cur-id)
5342     (when folder-buf
5343       (setq cur-id (save-excursion (set-buffer folder-buf)
5344                                    wl-folder-buffer-cur-entity-id))
5345       (wl-folder-get-prev-folder cur-id 'unread))))
5346
5347 (defun wl-summary-down (&optional interactive skip-no-unread)
5348   (interactive)
5349   (if wl-summary-move-direction-toggle
5350       (setq wl-summary-move-direction-downward t))
5351   (if (wl-summary-cursor-down)
5352       (if wl-summary-buffer-disp-msg
5353           (wl-summary-redisplay))
5354     (if (or interactive
5355             (interactive-p))
5356         (if wl-summary-buffer-next-folder-func
5357             (funcall wl-summary-buffer-next-folder-func)
5358           (let (next-entity finfo)
5359             (when wl-auto-select-next
5360               (setq next-entity (wl-summary-get-next-unread-folder)))
5361             (if next-entity
5362                 (setq finfo (wl-folder-get-entity-info next-entity)))
5363             (if (and skip-no-unread
5364                      (eq wl-auto-select-next 'skip-no-unread))
5365                 (wl-summary-next-folder-or-exit next-entity)
5366               (wl-ask-folder
5367                '(lambda () (wl-summary-next-folder-or-exit next-entity))
5368                (format
5369                 "No more unread messages. Type SPC to go to %s."
5370                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5371
5372 (defun wl-summary-goto-last-displayed-msg ()
5373   (interactive)
5374   (unless wl-summary-buffer-last-displayed-msg
5375     (setq wl-summary-buffer-last-displayed-msg
5376           wl-summary-buffer-current-msg))
5377   (if wl-summary-buffer-last-displayed-msg
5378       (progn
5379         (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
5380         (if wl-summary-buffer-disp-msg
5381             (wl-summary-redisplay)))
5382     (message "No last message.")))
5383
5384 (defun wl-summary-redisplay (&optional arg)
5385   (interactive "P")
5386   (if (and (not arg)
5387            (wl-summary-no-mime-p wl-summary-buffer-folder-name))
5388       (wl-summary-redisplay-no-mime)
5389     (wl-summary-redisplay-internal nil nil arg)))
5390
5391 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
5392   (interactive)
5393   (let* ((msgdb wl-summary-buffer-msgdb)
5394          (fld (or folder wl-summary-buffer-folder-name))
5395          (num (or number (wl-summary-message-number)))
5396          (wl-mime-charset      wl-summary-buffer-mime-charset)
5397          (default-mime-charset wl-summary-buffer-mime-charset)
5398          (wl-message-redisplay-func
5399           wl-summary-buffer-message-redisplay-func)
5400          fld-buf fld-win thr-entity)
5401     (if (and wl-thread-open-reading-thread
5402              (eq wl-summary-buffer-view 'thread)
5403              (not (wl-thread-entity-get-opened
5404                    (setq thr-entity (wl-thread-get-entity
5405                                      num))))
5406              (wl-thread-entity-get-children thr-entity))
5407         (wl-thread-force-open))
5408     (if num
5409         (progn
5410           (setq wl-summary-buffer-disp-msg t)
5411           (setq wl-summary-buffer-last-displayed-msg
5412                 wl-summary-buffer-current-msg)
5413           ;; hide folder window
5414           (if (and (not wl-stay-folder-window)
5415                    (setq fld-buf (get-buffer wl-folder-buffer-name)))
5416               (if (setq fld-win (get-buffer-window fld-buf))
5417                   (delete-window fld-win)))
5418           (setq wl-current-summary-buffer (current-buffer))
5419           (if (wl-message-redisplay fld num 'mime msgdb force-reload)
5420               (wl-summary-mark-as-read nil
5421                                        ;; cached, then change server-mark.
5422                                        (if wl-message-cache-used
5423                                            nil
5424                                          ;; plugged, then leave server-mark.
5425                                          (if (and
5426                                               (not
5427                                                (elmo-folder-local-p
5428                                                 wl-summary-buffer-folder-name))
5429                                               (elmo-folder-plugged-p
5430                                                wl-summary-buffer-folder-name))
5431                                              'leave))
5432                                        t ; displayed
5433                                        nil
5434                                        'cached ; cached by reading.
5435                                        )
5436             )
5437           (setq wl-summary-buffer-current-msg num)
5438           (when wl-summary-recenter
5439             (recenter (/ (- (window-height) 2) 2))
5440             (if (not wl-summary-width)
5441                 (wl-horizontal-recenter)))
5442           (wl-highlight-summary-displaying)
5443           (wl-cache-prefetch-next fld num (current-buffer))
5444           (run-hooks 'wl-summary-redisplay-hook))
5445       (message "No message to display."))))
5446
5447 (defun wl-summary-redisplay-no-mime (&optional folder number)
5448   (interactive)
5449   (let* ((msgdb wl-summary-buffer-msgdb)
5450          (fld (or folder wl-summary-buffer-folder-name))
5451          (num (or number (wl-summary-message-number)))
5452          (wl-mime-charset      wl-summary-buffer-mime-charset)
5453          (default-mime-charset wl-summary-buffer-mime-charset)
5454          wl-break-pages)
5455     (if num
5456         (progn
5457           (setq wl-summary-buffer-disp-msg t)
5458           (setq wl-summary-buffer-last-displayed-msg
5459                 wl-summary-buffer-current-msg)
5460           (setq wl-current-summary-buffer (current-buffer))
5461           (wl-normal-message-redisplay fld num 'no-mime msgdb)
5462           (wl-summary-mark-as-read nil nil t)
5463           (setq wl-summary-buffer-current-msg num)
5464           (when wl-summary-recenter
5465             (recenter (/ (- (window-height) 2) 2))
5466             (if (not wl-summary-width)
5467                 (wl-horizontal-recenter)))
5468           (wl-highlight-summary-displaying)
5469           (run-hooks 'wl-summary-redisplay-hook))
5470       (message "No message to display.")
5471       (wl-ask-folder 'wl-summary-exit
5472                      "No more messages. Type SPC to go to folder mode."))))
5473
5474 (defun wl-summary-redisplay-all-header (&optional folder number)
5475   (interactive)
5476   (let* ((msgdb wl-summary-buffer-msgdb)
5477          (fld (or folder wl-summary-buffer-folder-name))
5478          (num (or number (wl-summary-message-number)))
5479          (wl-mime-charset      wl-summary-buffer-mime-charset)
5480          (default-mime-charset wl-summary-buffer-mime-charset)
5481          (wl-message-redisplay-func wl-summary-buffer-message-redisplay-func))
5482     (if num
5483         (progn
5484           (setq wl-summary-buffer-disp-msg t)
5485           (setq wl-summary-buffer-last-displayed-msg
5486                 wl-summary-buffer-current-msg)
5487           (setq wl-current-summary-buffer (current-buffer))
5488           (if (wl-message-redisplay fld num 'all-header msgdb); t if displayed.
5489               (wl-summary-mark-as-read nil nil t))
5490           (setq wl-summary-buffer-current-msg num)
5491           (when wl-summary-recenter
5492             (recenter (/ (- (window-height) 2) 2))
5493             (if (not wl-summary-width)
5494                 (wl-horizontal-recenter)))
5495           (wl-highlight-summary-displaying)
5496           (run-hooks 'wl-summary-redisplay-hook))
5497       (message "No message to display."))))
5498
5499 (defun wl-summary-jump-to-current-message ()
5500   (interactive)
5501   (let (message-buf message-win)
5502     (if (setq message-buf (get-buffer wl-message-buf-name))
5503         (if (setq message-win (get-buffer-window message-buf))
5504             (select-window message-win)
5505           (wl-select-buffer (get-buffer wl-message-buf-name)))
5506       (wl-summary-redisplay)
5507       (wl-select-buffer (get-buffer wl-message-buf-name)))
5508     (goto-char (point-min))))
5509
5510 (defun wl-summary-cancel-message ()
5511   "Cancel an article on news."
5512   (interactive)
5513   (if (null (wl-summary-message-number))
5514       (message "No message.")
5515     (let ((summary-buf (current-buffer))
5516           message-buf)
5517       (wl-summary-set-message-buffer-or-redisplay)
5518       (if (setq message-buf (wl-message-get-original-buffer))
5519           (set-buffer message-buf))
5520       (unless (wl-message-news-p)
5521         (set-buffer summary-buf)
5522         (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
5523                      'nntp)
5524                  (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5525             (progn
5526               (wl-summary-redisplay t)
5527               (wl-summary-supersedes-message))
5528           (error "This is not a news article; supersedes is impossible")))
5529       (when (yes-or-no-p "Do you really want to cancel this article? ")
5530         (let (from newsgroups message-id distribution buf)
5531           (save-excursion
5532             (setq from (std11-field-body "from")
5533                   newsgroups (std11-field-body "newsgroups")
5534                   message-id (std11-field-body "message-id")
5535                   distribution (std11-field-body "distribution"))
5536             ;; Make sure that this article was written by the user.
5537             (unless (wl-address-user-mail-address-p
5538                      (wl-address-header-extract-address
5539                       (car (wl-parse-addresses from))))
5540               (error "This article is not yours"))
5541             ;; Make control message.
5542             (setq buf (set-buffer (get-buffer-create " *message cancel*")))
5543             (setq wl-draft-buffer-cur-summary-buffer summary-buf)
5544             (buffer-disable-undo (current-buffer))
5545             (erase-buffer)
5546             (insert "Newsgroups: " newsgroups "\n"
5547                     "From: " (wl-address-header-extract-address
5548                               wl-from) "\n"
5549                               "Subject: cmsg cancel " message-id "\n"
5550                               "Control: cancel " message-id "\n"
5551                               (if distribution
5552                                   (concat "Distribution: " distribution "\n")
5553                                 "")
5554                               mail-header-separator "\n"
5555                               wl-summary-cancel-message)
5556             (message "Canceling your message...")
5557             (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
5558             (message "Canceling your message...done")))))))
5559
5560 (defun wl-summary-supersedes-message ()
5561   "Supersede current message."
5562   (interactive)
5563   (let ((summary-buf (current-buffer))
5564         (mmelmo-force-fetch-entire-message t)
5565         message-buf from)
5566     (wl-summary-set-message-buffer-or-redisplay)
5567     (if (setq message-buf (wl-message-get-original-buffer))
5568         (set-buffer message-buf))
5569     (unless (wl-message-news-p)
5570       (set-buffer summary-buf)
5571       (if (and (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
5572                    'nntp)
5573                (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5574           (progn
5575             (wl-summary-redisplay t)
5576             (wl-summary-supersedes-message))
5577         (error "This is not a news article; supersedes is impossible")))
5578     (save-excursion
5579       (setq from (std11-field-body "from"))
5580       ;; Make sure that this article was written by the user.
5581       (unless (wl-address-user-mail-address-p
5582                (wl-address-header-extract-address
5583                 (car (wl-parse-addresses from))))
5584         (error "This article is not yours"))
5585       (let* ((message-id (std11-field-body "message-id"))
5586              (followup-to (std11-field-body "followup-to"))
5587              (mail-default-headers
5588               (concat mail-default-headers
5589                       "Supersedes: " message-id "\n"
5590                       (and followup-to
5591                            (concat "Followup-To: " followup-to "\n")))))
5592         (set-buffer (wl-message-get-original-buffer))
5593         (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
5594
5595 (defun wl-summary-save (&optional arg wl-save-dir)
5596   (interactive)
5597   (let ((filename)
5598         (num (wl-summary-message-number))
5599         (mmelmo-force-fetch-entire-message t))
5600     (if (null wl-save-dir)
5601         (setq wl-save-dir wl-tmp-dir))
5602     (if num
5603         (save-excursion
5604           (setq filename (expand-file-name
5605                           (int-to-string num)
5606                           wl-save-dir))
5607           (if (null (and arg
5608                          (null (file-exists-p filename))))
5609               (setq filename
5610                     (read-file-name "Save to file: " filename)))
5611
5612           (wl-summary-set-message-buffer-or-redisplay)
5613           (set-buffer (wl-message-get-original-buffer))
5614           (if (and (null arg) (file-exists-p filename))
5615               (if (y-or-n-p "File already exists.  override it? ")
5616                   (write-region (point-min) (point-max) filename))
5617             (write-region (point-min) (point-max) filename)))
5618       (message "No message to save."))
5619     num))
5620
5621 (defun wl-summary-save-region (beg end)
5622   (interactive "r")
5623   (save-excursion
5624     (save-restriction
5625       (narrow-to-region beg end)
5626       (goto-char (point-min))
5627       (let ((wl-save-dir
5628              (wl-read-directory-name "Save to directory: " wl-tmp-dir)))
5629         (if (null (file-exists-p wl-save-dir))
5630             (make-directory wl-save-dir))
5631         (if (eq wl-summary-buffer-view 'thread)
5632             (progn
5633               (while (not (eobp))
5634                 (let* ((number (wl-summary-message-number))
5635                        (entity (wl-thread-get-entity number)))
5636                   (if (wl-thread-entity-get-opened entity)
5637                       (wl-summary-save t wl-save-dir)
5638                     ;; closed
5639                     (wl-summary-save t wl-save-dir))
5640                   (forward-line 1))))
5641           (while (not (eobp))
5642             (wl-summary-save t wl-save-dir)
5643             (forward-line 1)))))))
5644
5645 ;; mew-summary-pipe-message()
5646 (defun wl-summary-pipe-message (prefix command)
5647   "Send this message via pipe."
5648   (interactive (list current-prefix-arg nil))
5649   (if (null (wl-summary-message-number))
5650       (message "No message.")
5651     (setq command (read-string "Shell command on message: "
5652                                wl-summary-shell-command-last))
5653     (if (y-or-n-p "Send this message to pipe? ")
5654         (save-excursion
5655           (wl-summary-set-message-buffer-or-redisplay)
5656           (set-buffer (wl-message-get-original-buffer))
5657           (if (string= command "")
5658               (setq command wl-summary-shell-command-last))
5659           (goto-char (point-min)) ; perhaps this line won't be necessary
5660           (if prefix
5661               (search-forward "\n\n"))
5662           (shell-command-on-region (point) (point-max) command nil)
5663           (setq wl-summary-shell-command-last command)))))
5664
5665 (defun wl-summary-print-message (&optional arg)
5666   (interactive "P")
5667   (if (null (wl-summary-message-number))
5668       (message "No message.")
5669     (save-excursion
5670       (wl-summary-set-message-buffer-or-redisplay)
5671       (if (or (not (interactive-p))
5672               (y-or-n-p "Print ok? "))
5673           (progn
5674             (let* ((message-buffer (get-buffer wl-message-buf-name))
5675 ;;;                (summary-buffer (get-buffer wl-summary-buffer-name))
5676                    (buffer (generate-new-buffer " *print*")))
5677               (set-buffer message-buffer)
5678               (copy-to-buffer buffer (point-min) (point-max))
5679               (set-buffer buffer)
5680               (funcall wl-print-buffer-func)
5681               (kill-buffer buffer)))
5682         (message "")))))
5683
5684 (defun wl-summary-print-message-with-ps-print (&optional filename)
5685   (interactive)
5686   (if (null (wl-summary-message-number))
5687       (message "No message.")
5688     (setq filename (ps-print-preprint current-prefix-arg))
5689     (if (or (not (interactive-p))
5690             (y-or-n-p "Print ok? "))
5691         (let ((summary-buffer (current-buffer))
5692               wl-break-pages)
5693           (save-excursion
5694 ;;;         (wl-summary-set-message-buffer-or-redisplay)
5695             (wl-summary-redisplay-internal)
5696             (let* ((message-buffer (get-buffer wl-message-buf-name))
5697                    (buffer (generate-new-buffer " *print*"))
5698                    (entity (progn
5699                              (set-buffer summary-buffer)
5700                              (assoc (cdr (assq
5701                                           (wl-summary-message-number)
5702                                           (elmo-msgdb-get-number-alist
5703                                            wl-summary-buffer-msgdb)))
5704                                     (elmo-msgdb-get-overview
5705                                      wl-summary-buffer-msgdb))))
5706                    (wl-ps-subject
5707                     (and entity
5708                          (or (elmo-msgdb-overview-entity-get-subject entity)
5709                              "")))
5710                    (wl-ps-from
5711                     (and entity
5712                          (or (elmo-msgdb-overview-entity-get-from entity) "")))
5713                    (wl-ps-date
5714                     (and entity
5715                          (or (elmo-msgdb-overview-entity-get-date entity) ""))))
5716               (run-hooks 'wl-ps-preprint-hook)
5717               (set-buffer message-buffer)
5718               (copy-to-buffer buffer (point-min) (point-max))
5719               (set-buffer buffer)
5720               (unwind-protect
5721                   (let ((ps-left-header
5722                          (list (concat "(" wl-ps-subject ")")
5723                                (concat "(" wl-ps-from ")")))
5724                         (ps-right-header
5725                          (list "/pagenumberstring load"
5726                                (concat "(" wl-ps-date ")"))))
5727                     (run-hooks 'wl-ps-print-hook)
5728                     (funcall wl-ps-print-buffer-func filename))
5729                 (kill-buffer buffer)))))
5730       (message ""))))
5731
5732 (if (featurep 'ps-print) ; ps-print is available.
5733     (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
5734
5735 (defun wl-summary-folder-info-update ()
5736   (let ((folder (elmo-string wl-summary-buffer-folder-name))
5737         (num-db (elmo-msgdb-get-number-alist
5738                  wl-summary-buffer-msgdb)))
5739     (wl-folder-set-folder-updated folder
5740                                   (list 0
5741                                         (+ wl-summary-buffer-unread-count
5742                                            wl-summary-buffer-new-count)
5743                                         (length num-db)))))
5744
5745 (defun wl-summary-get-newsgroups ()
5746   (let ((spec-list (elmo-folder-get-primitive-spec-list
5747                     (elmo-string wl-summary-buffer-folder-name)))
5748         ng-list)
5749     (while spec-list
5750       (when (eq (caar spec-list) 'nntp)
5751         (wl-append ng-list (list (nth 1 (car spec-list)))))
5752       (setq spec-list (cdr spec-list)))
5753     ng-list))
5754
5755 (defun wl-summary-set-crosspost (&optional type redisplay)
5756   (let* ((number (wl-summary-message-number))
5757          (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name
5758                                             number))
5759          (folder (nth 1 spec))
5760          message-buf newsgroups)
5761     (when (eq (car spec) 'nntp)
5762       (if redisplay
5763           (wl-summary-redisplay))
5764       (save-excursion
5765         (if (setq message-buf (wl-message-get-original-buffer))
5766             (set-buffer message-buf))
5767         (setq newsgroups (std11-field-body "newsgroups")))
5768       (when newsgroups
5769         (let* ((msgdb wl-summary-buffer-msgdb)
5770                (num-db (elmo-msgdb-get-number-alist msgdb))
5771                (ng-list (wl-summary-get-newsgroups)) ;; for multi folder
5772                crosspost-folders)
5773           (when (setq crosspost-folders
5774                       (elmo-list-delete ng-list
5775                                         (wl-parse-newsgroups newsgroups t)))
5776             (elmo-crosspost-message-set (cdr (assq number num-db)) ;;message-id
5777                                         crosspost-folders
5778                                         type) ;;not used
5779             (setq wl-crosspost-alist-modified t)))))))
5780
5781 (defun wl-summary-is-crosspost-folder (spec-list fld-list)
5782   (let (fld flds)
5783     (while spec-list
5784       (if (and (eq (caar spec-list) 'nntp)
5785                (member (setq fld (nth 1 (car spec-list))) fld-list))
5786           (wl-append flds (list fld)))
5787       (setq spec-list (cdr spec-list)))
5788     flds))
5789
5790 (defun wl-summary-update-crosspost ()
5791   (let* ((msgdb wl-summary-buffer-msgdb)
5792          (number-alist (elmo-msgdb-get-number-alist msgdb))
5793          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
5794          (spec-list (elmo-folder-get-primitive-spec-list
5795                      (elmo-string wl-summary-buffer-folder-name)))
5796          (alist elmo-crosspost-message-alist)
5797          (crossed 0)
5798          mark ngs num)
5799     (when (assq 'nntp spec-list)
5800       (while alist
5801         (when (setq ngs
5802                     (wl-summary-is-crosspost-folder
5803                      spec-list
5804                      (nth 1 (car alist))))
5805           (when (setq num (car (rassoc (caar alist) number-alist)))
5806             (if (and (setq mark (cadr (assq num mark-alist)))
5807                      (member mark (list wl-summary-new-mark
5808                                         wl-summary-unread-uncached-mark
5809                                         wl-summary-unread-cached-mark)))
5810                 (setq crossed (1+ crossed)))
5811             (if (wl-summary-jump-to-msg num)
5812                 (wl-summary-mark-as-read t);; opened
5813               (wl-summary-mark-as-read t nil nil num)));; closed
5814           ;; delete if message does't exists.
5815           (elmo-crosspost-message-delete (caar alist) ngs)
5816           (setq wl-crosspost-alist-modified t))
5817         (setq alist (cdr alist))))
5818     (if (> crossed 0)
5819         crossed)))
5820
5821 (defun wl-crosspost-alist-load ()
5822   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
5823   (setq wl-crosspost-alist-modified nil))
5824
5825 (defun wl-crosspost-alist-save ()
5826   (when wl-crosspost-alist-modified
5827     ;; delete non-exists newsgroups
5828     (let ((alist elmo-crosspost-message-alist)
5829           newsgroups)
5830       (while alist
5831         (setq newsgroups
5832               (elmo-delete-if
5833                '(lambda (x)
5834                   (not (intern-soft x wl-folder-newsgroups-hashtb)))
5835                (nth 1 (car alist))))
5836         (if newsgroups
5837             (setcar (cdar alist) newsgroups)
5838           (setq elmo-crosspost-message-alist
5839                 (delete (car alist) elmo-crosspost-message-alist)))
5840         (setq alist (cdr alist)))
5841       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
5842       (setq wl-crosspost-alist-modified nil))))
5843
5844 (defun wl-summary-pack-number (&optional arg)
5845   (interactive "P")
5846   (setq wl-summary-buffer-msgdb
5847         (elmo-pack-number
5848          wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg))
5849   (let (wl-use-scoring)
5850     (wl-summary-rescan)))
5851
5852 (defun wl-summary-target-mark-uudecode ()
5853   (interactive)
5854   (let ((mlist (reverse wl-summary-buffer-target-mark-list))
5855         (summary-buf (current-buffer))
5856         (tmp-buf (get-buffer-create "*WL UUENCODE*"))
5857         orig-buf i k filename rc errmsg)
5858     (setq i 1)
5859     (setq k (length mlist))
5860     (set-buffer tmp-buf)
5861     (erase-buffer)
5862     (save-window-excursion
5863       (while mlist
5864         (set-buffer summary-buf)
5865         (wl-summary-jump-to-msg (car mlist))
5866         (wl-summary-redisplay)
5867         (set-buffer (setq orig-buf (wl-message-get-original-buffer)))
5868         (goto-char (point-min))
5869         (cond ((= i 1) ; first
5870                (if (setq filename (wl-message-uu-substring
5871                                    orig-buf tmp-buf t
5872                                    (= i k)))
5873                    nil
5874                  (error "Can't find begin line")))
5875               ((< i k)
5876                (wl-message-uu-substring orig-buf tmp-buf))
5877               (t ; last
5878                (wl-message-uu-substring orig-buf tmp-buf nil t)))
5879         (setq i (1+ i))
5880         (setq mlist (cdr mlist)))
5881       (set-buffer tmp-buf)
5882       (message "Exec %s..." wl-prog-uudecode)
5883       (unwind-protect
5884           (let ((decode-dir wl-tmp-dir))
5885             (if (not wl-prog-uudecode-no-stdout-option)
5886                 (setq filename (read-file-name "Save to file: "
5887                                                (expand-file-name
5888                                                 (elmo-safe-filename filename)
5889                                                 wl-tmp-dir)))
5890               (setq decode-dir
5891                     (wl-read-directory-name "Save to directory: "
5892                                             wl-tmp-dir))
5893               (setq filename (expand-file-name filename decode-dir)))
5894             (if (file-exists-p filename)
5895                 (or (yes-or-no-p (format "File %s exists. Save anyway? "
5896                                          filename))
5897                     (error "")))
5898             (elmo-bind-directory
5899              decode-dir
5900              (setq rc
5901                    (as-binary-process
5902                     (apply 'call-process-region (point-min) (point-max)
5903                            wl-prog-uudecode t (current-buffer) nil
5904                            wl-prog-uudecode-arg))))
5905             (when (not (= 0 rc))
5906               (setq errmsg (buffer-substring (point-min)(point-max)))
5907               (error "Uudecode error: %s" errmsg))
5908             (if (not wl-prog-uudecode-no-stdout-option)
5909                 (let (file-name-handler-alist) ;; void jka-compr
5910                   (as-binary-output-file
5911                    (write-region (point-min) (point-max)
5912                                  filename nil 'no-msg))))
5913             (save-excursion
5914               (set-buffer summary-buf)
5915               (wl-summary-delete-all-temp-marks))
5916             (if (file-exists-p filename)
5917                 (message "Saved as %s" filename)))
5918         (kill-buffer tmp-buf)))))
5919
5920 (defun wl-summary-drop-unsync ()
5921   "Drop all unsync messages."
5922   (interactive)
5923   (if (elmo-folder-pipe-p wl-summary-buffer-folder-name)
5924       (error "You cannot drop unsync messages in this folder"))
5925   (if (or (not (interactive-p))
5926           (y-or-n-p "Drop all unsync messages? "))
5927       (let* ((folder-list (elmo-folder-get-primitive-folder-list
5928                            wl-summary-buffer-folder-name))
5929              (is-multi (elmo-multi-p wl-summary-buffer-folder-name))
5930              (sum 0)
5931              (multi-num 0)
5932              pair)
5933         (message "Dropping...")
5934         (while folder-list
5935           (setq pair (elmo-max-of-folder (car folder-list)))
5936           (when is-multi ;; dirty hack...
5937             (incf multi-num)
5938             (setcar pair (+ (* multi-num elmo-multi-divide-number)
5939                             (car pair))))
5940           (elmo-msgdb-set-number-alist
5941            wl-summary-buffer-msgdb
5942            (nconc
5943             (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
5944             (list (cons (car pair) nil))))
5945           (setq sum (+ sum (cdr pair)))
5946           (setq folder-list (cdr folder-list)))
5947         (wl-summary-set-message-modified)
5948         (wl-folder-set-folder-updated wl-summary-buffer-folder-name
5949                                       (list 0
5950                                             (+ wl-summary-buffer-unread-count
5951                                                wl-summary-buffer-new-count)
5952                                             sum))
5953         (message "Dropping...done"))))
5954
5955 (defun wl-summary-default-get-next-msg (msg)
5956   (or (wl-summary-next-message msg
5957                                (if wl-summary-move-direction-downward 'down
5958                                  'up)
5959                                nil)
5960       (cadr (memq msg (if wl-summary-move-direction-downward
5961                           wl-summary-buffer-number-list
5962                         (reverse wl-summary-buffer-number-list))))))
5963
5964 (defsubst wl-cache-prefetch-p (fld &optional num)
5965   (cond ((and num wl-cache-prefetch-folder-type-list)
5966          (memq
5967           (elmo-folder-number-get-type fld num)
5968           wl-cache-prefetch-folder-type-list))
5969         (wl-cache-prefetch-folder-type-list
5970          (let ((list wl-cache-prefetch-folder-type-list)
5971                type)
5972            (catch 'done
5973              (while (setq type (pop list))
5974                (if (elmo-folder-contains-type fld type)
5975                    (throw 'done t))))))
5976         ((consp wl-cache-prefetch-folder-list)
5977          (wl-string-match-member fld wl-cache-prefetch-folder-list))
5978         (t
5979          wl-cache-prefetch-folder-list)))
5980
5981 (defconst wl-cache-prefetch-idle-time
5982   (if (featurep 'lisp-float-type) (/ (float 1) (float 10)) 1))
5983
5984 (defun wl-cache-prefetch-next (fld msg &optional summary)
5985   (if (wl-cache-prefetch-p fld)
5986       (if elmo-use-buffer-cache
5987 ;;;       (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.")
5988         (save-excursion
5989           (set-buffer (or summary (get-buffer wl-summary-buffer-name)))
5990           (let ((next (funcall wl-cache-prefetch-get-next-func msg)))
5991             (when (and next
5992                        (wl-cache-prefetch-p fld next))
5993               (if (not (fboundp 'run-with-idle-timer))
5994                   (when (sit-for wl-cache-prefetch-idle-time)
5995                     (wl-cache-prefetch-message fld next summary))
5996                 (run-with-idle-timer
5997                  wl-cache-prefetch-idle-time
5998                  nil
5999                  'wl-cache-prefetch-message fld next summary)
6000                 (sit-for 0))))))))
6001
6002 (defvar wl-cache-prefetch-debug nil)
6003 (defun wl-cache-prefetch-message (folder msg summary &optional next)
6004   (when (buffer-live-p summary)
6005     (save-excursion
6006       (set-buffer summary)
6007       (when (string= folder wl-summary-buffer-folder-name)
6008         (unless next
6009           (setq next msg))
6010         (let* ((msgdb wl-summary-buffer-msgdb)
6011                (message-id (cdr (assq next
6012                                       (elmo-msgdb-get-number-alist msgdb)))))
6013           (if (not (elmo-buffer-cache-hit (list folder next message-id)))
6014               (let* ((size (elmo-msgdb-overview-entity-get-size
6015                             (assoc message-id
6016                                    (elmo-msgdb-get-overview msgdb)))))
6017                 (when (or (elmo-local-file-p folder next)
6018                           (not (and (integerp size)
6019                                     wl-cache-prefetch-threshold
6020                                     (>= size wl-cache-prefetch-threshold)
6021                                     (not (elmo-cache-exists-p message-id
6022                                                               folder next)))))
6023                   (if wl-cache-prefetch-debug
6024                       (message "Reading %d..." msg))
6025                   (elmo-buffer-cache-message folder next msgdb nil 'unread)
6026                   (if wl-cache-prefetch-debug
6027                       (message "Reading %d... done" msg))))))))))
6028
6029 (defun wl-summary-save-current-message ()
6030   "Save current message for `wl-summary-yank-saved-message'."
6031   (interactive)
6032   (let ((number (wl-summary-message-number)))
6033     (setq wl-summary-buffer-saved-message number)
6034     (and number (message "No: %s is saved." number))))
6035
6036 (defun wl-summary-yank-saved-message ()
6037   "Set current message as a parent of the saved message."
6038   (interactive)
6039   (if wl-summary-buffer-saved-message
6040       (let ((number (wl-summary-message-number)))
6041         (if (eq wl-summary-buffer-saved-message number)
6042             (message "Cannot set itself as a parent.")
6043           (save-excursion
6044             (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
6045             (wl-thread-set-parent number)
6046             (wl-summary-set-thread-modified))
6047           (setq  wl-summary-buffer-saved-message nil)))
6048     (message "There's no saved message.")))
6049
6050 (require 'product)
6051 (product-provide (provide 'wl-summary) (require 'wl-version))
6052
6053 ;;; wl-summary.el ends here