wl/wl-summary.el

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