wl/wl-summary.el

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