wl/wl-summary.el

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