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