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