wl/wl-summary.el

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