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