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