wl/wl-summary.el

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