wl/wl-summary.el

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