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