wl/wl-summary.el

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