wl/wl-summary.el

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