wl/wl-summary.el

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