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