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