wl/wl-summary.el

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