wl/wl-summary.el

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