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