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