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