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