wl/wl-summary.el

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