wl/wl-summary.el

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