wl/wl-summary.el

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