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