wl/wl-summary.el

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