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           (run-hooks 'wl-summary-toggle-disp-off-hook))
3604 ;;;     (switch-to-buffer cur-buf)
3605         )))
3606     (when wl-summary-lazy-highlight
3607       (wl-highlight-summary-window))))
3608
3609 (defun wl-summary-next-line-content ()
3610   "Show next line of the message."
3611   (interactive)
3612   (let ((cur-buf (current-buffer)))
3613     (wl-summary-toggle-disp-msg 'on)
3614     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3615       (set-buffer cur-buf)
3616       (wl-message-next-page 1))))
3617
3618 (defun wl-summary-prev-line-content ()
3619   (interactive)
3620   (let ((cur-buf (current-buffer)))
3621     (wl-summary-toggle-disp-msg 'on)
3622     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3623       (set-buffer cur-buf)
3624       (wl-message-prev-page 1))))
3625
3626 (defun wl-summary-next-page ()
3627   (interactive)
3628   (let ((cur-buf (current-buffer)))
3629     (wl-summary-toggle-disp-msg 'on)
3630     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3631       (set-buffer cur-buf)
3632       (wl-message-next-page))))
3633
3634 (defun wl-summary-prev-page ()
3635   (interactive)
3636   (let ((cur-buf (current-buffer)))
3637     (wl-summary-toggle-disp-msg 'on)
3638     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3639       (set-buffer cur-buf)
3640       (wl-message-prev-page))))
3641
3642 (defsubst wl-summary-no-mime-p (folder)
3643   (wl-string-match-member (elmo-folder-name-internal folder)
3644                           wl-summary-no-mime-folder-list))
3645
3646 (defun wl-summary-set-message-buffer-or-redisplay (&rest args)
3647   "Set message buffer.
3648 If message is not displayed yet, display it.
3649 Return t if message exists."
3650   (let ((folder wl-summary-buffer-elmo-folder)
3651         (number (wl-summary-message-number))
3652         cur-folder cur-number message-last-pos)
3653     (when (buffer-live-p wl-message-buffer)
3654       (save-window-excursion
3655         (wl-message-select-buffer wl-message-buffer)
3656         (setq cur-folder wl-message-buffer-cur-folder)
3657         (setq cur-number wl-message-buffer-cur-number)))
3658     (if (and (string= (elmo-folder-name-internal folder) (or cur-folder ""))
3659              (eq number (or cur-number 0)))
3660         (progn
3661           (set-buffer wl-message-buffer)
3662           t)
3663       (if (wl-summary-no-mime-p folder)
3664           (wl-summary-redisplay-no-mime-internal folder number)
3665         (wl-summary-redisplay-internal folder number))
3666       (when (buffer-live-p wl-message-buffer)
3667         (set-buffer wl-message-buffer))
3668       nil)))
3669
3670 (defun wl-summary-target-mark-forward (&optional arg)
3671   (interactive "P")
3672   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
3673         (summary-buf (current-buffer))
3674         (wl-draft-forward t)
3675         start-point
3676         draft-buf)
3677     (wl-summary-jump-to-msg (car mlist))
3678     (wl-summary-forward t)
3679     (setq start-point (point))
3680     (setq draft-buf (current-buffer))
3681     (setq mlist (cdr mlist))
3682     (save-window-excursion
3683       (when mlist
3684         (while mlist
3685           (set-buffer summary-buf)
3686           (wl-summary-jump-to-msg (car mlist))
3687           (wl-summary-redisplay)
3688           (set-buffer draft-buf)
3689           (goto-char (point-max))
3690           (wl-draft-insert-message)
3691           (setq mlist (cdr mlist)))
3692         (wl-draft-body-goto-top)
3693         (wl-draft-enclose-digest-region (point) (point-max)))
3694       (goto-char start-point)
3695       (save-excursion
3696         (set-buffer summary-buf)
3697         (wl-summary-delete-all-temp-marks)))
3698     (run-hooks 'wl-mail-setup-hook)))
3699
3700 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
3701   (interactive "P")
3702   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
3703         (summary-buf (current-buffer))
3704         change-major-mode-hook
3705         start-point
3706         draft-buf)
3707     (wl-summary-jump-to-msg (car mlist))
3708     (wl-summary-reply arg t)
3709     (goto-char (point-max))
3710     (setq start-point (point-marker))
3711     (setq draft-buf (current-buffer))
3712     (save-window-excursion
3713       (while mlist
3714         (set-buffer summary-buf)
3715         (delete-other-windows)
3716         (wl-summary-jump-to-msg (car mlist))
3717         (wl-summary-redisplay)
3718         (set-buffer draft-buf)
3719         (goto-char (point-max))
3720         (wl-draft-yank-original)
3721         (setq mlist (cdr mlist)))
3722       (goto-char start-point)
3723       (save-excursion
3724         (set-buffer summary-buf)
3725         (wl-summary-delete-all-temp-marks)))
3726     (wl-draft-reply-position wl-draft-reply-default-position)
3727     (run-hooks 'wl-mail-setup-hook)))
3728
3729 (defun wl-summary-reply-with-citation (&optional arg)
3730   (interactive "P")
3731   (when (wl-summary-reply arg t)
3732     (goto-char (point-max))
3733     (wl-draft-yank-original)
3734     (wl-draft-reply-position wl-draft-reply-default-position)
3735     (run-hooks 'wl-mail-setup-hook)))
3736
3737 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
3738   (interactive)
3739   (let* ((original (wl-summary-message-number))
3740          (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
3741          (entity (elmo-message-entity wl-summary-buffer-elmo-folder msgid))
3742          msg otherfld schar
3743          (errmsg (format "No message with id \"%s\" in the folder." msgid)))
3744     (if (setq msg (elmo-message-entity-number entity))
3745         (progn
3746           (wl-thread-jump-to-msg msg)
3747           t)
3748       ;; for XEmacs!
3749       (if (and elmo-use-database
3750                (setq errmsg
3751                      (format
3752                       "No message with id \"%s\" in the database." msgid))
3753                (setq otherfld (elmo-database-msgid-get msgid)))
3754           (if (cdr (wl-summary-jump-to-msg-internal
3755                     (car otherfld) (nth 1 otherfld) 'no-sync))
3756               t ; succeed.
3757             ;; Back to original.
3758             (wl-summary-jump-to-msg-internal
3759              (wl-summary-buffer-folder-name) original 'no-sync))
3760         (cond ((eq wl-summary-search-via-nntp 'confirm)
3761                (require 'elmo-nntp)
3762                (message "Search message in nntp server \"%s\" <y/n/s(elect)>? "
3763                         elmo-nntp-default-server)
3764                (setq schar (let ((cursor-in-echo-area t)) (read-char)))
3765                (cond ((eq schar ?y)
3766                       (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
3767                      ((eq schar ?s)
3768                       (wl-summary-jump-to-msg-by-message-id-via-nntp
3769                        msgid
3770                        (read-from-minibuffer "NNTP Server: ")))
3771                      (t
3772                       (message "%s" errmsg)
3773                       nil)))
3774               ((or (eq wl-summary-search-via-nntp 'force)
3775                    (and
3776                     (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
3777                         'nntp)
3778                     wl-summary-search-via-nntp))
3779                (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
3780               (t
3781                (message "%s" errmsg)
3782                nil))))))
3783
3784 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
3785   (interactive)
3786   (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
3787          newsgroups folder ret
3788          user server port type spec)
3789     (if server-spec
3790         (if (string-match "^-" server-spec)
3791             (setq spec (wl-folder-get-elmo-folder server-spec)
3792                   user (elmo-net-folder-user-internal spec)
3793                   server (elmo-net-folder-server-internal spec)
3794                   port (elmo-net-folder-port-internal spec)
3795                   type (elmo-net-folder-stream-type-internal spec))
3796           (setq server server-spec)))
3797     (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
3798                      msgid
3799                      (or server elmo-nntp-default-server)
3800                      (or user elmo-nntp-default-user)
3801                      (or port elmo-nntp-default-port)
3802                      (or type elmo-nntp-default-stream-type)))
3803       (setq newsgroups (elmo-nntp-parse-newsgroups ret))
3804       (setq folder (concat "-" (car newsgroups)
3805                            (elmo-nntp-folder-postfix user server port type)))
3806       (catch 'found
3807         (while newsgroups
3808           (if (wl-folder-entity-exists-p (car newsgroups)
3809                                          wl-folder-newsgroups-hashtb)
3810               (throw 'found
3811                      (setq folder (concat "-" (car newsgroups)
3812                                           (elmo-nntp-folder-postfix
3813                                            user server port type)))))
3814           (setq newsgroups (cdr newsgroups)))))
3815     (if ret
3816         (wl-summary-jump-to-msg-internal folder nil 'update msgid)
3817       (message "No message id \"%s\" in nntp server \"%s\"."
3818                msgid (or server elmo-nntp-default-server))
3819       nil)))
3820
3821 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
3822   (let (wl-auto-select-first entity)
3823     (if (or (string= folder (wl-summary-buffer-folder-name))
3824             (y-or-n-p
3825              (format
3826               "Message was found in the folder \"%s\". Jump to it? "
3827               folder)))
3828         (progn
3829           (unwind-protect
3830               (wl-summary-goto-folder-subr
3831                folder scan-type nil nil t)
3832             (if msgid
3833                 (setq msg
3834                       (elmo-message-entity-number
3835                        (elmo-message-entity
3836                         wl-summary-buffer-elmo-folder
3837                         msgid))))
3838             (setq entity (wl-folder-search-entity-by-name folder
3839                                                           wl-folder-entity
3840                                                           'folder))
3841             (if entity
3842                 (wl-folder-set-current-entity-id
3843                  (wl-folder-get-entity-id entity))))
3844           (if (null msg)
3845               (message "Message was not found currently in this folder.")
3846             (setq msg (and (wl-thread-jump-to-msg msg) msg)))
3847           (cons folder msg)))))
3848
3849 (defun wl-summary-jump-to-parent-message (arg)
3850   (interactive "P")
3851   (let ((cur-buf (current-buffer))
3852         (disp-msg wl-summary-buffer-disp-msg)
3853         (number (wl-summary-message-number))
3854         (regexp "\\(<[^<>]*>\\)[ \t]*$")
3855         (i -1) ;; xxx
3856         msg-id msg-num ref-list ref irt)
3857     (if (null number)
3858         (message "No message.")
3859       (when (eq wl-summary-buffer-view 'thread)
3860         (cond ((and arg (not (numberp arg)))
3861                (setq msg-num
3862                      (wl-thread-entity-get-number
3863                       (wl-thread-entity-get-top-entity
3864                        (wl-thread-get-entity number)))))
3865               ((and arg (numberp arg))
3866                (setq i 0)
3867                (setq msg-num number)
3868                (while (< i arg)
3869                  (setq msg-num
3870                        (wl-thread-entity-get-number
3871                         (wl-thread-entity-get-parent-entity
3872                          (wl-thread-get-entity msg-num))))
3873                  (setq i (1+ i))))
3874               (t (setq msg-num
3875                        (wl-thread-entity-get-number
3876                         (wl-thread-entity-get-parent-entity
3877                          (wl-thread-get-entity number)))))))
3878       (when (null msg-num)
3879         (wl-summary-set-message-buffer-or-redisplay)
3880         (set-buffer (wl-message-get-original-buffer))
3881         (message "Searching parent message...")
3882         (setq ref (std11-field-body "References")
3883               irt (std11-field-body "In-Reply-To"))
3884         (cond
3885          ((and arg (not (numberp arg)) ref (not (string= ref ""))
3886                (string-match regexp ref))
3887           ;; The first message of the thread.
3888           (setq msg-id (wl-match-string 1 ref)))
3889          ;; "In-Reply-To:" has only one msg-id.
3890          ((and (null arg) irt (not (string= irt ""))
3891                (string-match regexp irt))
3892           (setq msg-id (wl-match-string 1 irt)))
3893          ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
3894                (string-match regexp ref))
3895           ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
3896           (while (string-match regexp ref)
3897             (setq ref-list
3898                   (append (list
3899                            (wl-match-string 1 ref))
3900                           ref-list))
3901             (setq ref (substring ref (match-end 0)))
3902             (setq i (1+ i)))
3903           (setq msg-id
3904                 (if (null arg) (nth 0 ref-list) ;; previous
3905                   (if (<= arg i) (nth (1- arg) ref-list)
3906                     (nth i ref-list))))))
3907         (set-buffer cur-buf)
3908         (or disp-msg (wl-summary-toggle-disp-msg 'off)))
3909       (cond ((and (null msg-id) (null msg-num))
3910              (message "No parent message!")
3911              nil)
3912             ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
3913              (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
3914              (message "Searching parent message...done")
3915              t)
3916             ((and msg-num (wl-summary-jump-to-msg msg-num))
3917              (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
3918              (message "Searching parent message...done")
3919              t)
3920             (t ; failed.
3921              (message "Parent message was not found.")
3922              nil)))))
3923
3924 (defun wl-summary-reply (&optional arg without-setup-hook)
3925   "Reply to current message. Default is \"wide\" reply.
3926 Reply to author if invoked with ARG."
3927   (interactive "P")
3928   (let ((folder wl-summary-buffer-elmo-folder)
3929         (number (wl-summary-message-number))
3930         (summary-buf (current-buffer))
3931         mes-buf)
3932     (when number
3933       (save-excursion
3934         (wl-summary-redisplay-internal folder number))
3935       (elmo-folder-mark-as-answered folder (list number))
3936       (wl-summary-update-mark number)
3937       (setq mes-buf wl-message-buffer)
3938       (wl-message-select-buffer wl-message-buffer)
3939       (set-buffer mes-buf)
3940       (goto-char (point-min))
3941       (when (setq mes-buf (wl-message-get-original-buffer))
3942         (wl-draft-reply mes-buf arg summary-buf number)
3943         (wl-draft-reply-position wl-draft-reply-default-position)
3944         (unless without-setup-hook
3945           (run-hooks 'wl-mail-setup-hook)))
3946       t)))
3947
3948 (defun wl-summary-write ()
3949   "Write a new draft from Summary."
3950   (interactive)
3951   (wl-draft (list (cons 'To ""))
3952             nil nil nil nil (wl-summary-buffer-folder-name))
3953   (run-hooks 'wl-mail-setup-hook)
3954   (mail-position-on-field "To"))
3955
3956 (defvar wl-summary-write-current-folder-functions
3957   '(wl-folder-get-newsgroups
3958     wl-folder-guess-mailing-list-by-refile-rule
3959     wl-folder-guess-mailing-list-by-folder-name)
3960   "Newsgroups or Mailing List address guess functions list.
3961 Call from `wl-summary-write-current-folder'.
3962 When guess function return nil, challenge next guess-function.")
3963
3964 (defun wl-summary-write-current-folder (&optional folder)
3965   "Write message to current FOLDER's newsgroup or mailing-list.
3966 Use function list is `wl-summary-write-current-folder-functions'."
3967   (interactive)
3968   ;; default FOLDER is current buffer folder
3969   (setq folder (or folder (wl-summary-buffer-folder-name)))
3970   (let ((func-list wl-summary-write-current-folder-functions)
3971         guess-list guess-func)
3972     (while func-list
3973       (setq guess-list (funcall (car func-list) folder))
3974       (if (null guess-list)
3975           (setq func-list (cdr func-list))
3976         (setq guess-func (car func-list))
3977         (setq func-list nil)))
3978     (if (null guess-func)
3979         (wl-summary-write)
3980       (unless (or (stringp (nth 0 guess-list))
3981                   (stringp (nth 1 guess-list))
3982                   (stringp (nth 2 guess-list)))
3983         (error "Invalid value return guess function `%s'"
3984                (symbol-name guess-func)))
3985       (wl-draft (list (cons 'To (nth 0 guess-list))
3986                       (cons 'Cc (nth 1 guess-list))
3987                       (cons 'Newsgroups (nth 2 guess-list)))
3988                 nil nil nil nil folder)
3989       (run-hooks 'wl-mail-setup-hook)
3990       (mail-position-on-field "Subject"))))
3991
3992 (defun wl-summary-forward (&optional without-setup-hook)
3993   ""
3994   (interactive)
3995   (let ((folder wl-summary-buffer-elmo-folder)
3996         (number (wl-summary-message-number))
3997         (summary-buf (current-buffer))
3998         (wl-draft-forward t)
3999         mes-buf
4000         entity subject num)
4001     (if (null number)
4002         (message "No message.")
4003       (if (and (elmo-message-use-cache-p folder number)
4004                (eq (elmo-file-cache-status
4005                     (elmo-file-cache-get
4006                      (elmo-message-field folder number 'message-id)))
4007                    'section))
4008           ;; Reload.
4009           (wl-summary-redisplay-internal nil nil 'force-reload)
4010         (wl-summary-redisplay-internal folder number))
4011       (setq mes-buf wl-message-buffer)
4012       (wl-message-select-buffer mes-buf)
4013       ;; get original subject.
4014       (if summary-buf
4015           (save-excursion
4016             (set-buffer summary-buf)
4017             (setq subject
4018                   (or (elmo-message-field folder number 'subject) ""))))
4019       (set-buffer mes-buf)
4020       (wl-draft-forward subject summary-buf)
4021       (unless without-setup-hook
4022         (run-hooks 'wl-mail-setup-hook)))))
4023
4024 (defun wl-summary-click (e)
4025   (interactive "e")
4026   (mouse-set-point e)
4027   (wl-summary-read))
4028
4029 (defun wl-summary-read ()
4030   "Proceed reading message in the summary buffer."
4031   (interactive)
4032   (let ((cur-buf (current-buffer)))
4033     (wl-summary-toggle-disp-msg 'on)
4034     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4035       (set-buffer cur-buf)
4036       (if (wl-message-next-page)
4037           (wl-summary-down t)))))
4038
4039 (defsubst wl-summary-cursor-move-surface (downward interactive)
4040   (if wl-summary-move-direction-toggle
4041       (setq wl-summary-move-direction-downward downward))
4042   (let ((start (point))
4043         (skip-tmark-regexp (wl-regexp-opt wl-summary-skip-mark-list))
4044         (skip t)
4045         (column (current-column))
4046         skip-pmark-regexp goto-next next-entity finfo)
4047     (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
4048         ()
4049       (setq skip-pmark-regexp
4050             (wl-regexp-opt (list " "
4051                                  elmo-msgdb-unread-cached-mark
4052                                  elmo-msgdb-important-mark))))
4053     (beginning-of-line)
4054     (let (case-fold-search)
4055       (while (and skip
4056                   (not (if downward (eobp) (bobp))))
4057         (if downward
4058             (forward-line 1)
4059           (forward-line -1))
4060         (setq skip (or (string-match skip-tmark-regexp
4061                                      (save-excursion
4062                                        (wl-summary-temp-mark)))
4063                        (and skip-pmark-regexp
4064                             (not (string-match
4065                                   skip-pmark-regexp
4066                                   (save-excursion
4067                                     (wl-summary-persistent-mark)))))))))
4068     (if (if downward (eobp) (and (bobp) skip)) (setq goto-next t))
4069     (if (or (eobp) (and (bobp) skip))
4070         (goto-char start))
4071     (move-to-column column)
4072
4073     (if (not goto-next)
4074         (if wl-summary-buffer-disp-msg
4075             (wl-summary-redisplay))
4076       (if interactive
4077           (cond
4078            ((and (not downward) wl-summary-buffer-prev-folder-function)
4079             (funcall wl-summary-buffer-prev-folder-function))
4080            ((and downward wl-summary-buffer-next-folder-function)
4081             (funcall wl-summary-buffer-next-folder-function))
4082            (t
4083             (when wl-auto-select-next
4084               (setq next-entity
4085                     (if downward
4086                         (wl-summary-get-next-folder)
4087                       (wl-summary-get-prev-folder)))
4088               (if next-entity
4089                   (setq finfo (wl-folder-get-entity-info next-entity))))
4090             (wl-ask-folder
4091              '(lambda () (wl-summary-next-folder-or-exit next-entity))
4092              (format
4093               "No more messages. Type SPC to go to %s."
4094               (wl-summary-entity-info-msg next-entity finfo)))))))))
4095
4096 (defun wl-summary-prev (&optional interactive)
4097   (interactive)
4098   (wl-summary-cursor-move-surface nil (or interactive (interactive-p))))
4099
4100 (defun wl-summary-next (&optional interactive)
4101   (interactive)
4102   (wl-summary-cursor-move-surface t (or interactive (interactive-p))))
4103
4104 (defun wl-summary-up (&optional interactive skip-no-unread)
4105   ""
4106   (interactive)
4107   (if wl-summary-move-direction-toggle
4108       (setq wl-summary-move-direction-downward nil))
4109   (if (wl-summary-cursor-up)
4110       (if wl-summary-buffer-disp-msg
4111           (wl-summary-redisplay))
4112     (if (or interactive
4113             (interactive-p))
4114         (if wl-summary-buffer-prev-folder-function
4115             (funcall wl-summary-buffer-prev-folder-function)
4116           (let (next-entity finfo)
4117             (when wl-auto-select-next
4118               (progn
4119                 (setq next-entity (wl-summary-get-prev-unread-folder))
4120                 (if next-entity
4121                     (setq finfo (wl-folder-get-entity-info next-entity)))))
4122             (if (and skip-no-unread
4123                      (eq wl-auto-select-next 'skip-no-unread))
4124                 (wl-summary-next-folder-or-exit next-entity t)
4125               (wl-ask-folder
4126                '(lambda () (wl-summary-next-folder-or-exit next-entity t))
4127                (format
4128                 "No more unread messages. Type SPC to go to %s."
4129                 (wl-summary-entity-info-msg next-entity finfo)))))))))
4130
4131 (defun wl-summary-get-prev-folder ()
4132   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4133         last-entity cur-id)
4134     (when folder-buf
4135       (setq cur-id (save-excursion (set-buffer folder-buf)
4136                                    wl-folder-buffer-cur-entity-id))
4137       (wl-folder-get-prev-folder cur-id))))
4138
4139 (defun wl-summary-get-next-folder ()
4140   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4141         cur-id)
4142     (when folder-buf
4143       (setq cur-id (save-excursion (set-buffer folder-buf)
4144                                    wl-folder-buffer-cur-entity-id))
4145       (wl-folder-get-next-folder cur-id))))
4146
4147 (defun wl-summary-get-next-unread-folder ()
4148   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4149         cur-id)
4150     (when folder-buf
4151       (setq cur-id (save-excursion (set-buffer folder-buf)
4152                                    wl-folder-buffer-cur-entity-id))
4153       (wl-folder-get-next-folder cur-id 'unread))))
4154
4155 (defun wl-summary-get-prev-unread-folder ()
4156   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4157         cur-id)
4158     (when folder-buf
4159       (setq cur-id (save-excursion (set-buffer folder-buf)
4160                                    wl-folder-buffer-cur-entity-id))
4161       (wl-folder-get-prev-folder cur-id 'unread))))
4162
4163 (defun wl-summary-down (&optional interactive skip-no-unread)
4164   (interactive)
4165   (if wl-summary-move-direction-toggle
4166       (setq wl-summary-move-direction-downward t))
4167   (if (wl-summary-cursor-down)
4168       (if wl-summary-buffer-disp-msg
4169           (wl-summary-redisplay))
4170     (if (or interactive
4171             (interactive-p))
4172         (if wl-summary-buffer-next-folder-function
4173             (funcall wl-summary-buffer-next-folder-function)
4174           (let (next-entity finfo)
4175             (when wl-auto-select-next
4176               (setq next-entity (wl-summary-get-next-unread-folder)))
4177             (if next-entity
4178                 (setq finfo (wl-folder-get-entity-info next-entity)))
4179             (if (and skip-no-unread
4180                      (eq wl-auto-select-next 'skip-no-unread))
4181                 (wl-summary-next-folder-or-exit next-entity)
4182               (wl-ask-folder
4183                '(lambda () (wl-summary-next-folder-or-exit next-entity))
4184                (format
4185                 "No more unread messages. Type SPC to go to %s."
4186                 (wl-summary-entity-info-msg next-entity finfo)))))))))
4187
4188 (defun wl-summary-goto-last-displayed-msg ()
4189   (interactive)
4190   (unless wl-summary-buffer-last-displayed-msg
4191     (setq wl-summary-buffer-last-displayed-msg
4192           wl-summary-buffer-current-msg))
4193   (if wl-summary-buffer-last-displayed-msg
4194       (progn
4195         (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
4196         (if wl-summary-buffer-disp-msg
4197             (wl-summary-redisplay)))
4198     (message "No last message.")))
4199
4200 (defun wl-summary-redisplay (&optional arg)
4201   (interactive "P")
4202   (if (and (not arg)
4203            (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
4204       (wl-summary-redisplay-no-mime)
4205     (wl-summary-redisplay-internal nil nil arg)))
4206
4207 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
4208   (interactive)
4209   (let* ((folder (or folder wl-summary-buffer-elmo-folder))
4210          (num (or number (wl-summary-message-number)))
4211          (wl-mime-charset      wl-summary-buffer-mime-charset)
4212          (default-mime-charset wl-summary-buffer-mime-charset)
4213          no-folder-mark fld-buf fld-win thr-entity)
4214     (if (and wl-thread-open-reading-thread
4215              (eq wl-summary-buffer-view 'thread)
4216              (not (wl-thread-entity-get-opened
4217                    (setq thr-entity (wl-thread-get-entity
4218                                      num))))
4219              (wl-thread-entity-get-children thr-entity))
4220         (wl-thread-force-open))
4221     (if num
4222         (progn
4223           (setq wl-summary-buffer-disp-msg t)
4224           (setq wl-summary-buffer-last-displayed-msg
4225                 wl-summary-buffer-current-msg)
4226           ;; hide folder window
4227           (if (and (not wl-stay-folder-window)
4228                    (setq fld-buf (get-buffer wl-folder-buffer-name)))
4229               (if (setq fld-win (get-buffer-window fld-buf))
4230                   (delete-window fld-win)))
4231           (setq wl-current-summary-buffer (current-buffer))
4232           (setq no-folder-mark
4233                 ;; If cache is used, change folder-mark.
4234                 (if (wl-message-redisplay folder num
4235                                           'mime
4236                                           (or
4237                                            force-reload
4238                                            (string= (elmo-folder-name-internal
4239                                                      folder)
4240                                                     wl-draft-folder)))
4241                     nil
4242                   ;; plugged, then leave folder-mark.
4243                   (if (and (not (elmo-folder-local-p
4244                                  wl-summary-buffer-elmo-folder))
4245                            (elmo-folder-plugged-p
4246                             wl-summary-buffer-elmo-folder))
4247                       'leave)))
4248           (when (elmo-message-use-cache-p folder num)
4249             (elmo-message-set-cached folder num t))
4250           (if (member (elmo-message-mark wl-summary-buffer-elmo-folder
4251                                          num)
4252                       (elmo-msgdb-unread-marks))
4253               (wl-summary-mark-as-read num no-folder-mark)
4254             (wl-summary-update-mark))
4255           (setq wl-summary-buffer-current-msg num)
4256           (when wl-summary-recenter
4257             (recenter (/ (- (window-height) 2) 2))
4258             (if (not wl-summary-indent-length-limit)
4259                 (wl-horizontal-recenter)))
4260           (wl-highlight-summary-displaying)
4261           (wl-message-buffer-prefetch-next folder num
4262                                            wl-message-buffer-prefetch-depth
4263                                            (current-buffer)
4264                                            wl-summary-buffer-mime-charset)
4265           (run-hooks 'wl-summary-redisplay-hook))
4266       (message "No message to display."))))
4267
4268 (defun wl-summary-redisplay-no-mime (&optional ask-coding)
4269   "Display message without MIME decoding.
4270 If ASK-CODING is non-nil, coding-system for the message is asked."
4271   (interactive "P")
4272   (let ((elmo-mime-display-as-is-coding-system
4273          (if ask-coding
4274              (or (read-coding-system "Coding system: ")
4275                  elmo-mime-display-as-is-coding-system)
4276            elmo-mime-display-as-is-coding-system)))
4277     (wl-summary-redisplay-no-mime-internal)))
4278
4279 (defun wl-summary-redisplay-no-mime-internal (&optional folder number)
4280   (let* ((fld (or folder wl-summary-buffer-elmo-folder))
4281          (num (or number (wl-summary-message-number)))
4282          wl-break-pages)
4283     (if num
4284         (progn
4285           (setq wl-summary-buffer-disp-msg t)
4286           (setq wl-summary-buffer-last-displayed-msg
4287                 wl-summary-buffer-current-msg)
4288           (setq wl-current-summary-buffer (current-buffer))
4289           (wl-message-redisplay fld num 'as-is
4290                                 (string= (elmo-folder-name-internal fld)
4291                                          wl-draft-folder))
4292           (wl-summary-mark-as-read num)
4293           (setq wl-summary-buffer-current-msg num)
4294           (when wl-summary-recenter
4295             (recenter (/ (- (window-height) 2) 2))
4296             (if (not wl-summary-indent-length-limit)
4297                 (wl-horizontal-recenter)))
4298           (wl-highlight-summary-displaying)
4299           (run-hooks 'wl-summary-redisplay-hook))
4300       (message "No message to display.")
4301       (wl-ask-folder 'wl-summary-exit
4302                      "No more messages. Type SPC to go to folder mode."))))
4303
4304 (defun wl-summary-redisplay-all-header (&optional folder number)
4305   (interactive)
4306   (let* ((fld (or folder wl-summary-buffer-elmo-folder))
4307          (num (or number (wl-summary-message-number)))
4308          (wl-mime-charset      wl-summary-buffer-mime-charset)
4309          (default-mime-charset wl-summary-buffer-mime-charset))
4310     (if num
4311         (progn
4312           (setq wl-summary-buffer-disp-msg t)
4313           (setq wl-summary-buffer-last-displayed-msg
4314                 wl-summary-buffer-current-msg)
4315           (setq wl-current-summary-buffer (current-buffer))
4316           (if (wl-message-redisplay fld num 'all-header
4317                                     (string= (elmo-folder-name-internal fld)
4318                                              wl-draft-folder))
4319               (wl-summary-mark-as-read num))
4320           (setq wl-summary-buffer-current-msg num)
4321           (when wl-summary-recenter
4322             (recenter (/ (- (window-height) 2) 2))
4323             (if (not wl-summary-indent-length-limit)
4324                 (wl-horizontal-recenter)))
4325           (wl-highlight-summary-displaying)
4326           (run-hooks 'wl-summary-redisplay-hook))
4327       (message "No message to display."))))
4328
4329 (defun wl-summary-jump-to-current-message ()
4330   "Jump into Message buffer."
4331   (interactive)
4332   (let (message-buf message-win)
4333     (if (setq message-buf wl-message-buffer)
4334         (if (setq message-win (get-buffer-window message-buf))
4335             (select-window message-win)
4336           (wl-message-select-buffer wl-message-buffer))
4337       (wl-summary-redisplay)
4338       (wl-message-select-buffer wl-message-buffer))))
4339
4340 (defun wl-summary-cancel-message ()
4341   "Cancel an article on news."
4342   (interactive)
4343   (if (null (wl-summary-message-number))
4344       (message "No message.")
4345     (let ((summary-buf (current-buffer))
4346           message-buf)
4347       (wl-summary-set-message-buffer-or-redisplay)
4348       (if (setq message-buf (wl-message-get-original-buffer))
4349           (set-buffer message-buf))
4350       (unless (wl-message-news-p)
4351         (set-buffer summary-buf)
4352         (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
4353                      'nntp)
4354                  (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
4355             (progn
4356               (wl-summary-redisplay t)
4357               (wl-summary-supersedes-message))
4358           (error "This is not a news article; supersedes is impossible")))
4359       (when (yes-or-no-p "Do you really want to cancel this article? ")
4360         (let (from newsgroups message-id distribution buf)
4361           (save-excursion
4362             (setq from (std11-field-body "from")
4363                   newsgroups (std11-field-body "newsgroups")
4364                   message-id (std11-field-body "message-id")
4365                   distribution (std11-field-body "distribution"))
4366             ;; Make sure that this article was written by the user.
4367             (unless (wl-address-user-mail-address-p
4368                      (wl-address-header-extract-address
4369                       (car (wl-parse-addresses from))))
4370               (error "This article is not yours"))
4371             ;; Make control message.
4372             (setq buf (set-buffer (get-buffer-create " *message cancel*")))
4373             (setq wl-draft-buffer-cur-summary-buffer summary-buf)
4374             (buffer-disable-undo (current-buffer))
4375             (erase-buffer)
4376             (insert "Newsgroups: " newsgroups "\n"
4377                     "From: " (wl-address-header-extract-address
4378                               wl-from) "\n"
4379                               "Subject: cmsg cancel " message-id "\n"
4380                               "Control: cancel " message-id "\n"
4381                               (if distribution
4382                                   (concat "Distribution: " distribution "\n")
4383                                 "")
4384                               mail-header-separator "\n"
4385                               wl-summary-cancel-message)
4386             (message "Canceling your message...")
4387             (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
4388             (message "Canceling your message...done")))))))
4389
4390 (defun wl-summary-supersedes-message ()
4391   "Supersede current message."
4392   (interactive)
4393   (wl-summary-toggle-disp-msg 'off)
4394   (let ((summary-buf (current-buffer))
4395         message-buf from)
4396     (wl-summary-set-message-buffer-or-redisplay)
4397     (if (setq message-buf (wl-message-get-original-buffer))
4398         (set-buffer message-buf))
4399     (unless (wl-message-news-p)
4400       (set-buffer summary-buf)
4401       (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
4402                    'nntp)
4403                (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
4404           (progn
4405             (wl-summary-redisplay t)
4406             (wl-summary-supersedes-message))
4407         (error "This is not a news article; supersedes is impossible")))
4408     (save-excursion
4409       (setq from (std11-field-body "from"))
4410       ;; Make sure that this article was written by the user.
4411       (unless (wl-address-user-mail-address-p
4412                (wl-address-header-extract-address
4413                 (car (wl-parse-addresses from))))
4414         (error "This article is not yours"))
4415       (let* ((message-id (std11-field-body "message-id"))
4416              (followup-to (std11-field-body "followup-to"))
4417              (mail-default-headers
4418               (concat mail-default-headers
4419                       "Supersedes: " message-id "\n"
4420                       (and followup-to
4421                            (concat "Followup-To: " followup-to "\n")))))
4422         (if message-buf (set-buffer message-buf))
4423         (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
4424
4425 (defun wl-summary-save (&optional arg wl-save-dir)
4426   "Save current message to disk."
4427   (interactive)
4428   (let ((filename)
4429         (num (wl-summary-message-number)))
4430     (if (null wl-save-dir)
4431         (setq wl-save-dir wl-temporary-file-directory))
4432     (if num
4433         (save-excursion
4434           (setq filename (expand-file-name
4435                           (int-to-string num)
4436                           wl-save-dir))
4437           (if (null (and arg
4438                          (null (file-exists-p filename))))
4439               (setq filename
4440                     (read-file-name "Save to file: " filename)))
4441
4442           (wl-summary-set-message-buffer-or-redisplay)
4443           (set-buffer (wl-message-get-original-buffer))
4444           (if (and (null arg) (file-exists-p filename))
4445               (if (y-or-n-p "File already exists.  override it? ")
4446                   (write-region (point-min) (point-max) filename))
4447             (write-region (point-min) (point-max) filename)))
4448       (message "No message to save."))
4449     num))
4450
4451 (defun wl-summary-save-region (beg end)
4452   (interactive "r")
4453   (save-excursion
4454     (save-restriction
4455       (narrow-to-region beg end)
4456       (goto-char (point-min))
4457       (let ((wl-save-dir
4458              (wl-read-directory-name "Save to directory: "
4459                                      wl-temporary-file-directory)))
4460         (if (null (file-exists-p wl-save-dir))
4461             (make-directory wl-save-dir))
4462         (if (eq wl-summary-buffer-view 'thread)
4463             (progn
4464               (while (not (eobp))
4465                 (let* ((number (wl-summary-message-number))
4466                        (entity (wl-thread-get-entity number)))
4467                   (if (wl-thread-entity-get-opened entity)
4468                       (wl-summary-save t wl-save-dir)
4469                     ;; closed
4470                     (wl-summary-save t wl-save-dir))
4471                   (forward-line 1))))
4472           (while (not (eobp))
4473             (wl-summary-save t wl-save-dir)
4474             (forward-line 1)))))))
4475
4476 ;; mew-summary-pipe-message()
4477 (defun wl-summary-pipe-message (prefix command)
4478   "Send this message via pipe."
4479   (interactive (list current-prefix-arg nil))
4480   (if (null (wl-summary-message-number))
4481       (message "No message.")
4482     (setq command (read-string "Shell command on message: "
4483                                wl-summary-shell-command-last))
4484     (if (y-or-n-p "Send this message to pipe? ")
4485         (wl-summary-pipe-message-subr prefix command))))
4486
4487 (defun wl-summary-target-mark-pipe (prefix command)
4488   "Send each marked messages via pipe."
4489   (interactive (list current-prefix-arg nil))
4490   (if (null wl-summary-buffer-target-mark-list)
4491       (message "No marked message.")
4492     (setq command (read-string "Shell command on each marked message: "
4493                                wl-summary-shell-command-last))
4494     (when (y-or-n-p "Send each marked message to pipe? ")
4495       (while (car wl-summary-buffer-target-mark-list)
4496         (let ((num (car wl-summary-buffer-target-mark-list)))
4497           (wl-thread-jump-to-msg num)
4498           (wl-summary-pipe-message-subr prefix command)
4499           (wl-summary-unmark num))))))
4500
4501 (defun wl-summary-pipe-message-subr (prefix command)
4502   (save-excursion
4503     (wl-summary-set-message-buffer-or-redisplay)
4504     (set-buffer (wl-message-get-original-buffer))
4505     (if (string= command "")
4506         (setq command wl-summary-shell-command-last))
4507     (goto-char (point-min)) ; perhaps this line won't be necessary
4508     (if prefix
4509         (search-forward "\n\n"))
4510     (shell-command-on-region (point) (point-max) command nil)
4511     (setq wl-summary-shell-command-last command)))
4512
4513 (defun wl-summary-print-message (&optional arg)
4514   (interactive "P")
4515   (if (null (wl-summary-message-number))
4516       (message "No message.")
4517     (save-excursion
4518       (wl-summary-set-message-buffer-or-redisplay)
4519       (if (or (not (interactive-p))
4520               (y-or-n-p "Print ok? "))
4521           (progn
4522             (let ((buffer (generate-new-buffer " *print*")))
4523               (copy-to-buffer buffer (point-min) (point-max))
4524               (set-buffer buffer)
4525               (funcall wl-print-buffer-function)
4526               (kill-buffer buffer)))
4527         (message "")))))
4528
4529 (defun wl-summary-print-message-with-ps-print (&optional filename)
4530   "Print message via ps-print."
4531   (interactive)
4532   (if (null (wl-summary-message-number))
4533       (message "No message.")
4534     (setq filename (ps-print-preprint current-prefix-arg))
4535     (if (or (not (interactive-p))
4536             (y-or-n-p "Print ok? "))
4537         (let ((summary-buffer (current-buffer))
4538               wl-break-pages)
4539           (save-excursion
4540             (wl-summary-set-message-buffer-or-redisplay)
4541             ;; (wl-summary-redisplay-internal)
4542             (let* ((buffer (generate-new-buffer " *print*"))
4543                    (entity (progn
4544                              (set-buffer summary-buffer)
4545                              (elmo-message-entity
4546                               wl-summary-buffer-elmo-folder
4547                               (wl-summary-message-number))))
4548                    (wl-ps-subject
4549                     (and entity
4550                          (or (elmo-msgdb-overview-entity-get-subject entity)
4551                              "")))
4552                    (wl-ps-from
4553                     (and entity
4554                          (or (elmo-msgdb-overview-entity-get-from entity) "")))
4555                    (wl-ps-date
4556                     (and entity
4557                          (or (elmo-msgdb-overview-entity-get-date entity) ""))))
4558               (run-hooks 'wl-ps-preprint-hook)
4559               (set-buffer wl-message-buffer)
4560               (copy-to-buffer buffer (point-min) (point-max))
4561               (set-buffer buffer)
4562               (unwind-protect
4563                   (let ((ps-left-header
4564                          (list (concat "(" wl-ps-subject ")")
4565                                (concat "(" wl-ps-from ")")))
4566                         (ps-right-header
4567                          (list "/pagenumberstring load"
4568                                (concat "(" wl-ps-date ")"))))
4569                     (run-hooks 'wl-ps-print-hook)
4570                     (funcall wl-ps-print-buffer-function filename))
4571                 (kill-buffer buffer)))))
4572       (message ""))))
4573
4574 (if (featurep 'ps-print) ; ps-print is available.
4575     (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
4576
4577 (defun wl-summary-target-mark-print ()
4578   (interactive)
4579   (if (null wl-summary-buffer-target-mark-list)
4580       (message "No marked message.")
4581     (when (y-or-n-p "Print all marked messages. OK? ")
4582       (while (car wl-summary-buffer-target-mark-list)
4583         (let ((num (car wl-summary-buffer-target-mark-list)))
4584           (wl-thread-jump-to-msg num)
4585           (wl-summary-print-message)
4586           (wl-summary-unmark num))))))
4587
4588 (defun wl-summary-folder-info-update ()
4589   (wl-folder-set-folder-updated
4590    (elmo-string (wl-summary-buffer-folder-name))
4591    (list 0
4592          (+ wl-summary-buffer-unread-count
4593             wl-summary-buffer-new-count)
4594          (elmo-folder-length
4595           wl-summary-buffer-elmo-folder))))
4596
4597 (defun wl-summary-get-original-buffer ()
4598   "Get original buffer for the current summary."
4599   (save-excursion
4600     (wl-summary-set-message-buffer-or-redisplay)
4601     (wl-message-get-original-buffer)))
4602
4603 (defun wl-summary-pack-number (&optional arg)
4604   (interactive "P")
4605   (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
4606   (let (wl-use-scoring)
4607     (wl-summary-rescan)))
4608
4609 (defun wl-summary-target-mark-uudecode ()
4610   (interactive)
4611   (let ((mlist (reverse wl-summary-buffer-target-mark-list))
4612         (summary-buf (current-buffer))
4613         (tmp-buf (get-buffer-create "*WL UUENCODE*"))
4614         orig-buf i k filename rc errmsg)
4615     (setq i 1)
4616     (setq k (length mlist))
4617     (set-buffer tmp-buf)
4618     (erase-buffer)
4619     (save-window-excursion
4620       (while mlist
4621         (set-buffer summary-buf)
4622         (wl-summary-jump-to-msg (car mlist))
4623         (wl-summary-redisplay)
4624         (set-buffer (setq orig-buf (wl-summary-get-original-buffer)))
4625         (goto-char (point-min))
4626         (cond ((= i 1) ; first
4627                (if (setq filename (wl-message-uu-substring
4628                                    orig-buf tmp-buf t
4629                                    (= i k)))
4630                    nil
4631                  (error "Can't find begin line")))
4632               ((< i k)
4633                (wl-message-uu-substring orig-buf tmp-buf))
4634               (t ; last
4635                (wl-message-uu-substring orig-buf tmp-buf nil t)))
4636         (setq i (1+ i))
4637         (setq mlist (cdr mlist)))
4638       (set-buffer tmp-buf)
4639       (message "Exec %s..." wl-prog-uudecode)
4640       (unwind-protect
4641           (let ((decode-dir wl-temporary-file-directory))
4642             (if (not wl-prog-uudecode-no-stdout-option)
4643                 (setq filename (read-file-name "Save to file: "
4644                                                (expand-file-name
4645                                                 (elmo-safe-filename filename)
4646                                                 wl-temporary-file-directory)))
4647               (setq decode-dir
4648                     (wl-read-directory-name "Save to directory: "
4649                                             wl-temporary-file-directory))
4650               (setq filename (expand-file-name filename decode-dir)))
4651             (if (file-exists-p filename)
4652                 (or (yes-or-no-p (format "File %s exists. Save anyway? "
4653                                          filename))
4654                     (error "")))
4655             (elmo-bind-directory
4656              decode-dir
4657              (setq rc
4658                    (as-binary-process
4659                     (apply 'call-process-region (point-min) (point-max)
4660                            wl-prog-uudecode t (current-buffer) nil
4661                            wl-prog-uudecode-arg))))
4662             (when (not (= 0 rc))
4663               (setq errmsg (buffer-substring (point-min)(point-max)))
4664               (error "Uudecode error: %s" errmsg))
4665             (if (not wl-prog-uudecode-no-stdout-option)
4666                 (let (file-name-handler-alist) ;; void jka-compr
4667                   (as-binary-output-file
4668                    (write-region (point-min) (point-max)
4669                                  filename nil 'no-msg))))
4670             (save-excursion
4671               (set-buffer summary-buf)
4672               (wl-summary-delete-all-temp-marks))
4673             (if (file-exists-p filename)
4674                 (message "Saved as %s" filename)))
4675         (kill-buffer tmp-buf)))))
4676
4677 ;; Someday
4678 ;; (defun wl-summary-drop-unsync ()
4679 ;;   "Drop all unsync messages."
4680 ;;   (interactive)
4681 ;;   (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
4682 ;;       (error "You cannot drop unsync messages in this folder"))
4683 ;;   (if (or (not (interactive-p))
4684 ;;        (y-or-n-p "Drop all unsync messages? "))
4685 ;;       (let* ((folder-list (elmo-folder-get-primitive-folder-list
4686 ;;                         (wl-summary-buffer-folder-name)))
4687 ;;           (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
4688 ;;           (sum 0)
4689 ;;           (multi-num 0)
4690 ;;           pair)
4691 ;;      (message "Dropping...")
4692 ;;      (while folder-list
4693 ;;        (setq pair (elmo-folder-message-numbers (car folder-list)))
4694 ;;        (when is-multi ;; dirty hack...
4695 ;;          (incf multi-num)
4696 ;;          (setcar pair (+ (* multi-num elmo-multi-divide-number)
4697 ;;                          (car pair))))
4698 ;;        (elmo-msgdb-set-number-alist
4699 ;;         (wl-summary-buffer-msgdb)
4700 ;;         (nconc
4701 ;;          (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
4702 ;;          (list (cons (car pair) nil))))
4703 ;;        (setq sum (+ sum (cdr pair)))
4704 ;;        (setq folder-list (cdr folder-list)))
4705 ;;      (wl-summary-set-message-modified)
4706 ;;      (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
4707 ;;                                    (list 0
4708 ;;                                          (+ wl-summary-buffer-unread-count
4709 ;;                                             wl-summary-buffer-new-count)
4710 ;;                                          sum))
4711 ;;      (message "Dropping...done"))))
4712
4713 (defun wl-summary-default-get-next-msg (msg)
4714   (or (wl-summary-next-message msg
4715                                (if wl-summary-move-direction-downward 'down
4716                                  'up)
4717                                nil)
4718       (cadr (memq msg (if wl-summary-move-direction-downward
4719                           wl-summary-buffer-number-list
4720                         (reverse wl-summary-buffer-number-list))))))
4721
4722 (defun wl-summary-save-current-message ()
4723   "Save current message for `wl-summary-yank-saved-message'."
4724   (interactive)
4725   (let ((number (wl-summary-message-number)))
4726     (setq wl-summary-buffer-saved-message number)
4727     (and number (message "No: %s is saved." number))))
4728
4729 (defun wl-summary-yank-saved-message ()
4730   "Set current message as a parent of the saved message."
4731   (interactive)
4732   (if wl-summary-buffer-saved-message
4733       (let ((number (wl-summary-message-number)))
4734         (if (eq wl-summary-buffer-saved-message number)
4735             (message "Cannot set itself as a parent.")
4736           (save-excursion
4737             (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
4738             (wl-thread-set-parent number)
4739             (wl-summary-set-thread-modified))
4740           (setq  wl-summary-buffer-saved-message nil)))
4741     (message "There's no saved message.")))
4742
4743 (require 'product)
4744 (product-provide (provide 'wl-summary) (require 'wl-version))
4745
4746 ;;; wl-summary.el ends here