wl/wl-summary.el

   1 ;;; wl-summary.el -- Summary mode for Wanderlust.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
   5 ;; Copyright (C) 1999,2000      TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
   6 ;; Copyright (C) 1999,2000      Kenichi OKADA <okada@opaopa.org>
   7
   8 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   9 ;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
  10 ;;      TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
  11 ;;      Kenichi OKADA <okada@opaopa.org>
  12 ;; Keywords: mail, net news
  13
  14 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  15
  16 ;; This program is free software; you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation; either version 2, or (at your option)
  19 ;; any later version.
  20 ;;
  21 ;; This program is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25 ;;
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  29 ;; Boston, MA 02111-1307, USA.
  30 ;;
  31
  32 ;;; Commentary:
  33 ;;
  34
  35 ;;; Code:
  36 ;;
  37
  38 (require 'elmo)
  39 (require 'elmo-multi)
  40 (require 'wl-message)
  41 (require 'wl-vars)
  42 (require 'wl-highlight)
  43 (require 'wl-refile)
  44 (require 'wl-util)
  45 (condition-case nil (require 'timezone) (error nil))
  46 (condition-case nil (require 'easymenu) (error nil))
  47 (require 'elmo-date)
  48 (condition-case nil (require 'ps-print) (error nil))
  49
  50 (eval-when-compile
  51   (require 'cl)
  52   (condition-case () (require 'timer) (error nil))
  53   (defalias-maybe 'ps-print-buffer-with-faces 'ignore)
  54   (defalias-maybe 'elmo-database-msgid-put 'ignore)
  55   (defalias-maybe 'elmo-database-close 'ignore)
  56   (defalias-maybe 'elmo-database-msgid-get 'ignore)
  57   (defalias-maybe 'run-with-idle-timer 'ignore)
  58   (defalias-maybe 'ps-print-preprint 'ignore))
  59
  60 (defvar dragdrop-drop-functions)
  61 (defvar scrollbar-height)
  62 (defvar mail-reply-buffer)
  63
  64 (defvar wl-summary-buffer-name "Summary")
  65 (defvar wl-summary-mode-map nil)
  66 (defvar wl-current-summary-buffer nil)
  67
  68 (defvar wl-summary-buffer-elmo-folder nil)
  69
  70 (defmacro wl-summary-buffer-folder-name ()
  71   (` (and wl-summary-buffer-elmo-folder
  72           (elmo-folder-name-internal wl-summary-buffer-elmo-folder))))
  73
  74 (defmacro wl-summary-buffer-msgdb ()
  75   (` (and wl-summary-buffer-elmo-folder
  76           (elmo-folder-msgdb wl-summary-buffer-elmo-folder))))
  77
  78 (defvar wl-summary-buffer-folder-indicator nil)
  79 (defvar wl-summary-buffer-disp-msg    nil)
  80 (defvar wl-summary-buffer-disp-folder nil)
  81 (defvar wl-summary-buffer-refile-list nil)
  82 (defvar wl-summary-buffer-delete-list nil)
  83 (defvar wl-summary-buffer-last-displayed-msg nil)
  84 (defvar wl-summary-buffer-current-msg nil)
  85 (defvar wl-summary-buffer-unread-status " (0 new/0 unread)")
  86 (defvar wl-summary-buffer-unread-count 0)
  87 (defvar wl-summary-buffer-new-count    0)
  88 (defvar wl-summary-buffer-mime-charset  nil)
  89 (defvar wl-summary-buffer-weekday-name-lang  nil)
  90 (defvar wl-summary-buffer-thread-indent-set-alist  nil)
  91 (defvar wl-summary-buffer-view 'thread)
  92 (defvar wl-summary-buffer-message-modified nil)
  93 (defvar wl-summary-buffer-mark-modified nil)
  94 (defvar wl-summary-buffer-thread-modified nil)
  95 (defvar wl-summary-buffer-number-column nil)
  96 (defvar wl-summary-buffer-number-regexp nil)
  97 (defvar wl-summary-buffer-persistent nil)
  98 (defvar wl-summary-buffer-thread-nodes nil)
  99 (defvar wl-summary-buffer-target-mark-list nil)
 100 (defvar wl-summary-buffer-copy-list nil)
 101 (defvar wl-summary-buffer-prev-refile-destination nil)
 102 (defvar wl-summary-buffer-prev-copy-destination nil)
 103 (defvar wl-summary-buffer-saved-message nil)
 104 (defvar wl-summary-buffer-prev-folder-function nil)
 105 (defvar wl-summary-buffer-next-folder-function nil)
 106 (defvar wl-summary-buffer-exit-function nil)
 107 (defvar wl-summary-buffer-number-list nil)
 108 (defvar wl-summary-buffer-msgdb nil)
 109 (defvar wl-summary-buffer-folder-name nil)
 110
 111 (defvar wl-thread-indent-level-internal nil)
 112 (defvar wl-thread-have-younger-brother-str-internal nil)
 113 (defvar wl-thread-youngest-child-str-internal nil)
 114 (defvar wl-thread-vertical-str-internal nil)
 115 (defvar wl-thread-horizontal-str-internal nil)
 116 (defvar wl-thread-space-str-internal nil)
 117 (defvar wl-summary-last-visited-folder nil)
 118 (defvar wl-read-folder-hist nil)
 119 (defvar wl-summary-scored nil)
 120 (defvar wl-crosspost-alist-modified nil)
 121 (defvar wl-summary-alike-hashtb nil)
 122 (defvar wl-summary-search-buf-name " *wl-search-subject*")
 123 (defvar wl-summary-delayed-update nil)
 124 (defvar wl-summary-search-buf-folder-name nil)
 125
 126 (defvar wl-summary-get-petname-function 'wl-address-get-petname-1)
 127
 128 (defvar wl-summary-message-regexp "^ *\\([0-9-]+\\)")
 129
 130 (defvar wl-summary-shell-command-last "")
 131
 132 (defvar wl-ps-preprint-hook nil)
 133 (defvar wl-ps-print-hook nil)
 134
 135 (make-variable-buffer-local 'wl-summary-buffer-elmo-folder)
 136 (make-variable-buffer-local 'wl-summary-search-buf-folder-name)
 137 (make-variable-buffer-local 'wl-summary-buffer-disp-msg)
 138 (make-variable-buffer-local 'wl-summary-buffer-disp-folder)
 139 (make-variable-buffer-local 'wl-summary-buffer-refile-list)
 140 (make-variable-buffer-local 'wl-summary-buffer-copy-list)
 141 (make-variable-buffer-local 'wl-summary-buffer-target-mark-list)
 142 (make-variable-buffer-local 'wl-summary-buffer-delete-list)
 143 (make-variable-buffer-local 'wl-summary-buffer-folder-indicator)
 144 (make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg)
 145 (make-variable-buffer-local 'wl-summary-buffer-unread-status)
 146 (make-variable-buffer-local 'wl-summary-buffer-unread-count)
 147 (make-variable-buffer-local 'wl-summary-buffer-new-count)
 148 (make-variable-buffer-local 'wl-summary-buffer-mime-charset)
 149 (make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang)
 150 (make-variable-buffer-local 'wl-summary-buffer-thread-indent-set)
 151 (make-variable-buffer-local 'wl-summary-buffer-view)
 152 (make-variable-buffer-local 'wl-summary-buffer-message-modified)
 153 (make-variable-buffer-local 'wl-summary-buffer-mark-modified)
 154 (make-variable-buffer-local 'wl-summary-buffer-thread-modified)
 155 (make-variable-buffer-local 'wl-summary-buffer-number-column)
 156 (make-variable-buffer-local 'wl-summary-buffer-number-regexp)
 157 (make-variable-buffer-local 'wl-summary-buffer-persistent)
 158 (make-variable-buffer-local 'wl-summary-buffer-thread-nodes)
 159 (make-variable-buffer-local 'wl-summary-buffer-prev-refile-destination)
 160 (make-variable-buffer-local 'wl-summary-buffer-saved-message)
 161 (make-variable-buffer-local 'wl-summary-scored)
 162 (make-variable-buffer-local 'wl-summary-default-score)
 163 (make-variable-buffer-local 'wl-summary-move-direction-downward)
 164 (make-variable-buffer-local 'wl-summary-important-above)
 165 (make-variable-buffer-local 'wl-summary-target-above)
 166 (make-variable-buffer-local 'wl-summary-mark-below)
 167 (make-variable-buffer-local 'wl-summary-expunge-below)
 168 (make-variable-buffer-local 'wl-thread-indent-level-internal)
 169 (make-variable-buffer-local 'wl-thread-have-younger-brother-str-internal)
 170 (make-variable-buffer-local 'wl-thread-youngest-child-str-internal)
 171 (make-variable-buffer-local 'wl-thread-vertical-str-internal)
 172 (make-variable-buffer-local 'wl-thread-horizontal-str-internal)
 173 (make-variable-buffer-local 'wl-thread-space-str-internal)
 174 (make-variable-buffer-local 'wl-summary-buffer-prev-folder-function)
 175 (make-variable-buffer-local 'wl-summary-buffer-next-folder-function)
 176 (make-variable-buffer-local 'wl-summary-buffer-exit-function)
 177 (make-variable-buffer-local 'wl-summary-buffer-number-list)
 178 (make-variable-buffer-local 'wl-summary-buffer-msgdb)
 179 (make-variable-buffer-local 'wl-summary-buffer-folder-name)
 180
 181 ;; internal functions (dummy)
 182 (unless (fboundp 'wl-summary-append-message-func-internal)
 183   (defun wl-summary-append-message-func-internal (entity overview
 184                                                          mark-alist update
 185                                                          &optional force-insert)))
 186 (unless (fboundp 'wl-summary-from-func-internal)
 187   (defun wl-summary-from-func-internal (from)
 188     from))
 189 (unless (fboundp 'wl-summary-subject-func-internal)
 190   (defun wl-summary-subject-func-internal (subject)
 191     subject))
 192 (unless (fboundp 'wl-summary-subject-filter-func-internal)
 193   (defun wl-summary-subject-filter-func-internal (subject)
 194     subject))
 195
 196 (defmacro wl-summary-sticky-buffer-name (name)
 197   (` (concat wl-summary-buffer-name ":" (, name))))
 198
 199 (defun wl-summary-default-subject (subject-string)
 200   (if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string)
 201       (substring subject-string (match-end 0))
 202     subject-string))
 203
 204 (eval-when-compile (defvar-maybe entity nil)) ; silence byte compiler.
 205 (defun wl-summary-default-from (from)
 206   (let (retval tos ng)
 207     (unless
 208         (and (eq major-mode 'wl-summary-mode)
 209              (stringp wl-summary-showto-folder-regexp)
 210              (string-match wl-summary-showto-folder-regexp
 211                            (wl-summary-buffer-folder-name))
 212              (wl-address-user-mail-address-p from)
 213              (cond
 214               ((and (setq tos (elmo-msgdb-overview-entity-get-to entity))
 215                     (not (string= "" tos)))
 216                (setq retval
 217                      (concat "To:"
 218                              (mapconcat
 219                               (function
 220                                (lambda (to)
 221                                  (eword-decode-string
 222                                   (if wl-use-petname
 223                                       (or
 224                                        (funcall wl-summary-get-petname-function to)
 225                                        (car
 226                                         (std11-extract-address-components to))
 227                                        to)
 228                                     to))))
 229                               (wl-parse-addresses tos)
 230                               ","))))
 231               ((setq ng (elmo-msgdb-overview-entity-get-extra-field
 232                          entity "newsgroups"))
 233                (setq retval (concat "Ng:" ng)))))
 234       (if wl-use-petname
 235           (setq retval (or (funcall wl-summary-get-petname-function from)
 236                            (car (std11-extract-address-components from))
 237                            from))
 238         (setq retval from)))
 239     retval))
 240
 241 (defun wl-summary-simple-from (string)
 242   (if wl-use-petname
 243       (or (funcall wl-summary-get-petname-function string)
 244           (car (std11-extract-address-components string))
 245           string)
 246     string))
 247
 248 (defvar wl-summary-mode-menu-spec
 249   '("Summary"
 250     ["Read" wl-summary-read t]
 251     ["Prev page" wl-summary-prev-page t]
 252     ["Next page" wl-summary-next-page t]
 253     ["Top"       wl-summary-display-top t]
 254     ["Bottom"    wl-summary-display-bottom t]
 255     ["Prev"      wl-summary-prev t]
 256     ["Next"      wl-summary-next t]
 257     ["Up"        wl-summary-up t]
 258     ["Down"      wl-summary-down t]
 259     ["Parent message" wl-summary-jump-to-parent-message t]
 260     "----"
 261     ["Sync"            wl-summary-sync t]
 262     ["Execute"         wl-summary-exec t]
 263     ["Go to other folder" wl-summary-goto-folder t]
 264     ["Pick" wl-summary-pick t]
 265     ["Mark as read all" wl-summary-mark-as-read-all t]
 266     ["Unmark all"      wl-summary-unmark-all t]
 267     ["Toggle display message" wl-summary-toggle-disp-msg t]
 268     ["Display folder" wl-summary-toggle-disp-folder t]
 269     ["Toggle threading" wl-summary-toggle-thread t]
 270     ["Stick" wl-summary-stick t]
 271     ("Sort"
 272      ["By Number" wl-summary-sort-by-number t]
 273      ["By Date" wl-summary-sort-by-date t]
 274      ["By From" wl-summary-sort-by-from t]
 275      ["By Subject" wl-summary-sort-by-subject t])
 276     "----"
 277     ("Message Operation"
 278      ["Mark as read"    wl-summary-mark-as-read t]
 279      ["Mark as important" wl-summary-mark-as-important t]
 280      ["Mark as unread"   wl-summary-mark-as-unread t]
 281      ["Set delete mark" wl-summary-delete t]
 282      ["Set refile mark" wl-summary-refile t]
 283      ["Set copy mark"   wl-summary-copy t]
 284      ["Prefetch"        wl-summary-prefetch t]
 285      ["Set target mark" wl-summary-target-mark t]
 286      ["Unmark"          wl-summary-unmark t]
 287      ["Save"            wl-summary-save t]
 288      ["Cancel posted news" wl-summary-cancel-message t]
 289      ["Supersedes message" wl-summary-supersedes-message t]
 290      ["Resend bounced mail" wl-summary-resend-bounced-mail t]
 291      ["Resend message" wl-summary-resend-message t]
 292      ["Enter the message" wl-summary-jump-to-current-message t]
 293      ["Pipe message" wl-summary-pipe-message t]
 294      ["Print message" wl-summary-print-message t])
 295     ("Thread Operation"
 296      ["Open or Close" wl-thread-open-close (eq wl-summary-buffer-view 'thread)]
 297      ["Open all"     wl-thread-open-all (eq wl-summary-buffer-view 'thread)]
 298      ["Close all"    wl-thread-close-all (eq wl-summary-buffer-view 'thread)]
 299      ["Mark as read" wl-thread-mark-as-read (eq wl-summary-buffer-view 'thread)]
 300      ["Mark as important"       wl-thread-mark-as-important (eq wl-summary-buffer-view 'thread)]
 301      ["Mark as unread"          wl-thread-mark-as-unread (eq wl-summary-buffer-view 'thread)]
 302      ["Set delete mark"  wl-thread-delete (eq wl-summary-buffer-view 'thread)]
 303      ["Set refile mark"  wl-thread-refile (eq wl-summary-buffer-view 'thread)]
 304      ["Set copy mark"    wl-thread-copy (eq wl-summary-buffer-view 'thread)]
 305      ["Prefetch"     wl-thread-prefetch (eq wl-summary-buffer-view 'thread)]
 306      ["Set target mark"        wl-thread-target-mark (eq wl-summary-buffer-view 'thread)]
 307      ["Unmark"      wl-thread-unmark (eq wl-summary-buffer-view 'thread)]
 308      ["Save"            wl-thread-save (eq wl-summary-buffer-view 'thread)]
 309      ["Execute"      wl-thread-exec (eq wl-summary-buffer-view 'thread)])
 310     ("Region Operation"
 311      ["Mark as read" wl-summary-mark-as-read-region t]
 312      ["Mark as important" wl-summary-mark-as-important-region t]
 313      ["Mark as unread" wl-summary-mark-as-unread-region t]
 314      ["Set delete mark" wl-summary-delete-region t]
 315      ["Set refile mark" wl-summary-refile-region t]
 316      ["Set copy mark" wl-summary-copy-region t]
 317      ["Prefetch" wl-summary-prefetch-region t]
 318      ["Set target mark" wl-summary-target-mark-region t]
 319      ["Unmark" wl-summary-unmark-region t]
 320      ["Save" wl-summary-save-region t]
 321      ["Execute" wl-summary-exec-region t])
 322     ("Mark Operation"
 323      ["Mark as read" wl-summary-target-mark-mark-as-read t]
 324      ["Mark as important" wl-summary-target-mark-mark-as-important t]
 325      ["Mark as unread" wl-summary-target-mark-mark-as-unread t]
 326      ["Set delete mark" wl-summary-target-mark-delete t]
 327      ["Set refile mark" wl-summary-target-mark-refile t]
 328      ["Set copy mark" wl-summary-target-mark-copy t]
 329      ["Prefetch" wl-summary-target-mark-prefetch t]
 330      ["Save" wl-summary-target-mark-save t]
 331      ["Reply with citation" wl-summary-target-mark-reply-with-citation t]
 332      ["Forward" wl-summary-target-mark-forward t]
 333      ["uudecode" wl-summary-target-mark-uudecode t])
 334     ("Score Operation"
 335      ["Switch current score file" wl-score-change-score-file t]
 336      ["Edit current score file" wl-score-edit-current-scores t]
 337      ["Edit score file" wl-score-edit-file t]
 338      ["Set mark below" wl-score-set-mark-below t]
 339      ["Set expunge below" wl-score-set-expunge-below t]
 340      ["Rescore buffer" wl-summary-rescore t]
 341      ["Increase score" wl-summary-increase-score t]
 342      ["Lower score" wl-summary-lower-score t])
 343     "----"
 344     ("Writing Messages"
 345      ["Write a message" wl-summary-write t]
 346      ["Reply" wl-summary-reply t]
 347      ["Reply with citation" wl-summary-reply-with-citation t]
 348      ["Forward" wl-summary-forward t])
 349     "----"
 350     ["Toggle Plug Status" wl-toggle-plugged t]
 351     ["Change Plug Status" wl-plugged-change t]
 352     "----"
 353     ["Exit Current Folder" wl-summary-exit t]))
 354
 355 (if wl-on-xemacs
 356     (defun wl-summary-setup-mouse ()
 357       (define-key wl-summary-mode-map 'button4 'wl-summary-prev)
 358       (define-key wl-summary-mode-map 'button5 'wl-summary-next)
 359       (define-key wl-summary-mode-map [(shift button4)]
 360         'wl-summary-up)
 361       (define-key wl-summary-mode-map [(shift button5)]
 362         'wl-summary-down)
 363       (define-key wl-summary-mode-map 'button2 'wl-summary-click))
 364   (if wl-on-nemacs
 365       (defun wl-summary-setup-mouse ())
 366     (defun wl-summary-setup-mouse ()
 367       (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev)
 368       (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next)
 369       (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up)
 370       (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down)
 371       (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click))))
 372
 373 (if wl-summary-mode-map
 374     ()
 375   (setq wl-summary-mode-map (make-sparse-keymap))
 376   (define-key wl-summary-mode-map " "    'wl-summary-read)
 377   (define-key wl-summary-mode-map "."    'wl-summary-redisplay)
 378   (define-key wl-summary-mode-map "<"    'wl-summary-display-top)
 379   (define-key wl-summary-mode-map ">"    'wl-summary-display-bottom)
 380   (define-key wl-summary-mode-map "\177" 'wl-summary-prev-page)
 381   (unless wl-on-nemacs
 382     (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page))
 383   (define-key wl-summary-mode-map "\r"   'wl-summary-next-line-content)
 384   (define-key wl-summary-mode-map "\C-m" 'wl-summary-next-line-content)
 385   (define-key wl-summary-mode-map "/"    'wl-thread-open-close)
 386   (define-key wl-summary-mode-map "["    'wl-thread-open-all)
 387   (define-key wl-summary-mode-map "]"    'wl-thread-close-all)
 388   (define-key wl-summary-mode-map "-"    'wl-summary-prev-line-content)
 389   (define-key wl-summary-mode-map "\e\r" 'wl-summary-prev-line-content)
 390   (define-key wl-summary-mode-map "g"    'wl-summary-goto-folder)
 391   (define-key wl-summary-mode-map "c"    'wl-summary-mark-as-read-all)
 392 ;  (define-key wl-summary-mode-map "D"    'wl-summary-drop-unsync)
 393
 394   (define-key wl-summary-mode-map "a"    'wl-summary-reply)
 395   (define-key wl-summary-mode-map "A"    'wl-summary-reply-with-citation)
 396   (define-key wl-summary-mode-map "C"    'wl-summary-cancel-message)
 397   (define-key wl-summary-mode-map "E"    'wl-summary-reedit)
 398   (define-key wl-summary-mode-map "\eE"  'wl-summary-resend-bounced-mail)
 399   (define-key wl-summary-mode-map "f"    'wl-summary-forward)
 400   (define-key wl-summary-mode-map "$"    'wl-summary-mark-as-important)
 401   (define-key wl-summary-mode-map "@"    'wl-summary-edit-addresses)
 402
 403   (define-key wl-summary-mode-map "y"    'wl-summary-save)
 404   (define-key wl-summary-mode-map "n"    'wl-summary-next)
 405   (define-key wl-summary-mode-map "p"    'wl-summary-prev)
 406   (define-key wl-summary-mode-map "N"    'wl-summary-down)
 407   (define-key wl-summary-mode-map "P"    'wl-summary-up)
 408 ;;;(define-key wl-summary-mode-map "w"    'wl-draft)
 409   (define-key wl-summary-mode-map "w"    'wl-summary-write)
 410   (define-key wl-summary-mode-map "W"    'wl-summary-write-current-folder)
 411 ;;;(define-key wl-summary-mode-map "e"     'wl-draft-open-file)
 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 "H"    'wl-summary-redisplay-all-header)
 415   (define-key wl-summary-mode-map "M"    'wl-summary-redisplay-no-mime)
 416   (define-key wl-summary-mode-map "B"    'wl-summary-burst)
 417   (define-key wl-summary-mode-map "Z"    'wl-status-update)
 418   (define-key wl-summary-mode-map "#"    'wl-summary-print-message)
 419   (define-key wl-summary-mode-map "|"    'wl-summary-pipe-message)
 420   (define-key wl-summary-mode-map "q"    'wl-summary-exit)
 421   (define-key wl-summary-mode-map "Q"    'wl-summary-force-exit)
 422
 423   (define-key wl-summary-mode-map "j"    'wl-summary-jump-to-current-message)
 424   (define-key wl-summary-mode-map "J"    'wl-thread-jump-to-msg)
 425   (define-key wl-summary-mode-map "I"    'wl-summary-incorporate)
 426   (define-key wl-summary-mode-map "\M-j" 'wl-summary-jump-to-msg-by-message-id)
 427   (define-key wl-summary-mode-map "^"    'wl-summary-jump-to-parent-message)
 428   (define-key wl-summary-mode-map "!"    'wl-summary-mark-as-unread)
 429
 430   (define-key wl-summary-mode-map "s"    'wl-summary-sync)
 431   (define-key wl-summary-mode-map "S"    'wl-summary-sort)
 432   (define-key wl-summary-mode-map "\M-s"    'wl-summary-stick)
 433   (define-key wl-summary-mode-map "T"    'wl-summary-toggle-thread)
 434
 435   (define-key wl-summary-mode-map "l"    'wl-summary-toggle-disp-folder)
 436   (define-key wl-summary-mode-map "v"    'wl-summary-toggle-disp-msg)
 437   (define-key wl-summary-mode-map "V"    'wl-summary-virtual)
 438
 439   (define-key wl-summary-mode-map "\C-i"  'wl-summary-goto-last-displayed-msg)
 440   (define-key wl-summary-mode-map "?"    'wl-summary-pick)
 441   (define-key wl-summary-mode-map "\ee"  'wl-summary-expire)
 442
 443   ;; copy & paste.
 444   (define-key wl-summary-mode-map "\ew"  'wl-summary-save-current-message)
 445   (define-key wl-summary-mode-map "\C-y"  'wl-summary-yank-saved-message)
 446
 447   ;; line commands
 448   (define-key wl-summary-mode-map "R"    'wl-summary-mark-as-read)
 449   (define-key wl-summary-mode-map "i"    'wl-summary-prefetch)
 450   (define-key wl-summary-mode-map "x"    'wl-summary-exec)
 451   (define-key wl-summary-mode-map "*"    'wl-summary-target-mark)
 452   (define-key wl-summary-mode-map "o"    'wl-summary-refile)
 453   (define-key wl-summary-mode-map "O"    'wl-summary-copy)
 454   (define-key wl-summary-mode-map "\M-o" 'wl-summary-refile-prev-destination)
 455 ;  (define-key wl-summary-mode-map "\M-O" 'wl-summary-copy-prev-destination)
 456   (define-key wl-summary-mode-map "\C-o" 'wl-summary-auto-refile)
 457   (define-key wl-summary-mode-map "d"    'wl-summary-delete)
 458   (define-key wl-summary-mode-map "u"    'wl-summary-unmark)
 459   (define-key wl-summary-mode-map "U"    'wl-summary-unmark-all)
 460
 461   ;; thread commands
 462   (define-key wl-summary-mode-map "t"   (make-sparse-keymap))
 463   (define-key wl-summary-mode-map "tR" 'wl-thread-mark-as-read)
 464   (define-key wl-summary-mode-map "ti" 'wl-thread-prefetch)
 465   (define-key wl-summary-mode-map "tx" 'wl-thread-exec)
 466   (define-key wl-summary-mode-map "t*" 'wl-thread-target-mark)
 467   (define-key wl-summary-mode-map "to" 'wl-thread-refile)
 468   (define-key wl-summary-mode-map "tO" 'wl-thread-copy)
 469   (define-key wl-summary-mode-map "td" 'wl-thread-delete)
 470   (define-key wl-summary-mode-map "tu" 'wl-thread-unmark)
 471   (define-key wl-summary-mode-map "t!" 'wl-thread-mark-as-unread)
 472   (define-key wl-summary-mode-map "t$" 'wl-thread-mark-as-important)
 473   (define-key wl-summary-mode-map "ty" 'wl-thread-save)
 474   (define-key wl-summary-mode-map "ts" 'wl-thread-set-parent)
 475
 476   ;; target-mark commands
 477   (define-key wl-summary-mode-map "m"     (make-sparse-keymap))
 478   (define-key wl-summary-mode-map "mi"   'wl-summary-target-mark-prefetch)
 479   (define-key wl-summary-mode-map "mR"   'wl-summary-target-mark-mark-as-read)
 480   (define-key wl-summary-mode-map "mo"   'wl-summary-target-mark-refile)
 481   (define-key wl-summary-mode-map "mO"   'wl-summary-target-mark-copy)
 482   (define-key wl-summary-mode-map "md"   'wl-summary-target-mark-delete)
 483   (define-key wl-summary-mode-map "my"   'wl-summary-target-mark-save)
 484   (define-key wl-summary-mode-map "m!"   'wl-summary-target-mark-mark-as-unread)
 485   (define-key wl-summary-mode-map "m$"   'wl-summary-target-mark-mark-as-important)
 486   (define-key wl-summary-mode-map "mu"   'wl-summary-delete-all-temp-marks)
 487   (define-key wl-summary-mode-map "mU"   'wl-summary-target-mark-uudecode)
 488   (define-key wl-summary-mode-map "ma"   'wl-summary-target-mark-all)
 489   (define-key wl-summary-mode-map "mt"   'wl-summary-target-mark-thread)
 490   (define-key wl-summary-mode-map "mA"   'wl-summary-target-mark-reply-with-citation)
 491   (define-key wl-summary-mode-map "mf"   'wl-summary-target-mark-forward)
 492   (define-key wl-summary-mode-map "m?"   'wl-summary-target-mark-pick)
 493
 494   ;; region commands
 495   (define-key wl-summary-mode-map "r"    (make-sparse-keymap))
 496   (define-key wl-summary-mode-map "rR"   'wl-summary-mark-as-read-region)
 497   (define-key wl-summary-mode-map "ri"   'wl-summary-prefetch-region)
 498   (define-key wl-summary-mode-map "rx"   'wl-summary-exec-region)
 499   (define-key wl-summary-mode-map "mr"   'wl-summary-target-mark-region)
 500   (define-key wl-summary-mode-map "r*"   'wl-summary-target-mark-region)
 501   (define-key wl-summary-mode-map "ro"   'wl-summary-refile-region)
 502   (define-key wl-summary-mode-map "rO"   'wl-summary-copy-region)
 503   (define-key wl-summary-mode-map "rd"   'wl-summary-delete-region)
 504   (define-key wl-summary-mode-map "ru"   'wl-summary-unmark-region)
 505   (define-key wl-summary-mode-map "r!"   'wl-summary-mark-as-unread-region)
 506   (define-key wl-summary-mode-map "r$"   'wl-summary-mark-as-important-region)
 507   (define-key wl-summary-mode-map "ry"   'wl-summary-save-region)
 508
 509   ;; score commands
 510   (define-key wl-summary-mode-map "K"    'wl-summary-increase-score)
 511   (define-key wl-summary-mode-map "L"    'wl-summary-lower-score)
 512   (define-key wl-summary-mode-map "h"    (make-sparse-keymap))
 513   (define-key wl-summary-mode-map "hR"   'wl-summary-rescore)
 514   (define-key wl-summary-mode-map "hc"   'wl-score-change-score-file)
 515   (define-key wl-summary-mode-map "he"   'wl-score-edit-current-scores)
 516   (define-key wl-summary-mode-map "hf"   'wl-score-edit-file)
 517   (define-key wl-summary-mode-map "hF"   'wl-score-flush-cache)
 518   (define-key wl-summary-mode-map "hm"   'wl-score-set-mark-below)
 519   (define-key wl-summary-mode-map "hx"   'wl-score-set-expunge-below)
 520
 521   (define-key wl-summary-mode-map "\M-t" 'wl-toggle-plugged)
 522   (define-key wl-summary-mode-map "\C-t" 'wl-plugged-change)
 523   ;;
 524   (wl-summary-setup-mouse)
 525   (easy-menu-define
 526    wl-summary-mode-menu
 527    wl-summary-mode-map
 528    "Menu used in Summary mode."
 529    wl-summary-mode-menu-spec))
 530
 531 (defun wl-status-update ()
 532   (interactive)
 533   (wl-address-init))
 534
 535 (defun wl-summary-display-top ()
 536   (interactive)
 537   (goto-char (point-min))
 538   (if wl-summary-buffer-disp-msg
 539       (wl-summary-redisplay)))
 540
 541 (defun wl-summary-display-bottom ()
 542   (interactive)
 543   (goto-char (point-max))
 544   (forward-line -1)
 545   (if wl-summary-buffer-disp-msg
 546       (wl-summary-redisplay)))
 547
 548 (defun wl-summary-collect-unread (mark-alist &optional folder)
 549   (let (mark ret-val)
 550     (while mark-alist
 551       (setq mark (cadr (car mark-alist)))
 552       (and mark
 553            (or (string= mark wl-summary-new-mark)
 554                (string= mark wl-summary-unread-uncached-mark)
 555                (string= mark wl-summary-unread-cached-mark))
 556            (setq ret-val (cons (car (car mark-alist)) ret-val)))
 557       (setq mark-alist (cdr mark-alist)))
 558     ret-val))
 559
 560 (defun wl-summary-count-unread (mark-alist)
 561   (let ((new 0)
 562         (unread 0)
 563         mark)
 564     (while mark-alist
 565       (setq mark (cadr (car mark-alist)))
 566       (and mark
 567            (cond
 568             ((string= mark wl-summary-new-mark)
 569              (setq new (+ 1 new)))
 570             ((or (string= mark wl-summary-unread-uncached-mark)
 571                  (string= mark wl-summary-unread-cached-mark))
 572              (setq unread (+ 1 unread)))))
 573       (setq mark-alist (cdr mark-alist)))
 574     (if (eq major-mode 'wl-summary-mode)
 575         (setq wl-summary-buffer-new-count new
 576               wl-summary-buffer-unread-count unread))
 577     (+ new unread)))
 578
 579 (defun wl-summary-reedit (&optional arg)
 580   "Re-edit current message.
 581 If ARG is non-nil, Supersedes message"
 582   (interactive "P")
 583   (if arg
 584       (wl-summary-supersedes-message)
 585     (if (string= (wl-summary-buffer-folder-name) wl-draft-folder)
 586         (if (wl-summary-message-number)
 587             (unwind-protect
 588                 (wl-draft-reedit (wl-summary-message-number))
 589               (if (wl-message-news-p)
 590                   (mail-position-on-field "Newsgroups")
 591                 (mail-position-on-field "To"))
 592               (delete-other-windows)))
 593       (save-excursion
 594         (let ((mmelmo-force-fetch-entire-message t))
 595           (if (null (wl-summary-message-number))
 596               (message "No message.")
 597             (set-buffer (wl-summary-get-original-buffer))
 598             (wl-draft-edit-string (buffer-substring (point-min)
 599                                                     (point-max)))))))))
 600
 601 (defun wl-summary-resend-bounced-mail ()
 602   "Re-mail the current message.
 603 This only makes sense if the current message is a bounce message which
 604 contains some mail you have written but has been bounced back to
 605 you."
 606   (interactive)
 607   (save-excursion
 608     (let ((mmelmo-force-fetch-entire-message t))
 609       (wl-summary-set-message-buffer-or-redisplay)
 610       (set-buffer (wl-message-get-original-buffer))
 611       (goto-char (point-min))
 612       (let ((case-fold-search nil))
 613         (cond
 614          ((and
 615            (re-search-forward
 616             (concat "^\\($\\|[Cc]ontent-[Tt]ype:[ \t]+multipart/report\\)") nil t)
 617            (not (bolp))
 618            (re-search-forward "boundary=\"\\([^\"]+\\)\"" nil t))
 619           (let ((boundary (buffer-substring (match-beginning 1) (match-end 1)))
 620                 start)
 621             (cond
 622              ((and (setq start (re-search-forward
 623                            (concat "^--" boundary "\n"
 624                                    "[Cc]ontent-[Tt]ype:[ \t]+"
 625                                    "\\(message/rfc822\\|text/rfc822-headers\\)\n"
 626                                    "\\(.+\n\\)*\n") nil t))
 627                    (re-search-forward
 628                          (concat "\n\\(--" boundary "\\)--\n") nil t))
 629               (wl-draft-edit-string (buffer-substring start (match-beginning 1))))
 630              (t
 631               (message "Seems no message/rfc822 part.")))))
 632          ((let ((case-fold-search t))
 633             (re-search-forward wl-rejected-letter-start nil t))
 634           (skip-chars-forward " \t\n")
 635           (wl-draft-edit-string (buffer-substring (point) (point-max))))
 636          (t
 637           (message "Does not appear to be a rejected letter.")))))))
 638
 639 (defun wl-summary-resend-message (address)
 640   "Resend the current message to ADDRESS."
 641   (interactive "sResend message to: ")
 642   (if (or (null address) (string-match "^[ \t]*$" address))
 643       (message "No address specified.")
 644     (message "Resending message to %s..." address)
 645     (save-excursion
 646       (let ((mmelmo-force-fetch-entire-message t))
 647         (wl-summary-set-message-buffer-or-redisplay)
 648         ;; We first set up a normal mail buffer.
 649         (set-buffer (get-buffer-create " *wl-draft-resend*"))
 650         (buffer-disable-undo (current-buffer))
 651         (erase-buffer)
 652         (setq wl-sent-message-via nil)
 653         ;; Insert our usual headers.
 654         (wl-draft-insert-from-field)
 655         (wl-draft-insert-date-field)
 656         (insert "to: " address "\n")
 657         (goto-char (point-min))
 658         ;; Rename them all to "Resent-*".
 659         (while (re-search-forward "^[A-Za-z]" nil t)
 660           (forward-char -1)
 661           (insert "Resent-"))
 662         (widen)
 663         (forward-line)
 664         (delete-region (point) (point-max))
 665         (let ((beg  (point)))
 666           ;; Insert the message to be resent.
 667           (insert-buffer-substring (wl-message-get-original-buffer))
 668           (goto-char (point-min))
 669           (search-forward "\n\n")
 670           (forward-char -1)
 671           (save-restriction
 672             (narrow-to-region beg (point))
 673             (wl-draft-delete-fields wl-ignored-resent-headers)
 674             (goto-char (point-max)))
 675           (insert mail-header-separator)
 676           ;; Rename all old ("Previous-")Resent headers.
 677           (while (re-search-backward "^\\(Previous-\\)*Resent-" beg t)
 678             (beginning-of-line)
 679             (insert "Previous-"))
 680           ;; Quote any "From " lines at the beginning.
 681           (goto-char beg)
 682           (when (looking-at "From ")
 683             (replace-match "X-From-Line: ")))
 684         ;; Send it.
 685         (wl-draft-dispatch-message)
 686         (kill-buffer (current-buffer)))
 687       (message "Resending message to %s...done" address))))
 688
 689 (defun wl-summary-buffer-set-folder (folder)
 690   (if (stringp folder)
 691       (setq folder (wl-folder-get-elmo-folder folder)))
 692   (setq wl-summary-buffer-elmo-folder folder)
 693   (setq wl-summary-buffer-folder-indicator
 694         (if (memq 'modeline wl-use-folder-petname)
 695             (wl-folder-get-petname (elmo-folder-name-internal folder))
 696           (elmo-folder-name-internal folder)))
 697   (make-local-variable 'wl-message-buffer)
 698   (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value
 699                                             wl-folder-mime-charset-alist
 700                                             (elmo-folder-name-internal folder))
 701                                            wl-mime-charset))
 702   (setq wl-summary-buffer-weekday-name-lang
 703         (or (wl-get-assoc-list-value
 704              wl-folder-weekday-name-lang-alist
 705              (elmo-folder-name-internal folder))
 706             wl-summary-weekday-name-lang))
 707   (setq wl-summary-buffer-thread-indent-set
 708         (wl-get-assoc-list-value
 709          wl-folder-thread-indent-set-alist
 710          (elmo-folder-name-internal folder)))
 711   (setq wl-summary-buffer-persistent
 712         (wl-folder-persistent-p (elmo-folder-name-internal folder)))
 713   (elmo-folder-set-persistent-internal folder wl-summary-buffer-persistent)
 714   (setq
 715    wl-thread-indent-level-internal
 716    (or (nth 0 wl-summary-buffer-thread-indent-set)
 717        wl-thread-indent-level)
 718    wl-thread-have-younger-brother-str-internal
 719    (or (nth 1 wl-summary-buffer-thread-indent-set)
 720        wl-thread-have-younger-brother-str)
 721    wl-thread-youngest-child-str-internal
 722    (or (nth 2 wl-summary-buffer-thread-indent-set)
 723        wl-thread-youngest-child-str)
 724    wl-thread-vertical-str-internal
 725    (or (nth 3 wl-summary-buffer-thread-indent-set)
 726        wl-thread-vertical-str)
 727    wl-thread-horizontal-str-internal
 728    (or (nth 4 wl-summary-buffer-thread-indent-set)
 729        wl-thread-horizontal-str)
 730    wl-thread-space-str-internal
 731    (or (nth 5 wl-summary-buffer-thread-indent-set)
 732        wl-thread-space-str))
 733   (setq wl-thread-indent-regexp
 734         (concat
 735          (regexp-quote wl-thread-have-younger-brother-str-internal) "\\|"
 736          (regexp-quote wl-thread-youngest-child-str-internal) "\\|"
 737          (regexp-quote wl-thread-vertical-str-internal) "\\|"
 738          (regexp-quote wl-thread-horizontal-str-internal) "\\|"
 739          (regexp-quote wl-thread-space-str-internal)))
 740   (run-hooks 'wl-summary-buffer-set-folder-hook))
 741
 742 (defun wl-summary-mode ()
 743   "Major mode for reading threaded messages.
 744 See Info under Wanderlust for full documentation.
 745
 746 Special commands:
 747 \\{wl-summary-mode-map}
 748
 749 Entering Folder mode calls the value of `wl-summary-mode-hook'."
 750   (interactive)
 751   (unless (interactive-p) (kill-all-local-variables))
 752   (setq major-mode 'wl-summary-mode)
 753   (setq mode-name "Summary")
 754   (use-local-map wl-summary-mode-map)
 755 ;;;(setq default-directory (or wl-tmp-dir (expand-file-name "~/")))
 756   (setq buffer-read-only t)
 757   (setq truncate-lines t)
 758 ;;;(make-local-variable 'tab-width)
 759 ;;;(setq tab-width 1)
 760   (buffer-disable-undo (current-buffer))
 761   (wl-mode-line-buffer-identification '("Wanderlust: "
 762                                         wl-summary-buffer-folder-indicator
 763                                         wl-summary-buffer-unread-status))
 764   (easy-menu-add wl-summary-mode-menu)
 765   (when wl-summary-lazy-highlight
 766     (make-local-variable 'window-scroll-functions)
 767     (add-hook 'window-scroll-functions 'wl-highlight-summary-window))
 768   ;; This hook may contain the function `wl-setup-summary' for reasons
 769   ;; of system internal to accord facilities for the Emacs variants.
 770   (run-hooks 'wl-summary-mode-hook))
 771
 772 (defun wl-summary-overview-entity-compare-by-date (x y)
 773   "Compare entity X and Y by date."
 774   (condition-case nil
 775       (string<
 776        (timezone-make-date-sortable
 777         (elmo-msgdb-overview-entity-get-date x))
 778        (timezone-make-date-sortable
 779         (elmo-msgdb-overview-entity-get-date y)))
 780     (error))) ;; ignore error.
 781
 782 (defun wl-summary-overview-entity-compare-by-number (x y)
 783    "Compare entity X and Y by number."
 784   (<
 785    (elmo-msgdb-overview-entity-get-number x)
 786    (elmo-msgdb-overview-entity-get-number y)))
 787
 788 (defun wl-summary-overview-entity-compare-by-from (x y)
 789   "Compare entity X and Y by from."
 790   (string<
 791    (wl-address-header-extract-address
 792     (or (elmo-msgdb-overview-entity-get-from-no-decode x)
 793         wl-summary-no-from-message))
 794    (wl-address-header-extract-address
 795     (or (elmo-msgdb-overview-entity-get-from-no-decode y)
 796         wl-summary-no-from-message))))
 797
 798 (defun wl-summary-overview-entity-compare-by-subject (x y)
 799   "Compare entity X and Y by subject."
 800   (string< (elmo-msgdb-overview-entity-get-subject-no-decode x)
 801            (elmo-msgdb-overview-entity-get-subject-no-decode y)))
 802
 803 (defun wl-summary-sort-by-date ()
 804   (interactive)
 805   (wl-summary-rescan "date"))
 806 (defun wl-summary-sort-by-number ()
 807   (interactive)
 808   (wl-summary-rescan "number"))
 809 (defun wl-summary-sort-by-subject ()
 810   (interactive)
 811   (wl-summary-rescan "subject"))
 812 (defun wl-summary-sort-by-from ()
 813   (interactive)
 814   (wl-summary-rescan "from"))
 815
 816 (defun wl-summary-rescan (&optional sort-by)
 817   "Rescan current folder without updating."
 818   (interactive)
 819   (let* ((cur-buf (current-buffer))
 820          (msgdb (wl-summary-buffer-msgdb))
 821          (overview (elmo-msgdb-get-overview msgdb))
 822          (number-alist (elmo-msgdb-get-number-alist msgdb))
 823          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
 824          (elmo-mime-charset wl-summary-buffer-mime-charset)
 825          i percent num
 826          gc-message entity
 827          curp
 828          (inhibit-read-only t)
 829          (buffer-read-only nil)
 830          expunged)
 831     (fset 'wl-summary-append-message-func-internal
 832           (wl-summary-get-append-message-func))
 833     (wl-summary-buffer-number-column-detect nil)
 834     (erase-buffer)
 835     (message "Re-scanning...")
 836     (setq i 0)
 837     (setq num (length overview))
 838     (when sort-by
 839       (message "Sorting by %s..." sort-by)
 840       (setq overview
 841             (sort overview
 842                   (intern (format "wl-summary-overview-entity-compare-by-%s"
 843                                   sort-by))))
 844       (message "Sorting by %s...done" sort-by)
 845       (elmo-msgdb-set-overview (wl-summary-buffer-msgdb)
 846                                overview))
 847     (setq curp overview)
 848     (set-buffer cur-buf)
 849     (setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2)))
 850     (setq wl-thread-entity-list nil)
 851     (setq wl-thread-entities nil)
 852     (setq wl-summary-buffer-number-list nil)
 853     (setq wl-summary-buffer-target-mark-list nil)
 854     (setq wl-summary-buffer-refile-list nil)
 855     (setq wl-summary-buffer-delete-list nil)
 856     (setq wl-summary-delayed-update nil)
 857     (elmo-kill-buffer wl-summary-search-buf-name)
 858     (message "Constructing summary structure...")
 859     (while curp
 860       (setq entity (car curp))
 861       (wl-summary-append-message-func-internal entity overview mark-alist
 862                                                nil)
 863       (setq curp (cdr curp))
 864       (when (> num elmo-display-progress-threshold)
 865         (setq i (+ i 1))
 866         (if (or (zerop (% i 5)) (= i num))
 867             (elmo-display-progress
 868              'wl-summary-rescan "Constructing summary structure..."
 869              (/ (* i 100) num)))))
 870     (when wl-summary-delayed-update
 871       (while wl-summary-delayed-update
 872         (message "Parent (%d) of message %d is no entity"
 873                  (caar wl-summary-delayed-update)
 874                  (elmo-msgdb-overview-entity-get-number
 875                   (cdar wl-summary-delayed-update)))
 876         (wl-summary-append-message-func-internal
 877          (cdar wl-summary-delayed-update)
 878          overview mark-alist nil t)
 879         (setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
 880     (message "Constructing summary structure...done")
 881     (set-buffer cur-buf)
 882     (if (eq wl-summary-buffer-view 'thread)
 883         (progn
 884           (message "Inserting thread...")
 885           (wl-thread-insert-top)
 886           (message "Inserting thread...done"))
 887       (wl-summary-make-number-list))
 888     (when wl-use-scoring
 889       (setq wl-summary-scored nil)
 890       (wl-summary-score-headers nil msgdb
 891                                 (wl-summary-rescore-msgs number-alist)
 892                                 t)
 893       (when (and wl-summary-scored
 894                  (setq expunged (wl-summary-score-update-all-lines)))
 895         (message "%d message(s) are expunged by scoring." (length expunged))))
 896     (wl-summary-set-message-modified)
 897     (wl-summary-count-unread
 898      (elmo-msgdb-get-mark-alist
 899       (elmo-folder-msgdb wl-summary-buffer-elmo-folder)))
 900     (wl-summary-update-modeline)
 901     (goto-char (point-max))
 902     (forward-line -1)
 903     (set-buffer-modified-p nil)))
 904
 905 (defun wl-summary-next-folder-or-exit (&optional next-entity upward)
 906   (if (and next-entity
 907            wl-auto-select-next)
 908       (let (retval)
 909         (wl-summary-toggle-disp-msg 'off)
 910         (unwind-protect
 911             (setq retval
 912                   (wl-summary-goto-folder-subr next-entity
 913                                                'force-update
 914                                                nil
 915                                                nil ; not sticky
 916                                                t   ; interactive!
 917                                                ))
 918           (wl-folder-set-current-entity-id (wl-folder-get-entity-id next-entity))
 919           (if (and (eq retval 'more-next)
 920                    (memq wl-auto-select-next '(unread skip-no-unread))
 921                    (memq this-command wl-summary-next-no-unread-command))
 922               (if upward
 923                   (wl-summary-up
 924                    t (eq wl-auto-select-next 'skip-no-unread))
 925                 (goto-char (point-max))
 926                 (forward-line -1)
 927                 (wl-summary-down
 928                  t (eq wl-auto-select-next 'skip-no-unread))))))
 929     (wl-summary-exit)))
 930
 931 (defun wl-summary-entity-info-msg (entity finfo)
 932   (or (and entity
 933            (concat
 934             (elmo-replace-in-string
 935              (if (memq 'ask-folder wl-use-folder-petname)
 936                  (wl-folder-get-petname entity)
 937                entity)
 938              "%" "%%")
 939             (if (null (car finfo))
 940                 " (? new/? unread)"
 941               (format
 942                " (%d new/%d unread)"
 943                (nth 0 finfo)
 944                (+ (nth 0 finfo)
 945                   (nth 1 finfo))))))
 946       "folder mode"))
 947
 948 (defun wl-summary-set-message-modified ()
 949   (elmo-folder-set-message-modified-internal
 950    wl-summary-buffer-elmo-folder t)
 951   (setq wl-summary-buffer-message-modified t))
 952 (defun wl-summary-message-modified-p ()
 953   wl-summary-buffer-message-modified)
 954 (defun wl-summary-set-mark-modified ()
 955   (elmo-folder-set-mark-modified-internal
 956    wl-summary-buffer-elmo-folder t)
 957   (setq wl-summary-buffer-mark-modified t))
 958 (defun wl-summary-mark-modified-p ()
 959   wl-summary-buffer-mark-modified)
 960 (defun wl-summary-set-thread-modified ()
 961   (setq wl-summary-buffer-thread-modified t))
 962 (defun wl-summary-thread-modified-p ()
 963   wl-summary-buffer-thread-modified)
 964
 965 (defsubst wl-summary-cleanup-temp-marks (&optional sticky)
 966   (if (or wl-summary-buffer-refile-list
 967           wl-summary-buffer-copy-list
 968           wl-summary-buffer-delete-list)
 969       (if (y-or-n-p "Marks remain to be executed.  Execute them? ")
 970           (progn
 971             (wl-summary-exec)
 972             (if (or wl-summary-buffer-refile-list
 973                     wl-summary-buffer-copy-list
 974                     wl-summary-buffer-delete-list)
 975                 (error "Some execution was failed")))
 976         ;; delete temp-marks
 977         (message "")
 978         (wl-summary-delete-all-refile-marks)
 979         (wl-summary-delete-all-copy-marks)
 980         (wl-summary-delete-all-delete-marks)))
 981   (if wl-summary-buffer-target-mark-list
 982       (progn
 983         (wl-summary-delete-all-target-marks)
 984         (setq wl-summary-buffer-target-mark-list nil)))
 985   (wl-summary-delete-all-temp-marks-on-buffer sticky)
 986   (setq wl-summary-scored nil))
 987
 988 ;; a subroutine for wl-summary-exit/wl-save-status
 989 ;; Note that folder is not commited here.
 990 (defun wl-summary-save-view (&optional sticky)
 991   ;; already in summary buffer.
 992   (when wl-summary-buffer-persistent
 993     ;; save the current summary buffer view.
 994     (if (and wl-summary-cache-use
 995              (or (wl-summary-message-modified-p)
 996                  (wl-summary-mark-modified-p)
 997                  (wl-summary-thread-modified-p)))
 998         (wl-summary-save-view-cache))))
 999
1000 (defun wl-summary-force-exit ()
1001   "Exit current summary.  Buffer is deleted even the buffer is sticky."
1002   (interactive)
1003   (wl-summary-exit 'force-exit))
1004
1005 (defun wl-summary-exit (&optional force-exit)
1006   "Exit current summary.  if FORCE-EXIT, exits even the summary is sticky."
1007   (interactive "P")
1008   (let ((summary-buf (current-buffer))
1009         (sticky (wl-summary-sticky-p))
1010         summary-win
1011         message-buf message-win
1012         folder-buf folder-win)
1013     (if wl-summary-buffer-exit-function
1014         (funcall wl-summary-buffer-exit-function)
1015       (wl-summary-cleanup-temp-marks sticky)
1016       (unwind-protect
1017           ;; save summary status
1018           (progn
1019             (if (or force-exit
1020                     (not sticky))
1021                 (elmo-folder-close wl-summary-buffer-elmo-folder)
1022               (elmo-folder-commit wl-summary-buffer-elmo-folder)
1023               (elmo-folder-check wl-summary-buffer-elmo-folder))
1024             (wl-summary-save-view sticky)
1025             (if wl-use-scoring (wl-score-save)))
1026         ;; for sticky summary
1027         (wl-delete-all-overlays)
1028         (setq wl-summary-buffer-disp-msg nil)
1029         (elmo-kill-buffer wl-summary-search-buf-name)
1030         ;; delete message window if displayed.
1031         (if (and wl-message-buffer (get-buffer-window wl-message-buffer))
1032             (delete-window (get-buffer-window wl-message-buffer)))
1033         (if (setq folder-buf (get-buffer wl-folder-buffer-name))
1034             (if (setq folder-win (get-buffer-window folder-buf))
1035                 ;; folder win is already displayed.
1036                 (select-window folder-win)
1037               ;; folder win is not displayed.
1038               (switch-to-buffer folder-buf))
1039           ;; currently no folder buffer
1040           (wl-folder))
1041         (and wl-folder-move-cur-folder
1042              wl-folder-buffer-cur-point
1043              (goto-char wl-folder-buffer-cur-point))
1044         (setq wl-folder-buffer-cur-path nil)
1045         (setq wl-folder-buffer-cur-entity-id nil)
1046         (wl-delete-all-overlays)
1047         (if wl-summary-exit-next-move
1048             (wl-folder-next-unsync t)
1049           (beginning-of-line))
1050         (if (setq summary-win (get-buffer-window summary-buf))
1051             (delete-window summary-win))
1052         (if (or force-exit
1053                 (not sticky))
1054             (progn
1055               (set-buffer summary-buf)
1056               (kill-buffer summary-buf)))
1057         (run-hooks 'wl-summary-exit-hook)))))
1058
1059 (defun wl-summary-sync-force-update (&optional unset-cursor)
1060   (interactive)
1061   (wl-summary-sync-update unset-cursor))
1062
1063 (defsubst wl-summary-sync-all-init ()
1064   (wl-summary-cleanup-temp-marks)
1065   (erase-buffer)
1066   (wl-summary-set-message-modified)
1067   (wl-summary-set-mark-modified)
1068   (setq wl-thread-entity-hashtb (elmo-make-hash
1069                                  (* (length (elmo-msgdb-get-number-alist
1070                                              (wl-summary-buffer-msgdb))) 2)))
1071   (setq wl-thread-entity-list nil)
1072   (setq wl-thread-entities nil)
1073   (setq wl-summary-buffer-number-list nil)
1074   (setq wl-summary-buffer-target-mark-list nil)
1075   (setq wl-summary-buffer-refile-list nil)
1076   (setq wl-summary-buffer-copy-list nil)
1077   (setq wl-summary-buffer-delete-list nil)
1078   (wl-summary-buffer-number-column-detect nil))
1079
1080 (defun wl-summary-sync (&optional unset-cursor force-range)
1081   (interactive)
1082   (let* ((folder wl-summary-buffer-elmo-folder)
1083          (inhibit-read-only t)
1084          (buffer-read-only nil)
1085          (msgdb-dir (elmo-folder-msgdb-path folder))
1086          (range (or force-range (wl-summary-input-range
1087                                  (elmo-folder-name-internal folder)))))
1088     (cond ((string= range "rescan")
1089            (let ((msg (wl-summary-message-number)))
1090              (wl-summary-rescan)
1091              (and msg (wl-summary-jump-to-msg msg))))
1092           ((string= range "rescan-noscore")
1093            (let ((msg (wl-summary-message-number))
1094                  wl-use-scoring)
1095              (wl-summary-rescan)
1096              (and msg (wl-summary-jump-to-msg msg))))
1097           ((or (string-match "last:" range)
1098                (string-match "first:" range))
1099            (wl-summary-goto-folder-subr
1100             (wl-folder-get-elmo-folder (concat "/" range "/"
1101                                                (elmo-folder-name-internal
1102                                                 folder)))
1103             'force-update nil nil t))
1104           (t
1105            (wl-summary-sync-update unset-cursor
1106                                    (cond ((string= range "all") 'all)
1107                                          ((string= range "all-visible")
1108                                           'visible-only)))))))
1109
1110 (defvar wl-summary-edit-addresses-candidate-fields
1111   ;; First element becomes default.
1112   '("from" "to" "cc"))
1113
1114 (defun wl-summary-edit-addresses-collect-candidate-fields (mime-charset)
1115   (let ((fields wl-summary-edit-addresses-candidate-fields)
1116         body candidates components)
1117     (while fields
1118       (setq body
1119             (mapconcat 'identity (elmo-multiple-field-body (car fields))
1120                        ","))
1121       (setq body (wl-parse-addresses body))
1122       (if body (setq candidates (append candidates body)))
1123       (setq fields (cdr fields)))
1124     (setq candidates (elmo-uniq-list candidates))
1125     (elmo-set-work-buf
1126      (elmo-set-buffer-multibyte default-enable-multibyte-characters)
1127      (mapcar (function
1128               (lambda (x)
1129                 (setq components (std11-extract-address-components x))
1130                 (cons (nth 1 components)
1131                       (and (car components)
1132                            (eword-decode-string
1133                             (decode-mime-charset-string
1134                              (car components)
1135                              mime-charset))))))
1136              candidates))))
1137
1138 (defun wl-summary-edit-addresses-subr (the-email name-in-addr)
1139   ;; returns nil if there's no change.
1140   (if (elmo-get-hash-val (downcase the-email) wl-address-petname-hash)
1141       (let (char)
1142         (message (format "'%s' already exists. (e)dit/(d)elete/(c)ancel?"
1143                          the-email))
1144         (while (not (or (eq (setq char (read-char)) ?\r)
1145                         (eq char ?\n)
1146                         (eq char ? )
1147                         (eq char ?e)
1148                         (eq char ?c)
1149                         (eq char ?d)))
1150           (message
1151            "Please answer `e' or `d' or `c'. (e)dit/(d)elete/(c)ancel?"))
1152         (cond
1153          ((or (eq char ?e)
1154               (eq char ?\n)
1155               (eq char ?\r)
1156               (eq char ? ))
1157           ;; Change Addresses
1158           (wl-address-petname-add-or-change
1159            the-email
1160            (elmo-get-hash-val the-email wl-address-petname-hash)
1161            (wl-address-header-extract-realname
1162             (cdr (assoc
1163                   (let ((completion-ignore-case t) comp)
1164                     (setq comp
1165                           (try-completion the-email wl-address-completion-list))
1166                     (if (equal comp t) the-email comp))
1167                   wl-address-completion-list))) t)
1168           "edited")
1169          ((eq char ?d)
1170           ;; Delete Addresses
1171           (if (y-or-n-p (format "Delete '%s'? "
1172                                 the-email))
1173               (progn
1174                 (wl-address-petname-delete the-email)
1175                 "deleted")
1176             (message "")
1177             nil))
1178          (t (message "")
1179             nil)))
1180     ;; Add Petname
1181     (wl-address-petname-add-or-change
1182      the-email name-in-addr name-in-addr)
1183     "added"))
1184
1185 (defun wl-summary-edit-addresses (&optional addr-str)
1186   "Edit address book interactively.
1187 Optional argument ADDR-STR is used as a target address if specified."
1188   (interactive (if current-prefix-arg
1189                    (list (read-from-minibuffer "Target address: "))))
1190   (if (null (wl-summary-message-number))
1191       (message "No message.")
1192     (save-excursion
1193       (let* ((charset wl-summary-buffer-mime-charset)
1194              (candidates
1195               (with-current-buffer (wl-summary-get-original-buffer)
1196                 (wl-summary-edit-addresses-collect-candidate-fields
1197                  charset)))
1198              address pair result)
1199         (if addr-str
1200             (setq address addr-str)
1201           (when candidates
1202             (setq address (car (car candidates)))
1203             (setq address
1204                   (completing-read
1205                    (format "Target address (%s): " address)
1206                    (mapcar
1207                     (function (lambda (x) (cons (car x) (car x))))
1208                     candidates)
1209                    nil nil nil nil address))))
1210         (when address
1211           (setq pair (assoc address candidates))
1212           (unless pair
1213             (setq pair (cons address nil)))
1214           (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
1215             ;; update alias
1216             (wl-status-update)
1217             (setq address (assoc (car pair) wl-address-list))
1218             (if address
1219                 (message "%s, %s, <%s> is %s."
1220                          (nth 2 address)
1221                          (nth 1 address)
1222                          (nth 0 address)
1223                          result)))
1224 ;;; i'd like to update summary-buffer, but...
1225 ;;;     (wl-summary-rescan)
1226           (run-hooks 'wl-summary-edit-addresses-hook))))))
1227
1228 (defun wl-summary-incorporate (&optional arg)
1229   "Check and prefetch all uncached messages.
1230 If ARG is non-nil, checking is omitted."
1231   (interactive "P")
1232   (unless arg
1233     (save-excursion
1234       (wl-summary-sync-force-update)))
1235   (wl-summary-prefetch-region (point-min) (point-max)
1236                               wl-summary-incorporate-marks))
1237
1238 (defun wl-summary-prefetch-msg (number &optional arg)
1239   "Returns status-mark. if skipped, returns nil."
1240   ;; prefetching procedure.
1241   (save-excursion
1242     (let* ((msgdb (wl-summary-buffer-msgdb))
1243            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1244            (number-alist (elmo-msgdb-get-number-alist msgdb))
1245            (message-id (cdr (assq number number-alist)))
1246            (ov (elmo-msgdb-overview-get-entity
1247                 message-id (elmo-msgdb-get-overview msgdb)))
1248            (entity ov)
1249            (size (elmo-msgdb-overview-entity-get-size ov))
1250            (inhibit-read-only t)
1251            (buffer-read-only nil)
1252            (force-read (and size
1253                             (or (null wl-prefetch-threshold)
1254                                 (< size wl-prefetch-threshold))))
1255            mark new-mark)
1256       (if (or arg
1257               (null (elmo-file-cache-exists-p message-id)))
1258           (unwind-protect
1259               (progn
1260                 (when (and size (not force-read) wl-prefetch-confirm)
1261                   (setq force-read
1262                         (save-restriction
1263                           (widen)
1264                           (y-or-n-p
1265                            (format
1266                             "Message from %s has %d bytes.  Prefetch it? "
1267                             (concat
1268                              "[ "
1269                              (save-match-data
1270                                (wl-set-string-width
1271                                 wl-from-width
1272                                 (wl-summary-from-func-internal
1273                                  (eword-decode-string
1274                                   (elmo-delete-char
1275                                    ?\"
1276                                    (or
1277                                     (elmo-msgdb-overview-entity-get-from ov)
1278                                     "??")))))) " ]")
1279                             size))))
1280                   (message ""))         ; flush.
1281                 (setq mark (cadr (assq number mark-alist)))
1282                 (if force-read
1283                     (save-excursion
1284                       (save-match-data
1285                         ;; online
1286                         (elmo-message-encache
1287                          wl-summary-buffer-elmo-folder
1288                          number)
1289                         (setq new-mark
1290                               (cond
1291                                ((string= mark
1292                                          wl-summary-unread-uncached-mark)
1293                                 wl-summary-unread-cached-mark)
1294                                ((string= mark wl-summary-new-mark)
1295                                 (setq wl-summary-buffer-new-count
1296                                       (- wl-summary-buffer-new-count 1))
1297                                 (setq wl-summary-buffer-unread-count
1298                                       (+ wl-summary-buffer-unread-count 1))
1299                                 wl-summary-unread-cached-mark)
1300                                ((string= mark wl-summary-read-uncached-mark)
1301                                 nil)
1302                                (t mark)))
1303                         (setq mark-alist (elmo-msgdb-mark-set
1304                                           mark-alist number new-mark))
1305                         (or new-mark (setq new-mark " "))
1306                         (elmo-msgdb-set-mark-alist msgdb mark-alist)
1307                         (wl-summary-set-mark-modified)
1308                         (wl-summary-update-modeline)
1309                         (wl-folder-update-unread
1310                          (wl-summary-buffer-folder-name)
1311                          (+ wl-summary-buffer-unread-count
1312                             wl-summary-buffer-new-count)))
1313                       new-mark))))))))
1314
1315 ;;(defvar wl-summary-message-uncached-marks
1316 ;;  (list wl-summary-new-mark
1317 ;;      wl-summary-unread-uncached-mark
1318 ;;      wl-summary-read-uncached-mark))
1319
1320 (defun wl-summary-prefetch-region (beg end &optional prefetch-marks)
1321   (interactive "r")
1322   (let ((count 0)
1323         targets
1324         mark length
1325         entity msg
1326         start-pos pos)
1327     (save-excursion
1328       (setq start-pos (point))
1329       (save-restriction
1330         (narrow-to-region beg end)
1331         ;; collect prefetch targets.
1332         (message "Collecting marks...")
1333         (goto-char (point-min))
1334         (while (not (eobp))
1335           (beginning-of-line)
1336           (when (looking-at "^ *\\([0-9-]+\\)[^0-9]\\([^0-9]\\)")
1337             (setq mark (wl-match-buffer 2))
1338             (setq msg (string-to-int (wl-match-buffer 1)))
1339             (if (or (and (null prefetch-marks)
1340                          msg
1341                          (null (elmo-file-cache-exists-p
1342                                 (cdr (assq msg
1343                                            (elmo-msgdb-get-number-alist
1344                                             (wl-summary-buffer-msgdb)))))))
1345                     (member mark prefetch-marks))
1346                 (setq targets (nconc targets (list msg))))
1347             (setq entity (wl-thread-get-entity msg))
1348             (if (or (not (eq wl-summary-buffer-view 'thread))
1349                     (wl-thread-entity-get-opened entity))
1350                 (); opened. no hidden children.
1351               ;; hidden children!!
1352               (setq targets (nconc
1353                              targets
1354                              (wl-thread-get-children-msgs-uncached
1355                               msg prefetch-marks)))))
1356           (forward-line 1))
1357         (setq length (length targets))
1358         (message "Prefetching...")
1359         (while targets
1360           (setq mark (if (not (wl-thread-entity-parent-invisible-p
1361                                (wl-thread-get-entity (car targets))))
1362                          (progn
1363                            (wl-summary-jump-to-msg (car targets))
1364                            (wl-summary-prefetch))
1365                        (wl-summary-prefetch-msg (car targets))))
1366           (if (if prefetch-marks
1367                   (string= mark wl-summary-unread-cached-mark)
1368                 (or (string= mark wl-summary-unread-cached-mark)
1369                     (string= mark " ")))
1370               (message "Prefetching... %d/%d message(s)"
1371                        (setq count (+ 1 count)) length))
1372           ;; redisplay!
1373           (save-excursion
1374             (setq pos (point))
1375             (goto-char start-pos)
1376             (if (pos-visible-in-window-p pos)
1377                 (save-restriction
1378                   (widen)
1379                   (sit-for 0))))
1380           (setq targets (cdr targets)))
1381         (message "Prefetched %d/%d message(s)" count length)
1382         (cons count length)))))
1383
1384 (defun wl-summary-prefetch (&optional arg)
1385   "Prefetch current message."
1386   (interactive "P")
1387   (save-excursion
1388     (save-match-data
1389       (beginning-of-line)
1390       (when (looking-at "^ *\\([0-9-]+\\)[^0-9]\\([^0-9]\\)")
1391         (goto-char (match-beginning 2))
1392         (let ((inhibit-read-only t)
1393               (buffer-read-only nil)
1394               mark)
1395           (setq mark (wl-summary-prefetch-msg
1396                       (string-to-int (wl-match-buffer 1)) arg))
1397           (when mark
1398             (delete-region (match-beginning 2)
1399                            (match-end 2))
1400             (insert mark)
1401             (if wl-summary-highlight
1402                 (wl-highlight-summary-current-line)))
1403           (set-buffer-modified-p nil)
1404           mark)))))
1405
1406 (defun wl-summary-delete-all-status-marks-on-buffer ()
1407   (interactive)
1408   (save-excursion
1409     (goto-char (point-min))
1410     (let ((inhibit-read-only t)
1411           (buffer-read-only nil)
1412           (case-fold-search nil))
1413       (while (re-search-forward
1414               (concat "^" wl-summary-buffer-number-regexp ".\\(.\\)") nil t)
1415         (delete-region (match-beginning 1) (match-end 1))
1416         (insert " ")))))
1417
1418 (defun wl-summary-delete-marks-on-buffer (marks)
1419   (while marks
1420     (wl-summary-unmark (pop marks))))
1421
1422 (defun wl-summary-delete-copy-marks-on-buffer (copies)
1423   (wl-summary-delete-marks-on-buffer copies))
1424
1425 (defun wl-summary-delete-all-refile-marks ()
1426   (let ((marks wl-summary-buffer-refile-list))
1427     (while marks
1428       (wl-summary-unmark (car (pop marks))))))
1429
1430 (defun wl-summary-delete-all-copy-marks ()
1431   (let ((marks wl-summary-buffer-copy-list))
1432     (while marks
1433       (wl-summary-unmark (car (pop marks))))))
1434
1435 (defun wl-summary-delete-all-delete-marks ()
1436   (wl-summary-delete-marks-on-buffer wl-summary-buffer-delete-list))
1437
1438 (defun wl-summary-delete-all-target-marks ()
1439   (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list))
1440
1441 (defun wl-summary-delete-all-temp-marks-on-buffer (&optional sticky)
1442   ;; for summary view cache saving.
1443   (interactive)
1444   (save-excursion
1445     (goto-char (point-min))
1446     (let ((inhibit-read-only t)
1447           (buffer-read-only nil)
1448           (case-fold-search nil)
1449           (regexp (concat "^" wl-summary-buffer-number-regexp "\\([^ ]\\)" )))
1450       (while (re-search-forward regexp nil t)
1451         (delete-region (match-beginning 1) (match-end 1))
1452         (insert " ")
1453         (if (and sticky wl-summary-highlight)
1454             (wl-highlight-summary-current-line))))))
1455
1456 (defun wl-summary-delete-all-marks (mark-alist mark)
1457   "Delete all MARKs in MARK-ALIST."
1458   (let ((malist mark-alist)
1459         (ret-val mark-alist)
1460         entity)
1461     (while malist
1462       (setq entity (car malist))
1463       (if (string= (cadr entity) mark)
1464           ;; delete this entity
1465           (setq ret-val (delete entity ret-val)))
1466       (setq malist (cdr malist)))
1467     ret-val))
1468
1469 ;; Does not work correctly...
1470 (defun wl-summary-mark-as-read-region (beg end)
1471   (interactive "r")
1472   (save-excursion
1473     (save-restriction
1474       (narrow-to-region beg end)
1475 ;;; use narrowing.
1476 ;;;   (save-excursion (goto-char end)
1477 ;;;                   (end-of-line) (point)))
1478       (goto-char (point-min))
1479       (if (eq wl-summary-buffer-view 'thread)
1480           (progn
1481             (while (not (eobp))
1482               (let* ((number (wl-summary-message-number))
1483                      (entity (wl-thread-get-entity number))
1484                      children)
1485                 (if (wl-thread-entity-get-opened entity)
1486                     ;; opened...mark line.
1487                     ;; Crossposts are not processed
1488                     (wl-summary-mark-as-read t)
1489                   ;; closed
1490                   (wl-summary-mark-as-read t) ; mark itself.
1491                   (setq children (wl-thread-get-children-msgs number))
1492                   (while children
1493                     (wl-summary-mark-as-read t nil nil (car children))
1494                     (setq children (cdr children))))
1495                 (forward-line 1))))
1496         (while (not (eobp))
1497           (wl-summary-mark-as-read t)
1498           (forward-line 1)))))
1499   (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1500   (wl-summary-update-modeline))
1501
1502 (defun wl-summary-mark-as-unread-region (beg end)
1503   (interactive "r")
1504   (save-excursion
1505     (save-restriction
1506       (narrow-to-region beg end)
1507 ;;; use narrowing.
1508 ;;;      (save-excursion (goto-char end)
1509 ;;;                   (end-of-line) (point)))
1510       (goto-char (point-min))
1511       (if (eq wl-summary-buffer-view 'thread)
1512           (progn
1513             (while (not (eobp))
1514               (let* ((number (wl-summary-message-number))
1515                      (entity (wl-thread-get-entity number))
1516                      children)
1517                 (if (wl-thread-entity-get-opened entity)
1518                     ;; opened...mark line.
1519                     ;; Crossposts are not processed
1520                     (wl-summary-mark-as-unread)
1521                   ;; closed
1522                   (wl-summary-mark-as-unread) ; mark itself.
1523                   (setq children
1524                         (delq number (wl-thread-get-children-msgs number)))
1525                   (while children
1526                     (wl-summary-mark-as-unread (car children))
1527                     (setq children (cdr children))))
1528                 (forward-line 1))))
1529         (while (not (eobp))
1530           (wl-summary-mark-as-unread)
1531           (forward-line 1)))))
1532   (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1533   (wl-summary-update-modeline))
1534
1535 (defun wl-summary-mark-as-important-region (beg end)
1536   (interactive "r")
1537   (save-excursion
1538     (save-restriction
1539       (narrow-to-region beg end);(save-excursion (goto-char end)
1540                                         ;    (end-of-line) (point)))
1541       (goto-char (point-min))
1542       (if (eq wl-summary-buffer-view 'thread)
1543           (progn
1544             (while (not (eobp))
1545               (let* ((number (wl-summary-message-number))
1546                      (entity (wl-thread-get-entity number))
1547                      children)
1548                 (if (wl-thread-entity-get-opened entity)
1549                     ;; opened...mark line.
1550                     ;; Crossposts are not processed
1551                     (wl-summary-mark-as-important)
1552                   ;; closed
1553                   (wl-summary-mark-as-important) ; mark itself.
1554                   (setq children
1555                         (delq number (wl-thread-get-children-msgs number)))
1556                   (while children
1557                     (wl-thread-msg-mark-as-important (car children))
1558                     (setq children (cdr children))))
1559                 (forward-line 1))))
1560         (while (not (eobp))
1561           (wl-summary-mark-as-important)
1562           (forward-line 1)))))
1563   (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1564   (wl-summary-update-modeline))
1565
1566 (defun wl-summary-mark-as-read-all ()
1567   (interactive)
1568   (if (or (not (interactive-p))
1569           (y-or-n-p "Mark all messages as read? "))
1570       (let* ((folder wl-summary-buffer-elmo-folder)
1571              (cur-buf (current-buffer))
1572              (msgdb (wl-summary-buffer-msgdb))
1573 ;;;          (number-alist (elmo-msgdb-get-number-alist msgdb))
1574              (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1575              (malist mark-alist)
1576              (inhibit-read-only t)
1577              (buffer-read-only nil)
1578              (case-fold-search nil)
1579              msg mark)
1580         (message "Setting all msgs as read...")
1581         (elmo-folder-mark-as-read folder (wl-summary-collect-unread mark-alist))
1582         (save-excursion
1583           (goto-char (point-min))
1584           (while (re-search-forward "^ *\\([0-9-]+\\)[^0-9]\\([^0-9 ]\\)" nil t)
1585             (setq msg (string-to-int (wl-match-buffer 1)))
1586             (setq mark (wl-match-buffer 2))
1587             (when (and (not (string= mark wl-summary-important-mark))
1588                        (not (string= mark wl-summary-read-uncached-mark)))
1589               (delete-region (match-beginning 2) (match-end 2))
1590               (if (or (not (elmo-message-use-cache-p folder msg))
1591                       (string= mark wl-summary-unread-cached-mark))
1592                   (progn
1593                     (insert " ")
1594                     (setq mark-alist
1595                           (elmo-msgdb-mark-set
1596                            mark-alist
1597                            msg
1598 ;;; Use msg instead of (cdr (assq msg number-alist)).
1599 ;;;                        (cdr (assq msg number-alist))
1600                            nil)))
1601                 ;; New mark and unread-uncached mark
1602                 (insert wl-summary-read-uncached-mark)
1603                 (setq mark-alist
1604                       (elmo-msgdb-mark-set mark-alist
1605                                            msg
1606 ;;;                                        (cdr (assq msg number-alist))
1607                                            wl-summary-read-uncached-mark)))
1608               (if wl-summary-highlight
1609                   (wl-highlight-summary-current-line nil nil t)))))
1610         (setq mark-alist (wl-summary-set-as-read-mark-alist mark-alist))
1611         (wl-summary-set-mark-modified)
1612         (set-buffer cur-buf); why is this needed???
1613         (elmo-msgdb-set-mark-alist msgdb mark-alist)
1614         (wl-folder-update-unread (wl-summary-buffer-folder-name) 0)
1615         (setq wl-summary-buffer-unread-count 0)
1616         (setq wl-summary-buffer-new-count    0)
1617         (wl-summary-update-modeline)
1618         (message "Setting all msgs as read...done")
1619         (set-buffer-modified-p nil))))
1620
1621 (defun wl-summary-delete-cache ()
1622   "Delete cache of current message."
1623   (interactive)
1624   (save-excursion
1625     (let* ((inhibit-read-only t)
1626            (buffer-read-only nil)
1627            (folder wl-summary-buffer-elmo-folder)
1628            (msgdb (wl-summary-buffer-msgdb))
1629            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1630            (number-alist (elmo-msgdb-get-number-alist msgdb))
1631            (case-fold-search nil)
1632            mark number unread new-mark)
1633 ;;;   (re-search-backward "^ *[0-9]+..[0-9]+/[0-9]+" nil t) ; set cursor line
1634       (beginning-of-line)
1635       (when (looking-at "^ *\\([0-9-]+\\)[^0-9]\\([^0-9]\\)")
1636         (progn
1637           (setq mark (wl-match-buffer 2))
1638           (cond
1639            ((or (string= mark wl-summary-new-mark)
1640                 (string= mark wl-summary-unread-uncached-mark)
1641                 (string= mark wl-summary-important-mark))
1642             ;; noop
1643             )
1644            ((string= mark wl-summary-unread-cached-mark)
1645             (setq new-mark wl-summary-unread-uncached-mark))
1646            (t
1647             (setq new-mark wl-summary-read-uncached-mark)))
1648           (when new-mark
1649             (setq number (string-to-int (wl-match-buffer 1)))
1650             (delete-region (match-beginning 2) (match-end 2))
1651             (goto-char (match-beginning 2))
1652             (insert new-mark)
1653             (elmo-file-cache-delete
1654              (elmo-message-field wl-summary-buffer-elmo-folder
1655                                      number
1656                                      'message-id))
1657             (setq mark-alist
1658                   (elmo-msgdb-mark-set mark-alist number new-mark))
1659             (elmo-msgdb-set-mark-alist msgdb mark-alist)
1660             (wl-summary-set-mark-modified)
1661             (if wl-summary-highlight
1662                 (wl-highlight-summary-current-line nil nil t))
1663             (set-buffer-modified-p nil)))))))
1664
1665 (defun wl-summary-resume-cache-status ()
1666   "Resume the cache status of all messages in the current folder."
1667   (interactive)
1668   (let* ((folder wl-summary-buffer-elmo-folder)
1669          (cur-buf (current-buffer))
1670          (msgdb (wl-summary-buffer-msgdb))
1671          (number-alist (elmo-msgdb-get-number-alist msgdb))
1672          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1673          (inhibit-read-only t)
1674          (buffer-read-only nil)
1675          (case-fold-search nil)
1676          msg mark msgid set-mark)
1677     (message "Resuming cache status...")
1678     (save-excursion
1679       (goto-char (point-min))
1680       (while (re-search-forward "^ *\\([0-9-]+\\)[^0-9]\\([^0-9]\\)" nil t)
1681         (setq msg (string-to-int
1682                    (wl-match-buffer 1)))
1683         (setq mark (wl-match-buffer 2))
1684         (setq msgid (cdr (assq msg number-alist)))
1685         (setq set-mark nil)
1686         (if (elmo-file-cache-exists-p msgid)
1687             (if (or
1688                  (string= mark wl-summary-unread-uncached-mark) ; U -> !
1689                  (string= mark wl-summary-new-mark)             ; N -> !
1690                  )
1691                 (setq set-mark wl-summary-unread-cached-mark)
1692               (if (string= mark wl-summary-read-uncached-mark)  ; u -> ' '
1693                   (setq set-mark " ")))
1694           (if (string= mark " ")
1695               (setq set-mark wl-summary-read-uncached-mark)     ;' ' -> u
1696             (if (string= mark wl-summary-unread-cached-mark)
1697                 (setq set-mark wl-summary-unread-uncached-mark) ; !  -> U
1698               )))
1699         (when set-mark
1700           (delete-region (match-beginning 2) (match-end 2))
1701           (insert set-mark)
1702           (setq mark-alist
1703                 (elmo-msgdb-mark-set
1704                  mark-alist msg ; msgid
1705                  (if (string= set-mark " ") nil set-mark)))
1706           (if wl-summary-highlight
1707               (wl-highlight-summary-current-line))))
1708       (wl-summary-set-mark-modified)
1709       (set-buffer cur-buf); why is this needed???
1710       (elmo-msgdb-set-mark-alist msgdb mark-alist)
1711       (wl-summary-count-unread mark-alist)
1712       (wl-summary-update-modeline)
1713       (message "Resuming cache status...done")
1714       (set-buffer-modified-p nil))))
1715
1716 (defun wl-summary-resume-marks-and-highlight ()
1717   (let* ((msgdb (wl-summary-buffer-msgdb))
1718          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1719 ;;;      (number-alist (elmo-msgdb-get-number-alist msgdb))
1720          (count (count-lines (point-min)(point-max)))
1721          (i 0)
1722          msg-num percent smark)
1723     (save-excursion
1724       (goto-char (point-min))
1725       (message "Resuming all marks...")
1726       (while (not (eobp))
1727         (setq msg-num (wl-summary-message-number))
1728         (setq smark (car (cdr (assq msg-num mark-alist))))
1729         (if (looking-at (format "^ *%s \\( \\)" msg-num))
1730             (progn
1731               (goto-char (match-end 1))
1732               (delete-region (match-beginning 1) (match-end 1))
1733               (insert (or smark " "))))
1734         (wl-highlight-summary-current-line smark)
1735         (when (> count elmo-display-progress-threshold)
1736           (setq i (+ i 1))
1737           (setq percent (/ (* i 100) count))
1738           (elmo-display-progress
1739            'wl-summary-resume-marks-and-highlight "Resuming all marks..."
1740            percent))
1741         (forward-line 1)))
1742     (message "Resuming all marks...done")))
1743
1744 (defun wl-summary-resume-marks ()
1745   (let* ((msgdb (wl-summary-buffer-msgdb))
1746          (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1747          (number-alist (elmo-msgdb-get-number-alist msgdb))
1748          (count (length mark-alist))
1749          (i 0)
1750          entity msg-num percent)
1751     (save-excursion
1752       (message "Resuming all marks...")
1753       (while mark-alist
1754         (setq entity (car mark-alist))
1755         (if (setq msg-num (car (rassoc (car entity) number-alist)))
1756             (progn
1757 ;;;           (goto-char (point-min))
1758               (if (re-search-forward (format "^ *%s \\( \\)" msg-num) nil t)
1759                   (progn
1760                     (delete-region (match-beginning 1) (match-end 1))
1761                     (insert (or (cadr entity)
1762                                 " ")))
1763                 (if (re-search-backward (format "^ *%s \\( \\)" msg-num) nil t)
1764                     (progn
1765                       (goto-char (match-end 1))
1766                       (delete-region (match-beginning 1) (match-end 1))
1767                       (insert (or (cadr entity)
1768                                   " ")))))))
1769         (when (> count elmo-display-progress-threshold)
1770           (setq i (+ i 1))
1771           (setq percent (/ (* i 100) count))
1772           (elmo-display-progress
1773            'wl-summary-resume-marks "Resuming all marks..."
1774            percent))
1775         (setq mark-alist (cdr mark-alist)))
1776       (message "Resuming all marks...done"))))
1777
1778 (defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info)
1779   (interactive)
1780   (save-excursion
1781     (let ((inhibit-read-only t)
1782           (buffer-read-only nil)
1783           (msgs2 msgs)
1784           (len (length msgs))
1785           (i 0)
1786           update-list)
1787       (elmo-kill-buffer wl-summary-search-buf-name)
1788       (while msgs
1789         (if (eq wl-summary-buffer-view 'thread)
1790             (progn
1791               ;; don't use wl-append(nconc), because list is broken. ...why?
1792               (setq update-list
1793                     (append update-list
1794                             (wl-thread-delete-message (car msgs))))
1795               (setq update-list (delq (car msgs) update-list)))
1796           (goto-char (point-min))
1797           (if (re-search-forward (format "^ *%d[^0-9]\\([^0-9]\\).*$"
1798                                          (car msgs)) nil t)
1799               (progn
1800                 (delete-region (match-beginning 0) (match-end 0))
1801                 (delete-char 1) ; delete '\n'
1802                 (setq wl-summary-buffer-number-list
1803                       (delq (car msgs) wl-summary-buffer-number-list)))))
1804         (when (and deleting-info
1805                    (> len elmo-display-progress-threshold))
1806           (setq i (1+ i))
1807           (if (or (zerop (% i 5)) (= i len))
1808               (elmo-display-progress
1809                'wl-summary-delete-messages-on-buffer deleting-info
1810                (/ (* i 100) len))))
1811         (setq msgs (cdr msgs)))
1812       (when (eq wl-summary-buffer-view 'thread)
1813         (wl-thread-update-line-msgs (elmo-uniq-list update-list)
1814                                     (unless deleting-info 'no-msg))
1815         (wl-thread-cleanup-symbols msgs2))
1816       (wl-summary-count-unread
1817        (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1818       (wl-summary-update-modeline)
1819       (wl-folder-update-unread
1820        (wl-summary-buffer-folder-name)
1821        (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count)))))
1822
1823 (defun wl-summary-set-as-read-mark-alist (mark-alist)
1824   (let ((marks (list (cons wl-summary-unread-cached-mark
1825                            nil)
1826                      (cons wl-summary-unread-uncached-mark
1827                            wl-summary-read-uncached-mark)
1828                      (cons wl-summary-new-mark
1829                            wl-summary-read-uncached-mark)))
1830         (ret-val mark-alist)
1831         entity pair)
1832     (while mark-alist
1833       (setq entity (car mark-alist))
1834       (when (setq pair (assoc (cadr entity) marks))
1835         (if (elmo-message-use-cache-p wl-summary-buffer-elmo-folder
1836                                       (caar mark-alist))
1837             (if (cdr pair)
1838                 (setcar (cdr entity) (cdr pair))
1839               (setq ret-val (delete entity ret-val)))
1840           (setq ret-val (delete entity ret-val))))
1841       (setq mark-alist (cdr mark-alist)))
1842     ret-val))
1843
1844 (defun wl-summary-set-status-marks (mark-alist before after)
1845   "Set the BEFORE marks to AFTER."
1846   (let ((ret-val mark-alist)
1847         entity)
1848     (while mark-alist
1849       (setq entity (car mark-alist))
1850       (when (string= (cadr entity) before)
1851         (if after
1852             (setcar (cdr entity) after)
1853           (setq ret-val (delete entity ret-val))))
1854       (setq mark-alist (cdr mark-alist)))
1855     ret-val))
1856
1857 (defun wl-summary-set-status-marks-on-buffer (before after)
1858   "Set the MARKS marks on buffer."
1859   (interactive)
1860   (save-excursion
1861     (goto-char (point-min))
1862     (let ((inhibit-read-only t)
1863           (buffer-read-only nil)
1864           (regexp (concat "^" wl-summary-buffer-number-regexp ".\\(\\%s\\)")))
1865       (while (re-search-forward
1866               (format regexp (regexp-quote before)) nil t)
1867         (delete-region (match-beginning 1) (match-end 1))
1868         (insert after)
1869         (if wl-summary-highlight
1870             (wl-highlight-summary-current-line))))))
1871
1872 (defun wl-summary-get-delete-folder (folder)
1873   (if (string= folder wl-trash-folder)
1874       'null
1875     (let* ((type (or (wl-get-assoc-list-value wl-delete-folder-alist folder)
1876                      'trash)))
1877       (cond ((stringp type)
1878              type)
1879             ((or (equal type 'remove) (equal type 'null))
1880              'null)
1881             (t;; (equal type 'trash)
1882              wl-trash-folder)))))
1883
1884 (defun wl-summary-delete-important-msgs-from-list (delete-list
1885                                                    mark-alist)
1886   (let ((dlist delete-list))
1887     (while dlist
1888       (if (string= wl-summary-important-mark
1889                    (car (cdr (assq (car dlist) mark-alist))))
1890           (setq delete-list (delete (car dlist) delete-list)))
1891       (setq dlist (cdr dlist)))
1892     delete-list))
1893
1894 (defun wl-summary-delete-canceled-msgs-from-list (delete-list msgdb)
1895   (let ((dlist delete-list))
1896     (while dlist
1897       (if (null (cdr (assq (car dlist) (cadr msgdb))))
1898           (setq delete-list (delete (car dlist) delete-list)))
1899       (setq dlist (cdr dlist)))
1900     delete-list))
1901
1902 (defun wl-summary-get-append-message-func ()
1903   (if (eq wl-summary-buffer-view 'thread)
1904       'wl-summary-insert-thread-entity
1905 ;;;   'wl-summary-insert-thread
1906     'wl-summary-insert-summary))
1907
1908 (defun wl-summary-sort ()
1909   (interactive)
1910   (let ((sort-by (let ((input-range-list '("number" "date" "subject" "from"))
1911                        (default "date")
1912                        in)
1913                    (setq in
1914                          (completing-read
1915                           (format "Sort by (%s): " default)
1916                           (mapcar
1917                            (function (lambda (x) (cons x x)))
1918                            input-range-list)))
1919                    (if (string= in "")
1920                        default
1921                      in))))
1922     (if (not (member sort-by '("number" "date" "subject" "from")))
1923         (error "Sort by %s is not implemented"  sort-by))
1924     (wl-summary-rescan sort-by)))
1925
1926 (defun wl-summary-sync-marks ()
1927   "Update marks in summary."
1928   (interactive)
1929   (let ((last-progress 0)
1930         (i 0)
1931         mark-alist unread-marks importants unreads
1932         importants-in-db unreads-in-db diff diffs
1933         mes num-ma progress)
1934     ;; synchronize marks.
1935     (when (not (eq (elmo-folder-type-internal
1936                     wl-summary-buffer-elmo-folder)
1937                    'internal))
1938       (message "Updating marks...")
1939       (setq unread-marks (list wl-summary-unread-cached-mark
1940                                wl-summary-unread-uncached-mark
1941                                wl-summary-new-mark)
1942             mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))
1943             num-ma (length mark-alist)
1944             importants (elmo-folder-list-importants
1945                         wl-summary-buffer-elmo-folder
1946                         wl-summary-important-mark)
1947             unreads (elmo-folder-list-unreads
1948                      wl-summary-buffer-elmo-folder
1949                      unread-marks))
1950       (while mark-alist
1951         (if (string= (cadr (car mark-alist))
1952                      wl-summary-important-mark)
1953             (setq importants-in-db (cons (car (car mark-alist))
1954                                          importants-in-db))
1955           (if (member (cadr (car mark-alist)) unread-marks)
1956               (setq unreads-in-db (cons (car (car mark-alist))
1957                                         unreads-in-db))))
1958         (setq mark-alist (cdr mark-alist))
1959         (when (> num-ma elmo-display-progress-threshold)
1960           (setq i (1+ i)
1961                 progress (/ (* i 100) num-ma))
1962           (if (not (eq progress last-progress))
1963               (elmo-display-progress 'wl-summary-sync-marks
1964                                      "Updating marks..."
1965                                      progress))
1966           (setq last-progress progress)))
1967       (setq diff (elmo-list-diff importants importants-in-db))
1968       (setq diffs (cadr diff)) ; important-deletes
1969       (setq mes (format "Updated (-%d" (length diffs)))
1970       (while diffs
1971         (wl-summary-mark-as-important (car diffs)
1972                                       wl-summary-important-mark
1973                                       'no-server)
1974         (setq diffs (cdr diffs)))
1975       (setq diffs (car diff)) ; important-appends
1976       (setq mes (concat mes (format "/+%d) important," (length diffs))))
1977       (while diffs
1978         (wl-summary-mark-as-important (car diffs) " " 'no-server)
1979         (setq diffs (cdr diffs)))
1980       (setq diff (elmo-list-diff unreads unreads-in-db))
1981       (setq diffs (cadr diff))
1982       (setq mes (concat mes (format "(-%d" (length diffs))))
1983       (while diffs
1984         (wl-summary-mark-as-read t 'no-server nil (car diffs))
1985         (setq diffs (cdr diffs)))
1986       (setq diffs (car diff)) ; unread-appends
1987       (setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs))))
1988       (while diffs
1989         (wl-summary-mark-as-unread (car diffs) 'no-server 'no-modeline)
1990         (setq diffs (cdr diffs)))
1991       (if (interactive-p) (message mes)))))
1992
1993 (defun wl-summary-confirm-appends (appends)
1994   (let ((len (length appends))
1995         in)
1996     (if (> len wl-summary-update-confirm-threshold)
1997         (if (y-or-n-p (format "Too many messages(%d).  Continue? " len))
1998             appends
1999           (setq in wl-summary-update-confirm-threshold)
2000           (catch 'end
2001             (while t
2002               (setq in (read-from-minibuffer "Update number: "
2003                                              (int-to-string in))
2004                     in (string-to-int in))
2005               (if (< len in)
2006                   (throw 'end len))
2007               (if (y-or-n-p (format "%d messages are disappeared.  OK? "
2008                                     (max (- len in) 0)))
2009                   (throw 'end in))))
2010           (nthcdr (max (- len in) 0) appends))
2011       appends)))
2012
2013 (defun wl-summary-sync-update (&optional unset-cursor sync-all)
2014   "Update the summary view to the newest folder status."
2015   (interactive)
2016   (let* ((folder wl-summary-buffer-elmo-folder)
2017          (case-fold-search nil)
2018          (elmo-mime-charset wl-summary-buffer-mime-charset)
2019          (inhibit-read-only t)
2020          (buffer-read-only nil)
2021          gc-message
2022          overview number-alist mark-alist
2023          curp num i new-msgdb
2024          append-list delete-list crossed
2025          update-thread update-top-list
2026          expunged mes sync-result)
2027     (unless wl-summary-buffer-elmo-folder
2028       (error "(Internal error) Folder is not set:%s" (buffer-name
2029                                                       (current-buffer))))
2030     (fset 'wl-summary-append-message-func-internal
2031           (wl-summary-get-append-message-func))
2032     ;; Flush pending append operations (disconnected operation).
2033     ;;(setq seen-list
2034     ;;(wl-summary-flush-pending-append-operations seen-list))
2035     (goto-char (point-max))
2036     (wl-folder-confirm-existence folder 'force)
2037     (setq sync-result (elmo-folder-synchronize
2038                        folder
2039                        wl-summary-new-mark
2040                        wl-summary-unread-uncached-mark
2041                        wl-summary-unread-cached-mark
2042                        wl-summary-read-uncached-mark
2043                        wl-summary-important-mark
2044                        sync-all))
2045     (setq new-msgdb (nth 0 sync-result))
2046     (setq delete-list (nth 1 sync-result))
2047     (setq crossed (nth 2 sync-result))
2048     (if (or (and sync-all sync-result)
2049             sync-result)
2050         (progn
2051           ;; Setup sync-all
2052           (if sync-all (wl-summary-sync-all-init))
2053 ;    (if (and has-nntp
2054 ;            (elmo-nntp-max-number-precedes-list-active-p))
2055         ;; XXX this does not work correctly in rare case.
2056 ;       (setq delete-list
2057 ;             (wl-summary-delete-canceled-msgs-from-list
2058 ;              delete-list
2059 ;              (wl-summary-buffer-msgdb))))
2060           (when delete-list
2061             (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
2062             (message "Deleting...done"))
2063           (wl-summary-set-status-marks-on-buffer
2064            wl-summary-new-mark
2065            wl-summary-unread-uncached-mark)
2066           (setq append-list (elmo-msgdb-get-overview new-msgdb))
2067           (setq curp append-list)
2068           (setq num (length curp))
2069           (when append-list
2070             (setq i 0)
2071             ;; set these value for append-message-func
2072             (setq overview (elmo-msgdb-get-overview
2073                             (elmo-folder-msgdb folder)))
2074             (setq number-alist (elmo-msgdb-get-number-alist
2075                                 (elmo-folder-msgdb folder)))
2076             (setq mark-alist (elmo-msgdb-get-mark-alist
2077                               (elmo-folder-msgdb folder)))
2078             (setq wl-summary-delayed-update nil)
2079             (elmo-kill-buffer wl-summary-search-buf-name)
2080             (while curp
2081               (setq entity (car curp))
2082               (when (setq update-thread
2083                           (wl-summary-append-message-func-internal
2084                            entity overview mark-alist
2085                            (not sync-all)))
2086                 (wl-append update-top-list update-thread))
2087               (if elmo-use-database
2088                   (elmo-database-msgid-put
2089                    (car entity) (elmo-folder-name-internal folder)
2090                    (elmo-msgdb-overview-entity-get-number entity)))
2091               (setq curp (cdr curp))
2092               (when (> num elmo-display-progress-threshold)
2093                 (setq i (+ i 1))
2094                 (if (or (zerop (% i 5)) (= i num))
2095                     (elmo-display-progress
2096                      'wl-summary-sync-update "Updating thread..."
2097                      (/ (* i 100) num)))))
2098             (when wl-summary-delayed-update
2099               (while wl-summary-delayed-update
2100                 (message "Parent (%d) of message %d is no entity"
2101                          (caar wl-summary-delayed-update)
2102                          (elmo-msgdb-overview-entity-get-number
2103                           (cdar wl-summary-delayed-update)))
2104                 (when (setq update-thread
2105                             (wl-summary-append-message-func-internal
2106                              (cdar wl-summary-delayed-update)
2107                              overview mark-alist (not sync-all) t))
2108                   (wl-append update-top-list update-thread))
2109                 (setq wl-summary-delayed-update
2110                       (cdr wl-summary-delayed-update))))
2111             (when (and (eq wl-summary-buffer-view 'thread)
2112                        update-top-list)
2113               (wl-thread-update-indent-string-thread
2114                (elmo-uniq-list update-top-list)))
2115             (message "Updating thread...done"))
2116           (unless (eq wl-summary-buffer-view 'thread)
2117             (wl-summary-make-number-list))
2118           (wl-summary-set-message-modified)
2119           (wl-summary-set-mark-modified)
2120           (when (and sync-all (eq wl-summary-buffer-view 'thread))
2121             (elmo-kill-buffer wl-summary-search-buf-name)
2122             (message "Inserting thread...")
2123             (setq wl-thread-entity-cur 0)
2124             (wl-thread-insert-top)
2125             (message "Inserting thread...done"))
2126           (if elmo-use-database
2127               (elmo-database-close))
2128           (run-hooks 'wl-summary-sync-updated-hook)
2129           (setq mes (format "Updated (-%d/+%d) message(s)"
2130                             (length delete-list) num)))
2131       (setq mes (format
2132                  "No updates for \"%s\"" (elmo-folder-name-internal folder))))
2133     ;; synchronize marks.
2134     (if wl-summary-auto-sync-marks
2135         (wl-summary-sync-marks))
2136     ;; scoring
2137     (when wl-use-scoring
2138       (setq wl-summary-scored nil)
2139       (wl-summary-score-headers nil (wl-summary-buffer-msgdb)
2140                                 (and sync-all
2141                                      (wl-summary-rescore-msgs number-alist))
2142                                 sync-all)
2143       (when (and wl-summary-scored
2144                  (setq expunged (wl-summary-score-update-all-lines)))
2145         (setq mes (concat mes
2146                           (format " (%d expunged)"
2147                                   (length expunged))))))
2148     (if (and crossed (> crossed 0))
2149         (setq mes
2150               (if mes
2151                   (concat mes
2152                           (format " (%d crosspost)" crossed))
2153                 (format "%d crosspost message(s)" crossed)))
2154       (and mes (setq mes (concat mes "."))))
2155     ;; Update Folder mode
2156     (wl-folder-set-folder-updated
2157      (elmo-folder-name-internal folder)
2158      (list 0
2159            (wl-summary-count-unread
2160             (elmo-msgdb-get-mark-alist
2161              (elmo-folder-msgdb folder)))
2162            (elmo-folder-messages folder)))
2163     (wl-summary-update-modeline)
2164     (wl-summary-buffer-number-column-detect t)
2165     ;;
2166     (unless unset-cursor
2167       (goto-char (point-min))
2168       (if (not (wl-summary-cursor-down t))
2169           (progn
2170             (goto-char (point-max))
2171             (forward-line -1))
2172         (if (and wl-summary-highlight
2173                  (not (get-text-property (point) 'face)))
2174             (save-excursion
2175               (forward-line (- 0
2176                                (or
2177                                 wl-summary-partial-highlight-above-lines
2178                                 wl-summary-highlight-partial-threshold)))
2179               (wl-highlight-summary (point) (point-max))))))
2180     (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder))
2181     (wl-delete-all-overlays)
2182     (set-buffer-modified-p nil)
2183     (if mes (message "%s" mes))))
2184
2185 (defun wl-summary-set-score-mark (mark)
2186   (save-excursion
2187     (beginning-of-line)
2188     (let ((inhibit-read-only t)
2189           (buffer-read-only nil)
2190           msg-num
2191           cur-mark)
2192       (when (looking-at "^ *\\([0-9-]+\\)\\([^0-9]\\)")
2193         (setq msg-num  (string-to-int (wl-match-buffer 1)))
2194         (setq cur-mark (wl-match-buffer 2))
2195         (when (member cur-mark (list " "
2196                                      wl-summary-score-below-mark
2197                                      wl-summary-score-over-mark))
2198           (goto-char (match-end 1))
2199           (delete-region (match-beginning 2) (match-end 2))
2200           (insert mark)
2201           (if wl-summary-highlight
2202               (wl-highlight-summary-current-line nil nil t))
2203           (set-buffer-modified-p nil))))))
2204
2205 (defun wl-summary-get-score-mark (msg-num)
2206   (let ((score (cdr (assq msg-num wl-summary-scored))))
2207     (if score
2208         (cond ((< score wl-summary-default-score)
2209                "-")
2210               ((> score wl-summary-default-score)
2211                "+")))))
2212
2213 (defun wl-summary-update-modeline ()
2214   (setq wl-summary-buffer-unread-status
2215         (format " {%s}(%d new/%d unread)"
2216                 (if (eq wl-summary-buffer-view 'thread)
2217                     "T" "S")
2218                 wl-summary-buffer-new-count
2219                 (+ wl-summary-buffer-new-count
2220                    wl-summary-buffer-unread-count))))
2221
2222 (defsubst wl-summary-jump-to-msg (&optional number)
2223   (interactive)
2224   (let ((num (or number
2225                  (string-to-int
2226                   (read-from-minibuffer "Jump to Message(No.): ")))))
2227     (setq num (int-to-string num))
2228     (if (re-search-forward (concat "^[ \t]*" num "[^0-9]") nil t)
2229         (progn
2230           (beginning-of-line)
2231           t)
2232       (if (re-search-backward (concat "^[ \t]*" num "[^0-9]") nil t)
2233           (progn
2234             (beginning-of-line)
2235             t)
2236         nil))))
2237
2238 (defun wl-summary-highlight-msgs (msgs)
2239   (save-excursion
2240     (let ((len (length msgs))
2241           i)
2242       (message "Hilighting...")
2243       (setq i 0)
2244       (while msgs
2245         (if (wl-summary-jump-to-msg (car msgs))
2246             (wl-highlight-summary-current-line))
2247         (setq msgs (cdr msgs))
2248         (when (> len elmo-display-progress-threshold)
2249           (setq i (+ i 1))
2250           (if (or (zerop (% i 5)) (= i len))
2251               (elmo-display-progress
2252                'wl-summary-highlight-msgs "Highlighting..."
2253                (/ (* i 100) len)))))
2254       (message "Highlighting...done"))))
2255
2256 (defun wl-summary-message-number ()
2257   (save-excursion
2258     (beginning-of-line)
2259     (if (looking-at "^ *\\([0-9-]+\\)")
2260         (string-to-int (wl-match-buffer 1))
2261       nil)))
2262
2263 (defun wl-summary-move (src dsts-msgs)
2264   (let* ((dsts (car dsts-msgs))         ; (+foo +bar)
2265 ;;;      (msgs (cdr dsts-msgs))         ; (1 2 3)
2266 ;;;      (msgdb (wl-summary-buffer-msgdb))
2267 ;;;      result)
2268          )
2269     (while dsts
2270       (setq dsts (cdr dsts)))))
2271
2272 (defun wl-summary-delete-all-msgs ()
2273   (interactive)
2274   (let ((cur-buf (current-buffer))
2275         (dels (elmo-folder-list-messages wl-summary-buffer-elmo-folder)))
2276     (set-buffer cur-buf)
2277     (if (null dels)
2278         (message "No message to delete.")
2279       (if (y-or-n-p (format "%s has %d message(s).  Delete all? "
2280                             (wl-summary-buffer-folder-name)
2281                             (length dels)))
2282           (progn
2283             (message "Deleting...")
2284             (elmo-folder-delete-messages
2285              wl-summary-buffer-elmo-folder dels)
2286             (elmo-msgdb-delete-msgs (wl-summary-buffer-msgdb)
2287                                     dels)
2288 ;;;         (elmo-msgdb-save (wl-summary-buffer-folder-name) nil)
2289             (wl-summary-set-message-modified)
2290             (wl-summary-set-mark-modified)
2291             (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
2292                                           (list 0 0 0))
2293 ;;; for thread.
2294 ;;;         (setq wl-thread-top-entity '(nil t nil nil))
2295             (setq wl-summary-buffer-unread-count 0)
2296             (setq wl-summary-buffer-new-count    0)
2297             (wl-summary-update-modeline)
2298             (set-buffer cur-buf)
2299             (let ((inhibit-read-only t)
2300                   (buffer-read-only nil))
2301               (erase-buffer))
2302 ;;;         (if wl-summary-cache-use (wl-summary-save-view-cache))
2303             (message "Deleting...done")
2304             t)
2305         nil))))
2306
2307 (defun wl-summary-toggle-thread (&optional arg)
2308   "Toggle thread status (T)hread and (S)equential.
2309 If ARG, without confirm."
2310   (interactive "P")
2311   (when (or arg
2312             (y-or-n-p (format "Toggle threading? (y=%s): "
2313                               (if (eq wl-summary-buffer-view 'thread)
2314                                   "\"off\"" "\"on\""))))
2315     (if (eq wl-summary-buffer-view 'thread)
2316         (setq wl-summary-buffer-view 'sequence)
2317       (setq wl-summary-buffer-view 'thread))
2318     (wl-summary-update-modeline)
2319     (force-mode-line-update)
2320     (wl-summary-rescan)))
2321
2322 (defun wl-summary-load-file-object (filename)
2323   "Load lisp object from dir."
2324   (save-excursion
2325     (let ((tmp-buffer (get-buffer-create " *wl-summary-load-file-object*"))
2326           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
2327           insert-file-contents-post-hook
2328           ret-val)
2329       (if (not (file-readable-p filename))
2330           ()
2331         (set-buffer tmp-buffer)
2332         (as-binary-input-file (insert-file-contents filename))
2333         (setq ret-val
2334               (condition-case nil
2335                   (read (current-buffer))
2336                 (error (error "Reading failed")))))
2337       (kill-buffer tmp-buffer)
2338       ret-val)))
2339
2340 (defun wl-summary-goto-folder (&optional arg)
2341   (interactive "P")
2342   (wl-summary-goto-folder-subr nil nil nil arg t))
2343
2344 (defun wl-summary-goto-last-visited-folder ()
2345   (interactive)
2346   (let ((entity
2347          (wl-folder-search-entity-by-name wl-summary-last-visited-folder
2348                                           wl-folder-entity
2349                                           'folder)))
2350     (if entity (wl-folder-set-current-entity-id
2351                 (wl-folder-get-entity-id entity))))
2352   (wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t))
2353
2354 (defun wl-summary-sticky-p (&optional folder)
2355   (if folder
2356       (get-buffer (wl-summary-sticky-buffer-name
2357                    (elmo-folder-name-internal folder)))
2358     (not (string= wl-summary-buffer-name (buffer-name)))))
2359
2360 (defun wl-summary-always-sticky-folder-p (folder)
2361   (or (eq t wl-summary-always-sticky-folder-list)
2362       (wl-string-match-member
2363        (elmo-folder-name-internal folder)
2364        wl-summary-always-sticky-folder-list)))
2365
2366 (defun wl-summary-stick (&optional force)
2367   "Make current summary buffer sticky."
2368   (interactive "P")
2369   (if (wl-summary-sticky-p)
2370       (message "Current summary buffer is already sticky.")
2371     (when (or force (y-or-n-p "Stick current summary buffer? "))
2372       (wl-summary-toggle-disp-msg 'off)
2373       (wl-summary-switch-to-clone-buffer
2374        (wl-summary-sticky-buffer-name
2375         (wl-summary-buffer-folder-name)))
2376 ;;; ???hang up
2377 ;;;   (rename-buffer (wl-summary-sticky-buffer-name
2378 ;;;                   (wl-summary-buffer-folder-name))))
2379       (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name)))))
2380
2381 (defun wl-summary-switch-to-clone-buffer (buffer-name)
2382   (let ((cur-buf (current-buffer))
2383         (msg (wl-summary-message-number))
2384         (buf (get-buffer-create buffer-name))
2385         (folder wl-summary-buffer-elmo-folder)
2386         (copy-variables
2387          (append '(wl-summary-buffer-view
2388                    wl-summary-buffer-refile-list
2389                    wl-summary-buffer-delete-list
2390                    wl-summary-buffer-copy-list
2391                    wl-summary-buffer-target-mark-list
2392                    wl-summary-buffer-elmo-folder
2393                    wl-summary-buffer-number-column
2394                    wl-summary-buffer-number-regexp
2395                    wl-summary-buffer-message-modified
2396                    wl-summary-buffer-mark-modified
2397                    wl-summary-buffer-thread-modified
2398                    wl-summary-buffer-number-list
2399                    wl-summary-buffer-msgdb
2400                    wl-summary-buffer-folder-name)
2401                  (and (eq wl-summary-buffer-view 'thread)
2402                       '(wl-thread-entity-hashtb
2403                         wl-thread-entities
2404                         wl-thread-entity-list))
2405                  (and wl-use-scoring
2406                       '(wl-summary-scored
2407                         wl-summary-default-score
2408                         wl-summary-important-above
2409                         wl-summary-temp-above
2410                         wl-summary-mark-below
2411                         wl-summary-expunge-below))
2412                  (and (featurep 'wl-score)
2413                       '(wl-current-score-file
2414                         wl-score-alist)))))
2415     (set-buffer buf)
2416     (wl-summary-mode)
2417     (wl-summary-buffer-set-folder folder)
2418     (let ((buffer-read-only nil))
2419       (insert-buffer cur-buf))
2420     (set-buffer-modified-p nil)
2421     (while copy-variables
2422       (set (car copy-variables)
2423            (save-excursion
2424              (set-buffer cur-buf)
2425              (symbol-value (car copy-variables))))
2426       (setq copy-variables (cdr copy-variables)))
2427     (switch-to-buffer buf)
2428     (kill-buffer cur-buf)
2429     (wl-summary-count-unread
2430      (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
2431     (wl-summary-update-modeline)
2432     (if msg
2433         (if (eq wl-summary-buffer-view 'thread)
2434             (wl-thread-jump-to-msg msg)
2435           (wl-summary-jump-to-msg msg))
2436       (goto-char (point-max))
2437       (beginning-of-line))))
2438
2439 (defun wl-summary-get-buffer (folder)
2440   (or (and folder
2441            (get-buffer (wl-summary-sticky-buffer-name folder)))
2442       (get-buffer wl-summary-buffer-name)))
2443
2444 (defun wl-summary-get-buffer-create (name &optional force-sticky)
2445   (if force-sticky
2446       (get-buffer-create
2447        (wl-summary-sticky-buffer-name name))
2448     (or (get-buffer (wl-summary-sticky-buffer-name name))
2449         (get-buffer-create wl-summary-buffer-name))))
2450
2451 (defun wl-summary-make-number-list ()
2452   (setq wl-summary-buffer-number-list
2453         (mapcar
2454          (lambda (x) (elmo-msgdb-overview-entity-get-number x))
2455          (elmo-msgdb-get-overview (wl-summary-buffer-msgdb)))))
2456
2457 (defun wl-summary-goto-folder-subr (&optional name scan-type other-window
2458                                               sticky interactive scoring)
2459   "Display target folder on summary."
2460   (interactive)
2461   (let* ((keep-cursor (memq this-command
2462                             wl-summary-keep-cursor-command))
2463          (name (or name (wl-summary-read-folder wl-default-folder)))
2464          (cur-fld wl-summary-buffer-elmo-folder)
2465          folder buf mes hilit reuse-buf
2466          retval entity)
2467     (if (string= name "")
2468         (setq name wl-default-folder))
2469     (setq folder (wl-folder-get-elmo-folder name))
2470     (when (and (not (string=
2471                      (and cur-fld
2472                           (elmo-folder-name-internal cur-fld))
2473                      (elmo-folder-name-internal folder))) ; folder is moved.
2474                (eq major-mode 'wl-summary-mode)) ; called in summary.
2475       (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name))
2476       (wl-summary-cleanup-temp-marks (wl-summary-sticky-p))
2477       (wl-summary-save-view 'keep) ; keep current buffer, anyway.
2478       (elmo-folder-commit wl-summary-buffer-elmo-folder))
2479     (setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder)
2480                                             sticky))
2481     (setq reuse-buf
2482           (save-excursion
2483             (set-buffer buf)
2484             (string= (elmo-folder-name-internal folder)
2485                      (wl-summary-buffer-folder-name))))
2486     (unwind-protect
2487         (if reuse-buf
2488             (if interactive
2489                 (switch-to-buffer buf)
2490               (set-buffer buf))
2491           (if other-window
2492               (delete-other-windows))
2493           (set-buffer buf)
2494           (unless (eq major-mode 'wl-summary-mode)
2495             (wl-summary-mode))
2496           (wl-summary-buffer-set-folder folder)
2497           (setq wl-summary-buffer-disp-msg nil)
2498           (setq wl-summary-buffer-last-displayed-msg nil)
2499           (setq wl-summary-buffer-current-msg nil)
2500           (let ((case-fold-search nil)
2501                 (inhibit-read-only t)
2502                 (buffer-read-only nil))
2503             ;; Select folder
2504             (elmo-folder-open folder 'load-msgdb)
2505             ;; For compatibility
2506             (setq wl-summary-buffer-msgdb (elmo-folder-msgdb folder))
2507             (setq wl-summary-buffer-folder-name (elmo-folder-name-internal
2508                                                  folder))
2509             (erase-buffer)
2510             ;; Resume summary view
2511             (if wl-summary-cache-use
2512                 (let* ((dir (elmo-folder-msgdb-path folder))
2513                        (cache (expand-file-name wl-summary-cache-file dir))
2514                        (view (expand-file-name wl-summary-view-file dir)))
2515                   (when (file-exists-p cache)
2516                     (insert-file-contents-as-binary cache)
2517                     (elmo-set-buffer-multibyte
2518                      default-enable-multibyte-characters)
2519                     (decode-mime-charset-region
2520                      (point-min)(point-max)
2521                      wl-summary-buffer-mime-charset))
2522                   (when (file-exists-p view)
2523                     (setq wl-summary-buffer-view
2524                           (wl-summary-load-file-object view)))
2525                   (if (eq wl-summary-buffer-view 'thread)
2526                       (wl-thread-resume-entity folder)
2527                     (wl-summary-make-number-list)))
2528               (setq wl-summary-buffer-view
2529                     (wl-summary-load-file-object
2530                      (expand-file-name wl-summary-view-file
2531                                        (elmo-folder-msgdb-path folder))))
2532               (wl-summary-rescan))
2533             (wl-summary-count-unread
2534              (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
2535             (wl-summary-update-modeline)))
2536       (wl-summary-buffer-number-column-detect t)
2537       (wl-summary-toggle-disp-msg 'on)
2538       (unless (and reuse-buf keep-cursor)
2539         ;(setq hilit wl-summary-highlight)
2540         (unwind-protect
2541             (let ((wl-summary-highlight (if reuse-buf wl-summary-highlight))
2542                   (wl-use-scoring
2543                    (if (or scoring interactive) wl-use-scoring)))
2544               (if (and (not scan-type)
2545                        interactive
2546                        (not wl-ask-range))
2547                   (setq scan-type (wl-summary-get-sync-range folder)))
2548               (cond
2549                ((eq scan-type nil)
2550                 (wl-summary-sync 'unset-cursor))
2551                ((eq scan-type 'all)
2552                 (wl-summary-sync 'unset-cursor "all"))
2553                ((eq scan-type 'no-sync))
2554                ((or (eq scan-type 'force-update)
2555                     (eq scan-type 'update))
2556                 (setq mes (wl-summary-sync-force-update 'unset-cursor)))))
2557           (if interactive
2558               (switch-to-buffer buf)
2559             (set-buffer buf))
2560           ;; stick always-sticky-folder
2561           (when (wl-summary-always-sticky-folder-p folder)
2562             (or (wl-summary-sticky-p) (wl-summary-stick t)))
2563           (run-hooks 'wl-summary-prepared-pre-hook)
2564           (set-buffer-modified-p nil)
2565           (goto-char (point-min))
2566           (if (wl-summary-cursor-down t)
2567               (let ((unreadp (wl-summary-next-message
2568                               (wl-summary-message-number)
2569                               'down nil)))
2570                 (cond ((and wl-auto-select-first unreadp)
2571                        (setq retval 'disp-msg))
2572                       ((not unreadp)
2573                        (setq retval 'more-next))))
2574             (goto-char (point-max))
2575             (if (elmo-folder-plugged-p folder)
2576                 (forward-line -1)
2577               (wl-summary-prev))
2578             (setq retval 'more-next))
2579           ;(setq wl-summary-highlight hilit)
2580           (if (and wl-summary-highlight
2581                    (not wl-summary-lazy-highlight)
2582                    (not reuse-buf))
2583               (if (and wl-summary-highlight-partial-threshold
2584                        (> (count-lines (point-min) (point-max))
2585                           wl-summary-highlight-partial-threshold))
2586                   (save-excursion
2587                     (forward-line (-
2588                                    0
2589                                    (or
2590                                     wl-summary-partial-highlight-above-lines
2591                                     wl-summary-highlight-partial-threshold)))
2592                     (wl-highlight-summary (point) (point-max)))
2593                 (wl-highlight-summary (point-min) (point-max))))
2594           (if (eq retval 'disp-msg)
2595               (wl-summary-redisplay))
2596           (if mes (message "%s" mes))
2597           (if (and interactive wl-summary-recenter)
2598               (recenter (/ (- (window-height) 2) 2))))))
2599     ;; set current entity-id
2600     (if (and (not folder)
2601              (setq entity
2602                    (wl-folder-search-entity-by-name (elmo-folder-name-internal
2603                                                      folder)
2604                                                     wl-folder-entity
2605                                                     'folder)))
2606         ;; entity-id is unknown.
2607         (wl-folder-set-current-entity-id
2608          (wl-folder-get-entity-id entity)))
2609     (unwind-protect
2610         (run-hooks 'wl-summary-prepared-hook)
2611       (set-buffer-modified-p nil))
2612     retval))
2613
2614 (defun wl-summary-summary-line-already-exists-p (parent-number buffer)
2615   "Return the depth."
2616   (set-buffer buffer)
2617   (goto-char (point-max))
2618   (let ((depth 0))
2619     (when (re-search-backward (format "^ *%s..../..\(.*\)..:.. "
2620                                       parent-number) nil t)
2621       (goto-char (match-end 0))
2622       (while (string-match wl-thread-indent-regexp
2623                            (char-to-string
2624                             (char-after (point))))
2625         (setq depth (+ 1 depth))
2626         (forward-char))
2627       (/ depth wl-thread-indent-level-internal))))
2628
2629 (defun wl-summary-goto-bottom-of-current-thread ()
2630   (if (re-search-forward (concat "^" wl-summary-buffer-number-regexp
2631                                  "..../..\(.*\)..:.. [[<]") nil t)
2632       ()
2633     (goto-char (point-max))))
2634
2635 (defun wl-summary-goto-top-of-current-thread ()
2636   (wl-summary-jump-to-msg
2637    (wl-thread-entity-get-number
2638     (wl-thread-entity-get-top-entity (wl-thread-get-entity
2639                                       (wl-summary-message-number))))))
2640
2641 (defun wl-summary-goto-bottom-of-sub-thread (&optional depth)
2642   (interactive)
2643   (let ((depth (or depth
2644                    (wl-thread-get-depth-of-current-line))))
2645     (forward-line 1)
2646     (while (and (not (eobp))
2647                 (>= (wl-thread-get-depth-of-current-line)
2648                     depth))
2649       (forward-line 1))
2650     (beginning-of-line)))
2651
2652 (defun wl-summary-insert-line (line)
2653   "Insert LINE in the Summary."
2654   (if wl-use-highlight-mouse-line
2655       ;; remove 'mouse-face of current line.
2656       (put-text-property
2657        (save-excursion (beginning-of-line)(point))
2658        (save-excursion (end-of-line)(point))
2659        'mouse-face nil))
2660   (insert line "\n")
2661   (if wl-use-highlight-mouse-line
2662       ;; remove 'mouse-face of current line.
2663       (put-text-property
2664        (save-excursion (beginning-of-line)(point))
2665        (save-excursion (end-of-line)(point))
2666        'mouse-face nil))
2667   (condition-case nil ; it's dangerous, so ignore error.
2668       (run-hooks 'wl-summary-line-inserted-hook)
2669     (error (ding)
2670            (message "Error in wl-summary-line-inserted-hook"))))
2671
2672 (defun wl-summary-insert-summary (entity database mark-alist dummy &optional dummy)
2673   (let ((overview-entity entity)
2674         summary-line msg)
2675     (setq msg (elmo-msgdb-overview-entity-get-number entity))
2676     (when (setq summary-line
2677                 (wl-summary-overview-create-summary-line
2678                  msg entity nil 0 mark-alist))
2679       (let ((inhibit-read-only t)
2680             buffer-read-only)
2681         (goto-char (point-max))
2682         (wl-summary-insert-line summary-line)))))
2683
2684 (defun wl-summary-default-subject-filter (subject)
2685   (let ((case-fold-search t))
2686     (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" ""))
2687     (setq subject (elmo-replace-in-string subject "[ \t]" ""))
2688     (elmo-replace-in-string subject "^\\[.*\\]" "")))
2689
2690 (defun wl-summary-subject-equal (subject1 subject2)
2691   (string= (wl-summary-subject-filter-func-internal subject1)
2692            (wl-summary-subject-filter-func-internal subject2)))
2693
2694 (defmacro wl-summary-put-alike (alike)
2695   (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
2696                         (, alike)
2697                         wl-summary-alike-hashtb)))
2698
2699 (defmacro wl-summary-get-alike ()
2700   (` (elmo-get-hash-val (format "#%d" (wl-count-lines))
2701                         wl-summary-alike-hashtb)))
2702
2703 (defun wl-summary-insert-headers (overview func mime-decode)
2704   (let (ov this last alike)
2705     (buffer-disable-undo (current-buffer))
2706     (make-local-variable 'wl-summary-alike-hashtb)
2707     (setq wl-summary-alike-hashtb (elmo-make-hash (* (length overview) 2)))
2708     (when mime-decode
2709       (elmo-set-buffer-multibyte default-enable-multibyte-characters))
2710     (while (setq ov (pop overview))
2711       (setq this (funcall func ov))
2712       (and this (setq this (std11-unfold-string this)))
2713       (if (equal last this)
2714           (wl-append alike (list ov))
2715         (when last
2716           (wl-summary-put-alike alike)
2717           (insert last ?\n))
2718         (setq alike (list ov)
2719               last this)))
2720     (when last
2721       (wl-summary-put-alike alike)
2722       (insert last ?\n))
2723     (when mime-decode
2724       (decode-mime-charset-region (point-min) (point-max)
2725                                   elmo-mime-charset)
2726       (when (eq mime-decode 'mime)
2727         (eword-decode-region (point-min) (point-max))))
2728     (run-hooks 'wl-summary-insert-headers-hook)))
2729
2730 (defun wl-summary-search-by-subject (entity overview)
2731   (let ((buf (get-buffer-create wl-summary-search-buf-name))
2732         (folder-name (wl-summary-buffer-folder-name))
2733         match founds found-entity)
2734     (save-excursion
2735       (set-buffer buf)
2736       (let ((case-fold-search t))
2737         (when (or (not (string= wl-summary-search-buf-folder-name folder-name))
2738                   (zerop (buffer-size)))
2739           (setq wl-summary-search-buf-folder-name folder-name)
2740           (wl-summary-insert-headers
2741            overview
2742            (function
2743             (lambda (x)
2744               (wl-summary-subject-filter-func-internal
2745                (elmo-msgdb-overview-entity-get-subject-no-decode x))))
2746            t))
2747         (setq match (wl-summary-subject-filter-func-internal
2748                      (elmo-msgdb-overview-entity-get-subject entity)))
2749         (if (string= match "")
2750             (setq match "\n"))
2751         (goto-char (point-max))
2752         (while (and (not founds)
2753                     (not (= (point) (point-min)))
2754                     (search-backward match nil t))
2755           ;; check exactly match
2756           (when (and (bolp)
2757                      (= (point-at-eol)
2758                         (match-end 0)))
2759             (setq found-entity (wl-summary-get-alike))
2760             (if (and found-entity
2761                      ;; Is founded entity myself or children?
2762                      (not (string=
2763                            (elmo-msgdb-overview-entity-get-id entity)
2764                            (elmo-msgdb-overview-entity-get-id (car found-entity))))
2765                      (not (wl-thread-descendant-p
2766                            (elmo-msgdb-overview-entity-get-number entity)
2767                            (elmo-msgdb-overview-entity-get-number (car found-entity)))))
2768                 ;; return matching entity
2769                 (setq founds found-entity))))
2770         (if founds
2771             (car founds))))))
2772
2773 (defun wl-summary-insert-thread-entity (entity overview mark-alist update
2774                                                &optional force-insert)
2775   (let (update-list entity-stack)
2776     (while entity
2777       (let* ((this-id (elmo-msgdb-overview-entity-get-id entity))
2778              (parent-entity
2779               (elmo-msgdb-overview-get-parent-entity entity overview));; temp
2780 ;;;          (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
2781              (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
2782              (case-fold-search t)
2783              msg overview2 cur-entity linked retval delayed-entity)
2784         (setq msg (elmo-msgdb-overview-entity-get-number entity))
2785         (if (and parent-number
2786                  (not (wl-thread-get-entity parent-number))
2787                  (not force-insert))
2788             ;; parent is exists in overview, but not exists in wl-thread-entities
2789             (progn
2790               (wl-append wl-summary-delayed-update
2791                          (list (cons parent-number entity)))
2792               (setq entity nil)) ;; exit loop
2793           ;; Search parent by subject.
2794           (when (and (null parent-number)
2795                      wl-summary-search-parent-by-subject-regexp
2796                      (string-match wl-summary-search-parent-by-subject-regexp
2797                                    (elmo-msgdb-overview-entity-get-subject entity)))
2798             (let ((found (wl-summary-search-by-subject entity overview)))
2799               (when (and found
2800                          (not (member found wl-summary-delayed-update)))
2801                 (setq parent-entity found)
2802                 (setq parent-number
2803                       (elmo-msgdb-overview-entity-get-number parent-entity))
2804                 (setq linked t))))
2805           ;; If subject is change, divide thread.
2806           (if (and parent-number
2807                    wl-summary-divide-thread-when-subject-changed
2808                    (not (wl-summary-subject-equal
2809                          (or (elmo-msgdb-overview-entity-get-subject
2810                               entity) "")
2811                          (or (elmo-msgdb-overview-entity-get-subject
2812                               parent-entity) ""))))
2813               (setq parent-number nil))
2814           ;;
2815           (setq retval
2816                 (wl-thread-insert-message entity overview mark-alist
2817                                           msg parent-number update linked))
2818           (and retval
2819                (wl-append update-list (list retval)))
2820           (setq entity nil) ; exit loop
2821           (while (setq delayed-entity (assq msg wl-summary-delayed-update))
2822             (setq wl-summary-delayed-update
2823                   (delete delayed-entity wl-summary-delayed-update))
2824             ;; update delayed message
2825             (wl-append entity-stack (list (cdr delayed-entity)))))
2826         (if (and (not entity)
2827                  entity-stack)
2828             (setq entity (pop entity-stack)))))
2829     update-list))
2830
2831 (defun wl-summary-update-thread (entity
2832                                  overview
2833                                  mark-alist
2834                                  thr-entity
2835                                  parent-entity)
2836   (let* ((depth 0)
2837          (this-id (elmo-msgdb-overview-entity-get-id entity))
2838          (overview-entity entity)
2839          (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
2840          (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
2841          summary-line msg subject-differ)
2842     (cond
2843      ((or (not parent-id)
2844           (string= this-id parent-id))
2845       (goto-char (point-max))
2846       (beginning-of-line))
2847      ;; parent already exists in buffer.
2848      ((setq depth (or (wl-summary-summary-line-already-exists-p
2849                        parent-number (current-buffer)) -1))
2850       (setq depth (+ 1 depth))
2851       (wl-thread-goto-bottom-of-sub-thread)))
2852     (if (and (setq msg (elmo-msgdb-overview-entity-get-number entity)))
2853         (if (setq summary-line
2854                   (wl-summary-overview-create-summary-line
2855                    msg entity parent-entity depth mark-alist
2856                    (wl-thread-maybe-get-children-num msg)
2857                    nil thr-entity))
2858             (let ((inhibit-read-only t)
2859                   (buffer-read-only nil))
2860               (wl-summary-insert-line summary-line))))))
2861
2862 (defun wl-summary-mark-as-unread (&optional number
2863                                             no-server-update
2864                                             no-modeline-update)
2865   (interactive)
2866   (save-excursion
2867     (let* (eol
2868           (inhibit-read-only t)
2869           (buffer-read-only nil)
2870           (folder wl-summary-buffer-elmo-folder)
2871           (msgdb (wl-summary-buffer-msgdb))
2872           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
2873 ;;;       (number-alist (elmo-msgdb-get-number-alist msgdb))
2874           new-mark visible mark)
2875       (if number
2876           (progn
2877             (setq visible (wl-summary-jump-to-msg number))
2878             (unless (setq mark (cadr (assq number mark-alist)))
2879               (setq mark " ")))
2880         ;; interactive
2881         (setq visible t))
2882       (when visible
2883         (if (null (wl-summary-message-number))
2884             (message "No message.")
2885           (end-of-line)
2886           (setq eol (point))
2887           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
2888                                       "..../..")) ; set cursor line
2889           (beginning-of-line)))
2890       (if (or (and (not visible)
2891                    ;; already exists in msgdb.
2892                    (assq number (elmo-msgdb-get-number-alist msgdb)))
2893               (re-search-forward
2894                (format (concat "^ *\\("
2895                                (if number (int-to-string number)
2896                                  "[0-9]+")
2897                                "\\)[^0-9]\\(%s\\|%s\\)")
2898                        wl-summary-read-uncached-mark
2899                        " ") eol t))
2900           (progn
2901             (setq number (or number (string-to-int (wl-match-buffer 1))))
2902             (setq mark (or mark (elmo-match-buffer 2)))
2903             (save-match-data
2904               (setq new-mark (if (string= mark
2905                                           wl-summary-read-uncached-mark)
2906                                  wl-summary-unread-uncached-mark
2907                                (if (elmo-message-use-cache-p folder number)
2908                                    wl-summary-unread-mark
2909                                  wl-summary-unread-uncached-mark))))
2910             ;; server side mark
2911             (unless no-server-update
2912               (save-match-data
2913                 (unless (elmo-folder-unmark-read folder (list number))
2914                   (error "Setting mark failed"))))
2915             (when visible
2916               (delete-region (match-beginning 2) (match-end 2))
2917               (insert new-mark))
2918             (setq mark-alist
2919                   (elmo-msgdb-mark-set mark-alist
2920                                        number
2921                                        new-mark))
2922             (elmo-msgdb-set-mark-alist msgdb mark-alist)
2923             (unless no-modeline-update
2924               (setq wl-summary-buffer-unread-count
2925                     (+ 1 wl-summary-buffer-unread-count))
2926               (wl-summary-update-modeline)
2927               (wl-folder-update-unread
2928                (wl-summary-buffer-folder-name)
2929                (+ wl-summary-buffer-unread-count
2930                   wl-summary-buffer-new-count)))
2931             (wl-summary-set-mark-modified)
2932             (if (and visible wl-summary-highlight)
2933                 (wl-highlight-summary-current-line))))))
2934   (set-buffer-modified-p nil))
2935
2936 (defun wl-summary-delete (&optional number)
2937   "Mark Delete mark 'D'.
2938 If optional argument NUMBER is specified, mark message specified by NUMBER."
2939   (interactive)
2940   (let* ((buffer-num (wl-summary-message-number))
2941          (msg-num (or number buffer-num))
2942          mark)
2943     (catch 'done
2944       (when (null msg-num)
2945         (if (interactive-p)
2946             (message "No message."))
2947         (throw 'done nil))
2948       (when (setq mark (wl-summary-get-mark msg-num))
2949         (when (wl-summary-reserve-temp-mark-p mark)
2950           (if (interactive-p)
2951               (error "Already marked as `%s'" mark))
2952           (throw 'done nil))
2953         (wl-summary-unmark msg-num))
2954       (if (or (interactive-p)
2955               (eq number buffer-num))
2956           (wl-summary-mark-line "D"))
2957       (setq wl-summary-buffer-delete-list
2958             (cons msg-num wl-summary-buffer-delete-list))
2959       (if (interactive-p)
2960           (if (eq wl-summary-move-direction-downward nil)
2961               (wl-summary-prev)
2962             (wl-summary-next)))
2963       msg-num)))
2964
2965 (defun wl-summary-remove-destination ()
2966   (save-excursion
2967     (let ((inhibit-read-only t)
2968           (buffer-read-only nil)
2969           (buf (current-buffer))
2970           sol eol rs re)
2971       (beginning-of-line)
2972       (setq sol (point))
2973       (end-of-line)
2974       (setq eol (point))
2975       (setq rs (next-single-property-change sol 'wl-summary-destination
2976                                             buf eol))
2977       (setq re (next-single-property-change rs 'wl-summary-destination
2978                                             buf eol))
2979       (put-text-property rs re 'wl-summary-destination nil)
2980       (put-text-property rs re 'invisible nil)
2981       (goto-char re)
2982       (delete-char (- eol re)))))
2983
2984 (defun wl-summary-check-mark (msg mark)
2985   (let ((check-func (cond ((string= mark "o")
2986                            'wl-summary-msg-marked-as-refiled)
2987                           ((string= mark "O")
2988                            'wl-summary-msg-marked-as-copied)
2989                           ((string= mark "D")
2990                            'wl-summary-msg-marked-as-deleted)
2991                           ((string= mark "*")
2992                            'wl-summary-msg-marked-as-target))))
2993     (if check-func
2994         (funcall check-func msg))))
2995
2996 (defun wl-summary-mark-collect (mark &optional begin end)
2997   (save-excursion
2998     (save-restriction
2999       (let (msglist)
3000         (narrow-to-region (or begin (point-min))
3001                           (or end (point-max)))
3002         (goto-char (point-min))
3003         ;; for thread...
3004         (if (eq wl-summary-buffer-view 'thread)
3005             (progn
3006               (while (not (eobp))
3007                 (let* ((number (wl-summary-message-number))
3008                        (entity (wl-thread-get-entity number))
3009                        result)
3010                   ;; opened...only myself is checked.
3011                   (if (wl-summary-check-mark number mark)
3012                       (wl-append msglist (list number)))
3013                   (unless (wl-thread-entity-get-opened entity)
3014                     ;; closed...children is also checked.
3015                     (if (setq result (wl-thread-get-children-msgs-with-mark
3016                                       number
3017                                       mark))
3018                         (wl-append msglist result)))
3019                   (forward-line 1)))
3020               (elmo-uniq-list msglist))
3021           (let* ((case-fold-search nil)
3022                  (re (format (concat wl-summary-message-regexp "%s")
3023                              (regexp-quote mark))))
3024             (while (re-search-forward re nil t)
3025               (setq msglist (cons (wl-summary-message-number) msglist)))
3026             (nreverse msglist)))))))
3027
3028 (defun wl-summary-exec ()
3029   (interactive)
3030   (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list)
3031                         (reverse wl-summary-buffer-delete-list)
3032                         (mapcar 'car wl-summary-buffer-copy-list)))
3033
3034 (defun wl-summary-exec-region (beg end)
3035   (interactive "r")
3036   (message "Collecting marks ...")
3037   (save-excursion
3038     (goto-char beg)
3039     (beginning-of-line)
3040     (setq beg (point))
3041     (goto-char (1- end))
3042     (forward-line)
3043     (setq end (point))
3044     (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end)
3045                           (wl-summary-mark-collect "D" beg end)
3046                           (wl-summary-mark-collect "O" beg end))))
3047
3048 (defun wl-summary-exec-subr (moves dels copies)
3049   (if (not (or moves dels copies))
3050       (message "No marks")
3051     (save-excursion
3052       (let ((del-fld (wl-summary-get-delete-folder
3053                       (wl-summary-buffer-folder-name)))
3054             (start (point))
3055             (unread-marks (list wl-summary-unread-cached-mark
3056                                 wl-summary-unread-uncached-mark
3057                                 wl-summary-new-mark))
3058             (refiles (append moves dels))
3059             (refile-executed 0)
3060             (refile-failures 0)
3061             (copy-executed 0)
3062             (copy-failures 0)
3063             (copy-len (length copies))
3064             refile-len
3065             dst-msgs                    ; loop counter
3066             result)
3067         (message "Executing ...")
3068         (while dels
3069           (when (not (assq (car dels) wl-summary-buffer-refile-list))
3070             (wl-append wl-summary-buffer-refile-list
3071                        (list (cons (car dels) del-fld)))
3072             (setq wl-summary-buffer-delete-list
3073                   (delete (car dels) wl-summary-buffer-delete-list)))
3074           (setq dels (cdr dels)))
3075         ;; begin refile...
3076         (setq refile-len (length refiles))
3077         (setq dst-msgs
3078               (wl-inverse-alist refiles wl-summary-buffer-refile-list))
3079         (goto-char start)               ; avoid moving cursor to
3080                                         ; the bottom line.
3081         (while dst-msgs
3082           (setq result nil)
3083           (condition-case nil
3084               (setq result (elmo-folder-move-messages
3085                             wl-summary-buffer-elmo-folder
3086                             (cdr (car dst-msgs))
3087                             (wl-folder-get-elmo-folder
3088                              (car (car dst-msgs)))
3089                             (wl-summary-buffer-msgdb)
3090                             refile-len
3091                             refile-executed
3092                             (not (null (cdr dst-msgs)))
3093                             nil ; no-delete
3094                             nil ; same-number
3095                             unread-marks
3096                             t))
3097             (error nil))
3098           (if result                    ; succeeded.
3099               (progn
3100                 ;; update buffer.
3101                 (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
3102                 ;; update refile-alist.
3103                 (setq wl-summary-buffer-refile-list
3104                       (wl-delete-associations (cdr (car dst-msgs))
3105                                               wl-summary-buffer-refile-list)))
3106             (setq refile-failures
3107                   (+ refile-failures (length (cdr (car dst-msgs))))))
3108           (setq refile-executed (+ refile-executed (length (cdr (car dst-msgs)))))
3109           (setq dst-msgs (cdr dst-msgs)))
3110         ;; end refile
3111         ;; begin cOpy...
3112         (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
3113         (while dst-msgs
3114           (setq result nil)
3115           (condition-case nil
3116               (setq result (elmo-folder-move-messages
3117                             wl-summary-buffer-elmo-folder
3118                             (cdr (car dst-msgs))
3119                             (wl-folder-get-elmo-folder
3120                              (car (car dst-msgs)))
3121                             (wl-summary-buffer-msgdb)
3122                             copy-len
3123                             copy-executed
3124                             (not (null (cdr dst-msgs)))
3125                             t ; t is no-delete (copy)
3126                             nil ; same number
3127                             unread-marks
3128                             t))
3129             (error nil))
3130           (if result                    ; succeeded.
3131               (progn
3132                 ;; update buffer.
3133                 (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
3134                 ;; update copy-alist
3135                 (setq wl-summary-buffer-copy-list
3136                       (wl-delete-associations (cdr (car dst-msgs))
3137                                               wl-summary-buffer-copy-list)))
3138             (setq copy-failures
3139                   (+ copy-failures (length (cdr (car dst-msgs))))))
3140           (setq copy-executed (+ copy-executed (length (cdr (car dst-msgs)))))
3141           (setq dst-msgs (cdr dst-msgs)))
3142         ;; end cOpy
3143         (wl-summary-folder-info-update)
3144         (wl-summary-set-message-modified)
3145         (wl-summary-set-mark-modified)
3146         (run-hooks 'wl-summary-exec-hook)
3147         (set-buffer-modified-p nil)
3148         (message (concat "Executing ... done"
3149                          (if (> refile-failures 0)
3150                              (format " (%d refiling failed)" refile-failures)
3151                            "")
3152                          (if (> copy-failures 0)
3153                              (format " (%d copying failed)" copy-failures)
3154                            "")
3155                          "."))))))
3156
3157 (defun wl-summary-read-folder (default &optional purpose ignore-error
3158                                 no-create init)
3159   (let ((fld (completing-read
3160               (format "Folder name %s(%s): " (or purpose "")
3161                       default)
3162               (or wl-folder-completion-function
3163                   (if (memq 'read-folder wl-use-folder-petname)
3164                       (wl-folder-get-entity-with-petname)
3165                     wl-folder-entity-hashtb))
3166               nil nil (or init wl-default-spec)
3167               'wl-read-folder-hist)))
3168     (if (or (string= fld wl-default-spec)
3169             (string= fld ""))
3170         (setq fld default))
3171     (setq fld (elmo-string (wl-folder-get-realname fld)))
3172     (if (string-match "\n" fld)
3173         (error "Not supported folder name: %s" fld))
3174     (unless no-create
3175       (if ignore-error
3176           (condition-case nil
3177               (wl-folder-confirm-existence
3178                (wl-folder-get-elmo-folder
3179                 fld))
3180             (error))
3181         (wl-folder-confirm-existence (wl-folder-get-elmo-folder
3182                                       fld))))
3183     fld))
3184
3185 (defun wl-summary-print-destination (msg-num folder)
3186   "Print refile destination on line."
3187   (wl-summary-remove-destination)
3188   (let ((inhibit-read-only t)
3189         (folder (copy-sequence folder))
3190         (buffer-read-only nil)
3191         len rs re c)
3192     (setq len (string-width folder))
3193     (if (< len 1) ()
3194       (end-of-line)
3195       (setq re (point))
3196       (setq c 0)
3197       (while (< c len)
3198         (forward-char -1)
3199         (setq c (+ c (char-width (following-char)))))
3200       (and (> c len) (setq folder (concat " " folder)))
3201       (setq rs (point))
3202       (put-text-property rs re 'invisible t)
3203       (put-text-property rs re 'wl-summary-destination t)
3204       (goto-char re)
3205       (wl-highlight-refile-destination-string folder)
3206       (insert folder)
3207       (set-buffer-modified-p nil))))
3208
3209 ;; override.
3210 (when wl-on-nemacs
3211   (defun wl-summary-print-destination (msg-num &optional folder))
3212   (defun wl-summary-remove-destination ()))
3213
3214 (defsubst wl-summary-get-mark (number)
3215   "Return a temporal mark of message specified by NUMBER."
3216   (or (and (memq number wl-summary-buffer-delete-list) "D")
3217       (and (assq number wl-summary-buffer-copy-list) "O")
3218       (and (assq number wl-summary-buffer-refile-list) "o")
3219       (and (memq number wl-summary-buffer-target-mark-list) "*")))
3220
3221 (defsubst wl-summary-reserve-temp-mark-p (mark)
3222   "Return t if temporal MARK should be reserved."
3223   (member mark wl-summary-reserve-mark-list))
3224
3225 (defun wl-summary-refile (&optional dst number)
3226   "Put refile mark on current line message.
3227 If optional argument DST is specified, put mark without asking
3228 destination folder.
3229 If optional argument NUMBER is specified, mark message specified by NUMBER.
3230
3231 If folder is read-only, message should be copied.
3232 See `wl-refile-policy-alist' for more details."
3233   (interactive)
3234   (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
3235                                          (wl-summary-buffer-folder-name))))
3236     (cond ((eq policy 'copy)
3237            (if (interactive-p)
3238                (call-interactively 'wl-summary-copy)
3239              (wl-summary-copy dst number)))
3240           (t
3241            (wl-summary-refile-subr 'refile (interactive-p) dst number)))))
3242
3243 (defun wl-summary-copy (&optional dst number)
3244   "Put copy mark on current line message.
3245 If optional argument DST is specified, put mark without asking
3246 destination folder.
3247 If optional argument NUMBER is specified, mark message specified by NUMBER."
3248   (interactive)
3249   (wl-summary-refile-subr 'copy (interactive-p) dst number))
3250
3251 (defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number)
3252   (interactive)
3253   (let* ((buffer-num (wl-summary-message-number))
3254          (msg-num (or number buffer-num))
3255          (msgid (and msg-num
3256                      (elmo-message-field wl-summary-buffer-elmo-folder
3257                                          msg-num 'message-id)))
3258          (entity (and msg-num
3259                       (elmo-msgdb-overview-get-entity
3260                        msg-num (wl-summary-buffer-msgdb))))
3261          (variable
3262           (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3263          folder mark already tmp-folder)
3264     (catch 'done
3265       (when (null entity)
3266         ;; msgdb is empty?
3267         (if interactive
3268             (message "Cannot refile."))
3269         (throw 'done nil))
3270       (when (null msg-num)
3271         (if interactive
3272             (message "No message."))
3273         (throw 'done nil))
3274       (when (setq mark (wl-summary-get-mark msg-num))
3275         (when (wl-summary-reserve-temp-mark-p mark)
3276           (if interactive
3277               (error "Already marked as `%s'" mark))
3278           (throw 'done nil)))
3279       (setq folder (and msg-num
3280                         (or dst (wl-summary-read-folder
3281                                  (or (wl-refile-guess entity) wl-trash-folder)
3282                                  (format "for %s" copy-or-refile)))))
3283       ;; Cache folder hack by okada@opaopa.org
3284       (if (and (eq (elmo-folder-type-internal
3285                     (wl-folder-get-elmo-folder
3286                      (wl-folder-get-realname folder))) 'cache)
3287                (not (string= folder
3288                              (setq tmp-folder
3289                                    (concat "'cache/"
3290                                            (elmo-cache-get-path-subr
3291                                             (elmo-msgid-to-cache msgid)))))))
3292           (progn
3293             (setq folder tmp-folder)
3294             (message "Force refile to %s." folder)))
3295       (if (string= folder (wl-summary-buffer-folder-name))
3296           (error "Same folder"))
3297       (if (or (string= folder wl-queue-folder)
3298               (string= folder wl-draft-folder))
3299           (error "Don't %s messages to %s" copy-or-refile folder))
3300       ;; learn for refile.
3301       (if (eq copy-or-refile 'refile)
3302           (wl-refile-learn entity folder))
3303       (wl-summary-unmark msg-num)
3304       (set variable (append
3305                      (symbol-value variable)
3306                      (list (cons msg-num folder))))
3307       (when (or interactive
3308                 (eq number buffer-num))
3309         (wl-summary-mark-line (if (eq copy-or-refile 'refile)
3310                                   "o" "O"))
3311         ;; print refile destination
3312         (wl-summary-print-destination msg-num folder))
3313       (if interactive
3314           (if (eq wl-summary-move-direction-downward nil)
3315               (wl-summary-prev)
3316             (wl-summary-next)))
3317       (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile)))
3318       (setq wl-summary-buffer-prev-refile-destination folder)
3319       msg-num)))
3320
3321 (defun wl-summary-refile-prev-destination ()
3322   "Refile message to previously refiled destination."
3323   (interactive)
3324   (wl-summary-refile wl-summary-buffer-prev-refile-destination
3325                      (wl-summary-message-number))
3326   (if (eq wl-summary-move-direction-downward nil)
3327       (wl-summary-prev)
3328     (wl-summary-next)))
3329
3330 (defun wl-summary-copy-prev-destination ()
3331   "Refile message to previously refiled destination."
3332   (interactive)
3333   (wl-summary-copy wl-summary-buffer-prev-copy-destination
3334                    (wl-summary-message-number))
3335   (if (eq wl-summary-move-direction-downward nil)
3336       (wl-summary-prev)
3337     (wl-summary-next)))
3338
3339 (defsubst wl-summary-no-auto-refile-message-p (msg mark-alist)
3340   (member (cadr (assq msg mark-alist)) wl-summary-auto-refile-skip-marks))
3341
3342 (defun wl-summary-auto-refile (&optional open-all)
3343   "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
3344   (interactive "P")
3345   (message "Marking...")
3346   (save-excursion
3347     (if (and (eq wl-summary-buffer-view 'thread)
3348              open-all)
3349         (wl-thread-open-all))
3350     (let* ((spec (wl-summary-buffer-folder-name))
3351            (overview (elmo-msgdb-get-overview
3352                       (wl-summary-buffer-msgdb)))
3353            (mark-alist (elmo-msgdb-get-mark-alist
3354                         (wl-summary-buffer-msgdb)))
3355            checked-dsts
3356            (count 0)
3357            number dst thr-entity)
3358       (goto-line 1)
3359       (while (not (eobp))
3360         (setq number (wl-summary-message-number))
3361         (when (and (not (wl-summary-no-auto-refile-message-p number
3362                                                              mark-alist))
3363                    (setq dst
3364                          (wl-folder-get-realname
3365                           (wl-refile-guess-by-rule
3366                            (elmo-msgdb-overview-get-entity
3367                             number (wl-summary-buffer-msgdb)))))
3368                    (not (equal dst spec)))
3369           (when (not (member dst checked-dsts))
3370             (wl-folder-confirm-existence (wl-folder-get-elmo-folder dst))
3371             (setq checked-dsts (cons dst checked-dsts)))
3372           (if (wl-summary-refile dst number)
3373               (incf count))
3374           (message "Marking...%d message(s)." count))
3375         (if (eq wl-summary-buffer-view 'thread)
3376             ;; process invisible children.
3377             (unless (wl-thread-entity-get-opened
3378                      (setq thr-entity (wl-thread-get-entity number)))
3379               (let ((messages
3380                      (elmo-delete-if
3381                       (function
3382                        (lambda (x)
3383                          (wl-summary-no-auto-refile-message-p
3384                           x mark-alist)))
3385                       (wl-thread-entity-get-descendant thr-entity))))
3386                 (while messages
3387                   (when (and (setq dst
3388                                    (wl-refile-guess-by-rule
3389                                     (elmo-msgdb-overview-get-entity
3390                                      (car messages) (wl-summary-buffer-msgdb))))
3391                              (not (equal dst spec)))
3392                     (if (wl-summary-refile dst (car messages))
3393                         (incf count))
3394                     (message "Marking...%d message(s)." count))
3395                   (setq messages (cdr messages))))))
3396         (forward-line))
3397       (if (eq count 0)
3398           (message "No message was marked.")
3399         (message "Marked %d message(s)." count)))))
3400
3401 (defun wl-summary-unmark (&optional number)
3402   "Unmark marks (temporary, refile, copy, delete)of current line.
3403 If optional argument NUMBER is specified, unmark message specified by NUMBER."
3404   (interactive)
3405   (save-excursion
3406     (beginning-of-line)
3407     (let ((inhibit-read-only t)
3408           (buffer-read-only nil)
3409           visible
3410           msg-num
3411           cur-mark
3412           score-mark)
3413       (if number
3414           (setq visible (wl-summary-jump-to-msg number))
3415         (setq visible t))
3416       ;; Delete mark on buffer.
3417       (when (and visible
3418                  (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)"))
3419         (goto-char (match-end 2))
3420         (or number
3421             (setq number (string-to-int (wl-match-buffer 1))))
3422         (setq cur-mark (wl-match-buffer 2))
3423         (if (string= cur-mark " ")
3424             ()
3425           (delete-region (match-beginning 2) (match-end 2))
3426           (if (setq score-mark (wl-summary-get-score-mark number))
3427               (insert score-mark)
3428             (insert " ")))
3429         (if (or (string= cur-mark "o")
3430                 (string= cur-mark "O"))
3431             (wl-summary-remove-destination))
3432         (if wl-summary-highlight
3433             (wl-highlight-summary-current-line nil nil score-mark))
3434         (set-buffer-modified-p nil))
3435       ;; Remove from temporary mark structure.
3436       (and number
3437            (wl-summary-delete-mark number)))))
3438
3439 (defun wl-summary-msg-marked-as-target (msg)
3440   (if (memq msg wl-summary-buffer-target-mark-list)
3441       t))
3442
3443 (defun wl-summary-msg-marked-as-copied (msg)
3444   (assq msg wl-summary-buffer-copy-list))
3445
3446 (defun wl-summary-msg-marked-as-deleted (msg)
3447   (if (memq msg wl-summary-buffer-delete-list)
3448       t))
3449
3450 (defun wl-summary-msg-marked-as-refiled (msg)
3451   (assq msg wl-summary-buffer-refile-list))
3452
3453 (defun wl-summary-target-mark (&optional number)
3454   "Put target mark '*' on current message.
3455 If optional argument NUMBER is specified, mark message specified by NUMBER."
3456   (interactive)
3457   (let* ((buffer-num (wl-summary-message-number))
3458          (msg-num (or number buffer-num))
3459          mark)
3460     (catch 'done
3461       (when (null msg-num)
3462         (if (interactive-p)
3463             (message "No message."))
3464         (throw 'done nil))
3465       (when (setq mark (wl-summary-get-mark msg-num))
3466         (when (wl-summary-reserve-temp-mark-p mark)
3467           (if (interactive-p)
3468               (error "Already marked as `%s'" mark))
3469           (throw 'done nil))
3470         (wl-summary-unmark msg-num))
3471       (if (or (interactive-p)
3472               (eq number buffer-num))
3473           (wl-summary-mark-line "*"))
3474       (setq wl-summary-buffer-target-mark-list
3475             (cons msg-num wl-summary-buffer-target-mark-list))
3476       (if (interactive-p)
3477           (if (eq wl-summary-move-direction-downward nil)
3478               (wl-summary-prev)
3479             (wl-summary-next)))
3480       msg-num)))
3481
3482
3483 (defun wl-summary-refile-region (beg end)
3484   "Put copy mark on messages in the region specified by BEG and END."
3485   (interactive "r")
3486   (wl-summary-refile-region-subr "refile" beg end))
3487
3488 (defun wl-summary-copy-region (beg end)
3489   "Put copy mark on messages in the region specified by BEG and END."
3490   (interactive "r")
3491   (wl-summary-refile-region-subr "copy" beg end))
3492
3493 (defun wl-summary-refile-region-subr (copy-or-refile beg end)
3494   (save-excursion
3495     (save-restriction
3496       (goto-char beg)
3497       ;; guess by first msg
3498       (let* ((msgid (cdr (assq (wl-summary-message-number)
3499                                (elmo-msgdb-get-number-alist
3500                                 (wl-summary-buffer-msgdb)))))
3501              (function (intern (format "wl-summary-%s" copy-or-refile)))
3502              (entity (assoc msgid (elmo-msgdb-get-overview
3503                                    (wl-summary-buffer-msgdb))))
3504              folder)
3505         (if entity
3506             (setq folder (wl-summary-read-folder (wl-refile-guess entity)
3507                                                  (format "for %s"
3508                                                          copy-or-refile))))
3509         (narrow-to-region beg end)
3510         (if (eq wl-summary-buffer-view 'thread)
3511             (progn
3512               (while (not (eobp))
3513                 (let* ((number (wl-summary-message-number))
3514                        (entity (wl-thread-get-entity number))
3515                        children)
3516                   (if (wl-thread-entity-get-opened entity)
3517                       ;; opened...refile line.
3518                       (funcall function folder number)
3519                     ;; closed
3520                     (setq children (wl-thread-get-children-msgs number))
3521                     (while children
3522                       (funcall function folder (pop children))))
3523                   (forward-line 1))))
3524           (while (not (eobp))
3525             (funcall function folder (wl-summary-message-number))
3526             (forward-line 1)))))))
3527
3528 (defun wl-summary-unmark-region (beg end)
3529   (interactive "r")
3530   (save-excursion
3531     (save-restriction
3532       (narrow-to-region beg end)
3533       (goto-char (point-min))
3534       (if (eq wl-summary-buffer-view 'thread)
3535           (progn
3536             (while (not (eobp))
3537               (let* ((number (wl-summary-message-number))
3538                      (entity (wl-thread-get-entity number)))
3539                 (if (wl-thread-entity-get-opened entity)
3540                     ;; opened...unmark line.
3541                     (wl-summary-unmark)
3542                   ;; closed
3543                   (wl-summary-delete-marks-on-buffer
3544                    (wl-thread-get-children-msgs number))))
3545               (forward-line 1)))
3546         (while (not (eobp))
3547           (wl-summary-unmark)
3548           (forward-line 1))))))
3549
3550 (defun wl-summary-mark-region-subr (function beg end)
3551   (save-excursion
3552     (save-restriction
3553       (narrow-to-region beg end)
3554       (goto-char (point-min))
3555       (if (eq wl-summary-buffer-view 'thread)
3556           (progn
3557             (while (not (eobp))
3558               (let* ((number (wl-summary-message-number))
3559                      (entity (wl-thread-get-entity number))
3560                      (wl-summary-move-direction-downward t)
3561                      children)
3562                 (if (wl-thread-entity-get-opened entity)
3563                     ;; opened...delete line.
3564                     (funcall function number)
3565                   ;; closed
3566                   (setq children (wl-thread-get-children-msgs number))
3567                   (while children
3568                     (funcall function (pop children))))
3569                 (forward-line 1))))
3570         (while (not (eobp))
3571           (funcall function (wl-summary-message-number))
3572           (forward-line 1))))))
3573
3574 (defun wl-summary-delete-region (beg end)
3575   (interactive "r")
3576   (wl-summary-mark-region-subr 'wl-summary-delete beg end))
3577
3578 (defun wl-summary-target-mark-region (beg end)
3579   (interactive "r")
3580   (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
3581
3582 (defun wl-summary-target-mark-all ()
3583   (interactive)
3584   (wl-summary-target-mark-region (point-min) (point-max))
3585   (setq wl-summary-buffer-target-mark-list
3586         (mapcar 'car
3587                 (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))))
3588
3589 (defun wl-summary-delete-all-mark (mark)
3590   (goto-char (point-min))
3591   (let ((case-fold-search nil))
3592     (while (re-search-forward (format "^ *[0-9]+%s"
3593                                       (regexp-quote mark)) nil t)
3594       (wl-summary-unmark))
3595     (cond ((string= mark "*")
3596            (setq wl-summary-buffer-target-mark-list nil))
3597           ((string= mark "D")
3598            (setq wl-summary-buffer-delete-list nil))
3599           ((string= mark "O")
3600            (setq wl-summary-buffer-copy-list nil))
3601           ((string= mark "o")
3602            (setq wl-summary-buffer-refile-list nil)))))
3603
3604 (defun wl-summary-unmark-all ()
3605   "Unmark all according to what you input."
3606   (interactive)
3607   (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
3608         cur-mark)
3609     (save-excursion
3610       (while unmarks
3611         (setq cur-mark (char-to-string (car unmarks)))
3612         (wl-summary-delete-all-mark cur-mark)
3613         (setq unmarks (cdr unmarks))))))
3614
3615 (defun wl-summary-target-mark-thread ()
3616   (interactive)
3617   (let (beg end)
3618     (end-of-line)
3619     (wl-summary-goto-top-of-current-thread)
3620     (wl-thread-force-open)
3621     (setq beg (point))
3622     (end-of-line)
3623     (wl-summary-goto-bottom-of-current-thread)
3624 ;;; (forward-line -1)
3625     (beginning-of-line)
3626     (setq end (point))
3627     (wl-summary-target-mark-region beg end)))
3628
3629 (defun wl-summary-target-mark-msgs (msgs)
3630   (while msgs
3631     (if (eq wl-summary-buffer-view 'thread)
3632         (wl-thread-jump-to-msg (car msgs))
3633       (wl-summary-jump-to-msg (car msgs)))
3634     (wl-summary-target-mark (wl-summary-message-number))
3635     (setq msgs (cdr msgs))))
3636
3637 (defun wl-summary-pick (&optional from-list delete-marks)
3638   (interactive)
3639   (let ((result (elmo-msgdb-search
3640                  wl-summary-buffer-elmo-folder
3641                  (elmo-read-search-condition wl-summary-pick-field-default)
3642                  (wl-summary-buffer-msgdb))))
3643     (if delete-marks
3644       (let ((mlist wl-summary-buffer-target-mark-list))
3645         (while mlist
3646           (when (wl-summary-jump-to-msg (car mlist))
3647             (wl-summary-unmark))
3648           (setq mlist (cdr mlist)))
3649         (setq wl-summary-buffer-target-mark-list nil)))
3650     (if from-list
3651         (setq result (elmo-list-filter from-list result)))
3652     (message "%d message(s) are picked." (length result))
3653     (if (null result)
3654         (message "No message was picked.")
3655       (wl-summary-target-mark-msgs result))))
3656
3657 (defun wl-summary-unvirtual ()
3658   "Exit from current virtual folder."
3659   (interactive)
3660   (if (eq 'filter
3661           (elmo-folder-type-internal wl-summary-buffer-elmo-folder))
3662       (wl-summary-goto-folder-subr
3663        (elmo-folder-name-internal
3664         (elmo-filter-folder-target-internal
3665          wl-summary-buffer-elmo-folder))
3666        'update nil nil t)
3667     (error "This folder is not filtered")))
3668
3669 (defun wl-summary-virtual (&optional arg)
3670   "Goto virtual folder.
3671 If ARG, exit virtual folder."
3672   (interactive "P")
3673   (if arg
3674       (wl-summary-unvirtual)
3675     (wl-summary-goto-folder-subr (concat "/"
3676                                          (elmo-read-search-condition
3677                                           wl-summary-pick-field-default)
3678                                          "/"
3679                                          (wl-summary-buffer-folder-name))
3680                                  'update nil nil t)))
3681
3682 (defun wl-summary-delete-all-temp-marks ()
3683   (interactive)
3684   (save-excursion
3685     (goto-char (point-min))
3686     (message "Unmarking...")
3687     (while (not (eobp))
3688       (wl-summary-unmark)
3689       (forward-line))
3690     (message "Unmarking...done")
3691     (setq wl-summary-buffer-target-mark-list nil)
3692     (setq wl-summary-buffer-delete-list nil)
3693     (setq wl-summary-buffer-refile-list nil)
3694     (setq wl-summary-buffer-copy-list nil)))
3695
3696 (defun wl-summary-delete-mark (number)
3697   "Delete temporary mark of the message specified by NUMBER."
3698   (cond
3699    ((memq number wl-summary-buffer-target-mark-list)
3700     (setq wl-summary-buffer-target-mark-list
3701           (delq number wl-summary-buffer-target-mark-list)))
3702    ((memq number wl-summary-buffer-delete-list)
3703     (setq wl-summary-buffer-delete-list
3704           (delq number wl-summary-buffer-delete-list)))
3705    (t
3706     (let (pair)
3707       (cond
3708        ((setq pair (assq number wl-summary-buffer-copy-list))
3709         (setq wl-summary-buffer-copy-list
3710               (delq pair wl-summary-buffer-copy-list)))
3711        ((setq pair (assq number wl-summary-buffer-refile-list))
3712         (setq wl-summary-buffer-refile-list
3713               (delq pair wl-summary-buffer-refile-list))))))))
3714
3715 (defun wl-summary-mark-line (mark)
3716   "Put MARK on current line.  Return message number."
3717   (save-excursion
3718     (beginning-of-line)
3719     (let ((inhibit-read-only t)
3720           (buffer-read-only nil)
3721           msg-num
3722           cur-mark)
3723       (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
3724         (setq msg-num  (string-to-int (wl-match-buffer 1)))
3725         (setq cur-mark (wl-match-buffer 2))
3726         (goto-char (match-end 1))
3727         (delete-region (match-beginning 2) (match-end 2))
3728 ;;;     (wl-summary-delete-mark msg-num)
3729         (insert mark)
3730         (if wl-summary-highlight
3731             (wl-highlight-summary-current-line nil nil t))
3732         (set-buffer-modified-p nil)
3733         msg-num))))
3734
3735 (defun wl-summary-target-mark-delete ()
3736   (interactive)
3737   (save-excursion
3738     (goto-char (point-min))
3739     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3740           number mlist)
3741       (while (re-search-forward regexp nil t)
3742         (let (wl-summary-buffer-disp-msg)
3743           (when (setq number (wl-summary-message-number))
3744             (wl-summary-delete number)
3745             (setq wl-summary-buffer-target-mark-list
3746                   (delq number wl-summary-buffer-target-mark-list)))))
3747       (setq mlist wl-summary-buffer-target-mark-list)
3748       (while mlist
3749         (wl-append wl-summary-buffer-delete-list (list (car mlist)))
3750         (setq wl-summary-buffer-target-mark-list
3751               (delq (car mlist) wl-summary-buffer-target-mark-list))
3752         (setq mlist (cdr mlist))))))
3753
3754 (defun wl-summary-target-mark-prefetch ()
3755   (interactive)
3756   (save-excursion
3757     (let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
3758            (inhibit-read-only t)
3759            (buffer-read-only nil)
3760            (count 0)
3761            (length (length mlist))
3762            (pos (point))
3763            skipped
3764            new-mark)
3765       (while mlist
3766         (setq new-mark (wl-summary-prefetch-msg (car mlist)))
3767         (if new-mark
3768             (progn
3769               (message "Prefetching... %d/%d message(s)"
3770                        (setq count (+ 1 count)) length)
3771               (when (wl-summary-jump-to-msg (car mlist))
3772                 (wl-summary-unmark)
3773                 (when new-mark
3774                   (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)")
3775                     (delete-region (match-beginning 1) (match-end 1)))
3776                   (goto-char (match-beginning 1))
3777                   (insert new-mark)
3778                   (if wl-summary-highlight
3779                       (wl-highlight-summary-current-line))
3780                   (save-excursion
3781                     (goto-char pos)
3782                     (sit-for 0)))))
3783           (setq skipped (cons (car mlist) skipped)))
3784         (setq mlist (cdr mlist)))
3785       (setq wl-summary-buffer-target-mark-list skipped)
3786       (message "Prefetching... %d/%d message(s)." count length)
3787       (set-buffer-modified-p nil))))
3788
3789 (defun wl-summary-target-mark-refile-subr (copy-or-refile)
3790   (let ((variable
3791          (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3792         (function
3793          (intern (format "wl-summary-%s" copy-or-refile)))
3794         regexp number msgid entity folder mlist)
3795     (save-excursion
3796       (goto-char (point-min))
3797       (setq regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3798       ;; guess by first mark
3799       (when (re-search-forward regexp nil t)
3800         (setq msgid (cdr (assq (setq number (wl-summary-message-number))
3801                                (elmo-msgdb-get-number-alist
3802                                 (wl-summary-buffer-msgdb))))
3803               entity (assoc msgid
3804                             (elmo-msgdb-get-overview
3805                              (wl-summary-buffer-msgdb))))
3806         (if (null entity)
3807             (error "Cannot %s" copy-or-refile))
3808         (funcall function
3809                  (setq folder (wl-summary-read-folder
3810                                (wl-refile-guess entity)
3811                                (format "for %s" copy-or-refile)))
3812                  number)
3813         (if number
3814             (setq wl-summary-buffer-target-mark-list
3815                   (delq number wl-summary-buffer-target-mark-list)))
3816         (while (re-search-forward regexp nil t)
3817           (let (wl-summary-buffer-disp-msg)
3818             (when (setq number (wl-summary-message-number))
3819               (funcall function folder number)
3820               (setq wl-summary-buffer-target-mark-list
3821                     (delq number wl-summary-buffer-target-mark-list)))))
3822         ;; process invisible messages.
3823         (setq mlist wl-summary-buffer-target-mark-list)
3824         (while mlist
3825           (set variable
3826                (append (symbol-value variable)
3827                        (list (cons (car mlist) folder))))
3828           (setq wl-summary-buffer-target-mark-list
3829                 (delq (car mlist) wl-summary-buffer-target-mark-list))
3830           (setq mlist (cdr mlist)))))))
3831
3832 (defun wl-summary-target-mark-copy ()
3833   (interactive)
3834   (wl-summary-target-mark-refile-subr "copy"))
3835
3836 (defun wl-summary-target-mark-refile ()
3837   (interactive)
3838   (wl-summary-target-mark-refile-subr "refile"))
3839
3840 (defun wl-summary-target-mark-mark-as-read ()
3841   (interactive)
3842   (save-excursion
3843     (goto-char (point-min))
3844     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3845           (inhibit-read-only t)
3846           (buffer-read-only nil)
3847           number mlist)
3848       (while (re-search-forward regexp nil t)
3849         (let (wl-summary-buffer-disp-msg)
3850           ;; delete target-mark from buffer.
3851           (delete-region (match-beginning 1) (match-end 1))
3852           (insert " ")
3853           (setq number (wl-summary-mark-as-read t))
3854           (if wl-summary-highlight
3855               (wl-highlight-summary-current-line))
3856           (if number
3857               (setq wl-summary-buffer-target-mark-list
3858                     (delq number wl-summary-buffer-target-mark-list)))))
3859       (setq mlist wl-summary-buffer-target-mark-list)
3860       (while mlist
3861         (wl-summary-mark-as-read t nil nil (car mlist))
3862         (setq wl-summary-buffer-target-mark-list
3863               (delq (car mlist) wl-summary-buffer-target-mark-list))
3864         (setq mlist (cdr mlist)))
3865       (wl-summary-count-unread
3866        (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
3867       (wl-summary-update-modeline))))
3868
3869 (defun wl-summary-target-mark-mark-as-unread ()
3870   (interactive)
3871   (save-excursion
3872     (goto-char (point-min))
3873     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3874           (inhibit-read-only t)
3875           (buffer-read-only nil)
3876           number mlist)
3877       (while (re-search-forward regexp nil t)
3878         (let (wl-summary-buffer-disp-msg)
3879           ;; delete target-mark from buffer.
3880           (delete-region (match-beginning 1) (match-end 1))
3881           (insert " ")
3882           (setq number (wl-summary-mark-as-unread))
3883           (if wl-summary-highlight
3884               (wl-highlight-summary-current-line))
3885           (if number
3886               (setq wl-summary-buffer-target-mark-list
3887                     (delq number wl-summary-buffer-target-mark-list)))))
3888       (setq mlist wl-summary-buffer-target-mark-list)
3889       (while mlist
3890         (wl-summary-mark-as-unread (car mlist))
3891 ;;;     (wl-thread-msg-mark-as-unread (car mlist))
3892         (setq wl-summary-buffer-target-mark-list
3893               (delq (car mlist) wl-summary-buffer-target-mark-list))
3894         (setq mlist (cdr mlist)))
3895       (wl-summary-count-unread
3896        (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
3897       (wl-summary-update-modeline))))
3898
3899 (defun wl-summary-target-mark-mark-as-important ()
3900   (interactive)
3901   (save-excursion
3902     (goto-char (point-min))
3903     (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3904           (inhibit-read-only t)
3905           (buffer-read-only nil)
3906           number mlist)
3907       (while (re-search-forward regexp nil t)
3908         (let (wl-summary-buffer-disp-msg)
3909           ;; delete target-mark from buffer.
3910           (delete-region (match-beginning 1) (match-end 1))
3911           (insert " ")
3912           (setq number (wl-summary-mark-as-important))
3913           (if wl-summary-highlight
3914               (wl-highlight-summary-current-line))
3915           (if number
3916               (setq wl-summary-buffer-target-mark-list
3917                     (delq number wl-summary-buffer-target-mark-list)))))
3918       (setq mlist wl-summary-buffer-target-mark-list)
3919       (while mlist
3920         (wl-summary-mark-as-important (car mlist))
3921         (wl-thread-msg-mark-as-important (car mlist))
3922         (setq wl-summary-buffer-target-mark-list
3923               (delq (car mlist) wl-summary-buffer-target-mark-list))
3924         (setq mlist (cdr mlist)))
3925       (wl-summary-count-unread
3926        (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
3927       (wl-summary-update-modeline))))
3928
3929 (defun wl-summary-target-mark-save ()
3930   (interactive)
3931   (save-excursion
3932     (goto-char (point-min))
3933     (let ((wl-save-dir
3934            (wl-read-directory-name "Save to directory: " wl-tmp-dir))
3935           (regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3936           number mlist)
3937       (if (null (file-exists-p wl-save-dir))
3938           (make-directory wl-save-dir))
3939       (while (re-search-forward regexp nil t)
3940         (let (wl-summary-buffer-disp-msg)
3941           (setq number (wl-summary-save t wl-save-dir))
3942           (wl-summary-unmark)
3943           (if number
3944               (setq wl-summary-buffer-target-mark-list
3945                     (delq number wl-summary-buffer-target-mark-list))))))))
3946
3947 (defun wl-summary-target-mark-pick ()
3948   (interactive)
3949   (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
3950
3951 (defun wl-summary-mark-as-read (&optional notcrosses
3952                                           leave-server-side-mark-untouched
3953                                           displayed
3954                                           number
3955                                           cached)
3956   (interactive)
3957   (save-excursion
3958     (let* (eol
3959            (inhibit-read-only t)
3960            (buffer-read-only nil)
3961            (folder wl-summary-buffer-elmo-folder)
3962            (msgdb (wl-summary-buffer-msgdb))
3963            (mark-alist (elmo-msgdb-get-mark-alist msgdb))
3964 ;;;        (number-alist (elmo-msgdb-get-number-alist msgdb))
3965            (case-fold-search nil)
3966            mark stat visible uncached new-mark marked)
3967       (if number
3968           (progn
3969             (setq visible (wl-summary-jump-to-msg number))
3970             (setq mark (cadr (assq number mark-alist))))
3971         (setq visible t))
3972       (beginning-of-line)
3973       (if (or (not visible)
3974               (looking-at
3975                (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
3976                        (regexp-quote wl-summary-read-uncached-mark)
3977                        (regexp-quote wl-summary-unread-uncached-mark)
3978                        (regexp-quote wl-summary-unread-cached-mark)
3979                        (regexp-quote wl-summary-new-mark))))
3980           (progn
3981             (setq mark (or mark (wl-match-buffer 2)))
3982             (when mark
3983               (cond
3984                ((string= mark wl-summary-new-mark) ; N
3985                 (setq stat 'new)
3986                 (setq uncached t))
3987                ((string= mark wl-summary-unread-uncached-mark) ; U
3988                 (setq stat 'unread)
3989                 (setq uncached t))
3990                ((string= mark wl-summary-unread-cached-mark)  ; !
3991                 (setq stat 'unread))
3992                (t
3993                 ;; no need to mark server.
3994                 (setq leave-server-side-mark-untouched t))))
3995             (setq number (or number (string-to-int (wl-match-buffer 1))))
3996             ;; set server side mark...
3997             (setq new-mark (if (and uncached
3998                                     (if (elmo-message-use-cache-p folder number)
3999                                         (not (elmo-folder-local-p folder)))
4000                                     (not cached))
4001                                wl-summary-read-uncached-mark
4002                              nil))
4003             (if (not leave-server-side-mark-untouched)
4004                 (save-match-data
4005                   (setq marked (elmo-folder-mark-as-read
4006                                 folder
4007                                 (list number)))))
4008             (if (or leave-server-side-mark-untouched
4009                     marked)
4010                 (progn
4011                   (cond ((eq stat 'unread)
4012                          (setq wl-summary-buffer-unread-count
4013                                (1- wl-summary-buffer-unread-count)))
4014                         ((eq stat 'new)
4015                          (setq wl-summary-buffer-new-count
4016                                (1- wl-summary-buffer-new-count))))
4017                   (wl-summary-update-modeline)
4018                   (wl-folder-update-unread
4019                    (wl-summary-buffer-folder-name)
4020                    (+ wl-summary-buffer-unread-count
4021                       wl-summary-buffer-new-count))
4022                   (when (or stat cached)
4023                     (when visible
4024                       (goto-char (match-end 2))
4025                       (delete-region (match-beginning 2) (match-end 2))
4026                       (insert (or new-mark " ")))
4027                     (setq mark-alist
4028                           (elmo-msgdb-mark-set mark-alist number new-mark))
4029                     (elmo-msgdb-set-mark-alist msgdb mark-alist)
4030                     (wl-summary-set-mark-modified))
4031                   (if (and visible wl-summary-highlight)
4032                       (wl-highlight-summary-current-line nil nil t)))
4033               (if mark (message "Warning: Changing mark failed.")))))
4034       (set-buffer-modified-p nil)
4035       (if stat
4036           (run-hooks 'wl-summary-unread-message-hook))
4037       number ;return value
4038       )))
4039
4040 (defun wl-summary-mark-as-important (&optional number
4041                                                mark
4042                                                no-server-update)
4043   (interactive)
4044   (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
4045           'internal)
4046       (error "Cannot process mark in this folder"))
4047   (save-excursion
4048     (let* (eol
4049           (inhibit-read-only t)
4050           (buffer-read-only nil)
4051           (folder wl-summary-buffer-elmo-folder)
4052           (msgdb (wl-summary-buffer-msgdb))
4053           (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4054           (number-alist (elmo-msgdb-get-number-alist msgdb))
4055           message-id visible)
4056       (if number
4057           (progn
4058             (setq visible (wl-summary-jump-to-msg number))
4059             (setq mark (or mark (cadr (assq number mark-alist)))))
4060         (setq visible t))
4061       (when visible
4062         (if (null (wl-summary-message-number))
4063             (progn
4064               (message "No message.")
4065               (setq visible nil))
4066           (end-of-line)
4067           (setq eol (point))
4068           (re-search-backward (concat "^" wl-summary-buffer-number-regexp
4069                                       "..../..") nil t)) ; set cursor line
4070         )
4071       (beginning-of-line)
4072       (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)
4073           (progn
4074             (setq number (or number (string-to-int (wl-match-buffer 1))))
4075             (setq mark (or mark (wl-match-buffer 2)))
4076             (setq message-id (elmo-message-field
4077                               wl-summary-buffer-elmo-folder
4078                               number
4079                               'message-id))
4080             (if (string= mark wl-summary-important-mark)
4081                 (progn
4082                   ;; server side mark
4083                   (unless no-server-update
4084                     (elmo-folder-unmark-important folder (list number))
4085                     (elmo-msgdb-global-mark-delete message-id))
4086                   ;; Remove cache if local folder.
4087                   (save-match-data
4088                     (if (and (elmo-folder-local-p folder)
4089                              (not (eq 'mark
4090                                       (elmo-folder-type-internal folder))))
4091                         (elmo-file-cache-delete
4092                          (elmo-file-cache-get-path message-id))))
4093                   (when visible
4094                     (delete-region (match-beginning 2) (match-end 2))
4095                     (insert " "))
4096                   (setq mark-alist
4097                         (elmo-msgdb-mark-set mark-alist
4098                                              number
4099                                              nil)))
4100               ;; server side mark
4101               (unless no-server-update
4102                 (elmo-folder-mark-as-important folder (list number)))
4103               (when visible
4104                 (delete-region (match-beginning 2) (match-end 2))
4105                 (insert wl-summary-important-mark))
4106               (setq mark-alist
4107                     (elmo-msgdb-mark-set mark-alist
4108                                          (string-to-int (wl-match-buffer 1))
4109                                          wl-summary-important-mark))
4110               ;; Force cache message!!
4111               (elmo-message-encache folder number)
4112               (unless no-server-update
4113                 (elmo-msgdb-global-mark-set message-id
4114                                             wl-summary-important-mark)))
4115             (elmo-msgdb-set-mark-alist msgdb mark-alist)
4116             (wl-summary-set-mark-modified)))
4117       (if (and visible wl-summary-highlight)
4118           (wl-highlight-summary-current-line nil nil t))))
4119   (set-buffer-modified-p nil)
4120   number)
4121
4122 (defsubst wl-summary-format-date (date-string)
4123   (condition-case nil
4124       (let ((datevec (timezone-fix-time date-string nil
4125                                         wl-summary-fix-timezone)))
4126         (format "%02d/%02d(%s)%02d:%02d"
4127                 (aref datevec 1)
4128                 (aref datevec 2)
4129                 (elmo-date-get-week (aref datevec 0)
4130                                     (aref datevec 1)
4131                                     (aref datevec 2))
4132                 (aref datevec 3)
4133                 (aref datevec 4)))
4134     (error "??/??(??)??:??")))
4135
4136 (defun wl-summary-overview-create-summary-line (msg
4137                                                 entity
4138                                                 parent-entity
4139                                                 depth
4140                                                 mark-alist
4141                                                 &optional
4142                                                 children-num
4143                                                 temp-mark thr-entity
4144                                                 subject-differ)
4145   (let ((wl-mime-charset wl-summary-buffer-mime-charset)
4146         (elmo-mime-charset wl-summary-buffer-mime-charset)
4147         no-parent before-indent
4148         from subject parent-raw-subject parent-subject
4149         mark line
4150         (elmo-lang wl-summary-buffer-weekday-name-lang)
4151         (children-num (if children-num (int-to-string children-num)))
4152         (thr-str "")
4153         linked)
4154     (when thr-entity
4155       (setq thr-str (wl-thread-make-indent-string thr-entity))
4156       (setq linked (wl-thread-entity-get-linked thr-entity)))
4157     (if (string= thr-str "")
4158         (setq no-parent t)) ; no parent
4159     (if (and wl-summary-width
4160              wl-summary-indent-length-limit
4161              (< wl-summary-indent-length-limit
4162                 (string-width thr-str)))
4163         (setq thr-str (wl-set-string-width
4164                        wl-summary-indent-length-limit
4165                        thr-str)))
4166     (setq from
4167           (wl-set-string-width
4168            (if children-num
4169                (- wl-from-width (length children-num) 2)
4170              wl-from-width)
4171            (elmo-delete-char ?\n
4172                              (wl-summary-from-func-internal
4173                               (elmo-msgdb-overview-entity-get-from entity)))))
4174     (setq subject
4175           (elmo-delete-char ?\n
4176                             (or (elmo-msgdb-overview-entity-get-subject
4177                                  entity)
4178                                 wl-summary-no-subject-message)))
4179     (setq parent-raw-subject
4180           (elmo-msgdb-overview-entity-get-subject parent-entity))
4181     (setq parent-subject
4182           (if parent-raw-subject
4183               (elmo-delete-char ?\n parent-raw-subject)))
4184     (setq mark (or (cadr (assq msg mark-alist)) " "))
4185     (setq line
4186           (concat
4187            (setq before-indent
4188                  (format (concat "%"
4189                                  (int-to-string
4190                                   wl-summary-buffer-number-column)
4191                                  "s%s%s%s %s")
4192                          msg
4193                          (or temp-mark " ")
4194                          mark
4195                          (wl-summary-format-date
4196                           (elmo-msgdb-overview-entity-get-date entity))
4197                          (if thr-str thr-str "")))
4198            (format (if linked
4199                        "<%s > %s"
4200                      "[%s ] %s")
4201                    (if children-num
4202                        (concat "+" children-num ": " from)
4203                      (concat " " from))
4204                    (progn
4205                      (setq subject
4206                            (if (or no-parent
4207                                    (null parent-subject)
4208                                    (not (wl-summary-subject-equal
4209                                          subject parent-subject)))
4210                                (wl-summary-subject-func-internal subject) ""))
4211                      (if (and (not wl-summary-width)
4212                               wl-subject-length-limit)
4213                          (truncate-string subject wl-subject-length-limit)
4214                        subject)))))
4215     (if wl-summary-width (setq line
4216                                (wl-set-string-width
4217                                 (- wl-summary-width 1) line)))
4218     (if wl-summary-highlight
4219         (wl-highlight-summary-line-string line
4220                                           mark
4221                                           temp-mark
4222                                           thr-str))
4223     line))
4224
4225 (defsubst wl-summary-buffer-number-column-detect (update)
4226   (let (end)
4227     (save-excursion
4228       (goto-char (point-min))
4229       (setq wl-summary-buffer-number-column
4230             (or
4231              (if (and update
4232                       (setq end (if (re-search-forward "^ *[0-9-]+[^0-9]" nil t)
4233                                     (point))))
4234                  (- end (progn (beginning-of-line) (point)) 1))
4235              (wl-get-assoc-list-value wl-summary-number-column-alist
4236                                       (wl-summary-buffer-folder-name))
4237              wl-summary-default-number-column))
4238       (setq wl-summary-buffer-number-regexp
4239             (wl-repeat-string "." wl-summary-buffer-number-column)))))
4240
4241 (defsubst wl-summary-proc-wday (wday-str year month mday)
4242   (save-match-data
4243     (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
4244         (wl-match-string 1 wday-str)
4245       (elmo-date-get-week year month mday))))
4246
4247 (defvar wl-summary-move-spec-plugged-alist
4248   (` ((new . ((t . nil)
4249               (p . (, wl-summary-new-mark))
4250               (p . (, (wl-regexp-opt
4251                        (list wl-summary-unread-uncached-mark
4252                              wl-summary-unread-cached-mark))))
4253               (p . (, (regexp-quote wl-summary-important-mark)))))
4254       (unread . ((t . nil)
4255                  (p . (, (wl-regexp-opt
4256                           (list wl-summary-new-mark
4257                                 wl-summary-unread-uncached-mark
4258                                 wl-summary-unread-cached-mark))))
4259                  (p . (, (regexp-quote wl-summary-important-mark))))))))
4260
4261 (defvar wl-summary-move-spec-unplugged-alist
4262   (` ((new . ((t . nil)
4263               (p . (, wl-summary-unread-cached-mark))
4264               (p . (, (regexp-quote wl-summary-important-mark)))))
4265       (unread . ((t . nil)
4266                  (p . (, wl-summary-unread-cached-mark))
4267                  (p . (, (regexp-quote wl-summary-important-mark))))))))
4268
4269 (defsubst wl-summary-next-message (num direction hereto)
4270   (let ((cur-spec (cdr (assq wl-summary-move-order
4271                              (if (elmo-folder-plugged-p
4272                                   wl-summary-buffer-elmo-folder)
4273                                  wl-summary-move-spec-plugged-alist
4274                                wl-summary-move-spec-unplugged-alist))))
4275         (nums (memq num (if (eq direction 'up)
4276                             (reverse wl-summary-buffer-number-list)
4277                           wl-summary-buffer-number-list)))
4278         marked-list nums2)
4279     (unless hereto (setq nums (cdr nums)))
4280     (setq nums2 nums)
4281     (if cur-spec
4282         (catch 'done
4283           (while cur-spec
4284             (setq nums nums2)
4285             (cond ((eq (car (car cur-spec)) 'p)
4286                    (if (setq marked-list (elmo-folder-list-messages-mark-match
4287                                           wl-summary-buffer-elmo-folder
4288                                           (cdr (car cur-spec))))
4289                        (while nums
4290                          (if (memq (car nums) marked-list)
4291                              (throw 'done (car nums)))
4292                          (setq nums (cdr nums)))))
4293                   ((eq (car (car cur-spec)) 't)
4294                    (if wl-summary-buffer-target-mark-list
4295                        (while nums
4296                          (if (memq (car nums)
4297                                    wl-summary-buffer-target-mark-list)
4298                              (throw 'done (car nums)))
4299                          (setq nums (cdr nums))))))
4300             (setq cur-spec (cdr cur-spec))))
4301       (car nums))))
4302
4303 (defsubst wl-summary-cursor-move (direction hereto)
4304   (when (and (eq direction 'up)
4305              (eobp))
4306     (forward-line -1)
4307     (setq hereto t))
4308   (let (num)
4309     (when (setq num (wl-summary-next-message (wl-summary-message-number)
4310                                              direction hereto))
4311       (wl-thread-jump-to-msg num)
4312       t)))
4313 ;;
4314 ;; Goto unread or important
4315 ;; returns t if next message exists in this folder.
4316 (defun wl-summary-cursor-down (&optional hereto)
4317   (interactive "P")
4318   (wl-summary-cursor-move 'down hereto))
4319
4320 (defun wl-summary-cursor-up (&optional hereto)
4321   (interactive "P")
4322   (wl-summary-cursor-move 'up hereto))
4323
4324 (defun wl-summary-save-view-cache ()
4325   (save-excursion
4326     (let* ((dir (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder))
4327            (cache (expand-file-name wl-summary-cache-file dir))
4328            (view (expand-file-name wl-summary-view-file dir))
4329            (save-view wl-summary-buffer-view)
4330            (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
4331            (charset wl-summary-buffer-mime-charset))
4332       (if (file-directory-p dir)
4333           (); ok.
4334         (if (file-exists-p dir)
4335             (error "File %s already exists" dir)
4336           (elmo-make-directory dir)))
4337       (if (eq save-view 'thread)
4338           (wl-thread-save-entity dir))
4339       (unwind-protect
4340           (progn
4341             (when (file-writable-p cache)
4342               (copy-to-buffer tmp-buffer (point-min) (point-max))
4343               (with-current-buffer tmp-buffer
4344                 (widen)
4345                 (encode-mime-charset-region
4346                  (point-min) (point-max) charset)
4347                 (write-region-as-binary (point-min)(point-max)
4348                                         cache nil 'no-msg)))
4349             (when (file-writable-p view) ; 'thread or 'sequence
4350               (save-excursion
4351                 (set-buffer tmp-buffer)
4352                 (erase-buffer)
4353                 (prin1 save-view tmp-buffer)
4354                 (princ "\n" tmp-buffer)
4355                 (write-region (point-min) (point-max) view nil 'no-msg))))
4356         ;; kill tmp buffer.
4357         (kill-buffer tmp-buffer)))))
4358
4359 (defsubst wl-summary-get-sync-range (folder)
4360   (intern (or (and
4361                (elmo-folder-plugged-p folder)
4362                (wl-get-assoc-list-value
4363                 wl-folder-sync-range-alist
4364                 (elmo-folder-name-internal folder)))
4365               wl-default-sync-range)))
4366
4367 ;; redefined for wl-summary-sync-update
4368 (defun wl-summary-input-range (folder)
4369   "returns update or all or rescan."
4370   ;; for the case when parts are expanded in the bottom of the folder
4371   (let ((input-range-list '("update" "all" "rescan" "first:" "last:"
4372                             "no-sync" "rescan-noscore" "all-visible"))
4373         (default (or (wl-get-assoc-list-value
4374                       wl-folder-sync-range-alist
4375                       folder)
4376                      wl-default-sync-range))
4377         range)
4378     (setq range
4379           (completing-read (format "Range (%s): " default)
4380                            (mapcar
4381                             (function (lambda (x) (cons x x)))
4382                             input-range-list)))
4383     (if (string= range "")
4384         default
4385       range)))
4386
4387 (defun wl-summary-toggle-disp-folder (&optional arg)
4388   (interactive)
4389   (let ((cur-buf (current-buffer))
4390         (summary-win (get-buffer-window (current-buffer)))
4391         fld-buf fld-win)
4392     (cond
4393      ((eq arg 'on)
4394       (setq wl-summary-buffer-disp-folder t)
4395       ;; hide your folder window
4396       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4397           (if (setq fld-win (get-buffer-window fld-buf))
4398               (delete-window fld-win))))
4399      ((eq arg 'off)
4400       (setq wl-summary-buffer-disp-folder nil)
4401       ;; hide your wl-message window!
4402       (when (buffer-live-p wl-message-buffer)
4403         (wl-message-select-buffer wl-message-buffer)
4404         (delete-window))
4405       (select-window (get-buffer-window cur-buf))
4406       ;; display wl-folder window!!
4407       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4408           (if (setq fld-win (get-buffer-window fld-buf))
4409               ;; folder win is already displayed.
4410               (select-window fld-win)
4411             ;; folder win is not displayed.
4412             (switch-to-buffer fld-buf))
4413         ;; no folder buf
4414         (wl-folder))
4415       ;; temporarily delete summary-win.
4416       (if summary-win
4417           (delete-window summary-win))
4418       (split-window-horizontally wl-folder-window-width)
4419       (other-window 1)
4420       (switch-to-buffer cur-buf))
4421      (t
4422       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4423           (if (setq fld-win (get-buffer-window fld-buf))
4424               (setq wl-summary-buffer-disp-folder nil)
4425             (setq wl-summary-buffer-disp-folder t)))
4426       (if (not wl-summary-buffer-disp-folder)
4427           ;; hide message window
4428           (let ((mes-win (and wl-message-buffer
4429                               (get-buffer-window wl-message-buffer)))
4430                 (wl-stay-folder-window t))
4431             (if mes-win (delete-window mes-win))
4432             ;; hide your folder window
4433             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4434                 (if (setq fld-win (get-buffer-window fld-buf))
4435                     (progn
4436                       (delete-window (get-buffer-window cur-buf))
4437                       (select-window fld-win)
4438                       (switch-to-buffer cur-buf))))
4439             (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
4440             ;; resume message window.
4441             (when mes-win
4442               (wl-message-select-buffer wl-message-buffer)
4443               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4444               (select-window (get-buffer-window cur-buf)))
4445             )
4446         ;; hide message window
4447         (let ((wl-stay-folder-window t)
4448               (mes-win (and wl-message-buffer
4449                             (get-buffer-window wl-message-buffer))))
4450           (if mes-win (delete-window mes-win))
4451           (select-window (get-buffer-window cur-buf))
4452           ;; display wl-folder window!!
4453           (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4454               (if (setq fld-win (get-buffer-window fld-buf))
4455                   ;; folder win is already displayed.
4456                   (select-window fld-win)
4457                 ;; folder win is not displayed...occupy all.
4458                 (switch-to-buffer fld-buf))
4459             ;; no folder buf
4460             (wl-folder))
4461           (split-window-horizontally wl-folder-window-width)
4462           (other-window 1)
4463           (switch-to-buffer cur-buf)
4464           ;; resume message window.
4465           (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
4466           (when mes-win
4467             (wl-message-select-buffer wl-message-buffer)
4468             (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4469             (select-window (get-buffer-window cur-buf))))
4470         ))))
4471   (run-hooks 'wl-summary-toggle-disp-folder-hook))
4472
4473 (defun wl-summary-toggle-disp-msg (&optional arg)
4474   (interactive)
4475   (let ((cur-buf (current-buffer))
4476         fld-buf fld-win
4477         summary-win)
4478     (cond
4479      ((eq arg 'on)
4480       (setq wl-summary-buffer-disp-msg t)
4481       (save-excursion
4482         ;; hide your folder window
4483         (if (and (not wl-stay-folder-window)
4484                  (setq fld-buf (get-buffer wl-folder-buffer-name)))
4485             (if (setq fld-win (get-buffer-window fld-buf))
4486                 (unless (one-window-p fld-win)
4487                   (delete-window fld-win))))))
4488      ((eq arg 'off)
4489       (wl-delete-all-overlays)
4490       (setq wl-summary-buffer-disp-msg nil)
4491       (save-excursion
4492         (when (buffer-live-p wl-message-buffer)
4493           (wl-message-select-buffer wl-message-buffer)
4494           (delete-window)
4495           (and (get-buffer-window cur-buf)
4496                (select-window (get-buffer-window cur-buf))))
4497         (run-hooks 'wl-summary-toggle-disp-off-hook)))
4498      (t
4499       (if (and wl-message-buffer
4500                (get-buffer-window wl-message-buffer)) ; already displayed
4501           (setq wl-summary-buffer-disp-msg nil)
4502         (setq wl-summary-buffer-disp-msg t))
4503       (if wl-summary-buffer-disp-msg
4504           (progn
4505             (wl-summary-redisplay)
4506 ;;; hide your folder window
4507 ;;;         (setq fld-buf (get-buffer wl-folder-buffer-name))
4508 ;;;         (if (setq fld-win (get-buffer-window fld-buf))
4509 ;;;             (delete-window fld-win)))
4510             (run-hooks 'wl-summary-toggle-disp-on-hook))
4511         (wl-delete-all-overlays)
4512         (save-excursion
4513           (wl-message-select-buffer wl-message-buffer)
4514           (delete-window)
4515           (select-window (get-buffer-window cur-buf))
4516           (run-hooks 'wl-summary-toggle-disp-off-hook))
4517 ;;;     (switch-to-buffer cur-buf)
4518         )))))
4519
4520 (defun wl-summary-next-line-content ()
4521   "Show next line of the message."
4522   (interactive)
4523   (let ((cur-buf (current-buffer)))
4524     (wl-summary-toggle-disp-msg 'on)
4525     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4526       (set-buffer cur-buf)
4527       (wl-message-next-page 1))))
4528
4529 (defun wl-summary-prev-line-content ()
4530   (interactive)
4531   (let ((cur-buf (current-buffer)))
4532     (wl-summary-toggle-disp-msg 'on)
4533     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4534       (set-buffer cur-buf)
4535       (wl-message-prev-page 1))))
4536
4537 (defun wl-summary-next-page ()
4538   (interactive)
4539   (wl-message-next-page))
4540
4541 (defun wl-summary-prev-page ()
4542   (interactive)
4543   (wl-message-prev-page))
4544
4545 (defsubst wl-summary-no-mime-p (folder)
4546   (wl-string-match-member (elmo-folder-name-internal folder)
4547                           wl-summary-no-mime-folder-list))
4548
4549 (defun wl-summary-set-message-buffer-or-redisplay (&rest args)
4550   "Set message buffer.
4551 If message is not displayed yet, display it.
4552 Return t if message exists."
4553   (let ((folder wl-summary-buffer-elmo-folder)
4554         (number (wl-summary-message-number))
4555         cur-folder cur-number message-last-pos)
4556     (when (buffer-live-p wl-message-buffer)
4557       (save-window-excursion
4558         (wl-message-select-buffer wl-message-buffer)
4559         (setq cur-folder wl-message-buffer-cur-folder)
4560         (setq cur-number wl-message-buffer-cur-number)))
4561     (if (and (string= (elmo-folder-name-internal folder) (or cur-folder ""))
4562              (eq number (or cur-number 0)))
4563         (progn
4564           (set-buffer wl-message-buffer)
4565           t)
4566       (if (wl-summary-no-mime-p folder)
4567           (wl-summary-redisplay-no-mime folder number)
4568         (wl-summary-redisplay-internal folder number))
4569       (set-buffer wl-message-buffer)
4570       nil)))
4571
4572 (defun wl-summary-target-mark-forward (&optional arg)
4573   (interactive "P")
4574   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4575         (summary-buf (current-buffer))
4576         (wl-draft-forward t)
4577         start-point
4578         draft-buf)
4579     (wl-summary-jump-to-msg (car mlist))
4580     (wl-summary-forward t)
4581     (setq start-point (point))
4582     (setq draft-buf (current-buffer))
4583     (setq mlist (cdr mlist))
4584     (save-window-excursion
4585       (when mlist
4586         (while mlist
4587           (set-buffer summary-buf)
4588           (wl-summary-jump-to-msg (car mlist))
4589           (wl-summary-redisplay)
4590           (set-buffer draft-buf)
4591           (goto-char (point-max))
4592           (wl-draft-insert-message)
4593           (setq mlist (cdr mlist)))
4594         (wl-draft-body-goto-top)
4595         (wl-draft-enclose-digest-region (point) (point-max)))
4596       (goto-char start-point)
4597       (save-excursion
4598         (set-buffer summary-buf)
4599         (wl-summary-delete-all-temp-marks)))
4600     (run-hooks 'wl-mail-setup-hook)))
4601
4602 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
4603   (interactive "P")
4604   (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4605         (summary-buf (current-buffer))
4606         change-major-mode-hook
4607         start-point
4608         draft-buf)
4609     (wl-summary-jump-to-msg (car mlist))
4610     (wl-summary-reply arg t)
4611     (goto-char (point-max))
4612     (setq start-point (point))
4613     (setq draft-buf (current-buffer))
4614     (save-window-excursion
4615       (while mlist
4616         (set-buffer summary-buf)
4617         (wl-summary-jump-to-msg (car mlist))
4618         (wl-summary-redisplay)
4619         (set-buffer draft-buf)
4620         (goto-char (point-max))
4621         (wl-draft-yank-original)
4622         (setq mlist (cdr mlist)))
4623       (goto-char start-point)
4624       (save-excursion
4625         (set-buffer summary-buf)
4626         (wl-summary-delete-all-temp-marks)))
4627     (run-hooks 'wl-mail-setup-hook)))
4628
4629 (defun wl-summary-reply-with-citation (&optional arg)
4630   (interactive "P")
4631   (when (wl-summary-reply arg t)
4632     (goto-char (point-max))
4633     (wl-draft-yank-original)
4634     (run-hooks 'wl-mail-setup-hook)))
4635
4636 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
4637   (interactive)
4638   (let* ((original (wl-summary-message-number))
4639          (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4640          (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))
4641          msg otherfld schar
4642          (errmsg
4643           (format "No message with id \"%s\" in the folder." msgid)))
4644     (if (setq msg (car (rassoc msgid number-alist)))
4645 ;;;     (wl-summary-jump-to-msg-internal
4646 ;;;      (wl-summary-buffer-folder-name) msg 'no-sync)
4647         (progn
4648           (wl-thread-jump-to-msg msg)
4649           t)
4650       ;; for XEmacs!
4651       (if (and elmo-use-database
4652                (setq errmsg
4653                      (format
4654                       "No message with id \"%s\" in the database." msgid))
4655                (setq otherfld (elmo-database-msgid-get msgid)))
4656           (if (cdr (wl-summary-jump-to-msg-internal
4657                     (car otherfld) (nth 1 otherfld) 'no-sync))
4658               t ; succeed.
4659             ;; Back to original.
4660             (wl-summary-jump-to-msg-internal
4661              (wl-summary-buffer-folder-name) original 'no-sync))
4662         (cond ((eq wl-summary-search-via-nntp 'confirm)
4663                (require 'elmo-nntp)
4664                (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
4665                         elmo-nntp-default-server)
4666                (setq schar (read-char))
4667                (cond ((eq schar ?y)
4668                       (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4669                      ((eq schar ?s)
4670                       (wl-summary-jump-to-msg-by-message-id-via-nntp
4671                        msgid
4672                        (read-from-minibuffer "NNTP Server: ")))
4673                      (t
4674                       (message errmsg)
4675                       nil)))
4676               (wl-summary-search-via-nntp
4677                (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4678               (t
4679                (message errmsg)
4680                nil))))))
4681
4682 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4683   (interactive)
4684   (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4685          newsgroups folder ret
4686          user server port type spec)
4687     (if server-spec
4688         (if (string-match "^-" server-spec)
4689             (setq spec (wl-folder-get-elmo-folder server-spec)
4690                   user (elmo-net-folder-user-internal spec)
4691                   server (elmo-net-folder-server-internal spec)
4692                   port (elmo-net-folder-port-internal spec)
4693                   type (elmo-net-folder-stream-type-internal spec))
4694           (setq server server-spec)))
4695     (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4696                      msgid
4697                      (or server elmo-nntp-default-server)
4698                      (or user elmo-nntp-default-user)
4699                      (or port elmo-nntp-default-port)
4700                      (or type elmo-nntp-default-stream-type)))
4701       (setq newsgroups (elmo-nntp-parse-newsgroups ret))
4702       (setq folder (concat "-" (car newsgroups)
4703                            (elmo-nntp-folder-postfix user server port type)))
4704       (catch 'found
4705         (while newsgroups
4706           (if (wl-folder-entity-exists-p (car newsgroups)
4707                                          wl-folder-newsgroups-hashtb)
4708               (throw 'found
4709                      (setq folder (concat "-" (car newsgroups)
4710                                           (elmo-nntp-folder-postfix
4711                                            user server port type)))))
4712           (setq newsgroups (cdr newsgroups)))))
4713     (if ret
4714         (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4715       (message "No message id \"%s\" in nntp server \"%s\"."
4716                msgid (or server elmo-nntp-default-server))
4717       nil)))
4718
4719 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4720   (let (wl-auto-select-first entity)
4721     (if (or (string= folder (wl-summary-buffer-folder-name))
4722             (y-or-n-p
4723              (format
4724               "Message was found in the folder \"%s\". Jump to it? "
4725               folder)))
4726         (progn
4727           (unwind-protect
4728               (wl-summary-goto-folder-subr
4729                folder scan-type nil nil t)
4730             (if msgid
4731                 (setq msg
4732                       (car (rassoc msgid
4733                                    (elmo-msgdb-get-number-alist
4734                                     (wl-summary-buffer-msgdb))))))
4735             (setq entity (wl-folder-search-entity-by-name folder
4736                                                           wl-folder-entity
4737                                                           'folder))
4738             (if entity
4739                 (wl-folder-set-current-entity-id
4740                  (wl-folder-get-entity-id entity))))
4741           (if (null msg)
4742               (message "Message was not found currently in this folder.")
4743             (setq msg (and (wl-thread-jump-to-msg msg) msg)))
4744           (cons folder msg)))))
4745
4746 (defun wl-summary-jump-to-parent-message (arg)
4747   (interactive "P")
4748   (let ((cur-buf (current-buffer))
4749         (number (wl-summary-message-number))
4750         (regexp "\\(<[^<>]*>\\)[ \t]*$")
4751         (i -1) ;; xxx
4752         msg-id msg-num ref-list ref irt)
4753     (if (null number)
4754         (message "No message.")
4755       (when (eq wl-summary-buffer-view 'thread)
4756         (cond ((and arg (not (numberp arg)))
4757                (setq msg-num
4758                      (wl-thread-entity-get-number
4759                       (wl-thread-entity-get-top-entity
4760                        (wl-thread-get-entity number)))))
4761               ((and arg (numberp arg))
4762                (setq i 0)
4763                (setq msg-num number)
4764                (while (< i arg)
4765                  (setq msg-num
4766                        (wl-thread-entity-get-number
4767                         (wl-thread-entity-get-parent-entity
4768                          (wl-thread-get-entity msg-num))))
4769                  (setq i (1+ i))))
4770               (t (setq msg-num
4771                        (wl-thread-entity-get-number
4772                         (wl-thread-entity-get-parent-entity
4773                          (wl-thread-get-entity number)))))))
4774       (when (null msg-num)
4775         (wl-summary-set-message-buffer-or-redisplay)
4776         (set-buffer (wl-message-get-original-buffer))
4777         (message "Searching parent message...")
4778         (setq ref (std11-field-body "References")
4779               irt (std11-field-body "In-Reply-To"))
4780         (cond
4781          ((and arg (not (numberp arg)) ref (not (string= ref ""))
4782                (string-match regexp ref))
4783           ;; The first message of the thread.
4784           (setq msg-id (wl-match-string 1 ref)))
4785          ;; "In-Reply-To:" has only one msg-id.
4786          ((and (null arg) irt (not (string= irt ""))
4787                (string-match regexp irt))
4788           (setq msg-id (wl-match-string 1 irt)))
4789          ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
4790                (string-match regexp ref))
4791           ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
4792           (while (string-match regexp ref)
4793             (setq ref-list
4794                   (append (list
4795                            (wl-match-string 1 ref))
4796                           ref-list))
4797             (setq ref (substring ref (match-end 0)))
4798             (setq i (1+ i)))
4799           (setq msg-id
4800                 (if (null arg) (nth 0 ref-list) ;; previous
4801                   (if (<= arg i) (nth (1- arg) ref-list)
4802                     (nth i ref-list)))))))
4803       (set-buffer cur-buf)
4804       (cond ((and (null msg-id) (null msg-num))
4805              (message "No parent message!")
4806              nil)
4807             ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
4808              (wl-summary-redisplay)
4809              (message "Searching parent message...done")
4810              t)
4811             ((and msg-num (wl-summary-jump-to-msg msg-num))
4812              (wl-summary-redisplay)
4813              (message "Searching parent message...done")
4814              t)
4815             (t ; failed.
4816              (message "Parent message was not found.")
4817              nil)))))
4818
4819 (defun wl-summary-reply (&optional arg without-setup-hook)
4820   "Reply to current message. Default is \"wide\" reply.
4821 Reply to author if invoked with ARG."
4822   (interactive "P")
4823   (let ((folder wl-summary-buffer-elmo-folder)
4824         (number (wl-summary-message-number))
4825         (summary-buf (current-buffer))
4826         mes-buf)
4827     (when number
4828       (save-excursion
4829         (wl-summary-redisplay-internal folder number))
4830       (setq mes-buf wl-message-buffer)
4831       (wl-message-select-buffer wl-message-buffer)
4832       (set-buffer mes-buf)
4833       (goto-char (point-min))
4834       (or wl-draft-use-frame
4835           (split-window-vertically))
4836       (other-window 1)
4837       (when (setq mes-buf (wl-message-get-original-buffer))
4838         (wl-draft-reply mes-buf arg summary-buf)
4839         (unless without-setup-hook
4840           (run-hooks 'wl-mail-setup-hook)))
4841       t)))
4842
4843 (defun wl-summary-write ()
4844   "Write a new draft from Summary."
4845   (interactive)
4846   (wl-draft nil nil nil nil nil
4847             nil nil nil nil nil nil (current-buffer))
4848   (run-hooks 'wl-mail-setup-hook)
4849   (mail-position-on-field "To"))
4850
4851 (defvar wl-summary-write-current-folder-functions
4852   '(wl-folder-get-newsgroups
4853     wl-folder-guess-mailing-list-by-refile-rule
4854     wl-folder-guess-mailing-list-by-folder-name)
4855   "Newsgroups or Mailing List address guess functions list.
4856 Call from `wl-summary-write-current-folder'")
4857
4858 (defun wl-summary-write-current-folder (&optional folder)
4859   "Write message to current FOLDER's newsgroup or mailing-list.
4860 Use function list is `wl-summary-write-current-folder-functions'."
4861   (interactive)
4862   (let (newsgroups to cc)
4863     ;; default FOLDER is current buffer folder
4864     (setq folder (or folder (wl-summary-buffer-folder-name)))
4865     (let ((flist wl-summary-write-current-folder-functions)
4866           guess-list)
4867       (while flist
4868         (setq guess-list (funcall (car flist) folder))
4869         (if (or (nth 0 guess-list)      ; To:
4870 ;;;             (nth 1 guess-list)      ; Cc:
4871                 (nth 2 guess-list))     ; Newsgroups:
4872             (setq flist nil)
4873           (setq flist (cdr flist))))
4874       (if guess-list
4875           (progn
4876             (wl-draft (nth 0 guess-list) ; To:
4877                       nil nil
4878                       (nth 1 guess-list) ; Cc:
4879                       nil
4880                       (nth 2 guess-list)) ; Newsgroups:
4881             (run-hooks 'wl-mail-setup-hook))
4882 ;;;     (error "%s is not newsgroup" folder)
4883         (error "Can't guess by folder %s" folder)))))
4884
4885 (defun wl-summary-forward (&optional without-setup-hook)
4886   ""
4887   (interactive)
4888   (let ((folder wl-summary-buffer-elmo-folder)
4889         (number (wl-summary-message-number))
4890         (summary-buf (current-buffer))
4891         (wl-draft-forward t)
4892         mes-buf
4893         entity subject num)
4894     (if (null number)
4895         (message "No message.")
4896       (wl-summary-redisplay-internal nil nil 'force-reload)
4897       (setq mes-buf wl-message-buffer)
4898       (wl-message-select-buffer mes-buf)
4899       (or wl-draft-use-frame
4900           (split-window-vertically))
4901       (other-window 1)
4902       ;; get original subject.
4903       (if summary-buf
4904           (save-excursion
4905             (set-buffer summary-buf)
4906             (setq subject
4907                   (or (elmo-message-field folder number 'subject) ""))))
4908       (set-buffer mes-buf)
4909       (wl-draft-forward subject summary-buf)
4910       (unless without-setup-hook
4911         (run-hooks 'wl-mail-setup-hook)))))
4912
4913 (defun wl-summary-click (e)
4914   (interactive "e")
4915   (mouse-set-point e)
4916   (wl-summary-read))
4917
4918 (defun wl-summary-read ()
4919   "Proceed reading message in the summary buffer."
4920   (interactive)
4921   (let ((cur-buf (current-buffer)))
4922     (wl-summary-toggle-disp-msg 'on)
4923     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4924       (set-buffer cur-buf)
4925       (if (wl-message-next-page)
4926           (wl-summary-down t)))))
4927
4928 (defun wl-summary-prev (&optional interactive)
4929   ""
4930   (interactive)
4931   (if wl-summary-move-direction-toggle
4932       (setq wl-summary-move-direction-downward nil))
4933   (let ((skip-mark-regexp (mapconcat
4934                            'regexp-quote
4935                            wl-summary-skip-mark-list ""))
4936         goto-next regex-list regex next-entity finfo)
4937     (beginning-of-line)
4938     (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
4939         (setq regex (format "^%s[^%s]"
4940                             wl-summary-buffer-number-regexp
4941                             skip-mark-regexp))
4942       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
4943                           wl-summary-buffer-number-regexp
4944                           skip-mark-regexp
4945                           (regexp-quote wl-summary-unread-cached-mark)
4946                           (regexp-quote wl-summary-important-mark))))
4947     (unless (re-search-backward regex nil t)
4948       (setq goto-next t))
4949     (beginning-of-line)
4950     (if (not goto-next)
4951         (progn
4952           (if wl-summary-buffer-disp-msg
4953               (wl-summary-redisplay)))
4954       (if (or interactive (interactive-p))
4955           (if wl-summary-buffer-prev-folder-function
4956               (funcall wl-summary-buffer-prev-folder-function)
4957             (when wl-auto-select-next
4958               (setq next-entity (wl-summary-get-prev-folder))
4959               (if next-entity
4960                   (setq finfo (wl-folder-get-entity-info next-entity))))
4961             (wl-ask-folder
4962              '(lambda () (wl-summary-next-folder-or-exit next-entity))
4963              (format
4964               "No more messages. Type SPC to go to %s."
4965               (wl-summary-entity-info-msg next-entity finfo))))))))
4966
4967 (defun wl-summary-next (&optional interactive)
4968   ""
4969   (interactive)
4970   (if wl-summary-move-direction-toggle
4971       (setq wl-summary-move-direction-downward t))
4972   (let ((skip-mark-regexp (mapconcat
4973                            'regexp-quote
4974                            wl-summary-skip-mark-list ""))
4975         goto-next regex regex-list next-entity finfo)
4976     (end-of-line)
4977     (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
4978         (setq regex (format "^%s[^%s]"
4979                             wl-summary-buffer-number-regexp
4980                             skip-mark-regexp))
4981       (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
4982                           wl-summary-buffer-number-regexp
4983                           skip-mark-regexp
4984                           (regexp-quote wl-summary-unread-cached-mark)
4985                           (regexp-quote wl-summary-important-mark))))
4986     (unless (re-search-forward regex nil t)
4987       (forward-line 1)
4988       (setq goto-next t))
4989     (beginning-of-line)
4990     (if (not goto-next)
4991         (if wl-summary-buffer-disp-msg
4992             (wl-summary-redisplay))
4993       (if (or interactive (interactive-p))
4994           (if wl-summary-buffer-next-folder-function
4995               (funcall wl-summary-buffer-next-folder-function)
4996             (when wl-auto-select-next
4997               (setq next-entity (wl-summary-get-next-folder))
4998               (if next-entity
4999                   (setq finfo (wl-folder-get-entity-info next-entity))))
5000             (wl-ask-folder
5001              '(lambda () (wl-summary-next-folder-or-exit next-entity))
5002              (format
5003               "No more messages. Type SPC to go to %s."
5004               (wl-summary-entity-info-msg next-entity finfo))))))))
5005
5006 (defun wl-summary-up (&optional interactive skip-no-unread)
5007   ""
5008   (interactive)
5009   (if wl-summary-move-direction-toggle
5010       (setq wl-summary-move-direction-downward nil))
5011   (if (wl-summary-cursor-up)
5012       (if wl-summary-buffer-disp-msg
5013           (wl-summary-redisplay))
5014     (if (or interactive
5015             (interactive-p))
5016         (if wl-summary-buffer-prev-folder-function
5017             (funcall wl-summary-buffer-prev-folder-function)
5018           (let (next-entity finfo)
5019             (when wl-auto-select-next
5020               (progn
5021                 (setq next-entity (wl-summary-get-prev-unread-folder))
5022                 (if next-entity
5023                     (setq finfo (wl-folder-get-entity-info next-entity)))))
5024             (if (and skip-no-unread
5025                      (eq wl-auto-select-next 'skip-no-unread))
5026                 (wl-summary-next-folder-or-exit next-entity t)
5027               (wl-ask-folder
5028                '(lambda () (wl-summary-next-folder-or-exit next-entity t))
5029                (format
5030                 "No more unread messages. Type SPC to go to %s."
5031                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5032
5033 (defun wl-summary-get-prev-folder ()
5034   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5035         last-entity cur-id)
5036     (when folder-buf
5037       (setq cur-id (save-excursion (set-buffer folder-buf)
5038                                    wl-folder-buffer-cur-entity-id))
5039       (wl-folder-get-prev-folder cur-id))))
5040
5041 (defun wl-summary-get-next-folder ()
5042   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5043         cur-id)
5044     (when folder-buf
5045       (setq cur-id (save-excursion (set-buffer folder-buf)
5046                                    wl-folder-buffer-cur-entity-id))
5047       (wl-folder-get-next-folder cur-id))))
5048
5049 (defun wl-summary-get-next-unread-folder ()
5050   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5051         cur-id)
5052     (when folder-buf
5053       (setq cur-id (save-excursion (set-buffer folder-buf)
5054                                    wl-folder-buffer-cur-entity-id))
5055       (wl-folder-get-next-folder cur-id 'unread))))
5056
5057 (defun wl-summary-get-prev-unread-folder ()
5058   (let ((folder-buf (get-buffer wl-folder-buffer-name))
5059         cur-id)
5060     (when folder-buf
5061       (setq cur-id (save-excursion (set-buffer folder-buf)
5062                                    wl-folder-buffer-cur-entity-id))
5063       (wl-folder-get-prev-folder cur-id 'unread))))
5064
5065 (defun wl-summary-down (&optional interactive skip-no-unread)
5066   (interactive)
5067   (if wl-summary-move-direction-toggle
5068       (setq wl-summary-move-direction-downward t))
5069   (if (wl-summary-cursor-down)
5070       (if wl-summary-buffer-disp-msg
5071           (wl-summary-redisplay))
5072     (if (or interactive
5073             (interactive-p))
5074         (if wl-summary-buffer-next-folder-function
5075             (funcall wl-summary-buffer-next-folder-function)
5076           (let (next-entity finfo)
5077             (when wl-auto-select-next
5078               (setq next-entity (wl-summary-get-next-unread-folder)))
5079             (if next-entity
5080                 (setq finfo (wl-folder-get-entity-info next-entity)))
5081             (if (and skip-no-unread
5082                      (eq wl-auto-select-next 'skip-no-unread))
5083                 (wl-summary-next-folder-or-exit next-entity)
5084               (wl-ask-folder
5085                '(lambda () (wl-summary-next-folder-or-exit next-entity))
5086                (format
5087                 "No more unread messages. Type SPC to go to %s."
5088                 (wl-summary-entity-info-msg next-entity finfo)))))))))
5089
5090 (defun wl-summary-goto-last-displayed-msg ()
5091   (interactive)
5092   (unless wl-summary-buffer-last-displayed-msg
5093     (setq wl-summary-buffer-last-displayed-msg
5094           wl-summary-buffer-current-msg))
5095   (if wl-summary-buffer-last-displayed-msg
5096       (progn
5097         (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
5098         (if wl-summary-buffer-disp-msg
5099             (wl-summary-redisplay)))
5100     (message "No last message.")))
5101
5102 (defun wl-summary-redisplay (&optional arg)
5103   (interactive "P")
5104   (if (and (not arg)
5105            (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
5106       (wl-summary-redisplay-no-mime)
5107     (wl-summary-redisplay-internal nil nil arg)))
5108
5109 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
5110   (interactive)
5111   (let* ((msgdb (wl-summary-buffer-msgdb))
5112          (folder (or folder wl-summary-buffer-elmo-folder))
5113          (num (or number (wl-summary-message-number)))
5114          (wl-mime-charset      wl-summary-buffer-mime-charset)
5115          (default-mime-charset wl-summary-buffer-mime-charset)
5116          fld-buf fld-win thr-entity)
5117     (if (and wl-thread-open-reading-thread
5118              (eq wl-summary-buffer-view 'thread)
5119              (not (wl-thread-entity-get-opened
5120                    (setq thr-entity (wl-thread-get-entity
5121                                      num))))
5122              (wl-thread-entity-get-children thr-entity))
5123         (wl-thread-force-open))
5124     (if num
5125         (progn
5126           (setq wl-summary-buffer-disp-msg t)
5127           (setq wl-summary-buffer-last-displayed-msg
5128                 wl-summary-buffer-current-msg)
5129           ;; hide folder window
5130           (if (and (not wl-stay-folder-window)
5131                    (setq fld-buf (get-buffer wl-folder-buffer-name)))
5132               (if (setq fld-win (get-buffer-window fld-buf))
5133                   (delete-window fld-win)))
5134           (setq wl-current-summary-buffer (current-buffer))
5135           (wl-summary-mark-as-read
5136            nil
5137            ;; not fetched, then change server-mark.
5138            (if (wl-message-redisplay folder num 'mime force-reload)
5139                nil
5140              ;; plugged, then leave server-mark.
5141              (if (and
5142                   (not
5143                    (elmo-folder-local-p
5144                     wl-summary-buffer-elmo-folder))
5145                   (elmo-folder-plugged-p
5146                    wl-summary-buffer-elmo-folder))
5147                  'leave))
5148            t ; displayed
5149            nil
5150            'cached ; cached by reading.
5151            )
5152           (setq wl-summary-buffer-current-msg num)
5153           (when wl-summary-recenter
5154             (recenter (/ (- (window-height) 2) 2))
5155             (if (not wl-summary-width)
5156                 (wl-horizontal-recenter)))
5157           (wl-highlight-summary-displaying)
5158           (wl-message-buffer-prefetch-next folder num (current-buffer)
5159                                            wl-summary-buffer-mime-charset)
5160           (run-hooks 'wl-summary-redisplay-hook))
5161       (message "No message to display."))))
5162
5163 (defun wl-summary-redisplay-no-mime (&optional folder number)
5164   (interactive)
5165   (let* ((fld (or folder wl-summary-buffer-elmo-folder))
5166          (num (or number (wl-summary-message-number)))
5167          wl-break-pages)
5168     (if num
5169         (progn
5170           (setq wl-summary-buffer-disp-msg t)
5171           (setq wl-summary-buffer-last-displayed-msg
5172                 wl-summary-buffer-current-msg)
5173           (setq wl-current-summary-buffer (current-buffer))
5174           (wl-message-redisplay fld num 'as-is)
5175           (wl-summary-mark-as-read nil nil t)
5176           (setq wl-summary-buffer-current-msg num)
5177           (when wl-summary-recenter
5178             (recenter (/ (- (window-height) 2) 2))
5179             (if (not wl-summary-width)
5180                 (wl-horizontal-recenter)))
5181           (wl-highlight-summary-displaying)
5182           (run-hooks 'wl-summary-redisplay-hook))
5183       (message "No message to display.")
5184       (wl-ask-folder 'wl-summary-exit
5185                      "No more messages. Type SPC to go to folder mode."))))
5186
5187 (defun wl-summary-redisplay-all-header (&optional folder number)
5188   (interactive)
5189   (let* ((fld (or folder wl-summary-buffer-elmo-folder))
5190          (num (or number (wl-summary-message-number)))
5191          (wl-mime-charset      wl-summary-buffer-mime-charset)
5192          (default-mime-charset wl-summary-buffer-mime-charset))
5193     (if num
5194         (progn
5195           (setq wl-summary-buffer-disp-msg t)
5196           (setq wl-summary-buffer-last-displayed-msg
5197                 wl-summary-buffer-current-msg)
5198           (setq wl-current-summary-buffer (current-buffer))
5199           (if (wl-message-redisplay fld num 'all-header); t if displayed.
5200               (wl-summary-mark-as-read nil nil t))
5201           (setq wl-summary-buffer-current-msg num)
5202           (when wl-summary-recenter
5203             (recenter (/ (- (window-height) 2) 2))
5204             (if (not wl-summary-width)
5205                 (wl-horizontal-recenter)))
5206           (wl-highlight-summary-displaying)
5207           (run-hooks 'wl-summary-redisplay-hook))
5208       (message "No message to display."))))
5209
5210 (defun wl-summary-jump-to-current-message ()
5211   (interactive)
5212   (let (message-buf message-win)
5213     (if (setq message-buf wl-message-buffer)
5214         (if (setq message-win (get-buffer-window message-buf))
5215             (select-window message-win)
5216           (wl-message-select-buffer wl-message-buffer))
5217       (wl-summary-redisplay)
5218       (wl-message-select-buffer wl-message-buffer))
5219     (goto-char (point-min))))
5220
5221 (defun wl-summary-cancel-message ()
5222   "Cancel an article on news."
5223   (interactive)
5224   (if (null (wl-summary-message-number))
5225       (message "No message.")
5226     (let ((summary-buf (current-buffer))
5227           message-buf)
5228       (wl-summary-set-message-buffer-or-redisplay)
5229       (if (setq message-buf (wl-message-get-original-buffer))
5230           (set-buffer message-buf))
5231       (unless (wl-message-news-p)
5232         (set-buffer summary-buf)
5233         (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
5234                      'nntp)
5235                  (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5236             (progn
5237               (wl-summary-redisplay t)
5238               (wl-summary-supersedes-message))
5239           (error "This is not a news article; supersedes is impossible")))
5240       (when (yes-or-no-p "Do you really want to cancel this article? ")
5241         (let (from newsgroups message-id distribution buf)
5242           (save-excursion
5243             (setq from (std11-field-body "from")
5244                   newsgroups (std11-field-body "newsgroups")
5245                   message-id (std11-field-body "message-id")
5246                   distribution (std11-field-body "distribution"))
5247             ;; Make sure that this article was written by the user.
5248             (unless (wl-address-user-mail-address-p
5249                      (wl-address-header-extract-address
5250                       (car (wl-parse-addresses from))))
5251               (error "This article is not yours"))
5252             ;; Make control message.
5253             (setq buf (set-buffer (get-buffer-create " *message cancel*")))
5254             (setq wl-draft-buffer-cur-summary-buffer summary-buf)
5255             (buffer-disable-undo (current-buffer))
5256             (erase-buffer)
5257             (insert "Newsgroups: " newsgroups "\n"
5258                     "From: " (wl-address-header-extract-address
5259                               wl-from) "\n"
5260                               "Subject: cmsg cancel " message-id "\n"
5261                               "Control: cancel " message-id "\n"
5262                               (if distribution
5263                                   (concat "Distribution: " distribution "\n")
5264                                 "")
5265                               mail-header-separator "\n"
5266                               wl-summary-cancel-message)
5267             (message "Canceling your message...")
5268             (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
5269             (message "Canceling your message...done")))))))
5270
5271 (defun wl-summary-supersedes-message ()
5272   "Supersede current message."
5273   (interactive)
5274   (let ((summary-buf (current-buffer))
5275         (mmelmo-force-fetch-entire-message t)
5276         message-buf from)
5277     (wl-summary-set-message-buffer-or-redisplay)
5278     (if (setq message-buf (wl-message-get-original-buffer))
5279         (set-buffer message-buf))
5280     (unless (wl-message-news-p)
5281       (set-buffer summary-buf)
5282       (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
5283                    'nntp)
5284                (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5285           (progn
5286             (wl-summary-redisplay t)
5287             (wl-summary-supersedes-message))
5288         (error "This is not a news article; supersedes is impossible")))
5289     (save-excursion
5290       (setq from (std11-field-body "from"))
5291       ;; Make sure that this article was written by the user.
5292       (unless (wl-address-user-mail-address-p
5293                (wl-address-header-extract-address
5294                 (car (wl-parse-addresses from))))
5295         (error "This article is not yours"))
5296       (let* ((message-id (std11-field-body "message-id"))
5297              (followup-to (std11-field-body "followup-to"))
5298              (mail-default-headers
5299               (concat mail-default-headers
5300                       "Supersedes: " message-id "\n"
5301                       (and followup-to
5302                            (concat "Followup-To: " followup-to "\n")))))
5303         (set-buffer (wl-message-get-original-buffer))
5304         (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
5305
5306 (defun wl-summary-save (&optional arg wl-save-dir)
5307   (interactive)
5308   (let ((filename)
5309         (num (wl-summary-message-number))
5310         (mmelmo-force-fetch-entire-message t))
5311     (if (null wl-save-dir)
5312         (setq wl-save-dir wl-tmp-dir))
5313     (if num
5314         (save-excursion
5315           (setq filename (expand-file-name
5316                           (int-to-string num)
5317                           wl-save-dir))
5318           (if (null (and arg
5319                          (null (file-exists-p filename))))
5320               (setq filename
5321                     (read-file-name "Save to file: " filename)))
5322
5323           (wl-summary-set-message-buffer-or-redisplay)
5324           (set-buffer (wl-message-get-original-buffer))
5325           (if (and (null arg) (file-exists-p filename))
5326               (if (y-or-n-p "File already exists.  override it? ")
5327                   (write-region (point-min) (point-max) filename))
5328             (write-region (point-min) (point-max) filename)))
5329       (message "No message to save."))
5330     num))
5331
5332 (defun wl-summary-save-region (beg end)
5333   (interactive "r")
5334   (save-excursion
5335     (save-restriction
5336       (narrow-to-region beg end)
5337       (goto-char (point-min))
5338       (let ((wl-save-dir
5339              (wl-read-directory-name "Save to directory: " wl-tmp-dir)))
5340         (if (null (file-exists-p wl-save-dir))
5341             (make-directory wl-save-dir))
5342         (if (eq wl-summary-buffer-view 'thread)
5343             (progn
5344               (while (not (eobp))
5345                 (let* ((number (wl-summary-message-number))
5346                        (entity (wl-thread-get-entity number)))
5347                   (if (wl-thread-entity-get-opened entity)
5348                       (wl-summary-save t wl-save-dir)
5349                     ;; closed
5350                     (wl-summary-save t wl-save-dir))
5351                   (forward-line 1))))
5352           (while (not (eobp))
5353             (wl-summary-save t wl-save-dir)
5354             (forward-line 1)))))))
5355
5356 ;; mew-summary-pipe-message()
5357 (defun wl-summary-pipe-message (prefix command)
5358   "Send this message via pipe."
5359   (interactive (list current-prefix-arg nil))
5360   (if (null (wl-summary-message-number))
5361       (message "No message.")
5362     (setq command (read-string "Shell command on message: "
5363                                wl-summary-shell-command-last))
5364     (if (y-or-n-p "Send this message to pipe? ")
5365         (save-excursion
5366           (wl-summary-set-message-buffer-or-redisplay)
5367           (set-buffer (wl-message-get-original-buffer))
5368           (if (string= command "")
5369               (setq command wl-summary-shell-command-last))
5370           (goto-char (point-min)) ; perhaps this line won't be necessary
5371           (if prefix
5372               (search-forward "\n\n"))
5373           (shell-command-on-region (point) (point-max) command nil)
5374           (setq wl-summary-shell-command-last command)))))
5375
5376 (defun wl-summary-print-message (&optional arg)
5377   (interactive "P")
5378   (if (null (wl-summary-message-number))
5379       (message "No message.")
5380     (save-excursion
5381       (wl-summary-set-message-buffer-or-redisplay)
5382       (if (or (not (interactive-p))
5383               (y-or-n-p "Print ok? "))
5384           (progn
5385             (let ((buffer (generate-new-buffer " *print*")))
5386               (copy-to-buffer buffer (point-min) (point-max))
5387               (set-buffer buffer)
5388               (funcall wl-print-buffer-function)
5389               (kill-buffer buffer)))
5390         (message "")))))
5391
5392 (defun wl-summary-print-message-with-ps-print (&optional filename)
5393   (interactive)
5394   (if (null (wl-summary-message-number))
5395       (message "No message.")
5396     (setq filename (ps-print-preprint current-prefix-arg))
5397     (if (or (not (interactive-p))
5398             (y-or-n-p "Print ok? "))
5399         (let ((summary-buffer (current-buffer))
5400               wl-break-pages)
5401           (save-excursion
5402             (wl-summary-set-message-buffer-or-redisplay)
5403             ;; (wl-summary-redisplay-internal)
5404             (let* ((buffer (generate-new-buffer " *print*"))
5405                    (entity (progn
5406                              (set-buffer summary-buffer)
5407                              (assoc (cdr (assq
5408                                           (wl-summary-message-number)
5409                                           (elmo-msgdb-get-number-alist
5410                                            (wl-summary-buffer-msgdb))))
5411                                     (elmo-msgdb-get-overview
5412                                      (wl-summary-buffer-msgdb)))))
5413                    (wl-ps-subject
5414                     (and entity
5415                          (or (elmo-msgdb-overview-entity-get-subject entity)
5416                              "")))
5417                    (wl-ps-from
5418                     (and entity
5419                          (or (elmo-msgdb-overview-entity-get-from entity) "")))
5420                    (wl-ps-date
5421                     (and entity
5422                          (or (elmo-msgdb-overview-entity-get-date entity) ""))))
5423               (run-hooks 'wl-ps-preprint-hook)
5424               (set-buffer wl-message-buffer)
5425               (copy-to-buffer buffer (point-min) (point-max))
5426               (set-buffer buffer)
5427               (unwind-protect
5428                   (let ((ps-left-header
5429                          (list (concat "(" wl-ps-subject ")")
5430                                (concat "(" wl-ps-from ")")))
5431                         (ps-right-header
5432                          (list "/pagenumberstring load"
5433                                (concat "(" wl-ps-date ")"))))
5434                     (run-hooks 'wl-ps-print-hook)
5435                     (funcall wl-ps-print-buffer-function filename))
5436                 (kill-buffer buffer)))))
5437       (message ""))))
5438
5439 (if (featurep 'ps-print) ; ps-print is available.
5440     (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
5441
5442 (defun wl-summary-folder-info-update ()
5443   (let ((folder (elmo-string (wl-summary-buffer-folder-name)))
5444         (num-db (elmo-msgdb-get-number-alist
5445                  (wl-summary-buffer-msgdb))))
5446     (wl-folder-set-folder-updated folder
5447                                   (list 0
5448                                         (+ wl-summary-buffer-unread-count
5449                                            wl-summary-buffer-new-count)
5450                                         (length num-db)))))
5451
5452 (defun wl-summary-get-original-buffer ()
5453   "Get original buffer for the current summary."
5454   (save-excursion
5455     (wl-summary-set-message-buffer-or-redisplay)
5456     (wl-message-get-original-buffer)))
5457
5458 (defun wl-summary-pack-number (&optional arg)
5459   (interactive "P")
5460   (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
5461   (let (wl-use-scoring)
5462     (wl-summary-rescan)))
5463
5464 (defun wl-summary-target-mark-uudecode ()
5465   (interactive)
5466   (let ((mlist (reverse wl-summary-buffer-target-mark-list))
5467         (summary-buf (current-buffer))
5468         (tmp-buf (get-buffer-create "*WL UUENCODE*"))
5469         orig-buf i k filename rc errmsg)
5470     (setq i 1)
5471     (setq k (length mlist))
5472     (set-buffer tmp-buf)
5473     (erase-buffer)
5474     (save-window-excursion
5475       (while mlist
5476         (set-buffer summary-buf)
5477         (wl-summary-jump-to-msg (car mlist))
5478         (wl-summary-redisplay)
5479         (set-buffer (setq orig-buf (wl-summary-get-original-buffer)))
5480         (goto-char (point-min))
5481         (cond ((= i 1) ; first
5482                (if (setq filename (wl-message-uu-substring
5483                                    orig-buf tmp-buf t
5484                                    (= i k)))
5485                    nil
5486                  (error "Can't find begin line")))
5487               ((< i k)
5488                (wl-message-uu-substring orig-buf tmp-buf))
5489               (t ; last
5490                (wl-message-uu-substring orig-buf tmp-buf nil t)))
5491         (setq i (1+ i))
5492         (setq mlist (cdr mlist)))
5493       (set-buffer tmp-buf)
5494       (message "Exec %s..." wl-prog-uudecode)
5495       (unwind-protect
5496           (let ((decode-dir wl-tmp-dir))
5497             (if (not wl-prog-uudecode-no-stdout-option)
5498                 (setq filename (read-file-name "Save to file: "
5499                                                (expand-file-name
5500                                                 (elmo-safe-filename filename)
5501                                                 wl-tmp-dir)))
5502               (setq decode-dir
5503                     (wl-read-directory-name "Save to directory: "
5504                                             wl-tmp-dir))
5505               (setq filename (expand-file-name filename decode-dir)))
5506             (if (file-exists-p filename)
5507                 (or (yes-or-no-p (format "File %s exists. Save anyway? "
5508                                          filename))
5509                     (error "")))
5510             (elmo-bind-directory
5511              decode-dir
5512              (setq rc
5513                    (as-binary-process
5514                     (apply 'call-process-region (point-min) (point-max)
5515                            wl-prog-uudecode t (current-buffer) nil
5516                            wl-prog-uudecode-arg))))
5517             (when (not (= 0 rc))
5518               (setq errmsg (buffer-substring (point-min)(point-max)))
5519               (error "Uudecode error: %s" errmsg))
5520             (if (not wl-prog-uudecode-no-stdout-option)
5521                 (let (file-name-handler-alist) ;; void jka-compr
5522                   (as-binary-output-file
5523                    (write-region (point-min) (point-max)
5524                                  filename nil 'no-msg))))
5525             (save-excursion
5526               (set-buffer summary-buf)
5527               (wl-summary-delete-all-temp-marks))
5528             (if (file-exists-p filename)
5529                 (message "Saved as %s" filename)))
5530         (kill-buffer tmp-buf)))))
5531
5532 ;; Someday
5533 ;; (defun wl-summary-drop-unsync ()
5534 ;;   "Drop all unsync messages."
5535 ;;   (interactive)
5536 ;;   (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
5537 ;;       (error "You cannot drop unsync messages in this folder"))
5538 ;;   (if (or (not (interactive-p))
5539 ;;        (y-or-n-p "Drop all unsync messages? "))
5540 ;;       (let* ((folder-list (elmo-folder-get-primitive-folder-list
5541 ;;                         (wl-summary-buffer-folder-name)))
5542 ;;           (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
5543 ;;           (sum 0)
5544 ;;           (multi-num 0)
5545 ;;           pair)
5546 ;;      (message "Dropping...")
5547 ;;      (while folder-list
5548 ;;        (setq pair (elmo-folder-message-numbers (car folder-list)))
5549 ;;        (when is-multi ;; dirty hack...
5550 ;;          (incf multi-num)
5551 ;;          (setcar pair (+ (* multi-num elmo-multi-divide-number)
5552 ;;                          (car pair))))
5553 ;;        (elmo-msgdb-set-number-alist
5554 ;;         (wl-summary-buffer-msgdb)
5555 ;;         (nconc
5556 ;;          (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
5557 ;;          (list (cons (car pair) nil))))
5558 ;;        (setq sum (+ sum (cdr pair)))
5559 ;;        (setq folder-list (cdr folder-list)))
5560 ;;      (wl-summary-set-message-modified)
5561 ;;      (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
5562 ;;                                    (list 0
5563 ;;                                          (+ wl-summary-buffer-unread-count
5564 ;;                                             wl-summary-buffer-new-count)
5565 ;;                                          sum))
5566 ;;      (message "Dropping...done"))))
5567
5568 (defun wl-summary-default-get-next-msg (msg)
5569   (or (wl-summary-next-message msg
5570                                (if wl-summary-move-direction-downward 'down
5571                                  'up)
5572                                nil)
5573       (cadr (memq msg (if wl-summary-move-direction-downward
5574                           wl-summary-buffer-number-list
5575                         (reverse wl-summary-buffer-number-list))))))
5576
5577 (defun wl-summary-save-current-message ()
5578   "Save current message for `wl-summary-yank-saved-message'."
5579   (interactive)
5580   (let ((number (wl-summary-message-number)))
5581     (setq wl-summary-buffer-saved-message number)
5582     (and number (message "No: %s is saved." number))))
5583
5584 (defun wl-summary-yank-saved-message ()
5585   "Set current message as a parent of the saved message."
5586   (interactive)
5587   (if wl-summary-buffer-saved-message
5588       (let ((number (wl-summary-message-number)))
5589         (if (eq wl-summary-buffer-saved-message number)
5590             (message "Cannot set itself as a parent.")
5591           (save-excursion
5592             (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
5593             (wl-thread-set-parent number)
5594             (wl-summary-set-thread-modified))
5595           (setq  wl-summary-buffer-saved-message nil)))
5596     (message "There's no saved message.")))
5597
5598 (require 'product)
5599 (product-provide (provide 'wl-summary) (require 'wl-version))
5600
5601 ;;; wl-summary.el ends here