wl/wl-summary.el

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