wl/wl-summary.el

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