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