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