wl/wl-summary.el

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