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