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