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