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