wl/wl-summary.el

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