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