wl/wl-summary.el

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