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-04 13:36:01 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-check-refile-rule-alist-subr (rule dsts)
3408   "Collect destination folders from rule."
3409   (if (stringp rule)
3410       (if (member rule dsts)
3411           dsts
3412         (setq dsts (cons rule dsts)))
3413     ;; A rule.
3414     (let (pairs sub-dsts)
3415       (setq pairs (cdr rule))
3416       (while pairs
3417         (setq dsts
3418               (wl-summary-auto-refile-check-refile-rule-alist-subr
3419                (cdr (car pairs)) dsts))
3420         (setq pairs (cdr pairs))))
3421     dsts))
3422
3423 (defun wl-summary-auto-refile-check-refile-rule-alist ()
3424   (when wl-refile-rule-alist
3425     (message "Checking destination folders...")
3426     (let ((rules wl-refile-rule-alist)
3427           dsts)
3428       (while rules
3429         (setq dsts
3430               (append
3431                (wl-summary-auto-refile-check-refile-rule-alist-subr
3432                 (car rules) nil)
3433                dsts))
3434         (setq rules (cdr rules)))
3435       (mapcar
3436        'wl-folder-confirm-existence
3437        dsts))
3438     (message "Checking destination folders...done.")))
3439
3440 (defun wl-summary-auto-refile (&optional open-all)
3441   "Set refile mark automatically according to wl-refile-guess-by-rule."
3442   (interactive "P")
3443   (wl-summary-auto-refile-check-refile-rule-alist)
3444   (message "Marking...")
3445   (save-excursion
3446     (if (and (eq wl-summary-buffer-view 'thread)
3447              open-all)
3448         (wl-thread-open-all))
3449     (let* ((spec wl-summary-buffer-folder-name)
3450            (overview (elmo-msgdb-get-overview
3451                       wl-summary-buffer-msgdb))
3452            (mark-alist (elmo-msgdb-get-mark-alist
3453                         wl-summary-buffer-msgdb))
3454            (count 0)
3455            number dst thr-entity)
3456       (goto-line 1)
3457       (while (not (eobp))
3458         (setq number (wl-summary-message-number))
3459         (when (and (not (wl-summary-no-auto-refile-message-p number
3460                                                              mark-alist))
3461                    (setq dst
3462                          (wl-refile-guess-by-rule
3463                           (elmo-msgdb-overview-get-entity-by-number
3464                            overview number)))
3465                    (not (equal dst spec)))
3466           ;(wl-folder-confirm-existence dst)
3467           (if (wl-summary-refile dst number)
3468               (incf count))
3469           (message "Marking...%d message(s)." count))
3470         (if (eq wl-summary-buffer-view 'thread)
3471             ;; process invisible children.
3472             (if (not (wl-thread-entity-get-opened
3473                       (setq thr-entity (wl-thread-get-entity number))))
3474                 (mapcar
3475                  (function
3476                   (lambda (x)
3477                     (when (and (setq dst
3478                                      (wl-refile-guess-by-rule
3479                                       (elmo-msgdb-overview-get-entity-by-number
3480                                        overview x)))
3481                                (not (equal dst spec)))
3482                       (if (wl-summary-refile dst x)
3483                           (incf count))
3484                       (message "Marking...%d message(s)." count))))
3485                  (elmo-delete-if
3486                   (function (lambda (x)
3487                               (wl-summary-no-auto-refile-message-p
3488                                x
3489                                mark-alist)))
3490                   (wl-thread-entity-get-descendant thr-entity)))))
3491         (forward-line))
3492       (if (eq count 0)
3493           (message "No message was marked.")
3494         (message "Marked %d message(s)." count)))))
3495
3496 (defun wl-summary-unmark (&optional number)
3497   "Unmark marks (temporary, refile, copy, delete)of current line.
3498 If optional argument NUMBER is specified, unmark message specified by NUMBER."
3499   (interactive)
3500   (save-excursion
3501     (beginning-of-line)
3502     (let ((inhibit-read-only t)
3503           (buffer-read-only nil)
3504           visible
3505           msg-num
3506           cur-mark
3507           score-mark)
3508       (if number
3509           (setq visible (wl-summary-jump-to-msg number))
3510         (setq visible t))
3511       ;; Delete mark on buffer.
3512       (when (and visible
3513                  (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)"))
3514         (goto-char (match-end 2))
3515         (or number
3516             (setq number (string-to-int (wl-match-buffer 1))))
3517         (setq cur-mark (wl-match-buffer 2))
3518         (if (string= cur-mark " ")
3519             ()
3520           (delete-region (match-beginning 2) (match-end 2))
3521           (if (setq score-mark (wl-summary-get-score-mark number))
3522               (insert score-mark)
3523             (insert " ")))
3524         (if (or (string= cur-mark "o")
3525                 (string= cur-mark "O"))
3526             (wl-summary-remove-destination))
3527         (if wl-summary-highlight
3528             (wl-highlight-summary-current-line nil nil score-mark))
3529         (set-buffer-modified-p nil))
3530       ;; Remove from temporary mark structure.
3531       (and number
3532            (wl-summary-delete-mark number)))))
3533
3534 (defun wl-summary-msg-marked-as-target (msg)
3535   (if (memq msg wl-summary-buffer-target-mark-list)
3536       t))
3537
3538 (defun wl-summary-msg-marked-as-copied (msg)
3539   (assq msg wl-summary-buffer-copy-list))
3540
3541 (defun wl-summary-msg-marked-as-deleted (msg)
3542   (if (memq msg wl-summary-buffer-delete-list)
3543       t))
3544
3545 (defun wl-summary-msg-marked-as-refiled (msg)
3546   (assq msg wl-summary-buffer-refile-list))
3547
3548 (defun wl-summary-target-mark (&optional number)
3549   "Put target mark '*' on current message.
3550 If optional argument NUMBER is specified, mark message specified by NUMBER."
3551   (interactive)
3552   (let* ((buffer-num (wl-summary-message-number))
3553          (msg-num (or number buffer-num))
3554          mark)
3555     (catch 'done
3556       (when (null msg-num)
3557         (if (interactive-p)
3558             (message "No message."))
3559         (throw 'done nil))
3560       (when (setq mark (wl-summary-get-mark msg-num))
3561         (when (wl-summary-reserve-temp-mark-p mark)
3562           (if (interactive-p)
3563               (error "Already marked as `%s'" mark))
3564           (throw 'done nil))
3565         (wl-summary-unmark msg-num))
3566       (if (or (interactive-p)
3567               (eq number buffer-num))
3568           (wl-summary-mark-line "*"))
3569       (setq wl-summary-buffer-target-mark-list
3570             (cons msg-num wl-summary-buffer-target-mark-list))
3571       (if (interactive-p)
3572           (if (eq wl-summary-move-direction-downward nil)
3573               (wl-summary-prev)
3574             (wl-summary-next)))
3575       msg-num)))
3576
3577
3578 (defun wl-summary-refile-region (beg end)
3579   "Put copy mark on messages in the region specified by BEG and END."
3580   (interactive "r")
3581   (wl-summary-refile-region-subr "refile" beg end))
3582
3583 (defun wl-summary-copy-region (beg end)
3584   "Put copy mark on messages in the region specified by BEG and END."
3585   (interactive "r")
3586   (wl-summary-refile-region-subr "copy" beg end))
3587
3588 (defun wl-summary-refile-region-subr (copy-or-refile beg end)
3589   (save-excursion
3590     (save-restriction
3591       (goto-char beg)
3592       ;; guess by first msg
3593       (let* ((msgid (cdr (assq (wl-summary-message-number)
3594                                 (elmo-msgdb-get-number-alist
3595                                  wl-summary-buffer-msgdb))))
3596              (function (intern (format "wl-summary-%s" copy-or-refile)))
3597              (entity (assoc msgid (elmo-msgdb-get-overview
3598                                    wl-summary-buffer-msgdb)))
3599              folder)
3600         (if entity
3601             (setq folder (wl-summary-read-folder (wl-refile-guess entity)
3602                                                  (format "for %s"
3603                                                          copy-or-refile))))
3604         (narrow-to-region beg end)
3605         (if (eq wl-summary-buffer-view 'thread)
3606             (progn
3607               (while (not (eobp))
3608                 (let* ((number (wl-summary-message-number))
3609                        (entity (wl-thread-get-entity number))
3610                        children)
3611                   (if (wl-thread-entity-get-opened entity)
3612                       ;; opened...refile line.
3613                       (funcall function folder number)
3614                     ;; closed
3615                     (mapcar
3616                      (function
3617                       (lambda (x)
3618                         (funcall function folder x)))
3619                      (wl-thread-get-children-msgs number)))
3620                   (forward-line 1))))
3621           (while (not (eobp))
3622             (funcall function folder (wl-summary-message-number))
3623             (forward-line 1)))))))
3624
3625 (defun wl-summary-unmark-region (beg end)
3626   (interactive "r")
3627   (save-excursion
3628     (save-restriction
3629       (narrow-to-region beg end)
3630       (goto-char (point-min))
3631       (if (eq wl-summary-buffer-view 'thread)
3632           (progn
3633             (while (not (eobp))
3634               (let* ((number (wl-summary-message-number))
3635                      (entity (wl-thread-get-entity number)))
3636                 (if (wl-thread-entity-get-opened entity)
3637                     ;; opened...unmark line.
3638                     (wl-summary-unmark)
3639                   ;; closed
3640                   (mapcar
3641                    'wl-summary-unmark
3642                    (wl-thread-get-children-msgs number))))
3643               (forward-line 1)))
3644         (while (not (eobp))
3645           (wl-summary-unmark)
3646           (forward-line 1))))))
3647
3648 (defun wl-summary-mark-region-subr (function beg end)
3649   (save-excursion
3650     (save-restriction
3651       (narrow-to-region beg end)
3652       (goto-char (point-min))
3653       (if (eq wl-summary-buffer-view 'thread)
3654           (progn
3655             (while (not (eobp))
3656               (let* ((number (wl-summary-message-number))
3657                      (entity (wl-thread-get-entity number))
3658                      (wl-summary-move-direction-downward t))
3659                 (if (wl-thread-entity-get-opened entity)
3660                     ;; opened...delete line.
3661                     (funcall function number)
3662                   ;; closed
3663                   (mapcar
3664                    function
3665                    (wl-thread-get-children-msgs number)))
3666                 (forward-line 1))))
3667         (while (not (eobp))
3668           (funcall function (wl-summary-message-number))
3669           (forward-line 1))))))
3670
3671 (defun wl-summary-delete-region (beg end)
3672   (interactive "r")
3673   (wl-summary-mark-region-subr 'wl-summary-delete beg end))
3674
3675 (defun wl-summary-target-mark-region (beg end)
3676   (interactive "r")
3677   (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
3678
3679 (defun wl-summary-target-mark-all ()
3680   (interactive)
3681   (wl-summary-target-mark-region (point-min) (point-max))
3682   (setq wl-summary-buffer-target-mark-list
3683         (mapcar 'car
3684                 (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))))
3685
3686 (defun wl-summary-delete-all-mark (mark)
3687   (goto-char (point-min))
3688   (let ((case-fold-search nil))
3689     (while (re-search-forward (format "^ *[0-9]+%s"
3690                                       (regexp-quote mark)) nil t)
3691       (wl-summary-unmark))
3692     (cond ((string= mark "*")
3693            (setq wl-summary-buffer-target-mark-list nil))
3694           ((string= mark "D")
3695            (setq wl-summary-buffer-delete-list nil))
3696           ((string= mark "O")
3697            (setq wl-summary-buffer-copy-list nil))
3698           ((string= mark "o")
3699            (setq wl-summary-buffer-refile-list nil)))))
3700
3701 (defun wl-summary-unmark-all ()
3702   "Unmark all according to what you input."
3703   (interactive)
3704   (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
3705         cur-mark)
3706     (save-excursion
3707       (while unmarks
3708         (setq cur-mark (char-to-string (car unmarks)))
3709         (wl-summary-delete-all-mark cur-mark)
3710         (setq unmarks (cdr unmarks))))))
3711
3712 (defun wl-summary-target-mark-thread ()
3713   (interactive)
3714   (let (beg end)
3715     (end-of-line)
3716     (wl-summary-goto-top-of-current-thread)
3717     (wl-thread-force-open)
3718     (setq beg (point))
3719     (end-of-line)
3720     (wl-summary-goto-bottom-of-current-thread)
3721 ;    (forward-line -1)
3722     (beginning-of-line)
3723     (setq end (point))
3724     (wl-summary-target-mark-region beg end)))
3725
3726 (defun wl-summary-target-mark-msgs (msgs)
3727   (while msgs
3728     (if (eq wl-summary-buffer-view 'thread)
3729         (wl-thread-jump-to-msg (car msgs))
3730       (wl-summary-jump-to-msg (car msgs)))
3731     (wl-summary-target-mark (wl-summary-message-number))
3732     (setq msgs (cdr msgs))))
3733
3734 (defun wl-summary-pick (&optional from-list delete-marks)
3735   (interactive)
3736   (save-excursion
3737     (let* ((completion-ignore-case t)
3738            (field (completing-read
3739                    (format "Field name (%s): " wl-summary-pick-field-default)
3740                    (mapcar 'list
3741                            (append '("From" "Subject" "Date"
3742                                      "To" "Cc" "Body" "Since" "Before")
3743                                    elmo-msgdb-extra-fields))))
3744            (field (if (string= field "")
3745                       (setq field wl-summary-pick-field-default)
3746                     field))
3747            (value (if (string-match field "Since\\|Before")
3748                       (completing-read "Value: "
3749                                        (mapcar (function
3750                                                 (lambda (x)
3751                                                   (list (format "%s" (car x)))))
3752                                                elmo-date-descriptions))
3753                     (read-from-minibuffer "Value: ")))
3754            (overview (elmo-msgdb-get-overview wl-summary-buffer-msgdb))
3755            (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
3756            (elmo-search-mime-charset wl-search-mime-charset)
3757            server-side-search
3758            result get-func sum)
3759       (if delete-marks
3760           (let ((mlist wl-summary-buffer-target-mark-list))
3761             (while mlist
3762               (when (wl-summary-jump-to-msg (car mlist))
3763                 (wl-summary-unmark))
3764               (setq mlist (cdr mlist)))
3765             (setq wl-summary-buffer-target-mark-list nil)))
3766       (setq field (downcase field))
3767       (cond
3768        ((string-match field "from")
3769         (setq get-func 'elmo-msgdb-overview-entity-get-from))
3770        ((string-match field "subject")
3771         (setq get-func 'elmo-msgdb-overview-entity-get-subject))
3772        ((string-match field "date")
3773         (setq get-func 'elmo-msgdb-overview-entity-get-date))
3774        ((string-match field "to")
3775         (setq get-func 'elmo-msgdb-overview-entity-get-to))
3776        ((string-match field "cc")
3777         (setq get-func 'elmo-msgdb-overview-entity-get-cc))
3778        ((string-match field "since")
3779         (setq server-side-search (vector 'date "since" value)))
3780        ((string-match field "before")
3781         (setq server-side-search (vector 'date "before" value)))
3782        ((string-match field "body")
3783         (setq server-side-search (vector 'match "body" value)))
3784        ((member field elmo-msgdb-extra-fields)
3785         (setq get-func
3786               (lambda (entity)
3787                 (elmo-msgdb-overview-entity-get-extra-field entity field))))
3788        (t
3789         (error "Pick by %s is not supported" field)))
3790       (unwind-protect
3791           (if server-side-search
3792               (progn
3793                 (message "Searching...")
3794                 (let ((elmo-mime-charset wl-summary-buffer-mime-charset))
3795                   (setq result (elmo-search wl-summary-buffer-folder-name
3796                                             (list server-side-search))))
3797                 (if from-list
3798                     (setq result (elmo-list-filter from-list result)))
3799                 (message "%d message(s) are picked." (length result)))
3800             (setq sum 0)
3801             (message "Searching...")
3802             (while overview
3803               (when (and (string-match value
3804                                        (or
3805                                         (funcall get-func (car overview))
3806                                         ""))
3807                          (or (not from-list)
3808                              (memq
3809                               (elmo-msgdb-overview-entity-get-number
3810                                (car overview)) from-list)))
3811                 (setq result
3812                       (append result
3813                               (list
3814                                (elmo-msgdb-overview-entity-get-number
3815                                 (car overview)))))
3816                 (message "Picked %d message(s)." (setq sum (+ sum 1))))
3817               (setq overview (cdr overview)))
3818             (message "%d message(s) are picked." sum))
3819         (if (null result)
3820             (message "No message was picked.")
3821           (wl-summary-target-mark-msgs result))))))
3822
3823 (defun wl-summary-unvirtual ()
3824   "Exit from current virtual folder."
3825   (interactive)
3826   (if (eq 'filter
3827           (elmo-folder-get-type wl-summary-buffer-folder-name))
3828       (wl-summary-goto-folder-subr (nth 2 (elmo-folder-get-spec
3829                                            wl-summary-buffer-folder-name))
3830                                    'update nil nil t)
3831     (error "This folder is not filtered")))
3832
3833 (defun wl-summary-virtual (&optional arg)
3834   "Goto virtual folder."
3835   (interactive "P")
3836   (if arg
3837       (wl-summary-unvirtual)
3838     (let* ((completion-ignore-case t)
3839            (field (completing-read (format "Field name (%s): "
3840                                            wl-summary-pick-field-default)
3841                                    '(("From" . "From")
3842                                      ("Subject" . "Subject")
3843                                      ("To" . "To")
3844                                      ("Cc" . "Cc")
3845                                      ("Body" . "Body")
3846                                      ("Since" . "Since")
3847                                      ("Before" . "Before"))))
3848            (value (read-from-minibuffer "Value: ")))
3849       (if (string= field "")
3850           (setq field wl-summary-pick-field-default))
3851       (wl-summary-goto-folder-subr (concat "/" (downcase field) "=" value "/"
3852                                            wl-summary-buffer-folder-name)
3853                                    'update nil nil t))))
3854
3855 (defun wl-summary-delete-all-temp-marks ()
3856   (interactive)
3857   (save-excursion
3858     (goto-char (point-min))
3859     (message "Unmarking...")
3860     (while (not (eobp))
3861       (wl-summary-unmark)
3862       (forward-line))
3863     (message "Unmarking...done.")
3864     (setq wl-summary-buffer-target-mark-list nil)
3865     (setq wl-summary-buffer-delete-list nil)
3866     (setq wl-summary-buffer-refile-list nil)
3867     (setq wl-summary-buffer-copy-list nil)))
3868
3869 (defun wl-summary-delete-mark (number)
3870   "Delete temporary mark of the message specified by NUMBER."
3871   (cond
3872    ((memq number wl-summary-buffer-target-mark-list)
3873     (setq wl-summary-buffer-target-mark-list
3874           (delq number wl-summary-buffer-target-mark-list)))
3875    ((memq number wl-summary-buffer-delete-list)
3876     (setq wl-summary-buffer-delete-list
3877           (delq number wl-summary-buffer-delete-list)))
3878    (t
3879     (let (pair)
3880       (cond
3881        ((setq pair (assq number wl-summary-buffer-copy-list))
3882         (setq wl-summary-buffer-copy-list
3883               (delq pair wl-summary-buffer-copy-list)))
3884        ((setq pair (assq number wl-summary-buffer-refile-list))
3885         (setq wl-summary-buffer-refile-list
3886               (delq pair wl-summary-buffer-refile-list))))))))
3887
3888 (defun wl-summary-mark-line (mark)
3889   "Put MARK on current line. Returns message number."
3890   (save-excursion
3891     (beginning-of-line)
3892     (let ((inhibit-read-only t)
3893           (buffer-read-only nil)
3894           msg-num
3895           cur-mark)
3896       (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
3897         (setq msg-num  (string-to-int (wl-match-buffer 1)))
3898         (setq cur-mark (wl-match-buffer 2))
3899         (goto-char (match-end 1))
3900         (delete-region (match-beginning 2) (match-end 2))
3901         ;(wl-summary-delete-mark msg-num)
3902         (insert mark)
3903         (if wl-summary-highlight
3904             (wl-highlight-summary-current-line nil nil t))
3905         (set-buffer-modified-p nil)
3906         msg-num))))
3907
3908 (defun wl-summary-target-mark-delete ()
3909   (interactive)
3910   (save-excursion
3911     (goto-char (point-min))
3912     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3913           number mlist)
3914       (while (re-search-forward regexp nil t)
3915         (let (wl-summary-buffer-disp-msg)
3916           (when (setq number (wl-summary-message-number))
3917             (wl-summary-delete number)
3918             (setq wl-summary-buffer-target-mark-list
3919                   (delq number wl-summary-buffer-target-mark-list)))))
3920       (setq mlist wl-summary-buffer-target-mark-list)
3921       (while mlist
3922         (wl-append wl-summary-buffer-delete-list (list (car mlist)))
3923         (setq wl-summary-buffer-target-mark-list
3924               (delq (car mlist) wl-summary-buffer-target-mark-list))
3925         (setq mlist (cdr mlist))))))
3926
3927 (defun wl-summary-target-mark-prefetch ()
3928   (interactive)
3929   (save-excursion
3930     (let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
3931            (inhibit-read-only t)
3932            (buffer-read-only nil)
3933            (count 0)
3934            (length (length mlist))
3935            (pos (point))
3936            skipped
3937            new-mark)
3938       (while mlist
3939         (setq new-mark (wl-summary-prefetch-msg (car mlist)))
3940         (if new-mark
3941             (progn
3942               (message "Prefetching... %d/%d message(s)"
3943                        (setq count (+ 1 count)) length)
3944               (when (wl-summary-jump-to-msg (car mlist))
3945                 (wl-summary-unmark)
3946                 (when new-mark
3947                   (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)")
3948                     (delete-region (match-beginning 1) (match-end 1)))
3949                   (goto-char (match-beginning 1))
3950                   (insert new-mark)
3951                   (if wl-summary-highlight
3952                       (wl-highlight-summary-current-line))
3953                   (save-excursion
3954                     (goto-char pos)
3955                     (sit-for 0)))))
3956           (setq skipped (cons (car mlist) skipped)))
3957         (setq mlist (cdr mlist)))
3958       (setq wl-summary-buffer-target-mark-list skipped)
3959       (message "Prefetching... %d/%d message(s)." count length)
3960       (set-buffer-modified-p nil))))
3961
3962 (defun wl-summary-target-mark-refile-subr (copy-or-refile)
3963   (let ((variable
3964          (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3965         (function
3966          (intern (format "wl-summary-%s" copy-or-refile)))
3967         regexp number msgid entity folder mlist)
3968     (save-excursion
3969       (goto-char (point-min))
3970       (setq regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3971       ;; guess by first mark
3972       (when (re-search-forward regexp nil t)
3973         (setq msgid (cdr (assq (setq number (wl-summary-message-number))
3974                                (elmo-msgdb-get-number-alist
3975                                 wl-summary-buffer-msgdb)))
3976               entity (assoc msgid
3977                             (elmo-msgdb-get-overview
3978                              wl-summary-buffer-msgdb)))
3979         (if (null entity)
3980             (error "Cannot %s" copy-or-refile))
3981         (funcall function
3982                  (setq folder (wl-summary-read-folder
3983                                (wl-refile-guess entity)
3984                                (format "for %s" copy-or-refile)))
3985                  number)
3986         (if number
3987             (setq wl-summary-buffer-target-mark-list
3988                   (delq number wl-summary-buffer-target-mark-list)))
3989         (while (re-search-forward regexp nil t)
3990           (let (wl-summary-buffer-disp-msg)
3991             (when (setq number (wl-summary-message-number))
3992               (funcall function folder number)
3993               (setq wl-summary-buffer-target-mark-list
3994                     (delq number wl-summary-buffer-target-mark-list)))))
3995         ;; process invisible messages.
3996         (setq mlist wl-summary-buffer-target-mark-list)
3997         (while mlist
3998           (set variable
3999                (append (symbol-value variable)
4000                        (list (cons (car mlist) folder))))
4001           (setq wl-summary-buffer-target-mark-list
4002                 (delq (car mlist) wl-summary-buffer-target-mark-list))
4003           (setq mlist (cdr mlist)))))))
4004
4005 (defun wl-summary-target-mark-copy ()
4006   (interactive)
4007   (wl-summary-target-mark-refile-subr "copy"))
4008
4009 (defun wl-summary-target-mark-refile ()
4010   (interactive)
4011   (wl-summary-target-mark-refile-subr "refile"))
4012
4013 (defun wl-summary-target-mark-mark-as-read ()
4014   (interactive)
4015   (save-excursion
4016     (goto-char (point-min))
4017     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4018           (inhibit-read-only t)
4019           (buffer-read-only nil)
4020           number mlist)
4021       (while (re-search-forward regexp nil t)
4022         (let (wl-summary-buffer-disp-msg)
4023           ;; delete target-mark from buffer.
4024           (delete-region (match-beginning 1) (match-end 1))
4025           (insert " ")
4026           (setq number (wl-summary-mark-as-read t))
4027           (if wl-summary-highlight
4028               (wl-highlight-summary-current-line))
4029           (if number
4030               (setq wl-summary-buffer-target-mark-list
4031                     (delq number wl-summary-buffer-target-mark-list)))))
4032       (setq mlist wl-summary-buffer-target-mark-list)
4033       (while mlist
4034         (wl-thread-msg-mark-as-read (car mlist))
4035         (setq wl-summary-buffer-target-mark-list
4036               (delq (car mlist) wl-summary-buffer-target-mark-list))
4037         (setq mlist (cdr mlist)))
4038       (wl-summary-count-unread
4039        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4040       (wl-summary-update-modeline))))
4041
4042 (defun wl-summary-target-mark-mark-as-unread ()
4043   (interactive)
4044   (save-excursion
4045     (goto-char (point-min))
4046     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4047           (inhibit-read-only t)
4048           (buffer-read-only nil)
4049           number mlist)
4050       (while (re-search-forward regexp nil t)
4051         (let (wl-summary-buffer-disp-msg)
4052           ;; delete target-mark from buffer.
4053           (delete-region (match-beginning 1) (match-end 1))
4054           (insert " ")
4055           (setq number (wl-summary-mark-as-unread))
4056           (if wl-summary-highlight
4057               (wl-highlight-summary-current-line))
4058           (if number
4059               (setq wl-summary-buffer-target-mark-list
4060                     (delq number wl-summary-buffer-target-mark-list)))))
4061       (setq mlist wl-summary-buffer-target-mark-list)
4062       (while mlist
4063         (wl-summary-mark-as-unread (car mlist))
4064         (wl-thread-msg-mark-as-unread (car mlist))
4065         (setq wl-summary-buffer-target-mark-list
4066               (delq (car mlist) wl-summary-buffer-target-mark-list))
4067         (setq mlist (cdr mlist)))
4068       (wl-summary-count-unread
4069        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4070       (wl-summary-update-modeline))))
4071
4072 (defun wl-summary-target-mark-mark-as-important ()
4073   (interactive)
4074   (save-excursion
4075     (goto-char (point-min))
4076     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4077           (inhibit-read-only t)
4078           (buffer-read-only nil)
4079           number mlist)
4080       (while (re-search-forward regexp nil t)
4081         (let (wl-summary-buffer-disp-msg)
4082           ;; delete target-mark from buffer.
4083           (delete-region (match-beginning 1) (match-end 1))
4084           (insert " ")
4085           (setq number (wl-summary-mark-as-important))
4086           (if wl-summary-highlight
4087               (wl-highlight-summary-current-line))
4088           (if number
4089               (setq wl-summary-buffer-target-mark-list
4090                     (delq number wl-summary-buffer-target-mark-list)))))
4091       (setq mlist wl-summary-buffer-target-mark-list)
4092       (while mlist
4093         (wl-summary-mark-as-important (car mlist))
4094         (wl-thread-msg-mark-as-important (car mlist))
4095         (setq wl-summary-buffer-target-mark-list
4096               (delq (car mlist) wl-summary-buffer-target-mark-list))
4097         (setq mlist (cdr mlist)))
4098       (wl-summary-count-unread
4099        (elmo-msgdb-get-mark-alist wl-summary-buffer-msgdb))
4100       (wl-summary-update-modeline))))
4101
4102 (defun wl-summary-target-mark-save ()
4103   (interactive)
4104   (save-excursion
4105     (goto-char (point-min))
4106     (let ((wl-save-dir
4107            (wl-read-directory-name "Save to directory: " wl-tmp-dir))
4108           (regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
4109           number mlist)
4110       (if (null (file-exists-p wl-save-dir))
4111           (make-directory wl-save-dir))
4112       (while (re-search-forward regexp nil t)
4113         (let (wl-summary-buffer-disp-msg)
4114           (setq number (wl-summary-save t wl-save-dir))
4115           (wl-summary-unmark)
4116           (if number
4117               (setq wl-summary-buffer-target-mark-list
4118                     (delq number wl-summary-buffer-target-mark-list))))))))
4119
4120 (defun wl-summary-target-mark-pick ()
4121   (interactive)
4122   (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
4123
4124 (defun wl-summary-mark-as-read (&optional notcrosses
4125                                           leave-server-side-mark-untouched
4126                                           displayed
4127                                           number
4128                                           no-cache)
4129   (interactive)
4130   (save-excursion
4131     (let* (eol
4132            (inhibit-read-only t)
4133            (buffer-read-only nil)
4134            (folder wl-summary-buffer-folder-name)
4135            (msgdb wl-summary-buffer-msgdb)
4136            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4137            ;;(number-alist (elmo-msgdb-get-number-alist msgdb))
4138            (case-fold-search nil)
4139            mark unread visible uncached new-mark)
4140       (if number
4141           (progn
4142             (setq visible (wl-summary-jump-to-msg number))
4143             (setq mark (cadr (assq number mark-alist))))
4144         (setq visible t))
4145       (beginning-of-line)
4146       (if (or (not visible)
4147               (looking-at
4148                (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
4149                        (regexp-quote wl-summary-read-uncached-mark)
4150                        (regexp-quote wl-summary-unread-uncached-mark)
4151                        (regexp-quote wl-summary-unread-cached-mark)
4152                        (regexp-quote wl-summary-new-mark))))
4153           (progn
4154             (setq mark (or mark (wl-match-buffer 2)))
4155             (when mark
4156               (cond
4157                ((string= mark wl-summary-new-mark) ; N
4158                 (setq wl-summary-buffer-new-count
4159                       (- wl-summary-buffer-new-count 1))
4160                 (setq uncached t)
4161                 (setq unread t))
4162                ((string= mark wl-summary-unread-uncached-mark) ; U
4163                 (setq wl-summary-buffer-unread-count
4164                       (- wl-summary-buffer-unread-count 1))
4165                 (setq uncached t)
4166                 (setq unread t))
4167                ((string= mark wl-summary-unread-cached-mark)  ; !
4168                 (setq wl-summary-buffer-unread-count
4169                       (- wl-summary-buffer-unread-count 1))
4170                 (setq unread t))
4171                (t
4172                 ;; no need to mark server.
4173                 (setq leave-server-side-mark-untouched t)))
4174               (wl-summary-update-modeline)
4175               (wl-folder-update-unread
4176                folder
4177                (+ wl-summary-buffer-unread-count
4178                   wl-summary-buffer-new-count)))
4179             (setq number (or number (string-to-int (wl-match-buffer 1))))
4180             ;; set server side mark...
4181             (setq new-mark (if (and uncached no-cache)
4182                                wl-summary-read-uncached-mark
4183                              nil))
4184             (if (not leave-server-side-mark-untouched)
4185                 (elmo-mark-as-read folder
4186                                    (list number) msgdb))
4187             (when visible
4188               (goto-char (match-end 2))
4189               (delete-region (match-beginning 2) (match-end 2))
4190               (insert (or new-mark " ")))
4191             (setq mark-alist
4192                   (elmo-msgdb-mark-set mark-alist number new-mark))
4193             (elmo-msgdb-set-mark-alist msgdb mark-alist)
4194             (wl-summary-set-mark-modified)
4195             (if (and visible wl-summary-highlight)
4196                 (wl-highlight-summary-current-line nil nil t))
4197             (if (not notcrosses)
4198                 (wl-summary-set-crosspost nil (and wl-summary-buffer-disp-msg
4199                                                    (interactive-p))))))
4200       (set-buffer-modified-p nil)
4201       (if unread
4202           (run-hooks 'wl-summary-unread-message-hook))
4203       number ;return value
4204       )))
4205
4206 (defun wl-summary-mark-as-important (&optional number
4207                                                mark
4208                                                no-server-update)
4209   (interactive)
4210   (if (eq (elmo-folder-get-type wl-summary-buffer-folder-name)
4211           'internal)
4212       (error "Cannot process mark in this folder"))
4213   (save-excursion
4214     (let* (eol
4215           (inhibit-read-only t)
4216           (buffer-read-only nil)
4217           (folder wl-summary-buffer-folder-name)
4218           (msgdb wl-summary-buffer-msgdb)
4219           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4220           (number-alist (elmo-msgdb-get-number-alist msgdb))
4221           message-id visible)
4222       (if number
4223           (progn
4224             (setq visible (wl-summary-jump-to-msg number))
4225             (setq mark (or mark (cadr (assq number mark-alist)))))
4226         (setq visible t))
4227       (end-of-line)
4228       (setq eol (point))
4229       (if visible
4230           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
4231                                       "..../..") nil t)) ; set cursor line
4232       (beginning-of-line)
4233       (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)
4234           (progn
4235             (setq number (or number (string-to-int (wl-match-buffer 1))))
4236             (setq mark (or mark (wl-match-buffer 2)))
4237             (setq message-id (cdr (assq number number-alist)))
4238             (if (string= mark wl-summary-important-mark)
4239                 (progn
4240                   ;; server side mark
4241                   (unless no-server-update
4242                     (elmo-unmark-important folder (list number) msgdb)
4243                     (elmo-msgdb-global-mark-delete message-id))
4244                   (when visible
4245                     (delete-region (match-beginning 2) (match-end 2))
4246                     (insert " "))
4247                   (setq mark-alist
4248                         (elmo-msgdb-mark-set mark-alist
4249                                              number
4250                                              nil)))
4251               ;; server side mark
4252               (unless no-server-update
4253                 (elmo-mark-as-important folder (list number) msgdb))
4254               (when visible
4255                 (delete-region (match-beginning 2) (match-end 2))
4256                 (insert wl-summary-important-mark))
4257               (setq mark-alist
4258                     (elmo-msgdb-mark-set mark-alist
4259                                          (string-to-int (wl-match-buffer 1))
4260                                          wl-summary-important-mark))
4261               ;; Force cache message!!
4262               (save-match-data
4263                 (unless (elmo-cache-exists-p message-id)
4264                   (elmo-force-cache-msg folder number message-id
4265                                         (elmo-msgdb-get-location msgdb))))
4266               (unless no-server-update
4267                 (elmo-msgdb-global-mark-set message-id
4268                                             wl-summary-important-mark)))
4269             (elmo-msgdb-set-mark-alist msgdb mark-alist)
4270             (wl-summary-set-mark-modified)))
4271       (if (and visible wl-summary-highlight)
4272           (wl-highlight-summary-current-line nil nil t))))
4273   (set-buffer-modified-p nil)
4274   number)
4275
4276 (defsubst wl-summary-format-date (date-string)
4277   (condition-case nil
4278       (let ((datevec (timezone-fix-time date-string nil
4279                                         wl-summary-fix-timezone)))
4280         (format "%02d/%02d(%s)%02d:%02d"
4281                 (aref datevec 1)
4282                 (aref datevec 2)
4283                 (elmo-date-get-week (aref datevec 0)
4284                                     (aref datevec 1)
4285                                     (aref datevec 2))
4286                 (aref datevec 3)
4287                 (aref datevec 4)))
4288     (error "??/??(??)??:??")))
4289
4290 (defun wl-summary-overview-create-summary-line (msg
4291                                                 entity
4292                                                 parent-entity
4293                                                 depth
4294                                                 mark-alist
4295                                                 &optional
4296                                                 children-num
4297                                                 temp-mark thr-entity
4298                                                 subject-differ)
4299   (let ((wl-mime-charset wl-summary-buffer-mime-charset)
4300         (elmo-mime-charset wl-summary-buffer-mime-charset)
4301         no-parent before-indent
4302         from subject parent-raw-subject parent-subject
4303         mark line
4304         (elmo-lang wl-summary-buffer-weekday-name-lang)
4305         (children-num (if children-num (int-to-string children-num)))
4306         (thr-str ""))
4307     (if thr-entity
4308         (setq thr-str (wl-thread-make-indent-string thr-entity)))
4309     (if (string= thr-str "")
4310         (setq no-parent t)) ; no parent
4311     (if (and wl-summary-width
4312              wl-summary-indent-length-limit
4313              (< wl-summary-indent-length-limit
4314                 (string-width thr-str)))
4315         (setq thr-str (wl-set-string-width
4316                        wl-summary-indent-length-limit
4317                        thr-str)))
4318     (setq from
4319           (wl-set-string-width
4320            (if children-num
4321                (- wl-from-width (length children-num) 2)
4322              wl-from-width)
4323            (elmo-delete-char ?\n
4324                              (wl-summary-from-func-internal
4325                               (elmo-msgdb-overview-entity-get-from entity)))))
4326     (setq subject
4327           (elmo-delete-char ?\n
4328                             (or (elmo-msgdb-overview-entity-get-subject
4329                                  entity)
4330                                 wl-summary-no-subject-message)))
4331     (setq parent-raw-subject
4332           (elmo-msgdb-overview-entity-get-subject parent-entity))
4333     (setq parent-subject
4334           (if parent-raw-subject
4335               (elmo-delete-char ?\n parent-raw-subject)))
4336     (setq mark (or (cadr (assq msg mark-alist)) " "))
4337     (setq line
4338           (concat
4339            (setq before-indent
4340                  (format (concat "%"
4341                                  (int-to-string
4342                                   wl-summary-buffer-number-column)
4343                                  "s%s%s%s %s")
4344                          msg
4345                          (or temp-mark " ")
4346                          mark
4347                          (wl-summary-format-date
4348                           (elmo-msgdb-overview-entity-get-date entity))
4349                          (if thr-str thr-str "")))
4350            (format "[%s ] %s"
4351                    (if children-num
4352                        (concat "+" children-num ": " from)
4353                      (concat " " from))
4354                    (if (or no-parent
4355                            (null parent-subject)
4356                            (not (wl-summary-subject-equal
4357                                  subject parent-subject)))
4358                        (wl-summary-subject-func-internal subject) ""))))
4359     (if wl-summary-width (setq line
4360                                (wl-set-string-width
4361                                 (- wl-summary-width 1) line)))
4362     (if wl-summary-highlight
4363         (wl-highlight-summary-line-string line
4364                                           mark
4365                                           temp-mark
4366                                           thr-str))
4367     line))
4368
4369 (defsubst wl-summary-buffer-number-column-detect (update)
4370   (let (end)
4371     (save-excursion
4372       (setq wl-summary-buffer-number-column
4373             (or
4374              (if (and update
4375                       (setq end (if (re-search-forward "^ *[0-9]+[^0-9]" nil t)
4376                                     (point))))
4377                  (- end (progn (beginning-of-line) (point)) 1))
4378              (wl-get-assoc-list-value wl-summary-number-column-alist
4379                                       wl-summary-buffer-folder-name)
4380              wl-summary-default-number-column))
4381       (setq wl-summary-buffer-number-regexp
4382             (wl-repeat-string "." wl-summary-buffer-number-column)))))
4383
4384 (defsubst wl-summary-proc-wday (wday-str year month mday)
4385   (save-match-data
4386     (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
4387         (wl-match-string 1 wday-str)
4388       (elmo-date-get-week year month mday))))
4389
4390 (defmacro wl-summary-cursor-move-regex ()
4391   (` (let ((mark-alist
4392             (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
4393                 (cond ((eq wl-summary-move-order 'new)
4394                        (list
4395                         (list
4396                          wl-summary-new-mark)
4397                         (list
4398                          wl-summary-unread-uncached-mark
4399                          wl-summary-unread-cached-mark
4400                          wl-summary-important-mark)))
4401                       ((eq wl-summary-move-order 'unread)
4402                        (list
4403                        (list
4404                         wl-summary-unread-uncached-mark
4405                         wl-summary-unread-cached-mark
4406                         wl-summary-new-mark)
4407                        (list
4408                         wl-summary-important-mark)))
4409                       (t
4410                        (list
4411                        (list
4412                         wl-summary-unread-uncached-mark
4413                         wl-summary-unread-cached-mark
4414                         wl-summary-new-mark
4415                         wl-summary-important-mark))))
4416               (cond ((eq wl-summary-move-order 'unread)
4417                      (list
4418                      (list
4419                       wl-summary-unread-cached-mark)
4420                      (list
4421                       wl-summary-important-mark)))
4422                     (t
4423                      (list
4424                      (list
4425                       wl-summary-unread-cached-mark
4426                       wl-summary-important-mark)))))))
4427        (mapcar
4428         (function
4429          (lambda (mark-list)
4430            (concat wl-summary-message-regexp
4431                    ".\\("
4432                    (mapconcat 'regexp-quote
4433                               mark-list
4434                               "\\|")
4435                    "\\)\\|"
4436                    wl-summary-message-regexp "\\*")))
4437         mark-alist))))
4438
4439 ;;
4440 ;; Goto unread or important
4441 ;;
4442 (defun wl-summary-cursor-up (&optional hereto)
4443   (interactive "P")
4444   (if (and (not wl-summary-buffer-target-mark-list)
4445            (eq wl-summary-buffer-view 'thread))
4446       (progn
4447         (if (eobp)
4448             (forward-line -1))
4449         (wl-thread-jump-to-prev-unread hereto))
4450     (if hereto
4451         (end-of-line)
4452       (beginning-of-line))
4453     (let ((case-fold-search nil)
4454           regex-list)
4455       (setq regex-list (wl-summary-cursor-move-regex))
4456       (catch 'done
4457         (while regex-list
4458           (when (re-search-backward
4459                  (car regex-list)
4460                  nil t nil)
4461             (beginning-of-line)
4462             (throw 'done t))
4463           (setq regex-list (cdr regex-list)))
4464         (beginning-of-line)
4465         (throw 'done nil)))))
4466
4467 ;;
4468 ;; Goto unread or important
4469 ;; returns t if next message exists in this folder.
4470 (defun wl-summary-cursor-down (&optional hereto)
4471   (interactive "P")
4472   (if (and (null wl-summary-buffer-target-mark-list)
4473            (eq wl-summary-buffer-view 'thread))
4474       (wl-thread-jump-to-next-unread hereto)
4475     (if hereto
4476         (beginning-of-line)
4477       (end-of-line))
4478     (let ((case-fold-search nil)
4479           regex-list)
4480       (setq regex-list (wl-summary-cursor-move-regex))
4481       (catch 'done
4482         (while regex-list
4483           (when (re-search-forward
4484                  (car regex-list)
4485                  nil t nil)
4486             (beginning-of-line)
4487             (throw 'done t))
4488           (setq regex-list (cdr regex-list)))
4489         (beginning-of-line)
4490         (throw 'done nil)))))
4491
4492 (defun wl-summary-save-view-cache (&optional keep-current-buffer)
4493   (save-excursion
4494     (let* ((dir (elmo-msgdb-expand-path wl-summary-buffer-folder-name))
4495            (cache (expand-file-name wl-summary-cache-file dir))
4496            (view (expand-file-name wl-summary-view-file dir))
4497            ;;(coding-system-for-write wl-cs-cache)
4498            ;;(output-coding-system wl-cs-cache)
4499            (save-view wl-summary-buffer-view)
4500            (tmp-buffer(get-buffer-create " *wl-summary-save-view-cache*"))
4501            charset)
4502       (if (file-directory-p dir)
4503           (); ok.
4504         (if (file-exists-p dir)
4505             (error "File %s already exists" dir)
4506           (elmo-make-directory dir)))
4507       (if (eq save-view 'thread)
4508           (wl-thread-save-entity dir))
4509       (unwind-protect
4510           (progn
4511             (when (file-writable-p cache)
4512               (if keep-current-buffer
4513                   (progn
4514                     (save-excursion
4515                       (set-buffer tmp-buffer)
4516                       (erase-buffer))
4517                     (setq charset wl-summary-buffer-mime-charset)
4518                     (copy-to-buffer tmp-buffer (point-min) (point-max))
4519                     (save-excursion
4520                       (set-buffer tmp-buffer)
4521                       (widen)
4522                       (encode-mime-charset-region
4523                        (point-min) (point-max) charset)
4524                       (as-binary-output-file
4525                        (write-region (point-min)
4526                                      (point-max) cache nil 'no-msg))))
4527                 (let (buffer-read-only)
4528                   (widen)
4529                   (encode-mime-charset-region (point-min) (point-max)
4530                                               wl-summary-buffer-mime-charset)
4531                   (as-binary-output-file
4532                    (write-region (point-min) (point-max) cache nil 'no-msg)))))
4533             (when (file-writable-p view) ; 'thread or 'sequence
4534               (save-excursion
4535                 (set-buffer tmp-buffer)
4536                 (erase-buffer)
4537                 (prin1 save-view tmp-buffer)
4538                 (princ "\n" tmp-buffer)
4539                 (write-region (point-min) (point-max) view nil 'no-msg))))
4540         ;; kill tmp buffer.
4541         (kill-buffer tmp-buffer)))))
4542
4543 (defsubst wl-summary-get-sync-range (folder)
4544   (intern (or (and
4545                (elmo-folder-plugged-p folder)
4546                (wl-get-assoc-list-value
4547                 wl-folder-sync-range-alist
4548                 folder))
4549               wl-default-sync-range)))
4550
4551 ;; redefined for wl-summary-sync-update
4552 (defun wl-summary-input-range (folder)
4553   "returns update or all or rescan."
4554   ;; for the case when parts are expanded in the bottom of the folder
4555   (let ((input-range-list '("update" "all" "rescan" "first:" "last:"
4556                             "no-sync" "rescan-noscore"))
4557         (default (or (wl-get-assoc-list-value
4558                       wl-folder-sync-range-alist
4559                       folder)
4560                      wl-default-sync-range))
4561         range)
4562     (setq range
4563           (completing-read (format "Range (%s): " default)
4564                            (mapcar
4565                             (function (lambda (x) (cons x x)))
4566                             input-range-list)))
4567     (if (string= range "")
4568         default
4569       range)))
4570
4571 (defun wl-summary-toggle-disp-folder (&optional arg)
4572   (interactive)
4573   (let (fld-buf fld-win
4574         (view-message-buffer (wl-message-get-buffer-create))
4575         (cur-buf (current-buffer))
4576         (summary-win (get-buffer-window (current-buffer))))
4577     (cond
4578      ((eq arg 'on)
4579       (setq wl-summary-buffer-disp-folder t)
4580       ;; hide your folder window
4581       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4582           (if (setq fld-win (get-buffer-window fld-buf))
4583               (delete-window fld-win))))
4584      ((eq arg 'off)
4585       (setq wl-summary-buffer-disp-folder nil)
4586       ;; hide your wl-message window!
4587       (wl-select-buffer view-message-buffer)
4588       (delete-window)
4589       (select-window (get-buffer-window cur-buf))
4590       ;; display wl-folder window!!
4591       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4592           (if (setq fld-win (get-buffer-window fld-buf))
4593               ;; folder win is already displayed.
4594               (select-window fld-win)
4595             ;; folder win is not displayed.
4596             (switch-to-buffer fld-buf))
4597         ;; no folder buf
4598         (wl-folder))
4599       ;; temporarily delete summary-win.
4600       (if summary-win
4601           (delete-window summary-win))
4602       (split-window-horizontally wl-folder-window-width)
4603       (other-window 1)
4604       (switch-to-buffer cur-buf))
4605      (t
4606       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4607           (if (setq fld-win (get-buffer-window fld-buf))
4608               (setq wl-summary-buffer-disp-folder nil)
4609             (setq wl-summary-buffer-disp-folder t)))
4610       (if (not wl-summary-buffer-disp-folder)
4611           ;; hide message window
4612           (let ((mes-win (get-buffer-window view-message-buffer))
4613                 (wl-stay-folder-window t))
4614             (if mes-win (delete-window mes-win))
4615             ;; hide your folder window
4616             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4617                 (if (setq fld-win (get-buffer-window fld-buf))
4618                     (progn
4619                       (delete-window (get-buffer-window cur-buf))
4620                       (select-window fld-win)
4621                       (switch-to-buffer cur-buf))))
4622             (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
4623             ;; resume message window.
4624             (when mes-win
4625               (wl-select-buffer view-message-buffer)
4626               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4627               (select-window (get-buffer-window cur-buf)))
4628             )
4629         (save-excursion
4630           ;; hide message window
4631           (let ((mes-win (get-buffer-window view-message-buffer))
4632                 (wl-stay-folder-window t))
4633             (if mes-win (delete-window mes-win))
4634             (select-window (get-buffer-window cur-buf))
4635             ;; display wl-folder window!!
4636             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4637                 (if (setq fld-win (get-buffer-window fld-buf))
4638                     ;; folder win is already displayed.
4639                     (select-window fld-win)
4640                   ;; folder win is not displayed...occupy all.
4641                   (switch-to-buffer fld-buf))
4642               ;; no folder buf
4643               (wl-folder))
4644             (split-window-horizontally wl-folder-window-width)
4645             (other-window 1)
4646             (switch-to-buffer cur-buf)
4647             ;; resume message window.
4648             (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
4649             (when mes-win
4650               (wl-select-buffer view-message-buffer)
4651               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4652               (select-window (get-buffer-window cur-buf))))
4653           )))))
4654   (run-hooks 'wl-summary-toggle-disp-folder-hook))
4655
4656 (defun wl-summary-toggle-disp-msg (&optional arg)
4657   (interactive)
4658   (let (fld-buf fld-win
4659         (view-message-buffer (wl-message-get-buffer-create))
4660         (cur-buf (current-buffer))
4661         summary-win)
4662     (cond
4663      ((eq arg 'on)
4664       (setq wl-summary-buffer-disp-msg t)
4665       ;; hide your folder window
4666       (if (and (not wl-stay-folder-window)
4667                (setq fld-buf (get-buffer wl-folder-buffer-name)))
4668           (if (setq fld-win (get-buffer-window fld-buf))
4669               (delete-window fld-win))))
4670      ((eq arg 'off)
4671       (wl-delete-all-overlays)
4672       (setq wl-summary-buffer-disp-msg nil)
4673       (save-excursion
4674         (wl-select-buffer view-message-buffer)
4675         (delete-window)
4676         (and (get-buffer-window cur-buf)
4677              (select-window (get-buffer-window cur-buf)))
4678         (run-hooks 'wl-summary-toggle-disp-off-hook)))
4679      (t
4680       (if (get-buffer-window view-message-buffer) ; already displayed
4681           (setq wl-summary-buffer-disp-msg nil)
4682         (setq wl-summary-buffer-disp-msg t))
4683       (if wl-summary-buffer-disp-msg
4684           (progn
4685             (wl-summary-redisplay)
4686             ;; hide your folder window
4687 ;;              (setq fld-buf (get-buffer wl-folder-buffer-name))
4688 ;;              (if (setq fld-win (get-buffer-window fld-buf))
4689 ;;                  (delete-window fld-win)))
4690             (run-hooks 'wl-summary-toggle-disp-on-hook))
4691         (wl-delete-all-overlays)
4692         (save-excursion
4693           (wl-select-buffer view-message-buffer)
4694           (delete-window)
4695           (select-window (get-buffer-window cur-buf))
4696           (run-hooks 'wl-summary-toggle-disp-off-hook))
4697         ;;(switch-to-buffer cur-buf)
4698         )))))
4699
4700 (defun wl-summary-next-line-content ()
4701   (interactive)
4702   (let ((cur-buf (current-buffer)))
4703     (wl-summary-toggle-disp-msg 'on)
4704     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4705       (set-buffer cur-buf)
4706       (wl-message-next-page 1))))
4707
4708 (defun wl-summary-prev-line-content ()
4709   (interactive)
4710   (let ((cur-buf (current-buffer)))
4711     (wl-summary-toggle-disp-msg 'on)
4712     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4713       (set-buffer cur-buf)
4714       (wl-message-prev-page 1))))
4715
4716 (defun wl-summary-next-page ()
4717   (interactive)
4718   (wl-message-next-page))
4719
4720 (defun wl-summary-prev-page ()
4721   (interactive)
4722   (wl-message-prev-page))
4723
4724 (defsubst wl-summary-no-mime-p (folder)
4725   (wl-string-match-member folder wl-summary-no-mime-folder-list))
4726
4727 (defun wl-summary-set-message-buffer-or-redisplay (&optional ignore-original)
4728   ;; if current message is not displayed, display it.
4729   ;; return t if exists.
4730   (let ((folder wl-summary-buffer-folder-name)
4731         (number (wl-summary-message-number))
4732         cur-folder cur-number message-last-pos
4733         (view-message-buffer (wl-message-get-buffer-create)))
4734     (save-excursion
4735       (set-buffer view-message-buffer)
4736       (setq cur-folder wl-message-buffer-cur-folder)
4737       (setq cur-number wl-message-buffer-cur-number))
4738     (if (and (not ignore-original)
4739              (not
4740               (and (eq number (wl-message-original-buffer-number))
4741                    (string= folder (wl-message-original-buffer-folder)))))
4742         (progn
4743           (if (wl-summary-no-mime-p folder)
4744               (wl-summary-redisplay-no-mime folder number)
4745             (wl-summary-redisplay-internal folder number))
4746           nil)
4747       (if (and (string= folder (or cur-folder ""))
4748                (eq number (or cur-number 0)))
4749           (progn
4750             (set-buffer view-message-buffer)
4751             t)
4752         (if (wl-summary-no-mime-p folder)
4753             (wl-summary-redisplay-no-mime folder number)
4754           (wl-summary-redisplay-internal folder number))
4755         nil))))
4756
4757 (defun wl-summary-target-mark-forward (&optional arg)
4758   (interactive "P")
4759   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4760         (summary-buf (current-buffer))
4761         (wl-draft-forward t)
4762         start-point
4763         draft-buf)
4764     (wl-summary-jump-to-msg (car mlist))
4765     (wl-summary-forward t)
4766     (setq start-point (point))
4767     (setq draft-buf (current-buffer))
4768     (setq mlist (cdr mlist))
4769     (save-window-excursion
4770       (when mlist
4771         (while mlist
4772           (set-buffer summary-buf)
4773           (wl-summary-jump-to-msg (car mlist))
4774           (wl-summary-redisplay)
4775           (set-buffer draft-buf)
4776           (goto-char (point-max))
4777           (wl-draft-insert-message)
4778           (setq mlist (cdr mlist)))
4779         (wl-draft-body-goto-top)
4780         (wl-draft-enclose-digest-region (point) (point-max)))
4781       (goto-char start-point)
4782       (save-excursion
4783         (set-buffer summary-buf)
4784         (wl-summary-delete-all-temp-marks)))
4785     (run-hooks 'wl-mail-setup-hook)))
4786
4787 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
4788   (interactive "P")
4789   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4790         (summary-buf (current-buffer))
4791         change-major-mode-hook
4792         start-point
4793         draft-buf)
4794     (wl-summary-jump-to-msg (car mlist))
4795     (wl-summary-reply arg t)
4796     (goto-char (point-max))
4797     (setq start-point (point))
4798     (setq draft-buf (current-buffer))
4799     (save-window-excursion
4800       (while mlist
4801         (set-buffer summary-buf)
4802         (wl-summary-jump-to-msg (car mlist))
4803         (wl-summary-redisplay)
4804         (set-buffer draft-buf)
4805         (goto-char (point-max))
4806         (wl-draft-yank-original)
4807         (setq mlist (cdr mlist)))
4808       (goto-char start-point)
4809       (save-excursion
4810         (set-buffer summary-buf)
4811         (wl-summary-delete-all-temp-marks)))
4812     (run-hooks 'wl-mail-setup-hook)))
4813
4814 (defun wl-summary-reply-with-citation (&optional arg)
4815   (interactive "P")
4816   (unwind-protect
4817       (wl-summary-reply arg t)
4818     (goto-char (point-max))
4819     (wl-draft-yank-original)
4820     (run-hooks 'wl-mail-setup-hook)))
4821
4822 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
4823   (interactive)
4824   (let* ((original (wl-summary-message-number))
4825          (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4826          (number-alist (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb))
4827          msg otherfld schar
4828          (errmsg
4829           (format "No message with id \"%s\" in the folder." msgid)))
4830     (if (setq msg (car (rassoc msgid number-alist)))
4831         ;;(wl-summary-jump-to-msg-internal
4832         ;;wl-summary-buffer-folder-name msg 'no-sync)
4833         (progn
4834           (wl-thread-jump-to-msg msg)
4835           t)
4836       ;; for XEmacs!
4837       (if (and elmo-use-database
4838                (setq errmsg
4839                      (format
4840                       "No message with id \"%s\" in the database." msgid))
4841                (setq otherfld (elmo-database-msgid-get msgid)))
4842           (if (cdr (wl-summary-jump-to-msg-internal
4843                     (car otherfld) (nth 1 otherfld) 'no-sync))
4844               t ; succeed.
4845             ;; Back to original.
4846             (wl-summary-jump-to-msg-internal
4847              wl-summary-buffer-folder-name original 'no-sync))
4848         (cond ((eq wl-summary-search-via-nntp 'confirm)
4849                (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
4850                         elmo-default-nntp-server)
4851                (setq schar (read-char))
4852                (cond ((eq schar ?y)
4853                       (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4854                      ((eq schar ?s)
4855                       (wl-summary-jump-to-msg-by-message-id-via-nntp
4856                        msgid
4857                        (read-from-minibuffer "NNTP Server: ")))
4858                      (t
4859                       (message errmsg)
4860                       nil)))
4861               (wl-summary-search-via-nntp
4862                (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4863               (t
4864                (message errmsg)
4865                nil))))))
4866
4867 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4868   (interactive)
4869   (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4870          newsgroups folder ret
4871          user server port ssl spec)
4872     (if server-spec
4873         (if (string-match "^-" server-spec)
4874             (setq spec (elmo-nntp-get-spec server-spec)
4875                   user (nth 2 spec)
4876                   server (nth 3 spec)
4877                   port (nth 4 spec)
4878                   ssl (nth 5 spec))
4879           (setq server server-spec)))
4880     (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4881                      msgid
4882                      (or server elmo-default-nntp-server)
4883                      (or user elmo-default-nntp-user)
4884                      (or port elmo-default-nntp-port)
4885                      (or ssl elmo-default-nntp-ssl)))
4886       (setq newsgroups (wl-parse-newsgroups ret))
4887       (setq folder (concat "-" (car newsgroups)
4888                            (elmo-nntp-folder-postfix user server port ssl)))
4889       (catch 'found
4890         (while newsgroups
4891           (if (wl-folder-entity-exists-p (car newsgroups)
4892                                          wl-folder-newsgroups-hashtb)
4893               (throw 'found
4894                      (setq folder (concat "-" (car newsgroups)
4895                                           (elmo-nntp-folder-postfix user server port ssl)))))
4896           (setq newsgroups (cdr newsgroups)))))
4897     (if ret
4898         (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4899       (message "No message id \"%s\" in nntp server \"%s\"."
4900                msgid (or server elmo-default-nntp-server))
4901       nil)))
4902
4903 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4904   (let (wl-auto-select-first entity)
4905     (if (or (string= folder wl-summary-buffer-folder-name)
4906             (y-or-n-p
4907              (format
4908               "Message was found in the folder \"%s\". Jump to it? "
4909               folder)))
4910         (progn
4911           (unwind-protect
4912               (wl-summary-goto-folder-subr
4913                folder scan-type nil nil t)
4914             (if msgid
4915                 (setq msg
4916                       (car (rassoc msgid
4917                                    (elmo-msgdb-get-number-alist
4918                                     wl-summary-buffer-msgdb)))))
4919             (setq entity (wl-folder-search-entity-by-name folder
4920                                                           wl-folder-entity
4921                                                           'folder))
4922             (if entity
4923                 (wl-folder-set-current-entity-id
4924                  (wl-folder-get-entity-id entity))))
4925           (if (null msg)
4926               (message "Message was not found currently in this folder.")
4927             (setq msg (and (wl-thread-jump-to-msg msg) msg)))
4928           (cons folder msg)))))
4929
4930 (defun wl-summary-jump-to-parent-message (arg)
4931   (interactive "P")
4932   (let ((cur-buf (current-buffer))
4933         (regexp "\\(<[^<>]*>\\)[ \t]*$")
4934         (i -1) ;; xxx
4935         msg-id ref-list ref irt)
4936     (wl-summary-set-message-buffer-or-redisplay)
4937     (set-buffer (wl-message-get-original-buffer))
4938     (message "Searching parent message...")
4939     (setq ref (std11-field-body "References")
4940           irt (std11-field-body "In-Reply-To"))
4941     (cond
4942      ((and arg (not (numberp arg)) ref (not (string= ref ""))
4943            (string-match regexp ref))
4944       ;; The first message of the thread.
4945       (setq msg-id (wl-match-string 1 ref)))
4946      ;; "In-Reply-To:" has only one msg-id.
4947      ((and irt (not (string= irt ""))
4948            (string-match regexp irt))
4949       (setq msg-id (wl-match-string 1 irt)))
4950      ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
4951            (string-match regexp ref))
4952       ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
4953       (while (string-match regexp ref)
4954         (setq ref-list
4955               (append (list
4956                        (wl-match-string 1 ref))
4957                       ref-list))
4958         (setq ref (substring ref (match-end 0)))
4959         (setq i (1+ i)))
4960       (setq msg-id
4961             (if (null arg) (nth 0 ref-list) ;; previous
4962               (if (<= arg i) (nth (1- arg) ref-list)
4963                 (nth i ref-list))))))
4964     (set-buffer cur-buf)
4965     (cond ((null msg-id)
4966            (message "No parent message!")
4967            nil)
4968           ((wl-summary-jump-to-msg-by-message-id msg-id)
4969            (wl-summary-redisplay)
4970            (message "Searching parent message...done.")
4971            t)
4972           (t ; failed.
4973            (message "Parent message was not found.")
4974            nil))))
4975
4976 (defun wl-summary-reply (&optional arg without-setup-hook)
4977   "Reply to current message. Default is \"wide\" reply.
4978 Reply to author if invoked with argument."
4979   (interactive "P")
4980   (let ((folder wl-summary-buffer-folder-name)
4981         (number (wl-summary-message-number))
4982         (summary-buf (current-buffer))
4983         mes-buf)
4984     (wl-summary-redisplay-internal folder number)
4985     (wl-select-buffer (get-buffer (setq mes-buf (wl-current-message-buffer))))
4986     (set-buffer mes-buf)
4987     (goto-char (point-min))
4988     (or wl-draft-use-frame
4989         (split-window-vertically))
4990     (other-window 1)
4991     (when (setq mes-buf (wl-message-get-original-buffer))
4992       (wl-draft-reply mes-buf (not arg) summary-buf)
4993       (unless without-setup-hook
4994         (run-hooks 'wl-mail-setup-hook)))))
4995
4996 (defun wl-summary-write ()
4997   "Write a new draft from Summary."
4998   (interactive)
4999   (wl-draft nil nil nil nil nil
5000             nil nil nil nil nil (current-buffer))
5001   (run-hooks 'wl-mail-setup-hook)
5002   (mail-position-on-field "To"))
5003
5004 (defun wl-summary-write-current-newsgroup (&optional folder)
5005   (interactive)
5006   (let* ((folder (or folder wl-summary-buffer-folder-name))
5007          (flist (elmo-folder-get-primitive-folder-list folder))
5008          newsgroups fld ret)
5009     (while (setq fld (car flist))
5010       (if (setq ret
5011                 (cond ((eq 'nntp (elmo-folder-get-type fld))
5012                        (nth 1 (elmo-folder-get-spec fld)))
5013                       ((eq 'localnews (elmo-folder-get-type fld))
5014                        (elmo-replace-in-string
5015                         (nth 1 (elmo-folder-get-spec fld)) "/" "\\."))))
5016           (setq newsgroups (cond (newsgroups
5017                                   (concat newsgroups "," ret))
5018                                  (t ret))))
5019       (setq flist (cdr flist)))
5020     (if newsgroups
5021         (progn
5022           (wl-draft nil nil nil nil nil newsgroups)
5023           (run-hooks 'wl-mail-setup-hook))
5024       (error "%s is not newsgroup" folder))))
5025
5026 (defun wl-summary-forward (&optional without-setup-hook)
5027   (interactive)
5028   (let ((folder wl-summary-buffer-folder-name)
5029         (number (wl-summary-message-number))
5030         (summary-buf (current-buffer))
5031         (wl-draft-forward t)
5032         entity subject num)
5033     (wl-summary-redisplay-internal folder number)
5034     (wl-select-buffer (get-buffer wl-message-buf-name))
5035     (or wl-draft-use-frame
5036         (split-window-vertically))
5037     (other-window 1)
5038     ;; get original subject.
5039     (if summary-buf
5040         (save-excursion
5041           (set-buffer summary-buf)
5042           (setq num (wl-summary-message-number))
5043           (setq entity (assoc (cdr (assq num
5044                                          (elmo-msgdb-get-number-alist
5045                                           wl-summary-buffer-msgdb)))
5046                               (elmo-msgdb-get-overview
5047                                wl-summary-buffer-msgdb)))
5048           (and entity
5049                (setq subject
5050                      (or (elmo-msgdb-overview-entity-get-subject entity)
5051                          "")))))
5052     (wl-draft-forward subject summary-buf)
5053     (unless without-setup-hook
5054       (run-hooks 'wl-mail-setup-hook))))
5055
5056 (defun wl-summary-click (e)
5057   (interactive "e")
5058   (mouse-set-point e)
5059   (wl-summary-read))
5060
5061 (defun wl-summary-read ()
5062   (interactive)
5063   (let ((folder wl-summary-buffer-folder-name)
5064         (number (wl-summary-message-number))
5065         cur-folder cur-number message-last-pos
5066         (view-message-buffer (get-buffer-create wl-message-buf-name))
5067         (sticky-buf-name (and (wl-summary-sticky-p) wl-message-buf-name))
5068         (summary-buf-name (buffer-name)))
5069     (save-excursion
5070       (set-buffer view-message-buffer)
5071       (when (and sticky-buf-name
5072                  (not (wl-local-variable-p 'wl-message-buf-name
5073                                            (current-buffer))))
5074         (make-local-variable 'wl-message-buf-name)
5075         (setq wl-message-buf-name sticky-buf-name)
5076         (make-local-variable 'wl-message-buffer-cur-summary-buffer)
5077         (setq wl-message-buffer-cur-summary-buffer summary-buf-name))
5078       (setq cur-folder wl-message-buffer-cur-folder)
5079       (setq cur-number wl-message-buffer-cur-number))
5080     (wl-summary-toggle-disp-msg 'on)
5081     (if (and (string= folder cur-folder)
5082              (eq number cur-number))
5083         (progn
5084           (if (wl-summary-next-page)
5085               (wl-summary-down t)))
5086 ;           (wl-summary-scroll-up-content)))
5087       (if (wl-summary-no-mime-p folder)
5088           (wl-summary-redisplay-no-mime folder number)
5089         (wl-summary-redisplay-internal folder number)))))
5090
5091 (defun wl-summary-move-cached-regex (skip-marks)
5092   (if (eq wl-summary-move-order 'unread)
5093       (list
5094        (format "^%s[^%s]\\(%s\\)"
5095                wl-summary-buffer-number-regexp
5096                skip-marks
5097                (regexp-quote wl-summary-unread-cached-mark))
5098        (format "^%s[^%s]\\(%s\\| \\)"
5099                wl-summary-buffer-number-regexp
5100                skip-marks
5101                (regexp-quote wl-summary-important-mark)))
5102     (list
5103      (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5104              wl-summary-buffer-number-regexp
5105              skip-marks
5106              (regexp-quote wl-summary-unread-cached-mark)
5107              (regexp-quote wl-summary-important-mark)))))
5108
5109 (defun wl-summary-prev (&optional interactive)
5110   (interactive)
5111   (if wl-summary-move-direction-toggle
5112       (setq wl-summary-move-direction-downward nil))
5113   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5114         (skip-mark-regexp (mapconcat
5115                            'regexp-quote
5116                            wl-summary-skip-mark-list ""))
5117         goto-next regex-list regex next-entity finfo)
5118     (beginning-of-line)
5119     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5120         (progn
5121           (setq regex (format "^%s[^%s]"
5122                               wl-summary-buffer-number-regexp
5123                               skip-mark-regexp))
5124           (unless (re-search-backward regex nil t)
5125             (setq goto-next t)))
5126       (setq regex-list (wl-summary-move-cached-regex skip-mark-regexp))
5127       (catch 'done
5128         (while regex-list
5129           (if (re-search-backward (car regex-list) nil t)
5130               (throw 'done t))
5131           (setq regex-list (cdr regex-list)))
5132         (setq goto-next t)))
5133     (beginning-of-line)
5134     (if (not goto-next)
5135         (progn
5136           (if wl-summary-buffer-disp-msg
5137               (wl-summary-redisplay)))
5138       (if (or interactive (interactive-p))
5139           (progn
5140             (when wl-auto-select-next
5141               (setq next-entity (wl-summary-get-prev-folder))
5142               (if next-entity
5143                   (setq finfo (wl-folder-get-entity-info next-entity))))
5144             (wl-ask-folder
5145              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5146              (format
5147               "No more messages. Type SPC to go to %s."
5148               (wl-summary-entity-info-msg next-entity finfo))))))))
5149
5150 (defun wl-summary-next (&optional interactive)
5151   (interactive)
5152   (if wl-summary-move-direction-toggle
5153       (setq wl-summary-move-direction-downward t))
5154   (let ((type (elmo-folder-get-type wl-summary-buffer-folder-name))
5155         (skip-mark-regexp (mapconcat
5156                            'regexp-quote
5157                            wl-summary-skip-mark-list ""))
5158         goto-next regex regex-list next-entity finfo)
5159     (end-of-line)
5160     (if (elmo-folder-plugged-p wl-summary-buffer-folder-name)
5161         (progn
5162           (setq regex (format "^%s[^%s]"
5163                               wl-summary-buffer-number-regexp
5164                               skip-mark-regexp))
5165           (unless (re-search-forward regex nil t)
5166             (forward-line 1)
5167             (setq goto-next t)))
5168       (setq regex-list (wl-summary-move-cached-regex skip-mark-regexp))
5169       (catch 'done
5170         (while regex-list
5171           (if (re-search-forward (car regex-list) nil t)
5172               (throw 'done t))
5173           (setq regex-list (cdr regex-list)))
5174         (setq goto-next t)))
5175     (beginning-of-line)
5176     (if (not goto-next)
5177         (if wl-summary-buffer-disp-msg
5178             (wl-summary-redisplay))
5179       (if (or interactive (interactive-p))
5180           (progn
5181             (when wl-auto-select-next
5182               (setq next-entity (wl-summary-get-next-folder))
5183               (if next-entity
5184                   (setq finfo (wl-folder-get-entity-info next-entity))))
5185             (wl-ask-folder
5186              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5187              (format
5188               "No more messages. Type SPC to go to %s."
5189               (wl-summary-entity-info-msg next-entity finfo))))))))
5190
5191 (defun wl-summary-up (&optional interactive skip-no-unread)
5192   (interactive)
5193   (if wl-summary-move-direction-toggle
5194       (setq wl-summary-move-direction-downward nil))
5195   (if (wl-summary-cursor-up)
5196       (if wl-summary-buffer-disp-msg
5197           (wl-summary-redisplay))
5198     (if (or interactive
5199             (interactive-p))
5200         (let (next-entity finfo)
5201           (when wl-auto-select-next
5202             (progn
5203               (setq next-entity (wl-summary-get-prev-unread-folder))
5204               (if next-entity
5205                   (setq finfo (wl-folder-get-entity-info next-entity)))))
5206           (if (and skip-no-unread
5207                    (eq wl-auto-select-next 'skip-no-unread))
5208               (wl-summary-next-folder-or-exit next-entity t)
5209             (wl-ask-folder
5210              '(lambda () (wl-summary-next-folder-or-exit next-entity t))
5211              (format
5212               "No more unread messages. Type SPC to go to %s."
5213               (wl-summary-entity-info-msg next-entity finfo))))))))
5214
5215 (defun wl-summary-get-prev-folder ()
5216   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5217         last-entity cur-id)
5218     (when folder-buf
5219       (setq cur-id (save-excursion (set-buffer folder-buf)
5220                                    wl-folder-buffer-cur-entity-id))
5221       (wl-folder-get-prev-folder cur-id))))
5222
5223 (defun wl-summary-get-next-folder ()
5224   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5225         cur-id)
5226     (when folder-buf
5227       (setq cur-id (save-excursion (set-buffer folder-buf)
5228                                    wl-folder-buffer-cur-entity-id))
5229       (wl-folder-get-next-folder cur-id))))
5230
5231 (defun wl-summary-get-next-unread-folder ()
5232   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5233         cur-id)
5234     (when folder-buf
5235       (setq cur-id (save-excursion (set-buffer folder-buf)
5236                                    wl-folder-buffer-cur-entity-id))
5237       (wl-folder-get-next-folder cur-id 'unread))))
5238
5239 (defun wl-summary-get-prev-unread-folder ()
5240   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5241         cur-id)
5242     (when folder-buf
5243       (setq cur-id (save-excursion (set-buffer folder-buf)
5244                                    wl-folder-buffer-cur-entity-id))
5245       (wl-folder-get-prev-folder cur-id 'unread))))
5246
5247 (defun wl-summary-down (&optional interactive skip-no-unread)
5248   (interactive)
5249   (if wl-summary-move-direction-toggle
5250       (setq wl-summary-move-direction-downward t))
5251   (if (wl-summary-cursor-down)
5252       (if wl-summary-buffer-disp-msg
5253           (wl-summary-redisplay))
5254     (if (or interactive
5255             (interactive-p))
5256         (let (next-entity finfo)
5257           (when wl-auto-select-next
5258             (setq next-entity (wl-summary-get-next-unread-folder))
5259             (if next-entity
5260                 (setq finfo (wl-folder-get-entity-info next-entity))))
5261           (if (and skip-no-unread
5262                    (eq wl-auto-select-next 'skip-no-unread))
5263               (wl-summary-next-folder-or-exit next-entity)
5264             (wl-ask-folder
5265              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5266              (format
5267               "No more unread messages. Type SPC to go to %s."
5268               (wl-summary-entity-info-msg next-entity finfo))))))))
5269
5270 (defun wl-summary-goto-last-displayed-msg ()
5271   (interactive)
5272   (unless wl-summary-buffer-last-displayed-msg
5273     (setq wl-summary-buffer-last-displayed-msg
5274           wl-summary-buffer-current-msg))
5275   (if wl-summary-buffer-last-displayed-msg
5276       (progn
5277         (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
5278         (if wl-summary-buffer-disp-msg
5279             (wl-summary-redisplay)))
5280     (message "No last message.")))
5281
5282 (defun wl-summary-redisplay (&optional arg)
5283   (interactive "P")
5284   (if (and (not arg)
5285            (wl-summary-no-mime-p wl-summary-buffer-folder-name))
5286       (wl-summary-redisplay-no-mime)
5287     (wl-summary-redisplay-internal nil nil arg)))
5288
5289 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
5290   (interactive)
5291   (let* ((msgdb wl-summary-buffer-msgdb)
5292          (fld (or folder wl-summary-buffer-folder-name))
5293          (num (or number (wl-summary-message-number)))
5294          (wl-mime-charset      wl-summary-buffer-mime-charset)
5295          (default-mime-charset wl-summary-buffer-mime-charset)
5296          (wl-message-redisplay-func
5297           wl-summary-buffer-message-redisplay-func)
5298          fld-buf fld-win thr-entity)
5299     (if (and wl-thread-open-reading-thread
5300              (eq wl-summary-buffer-view 'thread)
5301              (not (wl-thread-entity-get-opened
5302                    (setq thr-entity (wl-thread-get-entity
5303                                      num))))
5304              (wl-thread-entity-get-children thr-entity))
5305         (wl-thread-force-open))
5306     (if num
5307         (progn
5308           (setq wl-summary-buffer-disp-msg t)
5309           (setq wl-summary-buffer-last-displayed-msg
5310                 wl-summary-buffer-current-msg)
5311           ;; hide folder window
5312           (if (and (not wl-stay-folder-window)
5313                    (setq fld-buf (get-buffer wl-folder-buffer-name)))
5314               (if (setq fld-win (get-buffer-window fld-buf))
5315                   (delete-window fld-win)))
5316           (setq wl-current-summary-buffer (current-buffer))
5317           (if (wl-message-redisplay fld num 'mime msgdb force-reload)
5318               (wl-summary-mark-as-read nil
5319                                        ;; cached, then change server-mark.
5320                                        (if wl-message-cache-used
5321                                            nil
5322                                          ;; plugged, then leave server-mark.
5323                                          (if (elmo-folder-plugged-p
5324                                               wl-summary-buffer-folder-name)
5325                                              'leave))
5326                                        t) ;; displayed
5327             )
5328           (setq wl-summary-buffer-current-msg num)
5329           (if wl-summary-recenter
5330               (recenter (/ (- (window-height) 2) 2)))
5331           (wl-highlight-summary-displaying)
5332           (wl-cache-prefetch-next fld num (current-buffer))
5333           (run-hooks 'wl-summary-redisplay-hook))
5334       (message "No message to display."))))
5335
5336 (defun wl-summary-redisplay-no-mime (&optional folder number)
5337   (interactive)
5338   (let* ((msgdb wl-summary-buffer-msgdb)
5339          (fld (or folder wl-summary-buffer-folder-name))
5340          (num (or number (wl-summary-message-number)))
5341          (wl-mime-charset      wl-summary-buffer-mime-charset)
5342          (default-mime-charset wl-summary-buffer-mime-charset)
5343          wl-break-pages)
5344     (if num
5345         (progn
5346           (setq wl-summary-buffer-disp-msg t)
5347           (setq wl-current-summary-buffer (current-buffer))
5348           (wl-normal-message-redisplay fld num 'no-mime msgdb)
5349           (wl-summary-mark-as-read nil nil t)
5350           (setq wl-summary-buffer-current-msg num)
5351           (if wl-summary-recenter
5352               (recenter (/ (- (window-height) 2) 2)))
5353           (wl-highlight-summary-displaying)
5354           (run-hooks 'wl-summary-redisplay-hook))
5355       (message "No message to display.")
5356       (wl-ask-folder 'wl-summary-exit
5357                      "No more messages. Type SPC to go to folder mode."))))
5358
5359 (defun wl-summary-redisplay-all-header (&optional folder number)
5360   (interactive)
5361   (let* ((msgdb wl-summary-buffer-msgdb)
5362          (fld (or folder wl-summary-buffer-folder-name))
5363          (num (or number (wl-summary-message-number)))
5364          (wl-mime-charset      wl-summary-buffer-mime-charset)
5365          (default-mime-charset wl-summary-buffer-mime-charset)
5366          (wl-message-redisplay-func wl-summary-buffer-message-redisplay-func))
5367     (if num
5368         (progn
5369           (if (wl-message-redisplay fld num 'all-header msgdb); t if displayed.
5370               (wl-summary-mark-as-read nil nil t))
5371           (run-hooks 'wl-summary-redisplay-hook))
5372       (message "No message to display."))))
5373
5374 (defun wl-summary-jump-to-current-message ()
5375   (interactive)
5376   (let (message-buf message-win)
5377     (if (setq message-buf (get-buffer wl-message-buf-name))
5378         (if (setq message-win (get-buffer-window message-buf))
5379             (select-window message-win)
5380           (wl-select-buffer (get-buffer wl-message-buf-name)))
5381       (wl-summary-redisplay)
5382       (wl-select-buffer (get-buffer wl-message-buf-name)))
5383     (goto-char (point-min))))
5384
5385 (defun wl-summary-cancel-message ()
5386   "Cancel an article on news."
5387   (interactive)
5388   (let ((summary-buf (current-buffer))
5389         message-buf)
5390     (wl-summary-set-message-buffer-or-redisplay)
5391     (if (setq message-buf (wl-message-get-original-buffer))
5392         (set-buffer message-buf))
5393     (unless (wl-message-news-p)
5394       (error "This is not a news article; canceling is impossible"))
5395     (when (yes-or-no-p "Do you really want to cancel this article? ")
5396       (let (from newsgroups message-id distribution buf)
5397         (save-excursion
5398           (setq from (std11-field-body "from")
5399                 newsgroups (std11-field-body "newsgroups")
5400                 message-id (std11-field-body "message-id")
5401                 distribution (std11-field-body "distribution"))
5402           ;; Make sure that this article was written by the user.
5403           (unless (wl-address-user-mail-address-p
5404                    (wl-address-header-extract-address
5405                     (car (wl-parse-addresses from))))
5406             (error "This article is not yours"))
5407           ;; Make control message.
5408           (setq buf (set-buffer (get-buffer-create " *message cancel*")))
5409           (setq wl-draft-buffer-cur-summary-buffer summary-buf)
5410           (buffer-disable-undo (current-buffer))
5411           (erase-buffer)
5412           (insert "Newsgroups: " newsgroups "\n"
5413                   "From: " (wl-address-header-extract-address
5414                             wl-from) "\n"
5415                             "Subject: cmsg cancel " message-id "\n"
5416                             "Control: cancel " message-id "\n"
5417                             (if distribution
5418                                 (concat "Distribution: " distribution "\n")
5419                               "")
5420                             mail-header-separator "\n"
5421                             wl-summary-cancel-message)
5422           (message "Canceling your message...")
5423           (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
5424           (message "Canceling your message...done"))))))
5425
5426 (defun wl-summary-supersedes-message ()
5427   "Supersede current message."
5428   (interactive)
5429   (let ((summary-buf (current-buffer))
5430         (mmelmo-force-fetch-entire-message t)
5431         message-buf from)
5432     (wl-summary-set-message-buffer-or-redisplay)
5433     (if (setq message-buf (wl-message-get-original-buffer))
5434         (set-buffer message-buf))
5435     (unless (wl-message-news-p)
5436       (error "This is not a news article; supersedes is impossible"))
5437     (save-excursion
5438       (setq from (std11-field-body "from"))
5439       ;; Make sure that this article was written by the user.
5440       (unless (wl-address-user-mail-address-p
5441                (wl-address-header-extract-address
5442                 (car (wl-parse-addresses from))))
5443         (error "This article is not yours"))
5444       (let* ((message-id (std11-field-body "message-id"))
5445              (followup-to (std11-field-body "followup-to"))
5446              (mail-default-headers
5447               (concat mail-default-headers
5448                       "Supersedes: " message-id "\n"
5449                       (and followup-to
5450                            (concat "Followup-To: " followup-to "\n")))))
5451         (set-buffer (wl-message-get-original-buffer))
5452         (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
5453
5454 (defun wl-summary-save (&optional arg wl-save-dir)
5455   (interactive)
5456   (let ((filename)
5457         (num (wl-summary-message-number))
5458         (mmelmo-force-fetch-entire-message t))
5459     (if (null wl-save-dir)
5460         (setq wl-save-dir wl-tmp-dir))
5461     (if num
5462         (save-excursion
5463           (setq filename (expand-file-name
5464                           (int-to-string num)
5465                           wl-save-dir))
5466           (if (null (and arg
5467                          (null (file-exists-p filename))))
5468               (setq filename
5469                     (read-file-name "Save to file: " filename)))
5470
5471           (wl-summary-set-message-buffer-or-redisplay)
5472           (set-buffer (wl-message-get-original-buffer))
5473           (if (and (null arg) (file-exists-p filename))
5474               (if (y-or-n-p "file already exists. override it?")
5475                   (write-region (point-min) (point-max) filename))
5476             (write-region (point-min) (point-max) filename)))
5477       (message "No message to save."))
5478     num))
5479
5480 (defun wl-summary-save-region (beg end)
5481   (interactive "r")
5482   (save-excursion
5483     (save-restriction
5484       (narrow-to-region beg end)
5485       (goto-char (point-min))
5486       (let ((wl-save-dir
5487              (wl-read-directory-name "Save to directory: " wl-tmp-dir)))
5488         (if (null (file-exists-p wl-save-dir))
5489             (make-directory wl-save-dir))
5490         (if (eq wl-summary-buffer-view 'thread)
5491             (progn
5492               (while (not (eobp))
5493                 (let* ((number (wl-summary-message-number))
5494                        (entity (wl-thread-get-entity number)))
5495                   (if (wl-thread-entity-get-opened entity)
5496                       (wl-summary-save t wl-save-dir)
5497                     ;; closed
5498                     (wl-summary-save t wl-save-dir))
5499                   (forward-line 1))))
5500           (while (not (eobp))
5501             (wl-summary-save t wl-save-dir)
5502             (forward-line 1)))))))
5503
5504 ;; mew-summary-pipe-message()
5505 (defun wl-summary-pipe-message (prefix command)
5506   "Send this message via pipe."
5507   (interactive
5508    (list current-prefix-arg
5509          (read-string "Shell command on message: " wl-summary-shell-command-last)))
5510   (if (y-or-n-p "Send this message to pipe? ")
5511       (save-excursion
5512         (wl-summary-set-message-buffer-or-redisplay)
5513         (set-buffer (wl-message-get-original-buffer))
5514         (if (string= command "")
5515             (setq command wl-summary-shell-command-last))
5516         (goto-char (point-min)) ; perhaps this line won't be necessary
5517         (if prefix
5518             (search-forward "\n\n"))
5519         (shell-command-on-region (point) (point-max) command nil)
5520         (setq wl-summary-shell-command-last command))))
5521
5522 (defun wl-summary-print-message (&optional arg)
5523   (interactive "P")
5524   (save-excursion
5525     (wl-summary-set-message-buffer-or-redisplay)
5526     (if (or (not (interactive-p))
5527             (y-or-n-p "Print ok?"))
5528         (progn
5529           (let* ((message-buffer (get-buffer wl-message-buf-name))
5530                  ;; (summary-buffer (get-buffer wl-summary-buffer-name))
5531                  (buffer (generate-new-buffer " *print*")))
5532             (set-buffer message-buffer)
5533             (copy-to-buffer buffer (point-min) (point-max))
5534             (set-buffer buffer)
5535             (funcall wl-print-buffer-func)
5536             (kill-buffer buffer)))
5537       (message ""))))
5538
5539 (defun wl-summary-print-message-with-ps-print (&optional filename)
5540   (interactive (list (ps-print-preprint current-prefix-arg)))
5541   (if (or (not (interactive-p))
5542           (y-or-n-p "Print ok?"))
5543       (let ((summary-buffer (current-buffer))
5544             wl-break-pages)
5545         (save-excursion
5546           ;;(wl-summary-set-message-buffer-or-redisplay)
5547           (wl-summary-redisplay-internal)
5548           (let* ((message-buffer (get-buffer wl-message-buf-name))
5549                  (buffer (generate-new-buffer " *print*"))
5550                  (entity (progn
5551                            (set-buffer summary-buffer)
5552                            (assoc (cdr (assq
5553                                         (wl-summary-message-number)
5554                                         (elmo-msgdb-get-number-alist
5555                                          wl-summary-buffer-msgdb)))
5556                                   (elmo-msgdb-get-overview
5557                                    wl-summary-buffer-msgdb))))
5558                  (wl-ps-subject
5559                   (and entity
5560                        (or (elmo-msgdb-overview-entity-get-subject entity)
5561                            "")))
5562                  (wl-ps-from
5563                   (and entity
5564                        (or (elmo-msgdb-overview-entity-get-from entity) "")))
5565                  (wl-ps-date
5566                   (and entity
5567                        (or (elmo-msgdb-overview-entity-get-date entity) ""))))
5568             (run-hooks 'wl-ps-preprint-hook)
5569             (set-buffer message-buffer)
5570             (copy-to-buffer buffer (point-min) (point-max))
5571             (set-buffer buffer)
5572             (unwind-protect
5573                 (let ((ps-left-header
5574                        (list (concat "(" wl-ps-subject ")")
5575                              (concat "(" wl-ps-from ")")))
5576                       (ps-right-header
5577                        (list "/pagenumberstring load"
5578                              (concat "(" wl-ps-date ")"))))
5579                   (run-hooks 'wl-ps-print-hook)
5580                   (funcall wl-ps-print-buffer-func filename))
5581               (kill-buffer buffer)))))
5582     (message "")))
5583
5584 (if (featurep 'ps-print) ; ps-print is available.
5585     (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
5586
5587 (defun wl-summary-folder-info-update ()
5588   (let ((folder (elmo-string wl-summary-buffer-folder-name))
5589         (num-db (elmo-msgdb-get-number-alist
5590                  wl-summary-buffer-msgdb)))
5591     (wl-folder-set-folder-updated folder
5592                                   (list 0
5593                                         (+ wl-summary-buffer-unread-count
5594                                            wl-summary-buffer-new-count)
5595                                         (length num-db)))))
5596
5597 (defun wl-summary-get-newsgroups ()
5598   (let ((spec-list (elmo-folder-get-primitive-spec-list
5599                     (elmo-string wl-summary-buffer-folder-name)))
5600         ng-list)
5601     (while spec-list
5602       (when (eq (caar spec-list) 'nntp)
5603         (wl-append ng-list (list (nth 1 (car spec-list)))))
5604       (setq spec-list (cdr spec-list)))
5605     ng-list))
5606
5607 (defun wl-summary-set-crosspost (&optional type redisplay)
5608   (let* ((number (wl-summary-message-number))
5609          (spec (elmo-folder-number-get-spec wl-summary-buffer-folder-name
5610                                             number))
5611          (folder (nth 1 spec))
5612          message-buf newsgroups)
5613     (when (eq (car spec) 'nntp)
5614       (if redisplay
5615           (wl-summary-redisplay))
5616       (save-excursion
5617         (if (setq message-buf (wl-message-get-original-buffer))
5618             (set-buffer message-buf))
5619         (setq newsgroups (std11-field-body "newsgroups")))
5620       (when newsgroups
5621         (let* ((msgdb wl-summary-buffer-msgdb)
5622                (num-db (elmo-msgdb-get-number-alist msgdb))
5623                (ng-list (wl-summary-get-newsgroups)) ;; for multi folder
5624                crosspost-folders)
5625           (when (setq crosspost-folders
5626                       (elmo-delete-lists ng-list
5627                                          (wl-parse-newsgroups newsgroups t)))
5628             (elmo-crosspost-message-set (cdr (assq number num-db)) ;;message-id
5629                                         crosspost-folders
5630                                         type) ;;not used
5631             (setq wl-crosspost-alist-modified t)))))))
5632
5633 (defun wl-summary-is-crosspost-folder (spec-list fld-list)
5634   (let (fld flds)
5635     (while spec-list
5636       (if (and (eq (caar spec-list) 'nntp)
5637                (member (setq fld (nth 1 (car spec-list))) fld-list))
5638           (wl-append flds (list fld)))
5639       (setq spec-list (cdr spec-list)))
5640     flds))
5641
5642 (defun wl-summary-update-crosspost ()
5643   (let* ((msgdb wl-summary-buffer-msgdb)
5644          (number-alist (elmo-msgdb-get-number-alist msgdb))
5645          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
5646          (spec-list (elmo-folder-get-primitive-spec-list
5647                      (elmo-string wl-summary-buffer-folder-name)))
5648          (alist elmo-crosspost-message-alist)
5649          (crossed 0)
5650          mark ngs num)
5651     (when (assq 'nntp spec-list)
5652       (while alist
5653         (when (setq ngs
5654                     (wl-summary-is-crosspost-folder
5655                      spec-list
5656                      (nth 1 (car alist))))
5657           (when (setq num (car (rassoc (caar alist) number-alist)))
5658             (if (and (setq mark (cadr (assq num mark-alist)))
5659                      (member mark (list wl-summary-new-mark
5660                                         wl-summary-unread-uncached-mark
5661                                         wl-summary-unread-cached-mark)))
5662                 (setq crossed (1+ crossed)))
5663             (if (wl-summary-jump-to-msg num)
5664                 (wl-summary-mark-as-read t);; opened
5665               (wl-thread-msg-mark-as-read num)));; closed
5666           ;; delete if message does't exists.
5667           (elmo-crosspost-message-delete (caar alist) ngs)
5668           (setq wl-crosspost-alist-modified t))
5669         (setq alist (cdr alist))))
5670     (if (> crossed 0)
5671         crossed)))
5672
5673 (defun wl-crosspost-alist-load ()
5674   (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
5675   (setq wl-crosspost-alist-modified nil))
5676
5677 (defun wl-crosspost-alist-save ()
5678   (when wl-crosspost-alist-modified
5679     ;; delete non-exists newsgroups
5680     (let ((alist elmo-crosspost-message-alist)
5681           newsgroups)
5682       (while alist
5683         (setq newsgroups
5684               (elmo-delete-if
5685                '(lambda (x)
5686                   (not (intern-soft x wl-folder-newsgroups-hashtb)))
5687                (nth 1 (car alist))))
5688         (if newsgroups
5689             (setcar (cdar alist) newsgroups)
5690           (setq elmo-crosspost-message-alist
5691                 (delete (car alist) elmo-crosspost-message-alist)))
5692         (setq alist (cdr alist)))
5693       (elmo-crosspost-alist-save elmo-crosspost-message-alist)
5694       (setq wl-crosspost-alist-modified nil))))
5695
5696 (defun wl-summary-pack-number (&optional arg)
5697   (interactive "P")
5698   (setq wl-summary-buffer-msgdb
5699         (elmo-pack-number
5700          wl-summary-buffer-folder-name wl-summary-buffer-msgdb arg))
5701   (wl-summary-rescan))
5702
5703 (defun wl-summary-target-mark-uudecode ()
5704   (interactive)
5705   (let ((mlist (reverse wl-summary-buffer-target-mark-list))
5706         (summary-buf (current-buffer))
5707         (tmp-buf (get-buffer-create "*WL UUENCODE*"))
5708         orig-buf i k filename rc errmsg)
5709     (setq i 1)
5710     (setq k (length mlist))
5711     (set-buffer tmp-buf)
5712     (erase-buffer)
5713     (save-window-excursion
5714       (while mlist
5715         (set-buffer summary-buf)
5716         (wl-summary-jump-to-msg (car mlist))
5717         (wl-summary-redisplay)
5718         (set-buffer (setq orig-buf (wl-message-get-original-buffer)))
5719         (goto-char (point-min))
5720         (cond ((= i 1) ; first
5721                (setq filename (wl-message-uu-substring
5722                                orig-buf tmp-buf t
5723                                (= i k))))
5724               ((< i k)
5725                (wl-message-uu-substring orig-buf tmp-buf))
5726               (t ; last
5727                (wl-message-uu-substring orig-buf tmp-buf nil t)))
5728         (setq i (1+ i))
5729         (setq mlist (cdr mlist)))
5730       (set-buffer tmp-buf)
5731       (message "Exec %s..." wl-prog-uudecode)
5732       (unwind-protect
5733           (let ((decode-dir wl-tmp-dir))
5734             (if (not wl-prog-uudecode-no-stdout-option)
5735                 (setq filename (read-file-name "Save to file: "
5736                                                (expand-file-name
5737                                                 (elmo-safe-filename filename)
5738                                                 wl-tmp-dir)))
5739               (setq decode-dir
5740                     (wl-read-directory-name "Save to directory: "
5741                                             wl-tmp-dir))
5742               (setq filename (expand-file-name filename decode-dir)))
5743             (if (file-exists-p filename)
5744                 (or (yes-or-no-p (format "File %s exists. Save anyway? "
5745                                          filename))
5746                     (error "")))
5747             (elmo-bind-directory
5748              decode-dir
5749              (setq rc
5750                    (as-binary-process
5751                     (apply 'call-process-region (point-min) (point-max)
5752                            wl-prog-uudecode t (current-buffer) nil
5753                            wl-prog-uudecode-arg))))
5754             (when (not (= 0 rc))
5755               (setq errmsg (buffer-substring (point-min)(point-max)))
5756               (error "uudecode error: %s" errmsg))
5757             (if (not wl-prog-uudecode-no-stdout-option)
5758                 (let (file-name-handler-alist) ;; void jka-compr
5759                   (as-binary-output-file
5760                    (write-region (point-min) (point-max)
5761                                  filename nil 'no-msg))))
5762             (save-excursion
5763               (set-buffer summary-buf)
5764               (wl-summary-delete-all-temp-marks))
5765             (if (file-exists-p filename)
5766                 (message "Saved as %s" filename)))
5767         (kill-buffer tmp-buf)))))
5768
5769 (defun wl-summary-drop-unsync ()
5770   "Drop all unsync messages."
5771   (interactive)
5772   (if (elmo-folder-pipe-p wl-summary-buffer-folder-name)
5773       (error "You cannot drop unsync messages in this folder"))
5774   (if (or (not (interactive-p))
5775           (y-or-n-p "Drop all unsync messages?"))
5776       (let* ((folder-list (elmo-folder-get-primitive-folder-list
5777                            wl-summary-buffer-folder-name))
5778              (is-multi (elmo-multi-p wl-summary-buffer-folder-name))
5779              (sum 0)
5780              (multi-num 0)
5781              pair)
5782         (message "Dropping...")
5783         (while folder-list
5784           (setq pair (elmo-max-of-folder (car folder-list)))
5785           (when is-multi ;; dirty hack...
5786             (incf multi-num)
5787             (setcar pair (+ (* multi-num elmo-multi-divide-number)
5788                             (car pair))))
5789           (elmo-msgdb-set-number-alist
5790            wl-summary-buffer-msgdb
5791            (nconc
5792             (elmo-msgdb-get-number-alist wl-summary-buffer-msgdb)
5793             (list (cons (car pair) nil))))
5794           (setq sum (+ sum (cdr pair)))
5795           (setq folder-list (cdr folder-list)))
5796         (wl-summary-set-message-modified)
5797         (wl-folder-set-folder-updated wl-summary-buffer-folder-name
5798                                       (list 0
5799                                             (+ wl-summary-buffer-unread-count
5800                                                wl-summary-buffer-new-count)
5801                                             sum))
5802         (message "Dropping...done."))))
5803
5804 (defun wl-summary-default-get-next-msg (msg)
5805   (let (next)
5806     (if (and (not wl-summary-buffer-target-mark-list)
5807              (eq wl-summary-buffer-view 'thread)
5808              (if (eq wl-summary-move-direction-downward nil)
5809                  (setq next (wl-thread-get-prev-unread msg))
5810                (setq next (wl-thread-get-next-unread msg))))
5811         next
5812       (save-excursion
5813         (wl-summary-jump-to-msg msg)
5814         (let (wl-summary-buffer-disp-msg)
5815           (if (eq wl-summary-move-direction-downward nil)
5816               (unless (wl-summary-cursor-up)
5817                 (wl-summary-prev))
5818             (unless (wl-summary-cursor-down)
5819               (wl-summary-next)))
5820           (wl-summary-message-number))))))
5821
5822 (defsubst wl-cache-prefetch-p (fld &optional num)
5823   (cond ((and num wl-cache-prefetch-folder-type-list)
5824          (memq
5825           (elmo-folder-number-get-type fld num)
5826           wl-cache-prefetch-folder-type-list))
5827         (wl-cache-prefetch-folder-type-list
5828          (let ((list wl-cache-prefetch-folder-type-list)
5829                type)
5830            (catch 'done
5831              (while (setq type (pop list))
5832                (if (elmo-folder-contains-type fld type)
5833                    (throw 'done t))))))
5834         ((consp wl-cache-prefetch-folder-list)
5835          (wl-string-match-member fld wl-cache-prefetch-folder-list))
5836         (t
5837          wl-cache-prefetch-folder-list)))
5838
5839 (defconst wl-cache-prefetch-idle-time
5840   (if (featurep 'lisp-float-type) (/ (float 1) (float 10)) 1))
5841
5842 (defun wl-cache-prefetch-next (fld msg &optional summary)
5843   (if (wl-cache-prefetch-p fld)
5844       (if (not elmo-use-buffer-cache)
5845          ;; (message "`elmo-use-buffer-cache' is nil, cache prefetch is disable.")
5846         (save-excursion
5847           (set-buffer (or summary (get-buffer wl-summary-buffer-name)))
5848           (let ((next (funcall wl-cache-prefetch-get-next-func msg)))
5849             (when (and next
5850                        (wl-cache-prefetch-p fld next))
5851               (if (not (fboundp 'run-with-idle-timer))
5852                   (when (sit-for wl-cache-prefetch-idle-time)
5853                     (wl-cache-prefetch-message fld next summary))
5854                 (run-with-idle-timer
5855                  wl-cache-prefetch-idle-time
5856                  nil
5857                  'wl-cache-prefetch-message fld next summary)
5858                 (sit-for 0))))))))
5859
5860 (defvar wl-cache-prefetch-debug nil)
5861 (defun wl-cache-prefetch-message (folder msg summary &optional next)
5862   (when (buffer-live-p summary)
5863     (save-excursion
5864       (set-buffer summary)
5865       (when (string= folder wl-summary-buffer-folder-name)
5866         (unless next
5867           (setq next msg))
5868         (let* ((msgdb wl-summary-buffer-msgdb)
5869                (message-id (cdr (assq next
5870                                       (elmo-msgdb-get-number-alist msgdb)))))
5871           (if (not (elmo-buffer-cache-hit (list folder next message-id)))
5872               (let* ((size (elmo-msgdb-overview-entity-get-size
5873                             (assoc message-id
5874                                    (elmo-msgdb-get-overview msgdb)))))
5875                 (when (or (elmo-local-file-p folder next)
5876                           (not (and (integerp size)
5877                                     wl-cache-prefetch-threshold
5878                                     (>= size wl-cache-prefetch-threshold)
5879                                     (not (elmo-cache-exists-p message-id
5880                                                               folder next)))))
5881                   (if wl-cache-prefetch-debug
5882                       (message "Reading %d..." msg))
5883                   (elmo-buffer-cache-message folder next msgdb)
5884                   (if wl-cache-prefetch-debug
5885                       (message "Reading %d... done" msg))))))))))
5886
5887 (provide 'wl-summary)
5888
5889 ;;; wl-summary.el ends here