wl/wl-summary.el

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