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