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