wl/wl-summary.el

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