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