wl/wl-summary.el

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