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