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