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