wl/wl-summary.el

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