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