wl/wl-summary.el

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