wl/wl-summary.el

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