wl/wl-summary.el

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