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