wl/wl-summary.el

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