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