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