wl/wl-summary.el

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