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