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