wl/wl-summary.el

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