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