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