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