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