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