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