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