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