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