wl/wl-summary.el

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