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