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