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