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