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