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