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