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