wl/wl-summary.el

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