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