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