wl/wl-summary.el

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