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-with-enable-multibyte
1389       (mapcar (function
1390                (lambda (x)
1391                  (setq components (std11-extract-address-components x))
1392                  (cons (nth 1 components)
1393                        (and (car components)
1394                             (eword-decode-string
1395                              (decode-mime-charset-string
1396                               (car components)
1397                               mime-charset))))))
1398               candidates))))
1399
1400 (defun wl-summary-edit-addresses-subr (the-email name-in-addr)
1401   ;; returns nil if there's no change.
1402   (if (elmo-get-hash-val (downcase the-email) wl-address-petname-hash)
1403       (let (char)
1404         (message "'%s' already exists. (e)dit/(d)elete/(c)ancel?"
1405                  the-email)
1406         (while (not (or (eq (setq char (read-char)) ?\r)
1407                         (eq char ?\n)
1408                         (eq char ? )
1409                         (eq char ?e)
1410                         (eq char ?c)
1411                         (eq char ?d)))
1412           (message
1413            "Please answer `e' or `d' or `c'. (e)dit/(d)elete/(c)ancel?"))
1414         (cond
1415          ((or (eq char ?e)
1416               (eq char ?\n)
1417               (eq char ?\r)
1418               (eq char ? ))
1419           ;; Change Addresses
1420           (wl-address-add-or-change
1421            the-email
1422            (wl-address-header-extract-realname
1423             (cdr (assoc
1424                   (let ((completion-ignore-case t) comp)
1425                     (setq comp
1426                           (try-completion the-email wl-address-completion-list))
1427                     (if (equal comp t) the-email comp))
1428                   wl-address-completion-list))))
1429           "edited")
1430          ((eq char ?d)
1431           ;; Delete Addresses
1432           (if (y-or-n-p (format "Delete '%s'? "
1433                                 the-email))
1434               (progn
1435                 (wl-address-delete the-email)
1436                 "deleted")
1437             (message "")
1438             nil))
1439          (t (message "")
1440             nil)))
1441     ;; Add Petname
1442     (wl-address-add-or-change the-email name-in-addr)
1443     "added"))
1444
1445 (defun wl-summary-edit-addresses (&optional addr-str)
1446   "Edit address book interactively.
1447 Optional argument ADDR-STR is used as a target address if specified."
1448   (interactive (if current-prefix-arg
1449                    (list (read-from-minibuffer "Target address: "))))
1450   (if (null (wl-summary-message-number))
1451       (message "No message.")
1452     (save-excursion
1453       (let* ((charset wl-summary-buffer-mime-charset)
1454              (candidates
1455               (with-current-buffer (wl-summary-get-original-buffer)
1456                 (wl-summary-edit-addresses-collect-candidate-fields
1457                  charset)))
1458              address pair result)
1459         (if addr-str
1460             (setq address addr-str)
1461           (when candidates
1462             (setq address (car (car candidates)))
1463             (setq address
1464                   (completing-read
1465                    (format "Target address (%s): " address)
1466                    (mapcar
1467                     (function (lambda (x) (cons (car x) (car x))))
1468                     candidates)
1469                    nil nil nil nil address))))
1470         (when address
1471           (setq pair (assoc address candidates))
1472           (unless pair
1473             (setq pair (cons address nil)))
1474           (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
1475             ;; update alias
1476             (wl-status-update)
1477             (setq address (assoc (car pair) wl-address-list))
1478             (if address
1479                 (message "%s, %s, <%s> is %s."
1480                          (nth 2 address)
1481                          (nth 1 address)
1482                          (nth 0 address)
1483                          result)))
1484 ;;; i'd like to update summary-buffer, but...
1485 ;;;     (wl-summary-rescan)
1486           (run-hooks 'wl-summary-edit-addresses-hook))))))
1487
1488 (defun wl-summary-incorporate (&optional arg)
1489   "Check and prefetch all uncached messages.
1490 If ARG is non-nil, checking is omitted."
1491   (interactive "P")
1492   (unless arg
1493     (save-excursion
1494       (wl-summary-sync-force-update)))
1495   (wl-summary-prefetch-region-no-mark (point-min) (point-max)
1496                                       wl-summary-incorporate-marks))
1497
1498 (defun wl-summary-force-prefetch ()
1499   "All uncached messages are cached."
1500   (interactive)
1501   (unless (elmo-folder-local-p wl-summary-buffer-elmo-folder)
1502     (let ((targets (elmo-folder-list-flagged wl-summary-buffer-elmo-folder
1503                                              'uncached 'in-msgdb))
1504           (count 0)
1505           wl-prefetch-confirm
1506           wl-prefetch-threshold
1507           (elmo-inhibit-display-retrieval-progress t)
1508           length msg)
1509       (save-excursion
1510         (goto-char (point-min))
1511         (setq length (length targets))
1512         (dolist (target targets)
1513           (when (if (not (wl-thread-entity-parent-invisible-p
1514                           (wl-thread-get-entity target)))
1515                     (progn
1516                       (wl-summary-jump-to-msg target)
1517                       (wl-summary-prefetch-msg
1518                        (wl-summary-message-number)))
1519                   (wl-summary-prefetch-msg target))
1520             (message "Retrieving... %d/%d" (incf count) length)))
1521         (message "Retrieved %d/%d message(s)" count length)))))
1522
1523 (defun wl-summary-prefetch-msg (number &optional arg)
1524   "Prefetch message and return non-nil value. If skipped, return nil."
1525   ;; prefetching procedure.
1526   (save-excursion
1527     (let* ((size (elmo-message-field wl-summary-buffer-elmo-folder
1528                                      number 'size))
1529            (file-cached (elmo-file-cache-exists-p
1530                          (elmo-message-field wl-summary-buffer-elmo-folder
1531                                              number 'message-id)))
1532            (force-read (and size
1533                             (or file-cached
1534                                 (and (null wl-prefetch-confirm) arg)
1535                                 (null wl-prefetch-threshold)
1536                                 (< size wl-prefetch-threshold))))
1537            mark new-mark)
1538       (ignore-errors
1539         (when (and (or arg (not file-cached))
1540                    size (not force-read) wl-prefetch-confirm)
1541           (let ((wl-message-entity (elmo-message-entity
1542                                     wl-summary-buffer-elmo-folder
1543                                     number)))
1544             (setq force-read
1545                   (save-restriction
1546                     (widen)
1547                     (y-or-n-p
1548                      (format
1549                       "Message from %s has %d bytes.  Prefetch it? "
1550                       (concat
1551                        "[ "
1552                        (save-match-data
1553                          (wl-set-string-width
1554                           17
1555                           (funcall
1556                            wl-summary-from-function
1557                            (elmo-delete-char
1558                             ?\"
1559                             (or
1560                              (elmo-message-entity-field
1561                               wl-message-entity
1562                               'from t)
1563                              "??")))))
1564                        " ]")
1565                       size))))
1566             (message "")))              ; flush.
1567         (if force-read
1568             (save-excursion
1569               (save-match-data
1570                 ;; online
1571                 (when (or arg (not file-cached))
1572                   (elmo-message-encache wl-summary-buffer-elmo-folder
1573                                         number))
1574                 (elmo-message-set-cached wl-summary-buffer-elmo-folder
1575                                          number t))
1576               t)
1577           nil)))))
1578
1579 (defsubst wl-summary-narrow-to-region (beg end)
1580   (narrow-to-region
1581    (save-excursion
1582      (goto-char beg)
1583      (beginning-of-line)
1584      (point))
1585    (save-excursion
1586      (goto-char end)
1587      (if (eq (current-column) 0) (beginning-of-line) (end-of-line))
1588      (point))))
1589
1590 (defun wl-summary-prefetch-region-no-mark (beg end &optional prefetch-marks)
1591   (interactive "r")
1592   (let ((count 0)
1593         targets
1594         mark length
1595         entity msg
1596         start-pos pos)
1597     (save-excursion
1598       (setq start-pos (point))
1599       (save-restriction
1600         (wl-summary-narrow-to-region beg end)
1601         ;; collect prefetch targets.
1602         (message "Collecting marks...")
1603         (goto-char (point-min))
1604         (while (not (eobp))
1605           (setq mark (wl-summary-persistent-mark)
1606                 msg (wl-summary-message-number))
1607           (if (or (and (null prefetch-marks)
1608                        msg
1609                        (null (elmo-file-cache-exists-p
1610                               (elmo-message-field
1611                                wl-summary-buffer-elmo-folder
1612                                msg
1613                                'message-id))))
1614                   (member mark prefetch-marks))
1615               (setq targets (nconc targets (list msg))))
1616           (setq entity (wl-thread-get-entity msg))
1617           (if (or (not (eq wl-summary-buffer-view 'thread))
1618                   (wl-thread-entity-get-opened entity))
1619               (); opened. no hidden children.
1620             (setq targets (nconc
1621                            targets
1622                            (wl-thread-get-children-msgs-uncached
1623                             msg prefetch-marks))))
1624           (forward-line 1))
1625         (setq length (length targets))
1626         (message "Prefetching...")
1627         (while targets
1628           (when (if (not (wl-thread-entity-parent-invisible-p
1629                           (wl-thread-get-entity (car targets))))
1630                     (progn
1631                       (wl-summary-jump-to-msg (car targets))
1632                       (wl-summary-prefetch-msg
1633                        (wl-summary-message-number)))
1634                   (wl-summary-prefetch-msg (car targets)))
1635             (message "Prefetching... %d/%d message(s)"
1636                      (setq count (+ 1 count)) length))
1637           (setq targets (cdr targets)))
1638         (message "Prefetched %d/%d message(s)" count length)
1639         (cons count length)))))
1640
1641 (defun wl-summary-delete-marks-on-buffer (marks)
1642   (while marks
1643     (wl-summary-unmark (pop marks))))
1644
1645 (defun wl-summary-delete-copy-marks-on-buffer (copies)
1646   (wl-summary-delete-marks-on-buffer copies))
1647
1648 ;;;
1649 (defun wl-summary-delete-all-target-marks ()
1650   (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list))
1651
1652 (defun wl-summary-number-list-from-region (beg end)
1653   (save-excursion
1654     (save-restriction
1655       (wl-summary-narrow-to-region beg end)
1656       (goto-char (point-min))
1657       (let (number-list)
1658         (if (eq wl-summary-buffer-view 'thread)
1659             (while (not (eobp))
1660               (let* ((number (wl-summary-message-number))
1661                      (entity (wl-thread-get-entity number)))
1662                 (setq number-list
1663                       (nconc number-list
1664                              (if (wl-thread-entity-get-opened entity)
1665                                  (list number)
1666                                (wl-thread-get-children-msgs number))))
1667                 (forward-line 1)))
1668           (while (not (eobp))
1669             (setq number-list
1670                   (nconc number-list (list (wl-summary-message-number))))
1671             (forward-line 1)))
1672         number-list))))
1673
1674 (defun wl-summary-mark-as-read-region (beg end)
1675   (interactive "r")
1676   (let ((number-list (wl-summary-number-list-from-region beg end)))
1677     (if (null number-list)
1678         (message "No message.")
1679       (wl-summary-mark-as-read number-list))))
1680
1681 (defun wl-summary-mark-as-unread-region (beg end)
1682   (interactive "r")
1683   (let ((number-list (wl-summary-number-list-from-region beg end)))
1684     (if (null number-list)
1685         (message "No message.")
1686       (wl-summary-mark-as-unread number-list))))
1687
1688 (defun wl-summary-set-flags-region (beg end &optional remove)
1689   (interactive "r\nP")
1690   (let ((number-list (wl-summary-number-list-from-region beg end)))
1691     (if (null number-list)
1692         (message "No message.")
1693       (wl-summary-set-flags-internal number-list nil nil remove)
1694       (wl-summary-count-unread)
1695       (wl-summary-update-modeline))))
1696
1697 (defun wl-summary-mark-as-answered-region (beg end &optional remove)
1698   (interactive "r\nP")
1699   (let ((number-list (wl-summary-number-list-from-region beg end))
1700         (remove (or remove
1701                     (elmo-message-flagged-p wl-summary-buffer-elmo-folder
1702                                             (save-excursion
1703                                               (goto-char beg)
1704                                               (wl-summary-message-number))
1705                                             'answered))))
1706     (if (null number-list)
1707         (message "No message.")
1708       (wl-summary-set-persistent-mark-internal remove 'answered
1709                                                number-list
1710                                                nil nil (interactive-p))
1711       (wl-summary-count-unread)
1712       (wl-summary-update-modeline))))
1713
1714 (defun wl-summary-mark-as-important-region (beg end &optional remove)
1715   (interactive "r\nP")
1716   (let ((number-list (wl-summary-number-list-from-region beg end))
1717         (remove (or remove
1718                     (elmo-message-flagged-p wl-summary-buffer-elmo-folder
1719                                             (save-excursion
1720                                               (goto-char beg)
1721                                               (wl-summary-message-number))
1722                                             'important))))
1723     (if (null number-list)
1724         (message "No message.")
1725       (wl-summary-set-persistent-mark-internal remove 'important number-list
1726                                                nil nil (interactive-p))
1727       (wl-summary-count-unread)
1728       (wl-summary-update-modeline))))
1729
1730 (defun wl-summary-mark-as-read-all ()
1731   (interactive)
1732   (if (or (not (interactive-p))
1733           (y-or-n-p "Mark all messages as read? "))
1734       (let ((folder wl-summary-buffer-elmo-folder)
1735             (cur-buf (current-buffer)))
1736         (message "Setting all msgs as read...")
1737         (elmo-folder-unset-flag
1738          folder
1739          (elmo-folder-list-flagged folder 'unread 'in-msgdb)
1740          'unread)
1741         (wl-folder-update-unread (wl-summary-buffer-folder-name) 0)
1742         (setq wl-summary-buffer-unread-count 0)
1743         (setq wl-summary-buffer-new-count    0)
1744         (wl-summary-update-modeline)
1745         (message "Setting all msgs as read...done"))))
1746
1747 (defun wl-summary-delete-cache ()
1748   "Delete cache of current message."
1749   (interactive)
1750   (save-excursion
1751     (let* ((folder wl-summary-buffer-elmo-folder)
1752            number)
1753       (setq number (wl-summary-message-number))
1754       (elmo-message-set-cached folder number nil)
1755       (ignore-errors
1756         (elmo-file-cache-delete
1757          (elmo-file-cache-get-path
1758           (elmo-message-field wl-summary-buffer-elmo-folder
1759                               number
1760                               'message-id)))))))
1761
1762 (defun wl-summary-resume-cache-status ()
1763   "Resume the cache status of all messages in the current folder."
1764   (interactive)
1765   (let ((folder wl-summary-buffer-elmo-folder)
1766         number msgid)
1767     (message "Resuming cache status...")
1768     (save-excursion
1769       (goto-char (point-min))
1770       (while (not (eobp))
1771         (setq number (wl-summary-message-number))
1772         (setq msgid (elmo-message-field folder number 'message-id))
1773         (elmo-message-set-cached folder number
1774                                  (elmo-file-cache-exists-p msgid))
1775         (forward-line 1))
1776       (wl-summary-count-unread)
1777       (wl-summary-update-modeline)
1778       (message "Resuming cache status...done"))))
1779
1780 (defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info)
1781   (interactive)
1782   (save-excursion
1783     (let ((inhibit-read-only t)
1784           (buffer-read-only nil)
1785           (msgs2 msgs)
1786           (len (length msgs))
1787           (i 0)
1788           ;(deleting-info (or deleting-info "Deleting..."))
1789           update-list)
1790       (elmo-kill-buffer wl-summary-search-buf-name)
1791       (while msgs
1792         (if (eq wl-summary-buffer-view 'thread)
1793             (progn
1794               ;; don't use wl-append(nconc), because list is broken. ...why?
1795               (setq update-list
1796                     (append update-list
1797                             (wl-thread-delete-message (car msgs))))
1798               (setq update-list (delq (car msgs) update-list)))
1799           (goto-char (point-min))
1800           (if (wl-summary-jump-to-msg (car msgs))
1801               (progn
1802                 (delete-region (point-at-bol) (point-at-eol))
1803                 (delete-char 1) ; delete '\n'
1804                 (setq wl-summary-buffer-number-list
1805                       (delq (car msgs) wl-summary-buffer-number-list)))))
1806 ;       (when (> len elmo-display-progress-threshold)
1807 ;         (setq i (1+ i))
1808 ;         (if (or (zerop (% i 5)) (= i len))
1809 ;             (elmo-display-progress
1810 ;              'wl-summary-delete-messages-on-buffer deleting-info
1811 ;              (/ (* i 100) len))))
1812         (setq msgs (cdr msgs)))
1813       (when (eq wl-summary-buffer-view 'thread)
1814         (wl-thread-update-line-msgs (elmo-uniq-list update-list))
1815         (wl-thread-cleanup-symbols msgs2))
1816       ;;(message (concat deleting-info "done"))
1817       (wl-summary-count-unread)
1818       (wl-summary-update-modeline)
1819       (wl-summary-folder-info-update))))
1820
1821 (defun wl-summary-update-status-marks (beg end &optional check)
1822   "Synchronize status marks on current buffer to the msgdb."
1823   (interactive "r")
1824   (save-excursion
1825     (goto-char beg)
1826     (while (and (< (point) end) (not (eobp)))
1827       (when (or (not check)
1828                 (wl-summary-persistent-mark-invalid-p))
1829         (wl-summary-update-persistent-mark))
1830       (forward-line 1))))
1831
1832 (defun wl-summary-update-mark-window (&optional win beg)
1833   "Update persistent mark in visible summary window.
1834 This function is defined for `window-scroll-functions'"
1835   (with-current-buffer (window-buffer win)
1836     (when (eq major-mode 'wl-summary-mode)
1837       (let ((start (window-start win))
1838             (end (condition-case nil
1839                      (window-end win t) ; old emacsen doesn't support 2nd arg.
1840                    (error (window-end win)))))
1841         (wl-summary-update-status-marks start end 'check)))))
1842
1843 (defun wl-summary-insert-message (&rest args)
1844   (if (eq wl-summary-buffer-view 'thread)
1845       (apply 'wl-summary-insert-thread args)
1846     (apply 'wl-summary-insert-sequential args)))
1847
1848 (defun wl-summary-sort (reverse)
1849   "Sort summary lines into the selected order; argument means descending order."
1850   (interactive "P")
1851   (wl-summary-rescan
1852    (completing-read
1853     (format "%s by (%s): "
1854             (if reverse "Reverse sort" "Sort")
1855             (symbol-name wl-summary-default-sort-spec))
1856     (mapcar (lambda (spec)
1857               (list (symbol-name spec)))
1858             wl-summary-sort-specs)
1859     nil t nil nil (symbol-name wl-summary-default-sort-spec))
1860    reverse))
1861
1862 (defun wl-summary-get-available-flags (&optional include-specials)
1863   (let ((flags (elmo-uniq-list
1864                 (append elmo-global-flags
1865                         (copy-sequence elmo-preserved-flags))
1866                 #'delq)))
1867     (if include-specials
1868         flags
1869       (delq 'new (delq 'cached flags)))))
1870
1871 (defun wl-summary-sync-marks ()
1872   "Update persistent marks in summary."
1873   (interactive)
1874   (let ((mes "Updated ")
1875         diff diffs)
1876     (message "Updating marks...")
1877     (dolist (flag (wl-summary-get-available-flags))
1878       (setq diff (elmo-list-diff (elmo-folder-list-flagged
1879                                   wl-summary-buffer-elmo-folder
1880                                   flag)
1881                                  (elmo-folder-list-flagged
1882                                   wl-summary-buffer-elmo-folder
1883                                   flag 'in-msgdb)))
1884       (setq diffs (cadr diff))
1885       (setq mes (concat mes (format "-%d" (length diffs))))
1886       (when diffs
1887         (wl-summary-unset-persistent-mark flag diffs 'no-modeline 'no-server))
1888       (setq diffs (car diff)
1889             mes (concat mes (format "/+%d %s " (length diffs) flag)))
1890       (when diffs
1891         (wl-summary-set-persistent-mark flag diffs 'no-modeline 'no-server)))
1892     (if (interactive-p) (message "%s" mes))))
1893
1894 (defun wl-summary-sync-update (&optional unset-cursor
1895                                          disable-killed
1896                                          sync-all
1897                                          no-check)
1898   "Update the summary view to the newest folder status."
1899   (interactive)
1900   (let* ((folder wl-summary-buffer-elmo-folder)
1901          (elmo-mime-charset wl-summary-buffer-mime-charset)
1902          (inhibit-read-only t)
1903          (buffer-read-only nil)
1904          gc-message                     ; for XEmacs
1905          crossed expunged mes)
1906     (unwind-protect
1907         (progn
1908           (unless wl-summary-buffer-elmo-folder
1909             (error "(Internal error) Folder is not set:%s" (buffer-name
1910                                                             (current-buffer))))
1911           ;; Flush pending append operations (disconnected operation).
1912           ;;(setq seen-list
1913           ;;(wl-summary-flush-pending-append-operations seen-list))
1914           (goto-char (point-max))
1915           (wl-folder-confirm-existence folder (elmo-folder-plugged-p folder))
1916           (setq crossed (elmo-folder-synchronize folder
1917                                                  disable-killed
1918                                                  sync-all
1919                                                  no-check))
1920           (if crossed
1921               (let ((wl-summary-highlight
1922                      (and wl-summary-highlight
1923                           (not wl-summary-lazy-highlight)))
1924                     append-list delete-list
1925                     update-thread update-top-list
1926                     num diff entity
1927                     (i 0))
1928                 ;; Setup sync-all
1929                 (if sync-all (wl-summary-sync-all-init))
1930                 (setq diff (elmo-list-diff (elmo-folder-list-messages
1931                                             folder
1932                                             (not disable-killed)
1933                                             'in-msgdb)
1934                                            wl-summary-buffer-number-list))
1935                 (setq append-list (car diff))
1936                 (setq delete-list (cadr diff))
1937
1938                 (when delete-list
1939                   (wl-summary-delete-messages-on-buffer delete-list))
1940                 (unless wl-summary-lazy-update-mark
1941                   (wl-summary-update-status-marks (point-min) (point-max)))
1942                 (when (and wl-summary-lazy-highlight
1943                            wl-summary-lazy-update-mark)
1944                   (let (buffer-read-only)
1945                     (put-text-property (point-min) (point-max) 'face nil)))
1946                 (setq num (length append-list))
1947                 (setq wl-summary-delayed-update nil)
1948                 (elmo-kill-buffer wl-summary-search-buf-name)
1949                 (dolist (number append-list)
1950                   (setq entity (elmo-message-entity folder number))
1951                   (when (setq update-thread
1952                               (wl-summary-insert-message
1953                                entity folder
1954                                (not sync-all)))
1955                     (wl-append update-top-list update-thread))
1956                   (if elmo-use-database
1957                       (elmo-database-msgid-put
1958                        (car entity) (elmo-folder-name-internal folder)
1959                        (elmo-message-entity-number entity)))
1960                   (when (> num elmo-display-progress-threshold)
1961                     (setq i (+ i 1))
1962                     (if (or (zerop (% i 5)) (= i num))
1963                         (elmo-display-progress
1964                          'wl-summary-sync-update
1965                          (if (eq wl-summary-buffer-view 'thread)
1966                              "Making thread..."
1967                            "Inserting message...")
1968                          (/ (* i 100) num)))))
1969                 (when wl-summary-delayed-update
1970                   (while wl-summary-delayed-update
1971                     (message "Parent (%d) of message %d is no entity"
1972                              (caar wl-summary-delayed-update)
1973                              (elmo-message-entity-number
1974                               (cdar wl-summary-delayed-update)))
1975                     (when (setq update-thread
1976                                 (wl-summary-insert-message
1977                                  (cdar wl-summary-delayed-update)
1978                                  wl-summary-buffer-elmo-folder
1979                                  (not sync-all) t))
1980                       (wl-append update-top-list update-thread))
1981                     (setq wl-summary-delayed-update
1982                           (cdr wl-summary-delayed-update))))
1983                 (when (and (eq wl-summary-buffer-view 'thread)
1984                            update-top-list)
1985                   (wl-thread-update-indent-string-thread
1986                    (elmo-uniq-list update-top-list)))
1987                 (message (if (eq wl-summary-buffer-view 'thread)
1988                              "Making thread...done"
1989                            "Inserting message...done"))
1990                 (when (or delete-list append-list)
1991                   (wl-summary-set-message-modified))
1992                 (when (and sync-all (eq wl-summary-buffer-view 'thread))
1993                   (elmo-kill-buffer wl-summary-search-buf-name)
1994                   (message "Inserting message...")
1995                   (wl-thread-insert-top)
1996                   (message "Inserting message...done"))
1997                 (if elmo-use-database
1998                     (elmo-database-close))
1999                 (run-hooks 'wl-summary-sync-updated-hook)
2000                 (setq mes
2001                       (if (and (eq (length delete-list) 0)
2002                                (eq num 0))
2003                           (format
2004                            "No updates for \"%s\"" (elmo-folder-name-internal
2005                                                     folder))
2006                         (format "Updated (-%d/+%d) message(s)"
2007                                 (length delete-list) num))))
2008             (setq mes "Quit updating")))
2009       ;; synchronize marks.
2010       (if (and crossed wl-summary-auto-sync-marks)
2011           (wl-summary-sync-marks))
2012       ;; scoring
2013       (when wl-use-scoring
2014         (setq wl-summary-scored nil)
2015         (wl-summary-score-headers (and sync-all
2016                                        (wl-summary-rescore-msgs
2017                                         wl-summary-buffer-number-list))
2018                                   sync-all)
2019         (when (and wl-summary-scored
2020                    (setq expunged (wl-summary-score-update-all-lines)))
2021           (setq mes (concat mes
2022                             (format " (%d expunged)"
2023                                     (length expunged))))))
2024       (if (and crossed (> crossed 0))
2025           (setq mes
2026                 (if mes
2027                     (concat mes
2028                             (format " (%d crosspost)" crossed))
2029                   (format "%d crosspost message(s)" crossed)))
2030         (and mes (setq mes (concat mes "."))))
2031       ;; Update Folder mode
2032       (wl-folder-set-folder-updated
2033        (elmo-folder-name-internal folder)
2034        (list 0
2035              (or (cdr (assq 'unread (wl-summary-count-unread))) 0)
2036              (elmo-folder-length folder)))
2037       (wl-summary-update-modeline)
2038       ;;
2039       (unless unset-cursor
2040         (goto-char (point-min))
2041         (if (not (wl-summary-cursor-down t))
2042             (progn
2043               (goto-char (point-max))
2044               (forward-line -1))
2045           (when (and wl-summary-highlight
2046                      (not wl-summary-lazy-highlight)
2047                      (not (get-text-property (point) 'face)))
2048             (save-excursion
2049               (forward-line (- 0
2050                                (or
2051                                 wl-summary-partial-highlight-above-lines
2052                                 wl-summary-highlight-partial-threshold)))
2053               (wl-highlight-summary (point) (point-max))))))
2054       (wl-delete-all-overlays)
2055       (run-hooks 'wl-summary-buffer-window-scroll-functions)
2056       (set-buffer-modified-p nil)
2057       (if mes (message "%s" mes)))))
2058
2059 (defun wl-summary-set-score-mark (mark)
2060   (save-excursion
2061     (beginning-of-line)
2062     (let ((cur-mark (wl-summary-temp-mark)))
2063       (when (member cur-mark (list " "
2064                                    wl-summary-score-below-mark
2065                                    wl-summary-score-over-mark))
2066         (wl-summary-put-temp-mark mark)
2067         (if wl-summary-highlight
2068             (wl-highlight-summary-current-line))
2069         (set-buffer-modified-p nil)))))
2070
2071 (defun wl-summary-get-score-mark (msg-num)
2072   (let ((score (cdr (assq msg-num wl-summary-scored))))
2073     (if score
2074         (cond ((< score wl-summary-default-score)
2075                "-")
2076               ((> score wl-summary-default-score)
2077                "+")))))
2078
2079 (defun wl-summary-update-modeline ()
2080   (setq wl-summary-buffer-mode-line
2081         (funcall wl-summary-buffer-mode-line-formatter)))
2082
2083 (defun wl-summary-jump-to-msg (&optional number beg end)
2084   (interactive "NJump to Number:")
2085   (let ((num (or number
2086                  (string-to-int
2087                   (read-from-minibuffer "Jump to Message(No.): "))))
2088         (pos (point))
2089         regexp)
2090     (setq regexp (concat "\r" (int-to-string num) "[^0-9]"))
2091     (if (and beg end (or (< pos beg) (< end pos)))
2092         (progn
2093           (goto-char beg)
2094           (if (re-search-forward regexp end t)
2095               (progn (backward-char 1) (beginning-of-line) t)
2096             (goto-char pos)
2097             nil))
2098       (beginning-of-line)
2099       (if (or (and (re-search-forward regexp end t)
2100                    (progn (backward-char 1) t))
2101               (re-search-backward regexp beg t))
2102           (progn (beginning-of-line) t)
2103         nil))))
2104
2105 (defun wl-summary-highlight-msgs (msgs)
2106   (save-excursion
2107     (let ((len (length msgs))
2108           i)
2109       (message "Hilighting...")
2110       (setq i 0)
2111       (while msgs
2112         (if (wl-summary-jump-to-msg (car msgs))
2113             (wl-highlight-summary-current-line))
2114         (setq msgs (cdr msgs))
2115         (when (> len elmo-display-progress-threshold)
2116           (setq i (+ i 1))
2117           (if (or (zerop (% i 5)) (= i len))
2118               (elmo-display-progress
2119                'wl-summary-highlight-msgs "Highlighting..."
2120                (/ (* i 100) len)))))
2121       (message "Highlighting...done"))))
2122
2123 (defun wl-summary-message-number ()
2124   (save-excursion
2125     (beginning-of-line)
2126     (if (or (re-search-forward "\r\\(-?[0-9]+\\)" (point-at-eol) t)
2127             (re-search-forward "^ *\\(-?[0-9]+\\)" (point-at-eol) t))
2128         (string-to-int (wl-match-buffer 1))
2129       nil)))
2130
2131 (defun wl-summary-delete-all-msgs ()
2132   (interactive)
2133   (let ((cur-buf (current-buffer))
2134         (dels (elmo-folder-list-messages wl-summary-buffer-elmo-folder)))
2135     (set-buffer cur-buf)
2136     (if (null dels)
2137         (message "No message to delete.")
2138       (if (y-or-n-p (format "%s has %d message(s).  Delete all? "
2139                             (wl-summary-buffer-folder-name)
2140                             (length dels)))
2141           (progn
2142             (message "Deleting...")
2143             (elmo-folder-move-messages wl-summary-buffer-elmo-folder dels
2144                                        'null)
2145             (wl-summary-set-message-modified)
2146             (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
2147                                           (list 0 0 0))
2148 ;;; for thread.
2149 ;;;         (setq wl-thread-top-entity '(nil t nil nil))
2150             (setq wl-summary-buffer-unread-count 0)
2151             (setq wl-summary-buffer-new-count    0)
2152             (wl-summary-update-modeline)
2153             (set-buffer cur-buf)
2154             (let ((inhibit-read-only t)
2155                   (buffer-read-only nil))
2156               (erase-buffer))
2157 ;;;         (if wl-summary-cache-use (wl-summary-save-view-cache))
2158             (message "Deleting...done")
2159             t)
2160         nil))))
2161
2162 (defun wl-summary-toggle-thread (&optional arg)
2163   "Toggle thread status (T)hread and (S)equential.
2164 If ARG, without confirm."
2165   (interactive "P")
2166   (when (or arg
2167             (y-or-n-p (format "Toggle threading? (y=%s): "
2168                               (if (eq wl-summary-buffer-view 'thread)
2169                                   "\"off\"" "\"on\""))))
2170     (if (eq wl-summary-buffer-view 'thread)
2171         (setq wl-summary-buffer-view 'sequence)
2172       (setq wl-summary-buffer-view 'thread))
2173     (wl-summary-update-modeline)
2174     (force-mode-line-update)
2175     (wl-summary-rescan nil nil nil t)))
2176
2177 (defun wl-summary-load-file-object (filename)
2178   "Load lisp object from dir."
2179   (with-temp-buffer
2180     (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
2181           insert-file-contents-post-hook
2182           ret-val)
2183       (if (not (file-readable-p filename))
2184           ()
2185         (as-binary-input-file (insert-file-contents filename))
2186         (condition-case nil
2187             (read (current-buffer))
2188           (error (error "Reading failed")))))))
2189
2190 (defun wl-summary-goto-folder (&optional arg)
2191   (interactive "P")
2192   (wl-summary-goto-folder-subr nil nil nil nil t nil arg))
2193
2194 (defun wl-summary-goto-folder-sticky ()
2195   (interactive)
2196   (wl-summary-goto-folder-subr nil nil nil t t))
2197
2198 (defun wl-summary-goto-last-visited-folder ()
2199   (interactive)
2200   (let ((entity
2201          (wl-folder-search-entity-by-name wl-summary-last-visited-folder
2202                                           wl-folder-entity
2203                                           'folder)))
2204     (if entity (wl-folder-set-current-entity-id
2205                 (wl-folder-get-entity-id entity))))
2206   (wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t))
2207
2208 (defun wl-summary-sticky-p (&optional folder)
2209   (if folder
2210       (get-buffer (wl-summary-sticky-buffer-name
2211                    (elmo-folder-name-internal folder)))
2212     (not (string= wl-summary-buffer-name (buffer-name)))))
2213
2214 (defun wl-summary-always-sticky-folder-p (folder)
2215   (or (eq t wl-summary-always-sticky-folder-list)
2216       (wl-string-match-member
2217        (elmo-folder-name-internal folder)
2218        wl-summary-always-sticky-folder-list)))
2219
2220 (defun wl-summary-stick (&optional force)
2221   "Make current summary buffer sticky."
2222   (interactive "P")
2223   (if (wl-summary-sticky-p)
2224       (message "Current summary buffer is already sticky.")
2225     (when (or force (y-or-n-p "Stick current summary buffer? "))
2226       (wl-summary-toggle-disp-msg 'off)
2227       (wl-summary-switch-to-clone-buffer
2228        (wl-summary-sticky-buffer-name
2229         (wl-summary-buffer-folder-name)))
2230 ;;; ???hang up
2231 ;;;   (rename-buffer (wl-summary-sticky-buffer-name
2232 ;;;                   (wl-summary-buffer-folder-name))))
2233       (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name)))))
2234
2235 (defun wl-summary-switch-to-clone-buffer (buffer-name)
2236   (let ((cur-buf (current-buffer))
2237         (msg (wl-summary-message-number))
2238         (buf (get-buffer-create buffer-name))
2239         (folder wl-summary-buffer-elmo-folder)
2240         (copy-variables
2241          (append '(wl-summary-buffer-view
2242                    wl-summary-buffer-temp-mark-list
2243                    wl-summary-buffer-target-mark-list
2244                    wl-summary-buffer-elmo-folder
2245                    wl-summary-buffer-number-column
2246                    wl-summary-buffer-temp-mark-column
2247                    wl-summary-buffer-persistent-mark-column
2248                    wl-summary-buffer-message-modified
2249                    wl-summary-buffer-thread-modified
2250                    wl-summary-buffer-number-list
2251                    wl-summary-buffer-persistent-mark-version
2252                    wl-summary-buffer-folder-name
2253                    wl-summary-buffer-line-formatter)
2254                  (and (eq wl-summary-buffer-view 'thread)
2255                       '(wl-thread-entity-hashtb
2256                         wl-thread-entities
2257                         wl-thread-entity-list))
2258                  (and wl-use-scoring
2259                       '(wl-summary-scored
2260                         wl-summary-default-score
2261                         wl-summary-important-above
2262                         wl-summary-target-above
2263                         wl-summary-mark-below
2264                         wl-summary-expunge-below))
2265                  (and (featurep 'wl-score)
2266                       '(wl-current-score-file
2267                         wl-score-alist)))))
2268     (set-buffer buf)
2269     (wl-summary-mode)
2270     (wl-summary-buffer-set-folder folder)
2271     (let ((buffer-read-only nil))
2272       (insert-buffer cur-buf))
2273     (set-buffer-modified-p nil)
2274     (while copy-variables
2275       (set (car copy-variables)
2276            (save-excursion
2277              (set-buffer cur-buf)
2278              (symbol-value (car copy-variables))))
2279       (setq copy-variables (cdr copy-variables)))
2280     (switch-to-buffer buf)
2281     (kill-buffer cur-buf)
2282     (wl-summary-count-unread)
2283     (wl-summary-update-modeline)
2284     (if msg
2285         (if (eq wl-summary-buffer-view 'thread)
2286             (wl-thread-jump-to-msg msg)
2287           (wl-summary-jump-to-msg msg))
2288       (goto-char (point-max))
2289       (beginning-of-line))))
2290
2291 (defun wl-summary-get-buffer (folder)
2292   (or (and folder
2293            (get-buffer (wl-summary-sticky-buffer-name folder)))
2294       (get-buffer wl-summary-buffer-name)))
2295
2296 (defun wl-summary-get-buffer-create (name &optional force-sticky)
2297   (if force-sticky
2298       (get-buffer-create
2299        (wl-summary-sticky-buffer-name name))
2300     (or (get-buffer (wl-summary-sticky-buffer-name name))
2301         (get-buffer-create wl-summary-buffer-name))))
2302
2303 (defun wl-summary-make-number-list ()
2304   (save-excursion
2305     (goto-char (point-min))
2306     (setq wl-summary-buffer-number-list nil)
2307     (while (not (eobp))
2308       (setq wl-summary-buffer-number-list
2309             (cons (wl-summary-message-number)
2310                   wl-summary-buffer-number-list))
2311       (forward-line 1))
2312     (setq wl-summary-buffer-number-list
2313           (nreverse wl-summary-buffer-number-list))))
2314
2315 (defun wl-summary-auto-select-msg-p (unread-msg)
2316   (and unread-msg
2317        (not (elmo-message-has-global-flag-p
2318              wl-summary-buffer-elmo-folder unread-msg))))
2319
2320 (defsubst wl-summary-open-folder (folder)
2321   ;; Select folder
2322   (let ((elmo-mime-charset wl-summary-buffer-mime-charset))
2323     (unwind-protect
2324         (elmo-folder-open folder 'load-msgdb)
2325       ;; For compatibility
2326       (setq wl-summary-buffer-folder-name (elmo-folder-name-internal
2327                                            folder)))))
2328
2329 (defun wl-summary-goto-folder-subr (&optional name scan-type other-window
2330                                               sticky interactive scoring
2331                                               force-exit)
2332   "Display target folder on summary."
2333   (interactive)
2334   (let* ((keep-cursor (memq this-command
2335                             wl-summary-keep-cursor-command))
2336          (name (or name (wl-summary-read-folder wl-default-folder)))
2337          (cur-fld wl-summary-buffer-elmo-folder)
2338          folder buf mes hilit reuse-buf
2339          retval entity)
2340     (if (string= name "")
2341         (setq name wl-default-folder))
2342     (setq folder (wl-folder-get-elmo-folder name))
2343     (when (and (not (string=
2344                      (and cur-fld (elmo-folder-name-internal cur-fld))
2345                      (elmo-folder-name-internal folder))) ; folder is moved.
2346                (eq major-mode 'wl-summary-mode)) ; called in summary.
2347       (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name))
2348       (run-hooks 'wl-summary-exit-pre-hook)
2349       (if (or force-exit (not (wl-summary-sticky-p)))
2350           (wl-summary-cleanup-temp-marks))
2351       (wl-summary-save-view)
2352       (elmo-folder-commit wl-summary-buffer-elmo-folder)
2353       (if (and (wl-summary-sticky-p) force-exit)
2354           (kill-buffer (current-buffer))))
2355     (setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder)
2356                                             sticky))
2357     (setq reuse-buf
2358           (save-excursion
2359             (set-buffer buf)
2360             (string= (elmo-folder-name-internal folder)
2361                      (wl-summary-buffer-folder-name))))
2362     (unwind-protect
2363         (if reuse-buf
2364             (if interactive
2365                 (switch-to-buffer buf)
2366               (set-buffer buf))
2367           (if other-window
2368               (delete-other-windows))
2369           (set-buffer buf)
2370           (unless (eq major-mode 'wl-summary-mode)
2371             (wl-summary-mode))
2372           (wl-summary-buffer-set-folder folder)
2373           (setq wl-summary-buffer-display-mime-mode
2374                 (if (wl-summary-no-mime-p wl-summary-buffer-elmo-folder)
2375                     'as-is
2376                   'mime))
2377           (setq wl-summary-buffer-disp-msg nil)
2378           (setq wl-summary-buffer-last-displayed-msg nil)
2379           (setq wl-summary-buffer-current-msg nil)
2380           (setq wl-summary-buffer-persistent-mark-version 0)
2381           (let ((inhibit-read-only t)
2382                 (buffer-read-only nil))
2383             (erase-buffer)
2384             ;; Resume summary view
2385             (if wl-summary-cache-use
2386                 (let* ((dir (elmo-folder-msgdb-path folder))
2387                        (cache (expand-file-name wl-summary-cache-file dir))
2388                        (view (expand-file-name wl-summary-view-file dir)))
2389                   (when (file-exists-p cache)
2390                     (insert-file-contents-as-binary cache)
2391                     (set-buffer-multibyte
2392                      default-enable-multibyte-characters)
2393                     (decode-mime-charset-region
2394                      (point-min)(point-max)
2395                      wl-summary-buffer-mime-charset 'LF))
2396                   (if (file-exists-p view)
2397                       (setq wl-summary-buffer-view
2398                             (wl-summary-load-file-object view))
2399                     (setq wl-summary-buffer-view
2400                           (or (wl-get-assoc-list-value
2401                                wl-summary-default-view-alist
2402                                (elmo-folder-name-internal folder))
2403                               wl-summary-default-view)))
2404                   (wl-thread-resume-entity folder)
2405                   (wl-summary-open-folder folder)
2406                   (wl-summary-detect-mark-position))
2407               (setq wl-summary-buffer-view
2408                     (wl-summary-load-file-object
2409                      (expand-file-name wl-summary-view-file
2410                                        (elmo-folder-msgdb-path folder))))
2411               (wl-summary-open-folder folder)
2412               (wl-summary-detect-mark-position)
2413               (wl-summary-rescan))
2414             (wl-summary-count-unread)
2415             (wl-summary-update-modeline)))
2416       (unless (eq wl-summary-buffer-view 'thread)
2417         (wl-summary-make-number-list))
2418       (when (and wl-summary-cache-use
2419                  (or (and wl-summary-check-line-format
2420                           (wl-summary-line-format-changed-p))
2421                      (wl-summary-view-old-p)))
2422         (wl-summary-rescan))
2423       (wl-summary-toggle-disp-msg (if wl-summary-buffer-disp-msg 'on 'off))
2424       (unless (and reuse-buf keep-cursor)
2425         (unwind-protect
2426             (let ((wl-use-scoring
2427                    (if (or scoring interactive) wl-use-scoring)))
2428               (if (and (not scan-type)
2429                        interactive
2430                        (not wl-ask-range))
2431                   (setq scan-type (wl-summary-get-sync-range folder)))
2432               (cond
2433                ((eq scan-type nil)
2434                 (wl-summary-sync 'unset-cursor))
2435                ((eq scan-type 'all)
2436                 (wl-summary-sync 'unset-cursor "all"))
2437                ((eq scan-type 'no-sync))
2438                ((eq scan-type 'rescan)
2439                 (wl-summary-rescan))
2440                ((or (eq scan-type 'force-update)
2441                     (eq scan-type 'update))
2442                 (setq mes (wl-summary-sync-force-update
2443                            'unset-cursor)))))
2444           (if interactive
2445               (switch-to-buffer buf)
2446             (set-buffer buf))
2447           ;; stick always-sticky-folder
2448           (when (wl-summary-always-sticky-folder-p folder)
2449             (or (wl-summary-sticky-p) (wl-summary-stick t)))
2450           (run-hooks 'wl-summary-prepared-pre-hook)
2451           (set-buffer-modified-p nil)
2452           (goto-char (point-min))
2453           (if (wl-summary-cursor-down t)
2454               (let ((unreadp (wl-summary-next-message
2455                               (wl-summary-message-number)
2456                               'down t)))
2457                 (cond ((and wl-auto-select-first
2458                             (wl-summary-auto-select-msg-p unreadp))
2459                        ;; wl-auto-select-first is non-nil and
2460                        ;; unreadp is non-nil but not flagged
2461                        (setq retval 'disp-msg))
2462                       ((and wl-auto-prefetch-first
2463                             (wl-summary-auto-select-msg-p unreadp))
2464                        ;; wl-auto-select-first is non-nil and
2465                        ;; unreadp is non-nil but not flagged
2466                        (setq retval 'prefetch-msg))
2467                       ((not (wl-summary-auto-select-msg-p unreadp))
2468                        ;; unreadp is nil or flagged
2469                        (setq retval 'more-next))))
2470             (goto-char (point-max))
2471             (if (elmo-folder-plugged-p folder)
2472                 (forward-line -1)
2473               (wl-summary-prev))
2474             (setq retval 'more-next))
2475           (if (and wl-summary-highlight
2476                    (not wl-summary-lazy-highlight)
2477                    (not reuse-buf))
2478               (if (and wl-summary-highlight-partial-threshold
2479                        (> (count-lines (point-min) (point-max))
2480                           wl-summary-highlight-partial-threshold))
2481                   (save-excursion
2482                     (forward-line (-
2483                                    0
2484                                    (or
2485                                     wl-summary-partial-highlight-above-lines
2486                                     wl-summary-highlight-partial-threshold)))
2487                     (wl-highlight-summary (point) (point-max)))
2488                 (wl-highlight-summary (point-min) (point-max))))
2489           (if (eq retval 'disp-msg)
2490               (wl-summary-redisplay))
2491           (if (eq retval 'prefetch-msg)
2492               (wl-message-buffer-prefetch
2493                folder
2494                (wl-summary-message-number)
2495                (min (or wl-message-buffer-prefetch-depth 0)
2496                     (1- wl-message-buffer-cache-size))
2497                (current-buffer)
2498                wl-summary-buffer-mime-charset))
2499           (if mes (message "%s" mes))
2500           (if (and interactive wl-summary-recenter)
2501               (recenter (/ (- (window-height) 2) 2))))))
2502     ;; set current entity-id
2503     (when (and folder
2504                (setq entity
2505                      (wl-folder-search-entity-by-name
2506                       (elmo-folder-name-internal folder)
2507                       wl-folder-entity
2508                       'folder)))
2509       ;; entity-id is unknown.
2510       (wl-folder-set-current-entity-id
2511        (wl-folder-get-entity-id entity)))
2512     (when (and wl-summary-buffer-window-scroll-functions
2513                wl-on-xemacs)
2514       (sit-for 0))
2515     (when (or (eq t wl-summary-force-prefetch-folder-list)
2516               (wl-string-match-member
2517                (elmo-folder-name-internal wl-summary-buffer-elmo-folder)
2518                wl-summary-force-prefetch-folder-list))
2519       (wl-summary-force-prefetch))
2520     (unwind-protect
2521         (run-hooks 'wl-summary-prepared-hook)
2522       (set-buffer-modified-p nil))
2523     retval))
2524
2525 (defun wl-summary-goto-previous-message-beginning ()
2526   (end-of-line)
2527   (re-search-backward "\r\\(-?[0-9]+\\)" nil t)
2528   (beginning-of-line))
2529
2530 (defun wl-summary-goto-top-of-current-thread ()
2531   (wl-summary-jump-to-msg
2532    (wl-thread-entity-get-number
2533     (wl-thread-entity-get-top-entity (wl-thread-get-entity
2534                                       (wl-summary-message-number))))))
2535
2536 (defun wl-summary-goto-bottom-of-sub-thread (&optional depth)
2537   (interactive)
2538   (let ((depth (or depth
2539                    (wl-thread-get-depth-of-current-line))))
2540     (forward-line 1)
2541     (while (and (not (eobp))
2542                 (>= (wl-thread-get-depth-of-current-line)
2543                     depth))
2544       (forward-line 1))
2545     (beginning-of-line)))
2546
2547 (defun wl-summary-insert-line (line)
2548   "Insert LINE in the Summary."
2549   (if wl-use-highlight-mouse-line
2550       ;; remove 'mouse-face of current line.
2551       (put-text-property
2552        (save-excursion (beginning-of-line)(point))
2553        (save-excursion (end-of-line)(point))
2554        'mouse-face nil))
2555   (insert line "\n")
2556   (if wl-use-highlight-mouse-line
2557       ;; remove 'mouse-face of current line.
2558       (put-text-property
2559        (save-excursion (beginning-of-line)(point))
2560        (save-excursion (end-of-line)(point))
2561        'mouse-face nil))
2562   (ignore-errors
2563     (run-hooks 'wl-summary-line-inserted-hook)))
2564
2565 (defun wl-summary-insert-sequential (entity folder &rest args)
2566   (when entity
2567     (let ((inhibit-read-only t)
2568           (number (elmo-message-entity-number entity))
2569           buffer-read-only)
2570       (goto-char (point-max))
2571       (wl-summary-insert-line
2572        (wl-summary-create-line entity nil nil
2573                                (elmo-message-flags
2574                                 wl-summary-buffer-elmo-folder
2575                                 number)
2576                                (elmo-message-cached-p
2577                                 wl-summary-buffer-elmo-folder
2578                                 number)))
2579       (setq wl-summary-buffer-number-list
2580             (wl-append wl-summary-buffer-number-list
2581                        (list (elmo-message-entity-number entity))))
2582       nil)))
2583
2584 (defun wl-summary-default-subject-filter (subject)
2585   (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\)[:>]" ""))
2586   (setq subject (elmo-replace-in-string subject "[ \t]" ""))
2587   (elmo-replace-in-string subject "^\\[[^]]*\\]" ""))
2588
2589 (defun wl-summary-subject-equal (subject1 subject2)
2590   (string= (funcall wl-summary-subject-filter-function subject1)
2591            (funcall wl-summary-subject-filter-function subject2)))
2592
2593 (defmacro wl-summary-put-alike (alike)
2594   (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
2595                         (, alike)
2596                         wl-summary-alike-hashtb)))
2597
2598 (defmacro wl-summary-get-alike ()
2599   (` (elmo-get-hash-val (format "#%d" (wl-count-lines))
2600                         wl-summary-alike-hashtb)))
2601
2602 (defun wl-summary-insert-headers (folder func mime-decode)
2603   (let ((numbers (elmo-folder-list-messages folder 'visible t))
2604         ov this last alike)
2605     (buffer-disable-undo (current-buffer))
2606     (make-local-variable 'wl-summary-alike-hashtb)
2607     (setq wl-summary-alike-hashtb (elmo-make-hash (* (length numbers) 2)))
2608     (when mime-decode
2609       (set-buffer-multibyte default-enable-multibyte-characters))
2610     (while (setq ov (elmo-message-entity folder (pop numbers)))
2611       (setq this (funcall func ov))
2612       (and this (setq this (std11-unfold-string this)))
2613       (if (equal last this)
2614           (setq alike (cons ov alike))
2615         (when last
2616           (wl-summary-put-alike alike)
2617           (insert last ?\n))
2618         (setq alike (list ov)
2619               last this)))
2620     (when last
2621       (wl-summary-put-alike alike)
2622       (insert last ?\n))
2623     (when mime-decode
2624       (decode-mime-charset-region (point-min) (point-max)
2625                                   elmo-mime-charset)
2626       (when (eq mime-decode 'mime)
2627         (eword-decode-region (point-min) (point-max))))
2628     (run-hooks 'wl-summary-insert-headers-hook)))
2629
2630 (defun wl-summary-search-by-subject (entity folder)
2631   (let ((summary-buf (current-buffer))
2632         (buf (get-buffer-create wl-summary-search-buf-name))
2633         (folder-name (wl-summary-buffer-folder-name))
2634         match founds result)
2635     (with-current-buffer buf
2636       (let ((case-fold-search t))
2637         (when (or (not (string= wl-summary-search-buf-folder-name folder-name))
2638                   (zerop (buffer-size)))
2639           (setq wl-summary-search-buf-folder-name folder-name)
2640           (message "Creating subject cache...")
2641           (wl-summary-insert-headers
2642            folder
2643            (function
2644             (lambda (x)
2645               (funcall wl-summary-subject-filter-function
2646                        (elmo-message-entity-field x 'subject))))
2647            t)
2648           (message "Creating subject cache...done"))
2649         (setq match (funcall wl-summary-subject-filter-function
2650                              (elmo-message-entity-field entity 'subject
2651                                                         'decode)))
2652         (if (string= match "")
2653             (setq match "\n"))
2654         (goto-char (point-max))
2655         (while (and (null result)
2656                     (not (= (point) (point-min)))
2657                     (search-backward match nil t))
2658           ;; check exactly match
2659           (when (and (bolp) (= (point-at-eol)(match-end 0)))
2660             (setq founds (wl-summary-get-alike))
2661             (with-current-buffer summary-buf
2662               (while founds
2663                 (when (and
2664                        ;; the first element of found-entity list exists on
2665                        ;; thread tree.
2666                        (wl-thread-get-entity
2667                         (elmo-message-entity-number (car founds)))
2668                        ;; message id is not same as myself.
2669                        (not (string=
2670                              (elmo-message-entity-field entity 'message-id)
2671                              (elmo-message-entity-field (car founds)
2672                                                         'message-id)))
2673                        ;; not a descendant.
2674                        (not (wl-thread-descendant-p
2675                              (elmo-message-entity-number entity)
2676                              (elmo-message-entity-number (car founds)))))
2677                   (setq result (car founds)
2678                         founds nil))
2679                 (setq founds (cdr founds))))))
2680         result))))
2681
2682 (defun wl-summary-insert-thread (entity folder update
2683                                         &optional force-insert)
2684   (let ((depth 0)
2685         this-id parent-entity parent-number
2686         number cur-entity linked retval delayed-entity
2687         update-list entity-stack thread-entity)
2688     (while entity
2689       (setq this-id (elmo-message-entity-field entity 'message-id)
2690             number (elmo-message-entity-number entity))
2691       (if (and wl-thread-saved-entity-hashtb-internal
2692                (setq thread-entity
2693                      (elmo-get-hash-val
2694                       (format "#%d" (elmo-message-entity-number entity))
2695                       wl-thread-saved-entity-hashtb-internal)))
2696           (setq parent-entity
2697                 (elmo-message-entity
2698                  folder
2699                  (wl-thread-entity-get-parent thread-entity))
2700                 linked (wl-thread-entity-get-linked thread-entity))
2701         (setq parent-entity (elmo-message-entity-parent folder entity)
2702               linked nil))
2703       (setq parent-number (and parent-entity
2704                                (elmo-message-entity-number parent-entity)))
2705       ;; If thread loop detected, set parent as nil.
2706       (let ((cur entity)
2707             anumber relatives)
2708         (while cur
2709           (when (setq anumber
2710                       (elmo-message-entity-number
2711                        (setq cur (elmo-message-entity-parent folder cur))))
2712             (if (memq anumber relatives)
2713                 (setq parent-number nil
2714                       cur nil))
2715             (setq relatives (cons anumber relatives)))))
2716       (if (and parent-number
2717                (not (wl-thread-get-entity parent-number))
2718                (not force-insert))
2719           ;; parent exists in overview, but not in wl-thread-entities
2720           (progn
2721             (wl-append wl-summary-delayed-update
2722                        (list (cons parent-number entity)))
2723             (setq entity nil)) ;; exit loop
2724         ;; Search parent by subject.
2725         (when (and (null parent-number)
2726                    wl-summary-search-parent-by-subject-regexp
2727                    (string-match
2728                     wl-summary-search-parent-by-subject-regexp
2729                     (elmo-message-entity-field entity 'subject)))
2730           (let ((found (wl-summary-search-by-subject entity folder)))
2731             (when (and found
2732                        (not (member found wl-summary-delayed-update)))
2733               (setq parent-entity found)
2734               (setq parent-number
2735                     (elmo-message-entity-number parent-entity))
2736               (setq linked t))))
2737         ;; If subject is change, divide thread.
2738         (if (and parent-number
2739                  wl-summary-divide-thread-when-subject-changed
2740                  (not (wl-summary-subject-equal
2741                        (or (elmo-message-entity-field entity
2742                                                       'subject t) "")
2743                        (or (elmo-message-entity-field parent-entity
2744                                                       'subject t) ""))))
2745             (setq parent-number nil))
2746         (setq retval
2747               (wl-thread-insert-message entity
2748                                         number parent-number update linked))
2749         (and retval
2750              (wl-append update-list (list retval)))
2751         (setq entity nil) ; exit loop
2752         (while (setq delayed-entity (assq number wl-summary-delayed-update))
2753           (setq wl-summary-delayed-update
2754                 (delq delayed-entity wl-summary-delayed-update))
2755           ;; update delayed message
2756           (wl-append entity-stack (list (cdr delayed-entity)))))
2757       (if (and (not entity)
2758                entity-stack)
2759           (setq entity (pop entity-stack))))
2760     update-list))
2761
2762 (defun wl-summary-update-thread (entity
2763                                  thr-entity
2764                                  parent-entity)
2765   (let* ((this-id (elmo-message-entity-field entity 'message-id))
2766          (overview-entity entity)
2767          (parent-id (elmo-message-entity-field parent-entity 'message-id))
2768          (number (elmo-message-entity-number entity))
2769          (parent-number (elmo-message-entity-number parent-entity))
2770          insert-line)
2771     (cond
2772      ((or (not parent-id)
2773           (string= this-id parent-id))
2774       (goto-char (point-max))
2775       (beginning-of-line)
2776       (setq insert-line t))
2777      ;; parent already exists in buffer.
2778      ((wl-summary-jump-to-msg parent-number)
2779       (wl-thread-goto-bottom-of-sub-thread)
2780       (setq insert-line t)))
2781     (when insert-line
2782       (let (buffer-read-only)
2783         (wl-summary-insert-line
2784          (wl-summary-create-line
2785           entity
2786           parent-entity
2787           nil
2788           (elmo-message-flags wl-summary-buffer-elmo-folder number)
2789           (elmo-message-cached-p wl-summary-buffer-elmo-folder number)
2790           (wl-thread-maybe-get-children-num number)
2791           (wl-thread-make-indent-string thr-entity)
2792           (wl-thread-entity-get-linked thr-entity)))))))
2793
2794 (defun wl-summary-target-mark-msgs (msgs)
2795   "Return the number of marked messages."
2796   (let ((i 0))
2797     (dolist (number msgs)
2798       (when (wl-summary-target-mark number)
2799         (setq i (1+ i))))
2800     i))
2801
2802 (defun wl-summary-pick (&optional from-list delete-marks)
2803   (interactive "i\nP")
2804   (save-excursion
2805     (let* ((messages (or from-list
2806                          (elmo-folder-list-messages
2807                           wl-summary-buffer-elmo-folder
2808                           'visible
2809                           'in-msgdb)
2810                          (error "No messages")))
2811            (condition (car (elmo-parse-search-condition
2812                             (wl-read-search-condition
2813                              wl-summary-pick-field-default))))
2814            (result (elmo-folder-search wl-summary-buffer-elmo-folder
2815                                        condition
2816                                        messages))
2817            num)
2818       (if delete-marks
2819           (let ((mlist wl-summary-buffer-target-mark-list))
2820             (while mlist
2821               (when (wl-summary-jump-to-msg (car mlist))
2822                 (wl-summary-unmark))
2823               (setq mlist (cdr mlist)))
2824             (setq wl-summary-buffer-target-mark-list nil)))
2825       (if (and result
2826                (setq num (wl-summary-target-mark-msgs result))
2827                (> num 0))
2828           (if (= num (length result))
2829               (message "%d message(s) are picked." num)
2830             (message "%d(%d) message(s) are picked." num
2831                      (- (length result) num)))
2832         (message "No message was picked.")))))
2833
2834 (defun wl-summary-unvirtual ()
2835   "Exit from current virtual folder."
2836   (interactive)
2837   (if (eq 'filter
2838           (elmo-folder-type-internal wl-summary-buffer-elmo-folder))
2839       (wl-summary-goto-folder-subr
2840        (elmo-folder-name-internal
2841         (elmo-filter-folder-target-internal
2842          wl-summary-buffer-elmo-folder))
2843        'update nil nil t)
2844     (error "This folder is not filtered")))
2845
2846 (defun wl-summary-virtual (&optional arg)
2847   "Goto virtual folder.
2848 If ARG, exit virtual folder."
2849   (interactive "P")
2850   (if arg
2851       (wl-summary-unvirtual)
2852     (wl-summary-goto-folder-subr (concat "/"
2853                                          (wl-read-search-condition
2854                                           wl-summary-pick-field-default)
2855                                          "/"
2856                                          (wl-summary-buffer-folder-name))
2857                                  'update nil nil t)
2858     (run-hooks 'wl-summary-virtual-hook)))
2859
2860 (defun wl-summary-delete-all-temp-marks (&optional no-msg force)
2861   "Erase all temp marks from buffer."
2862   (interactive)
2863   (when (or wl-summary-buffer-target-mark-list
2864             wl-summary-buffer-temp-mark-list
2865             wl-summary-scored)
2866     (save-excursion
2867       (goto-char (point-min))
2868       (unless no-msg
2869         (message "Unmarking..."))
2870       (while (not (eobp))
2871         (wl-summary-unset-mark nil nil force)
2872         (forward-line 1))
2873       (unless no-msg
2874         (message "Unmarking...done"))
2875       (setq wl-summary-buffer-target-mark-list nil)
2876       (setq wl-summary-buffer-temp-mark-list nil))))
2877
2878 (defsubst wl-summary-temp-mark (&optional number)
2879   "Return temp-mark string of current line."
2880   (let ((number (or number (wl-summary-message-number)))
2881         info)
2882     (or (and (wl-summary-have-target-mark-p number)
2883              "*")
2884         (and (setq info (wl-summary-registered-temp-mark number))
2885              (nth 1 info))
2886         (wl-summary-get-score-mark number)
2887         " ")))
2888
2889 (defun wl-summary-persistent-mark-invalid-p ()
2890   (not
2891    (equal
2892     ;; mey be nil.
2893     (get-text-property (point) 'wl-summary-persistent-mark-version)
2894     wl-summary-buffer-persistent-mark-version)))
2895
2896 (defun wl-summary-validate-persistent-mark (beg end)
2897   (let ((inhibit-read-only t)
2898         (buffer-read-only nil))
2899     (put-text-property beg end
2900                        'wl-summary-persistent-mark-version
2901                        wl-summary-buffer-persistent-mark-version)
2902     (set-buffer-modified-p nil)))
2903
2904 (defun wl-summary-validate-persistent-mark-string (string)
2905   (put-text-property 0 (length string)
2906                      'wl-summary-persistent-mark-version
2907                      wl-summary-buffer-persistent-mark-version
2908                      string))
2909
2910 (defun wl-summary-invalidate-persistent-mark ()
2911   (setq wl-summary-buffer-persistent-mark-version
2912         (1+ wl-summary-buffer-persistent-mark-version)))
2913
2914 (defsubst wl-summary-persistent-mark-string (folder flags cached)
2915   "Return the persistent mark string.
2916 The mark is decided according to the FOLDER, FLAGS and CACHED."
2917   (let ((priorities wl-summary-persistent-mark-priority-list)
2918         mark)
2919     (while (and (null mark) priorities)
2920       (if (and (eq (car priorities) 'flag)
2921                (elmo-get-global-flags flags 'ignore-preserved))
2922           (let ((specs wl-summary-flag-alist)
2923                 spec)
2924             (while (setq spec (car specs))
2925               (if (memq (car spec) flags)
2926                   (setq mark (or (nth 2 spec) wl-summary-flag-mark)
2927                         specs nil)
2928                 (setq specs (cdr specs))))
2929             (unless mark
2930               (setq mark wl-summary-flag-mark)))
2931         (when (memq (car priorities) flags)
2932           (setq mark
2933                 (let ((var
2934                        (intern
2935                         (if cached
2936                             (format
2937                              "wl-summary-%s-cached-mark" (car priorities))
2938                           (format
2939                            "wl-summary-%s-uncached-mark" (car priorities))))))
2940                   (if (and (boundp var)
2941                            (symbol-value var))
2942                       (symbol-value var)
2943                     (if cached
2944                         (downcase (substring (symbol-name (car priorities))
2945                                              0 1))
2946                       (upcase (substring (symbol-name (car priorities))
2947                                          0 1))))))))
2948       (setq priorities (cdr priorities)))
2949     (or mark
2950         (if (or cached (elmo-folder-local-p folder))
2951             nil
2952           wl-summary-uncached-mark))))
2953
2954 (defsubst wl-summary-message-mark (folder number &optional flags)
2955   "Return mark of the message."
2956   (ignore-errors
2957     (wl-summary-persistent-mark-string
2958      folder
2959      (or flags (setq flags (elmo-message-flags folder number)))
2960      (memq 'cached flags) ; XXX for speed-up.
2961      )))
2962
2963 (defsubst wl-summary-persistent-mark (&optional number flags)
2964   "Return persistent-mark string of current line."
2965   (or (wl-summary-message-mark wl-summary-buffer-elmo-folder
2966                                (or number (wl-summary-message-number))
2967                                flags)
2968       " "))
2969
2970 (defun wl-summary-put-temp-mark (mark)
2971   "Put temp MARK on current line."
2972   (when wl-summary-buffer-temp-mark-column
2973     (save-excursion
2974       (beginning-of-line)
2975       (let ((inhibit-read-only t)
2976             (buffer-read-only nil))
2977         (move-to-column wl-summary-buffer-temp-mark-column)
2978         (delete-backward-char 1)
2979         (insert mark)))))
2980
2981 (defun wl-summary-next-buffer ()
2982   "Switch to next summary buffer."
2983   (interactive)
2984   (let ((buffers (sort (wl-collect-summary)
2985                        (lambda (buffer1 buffer2)
2986                          (string-lessp (buffer-name buffer1)
2987                                        (buffer-name buffer2))))))
2988     (switch-to-buffer
2989      (or (cadr (memq (current-buffer) buffers))
2990          (car buffers)))))
2991
2992 (defun wl-summary-previous-buffer ()
2993   "Switch to previous summary buffer."
2994   (interactive)
2995   (let ((buffers (sort (wl-collect-summary)
2996                        (lambda (buffer1 buffer2)
2997                          (not (string-lessp (buffer-name buffer1)
2998                                             (buffer-name buffer2)))))))
2999     (switch-to-buffer
3000      (or (cadr (memq (current-buffer) buffers))
3001          (car buffers)))))
3002
3003 (defun wl-summary-check-target-mark ()
3004   (when (null wl-summary-buffer-target-mark-list)
3005     (error "No marked message")))
3006
3007 (defun wl-summary-target-mark-mark-as-read ()
3008   (interactive)
3009   (wl-summary-check-target-mark)
3010   (save-excursion
3011     (goto-char (point-min))
3012     (let ((inhibit-read-only t)
3013           (buffer-read-only nil)
3014           wl-summary-buffer-disp-msg)
3015       (wl-summary-mark-as-read wl-summary-buffer-target-mark-list)
3016       (dolist (number wl-summary-buffer-target-mark-list)
3017         (wl-summary-unset-mark number)))))
3018
3019 (defun wl-summary-target-mark-mark-as-unread ()
3020   (interactive)
3021   (wl-summary-check-target-mark)
3022   (save-excursion
3023     (goto-char (point-min))
3024     (let ((inhibit-read-only t)
3025           (buffer-read-only nil)
3026           wl-summary-buffer-disp-msg)
3027       (wl-summary-mark-as-unread wl-summary-buffer-target-mark-list)
3028       (dolist (number wl-summary-buffer-target-mark-list)
3029         (wl-summary-unset-mark number)))))
3030
3031 (defun wl-summary-target-mark-operation (flag &optional inverse)
3032   (wl-summary-check-target-mark)
3033   (save-excursion
3034     (let ((inhibit-read-only t)
3035           (buffer-read-only nil)
3036           wl-summary-buffer-disp-msg)
3037       (funcall
3038        (intern (format "wl-summary-mark-as-%s-internal" flag))
3039        inverse
3040        wl-summary-buffer-target-mark-list)
3041       (wl-summary-delete-all-target-marks))))
3042
3043 (defun wl-summary-target-mark-mark-as-important (&optional remove)
3044   (interactive "P")
3045   (wl-summary-target-mark-operation 'important remove))
3046
3047 (defun wl-summary-target-mark-mark-as-answered (&optional remove)
3048   (interactive "P")
3049   (wl-summary-target-mark-operation 'answered remove))
3050
3051 (defun wl-summary-target-mark-set-flags (&optional remove)
3052   (interactive "P")
3053   (wl-summary-check-target-mark)
3054   (save-excursion
3055     (let ((inhibit-read-only t)
3056           (buffer-read-only nil)
3057           wl-summary-buffer-disp-msg)
3058       (wl-summary-set-flags-internal wl-summary-buffer-target-mark-list
3059                                      nil nil remove)
3060       (wl-summary-delete-all-target-marks)
3061       (wl-summary-count-unread)
3062       (wl-summary-update-modeline))))
3063
3064 (defun wl-summary-target-mark-save ()
3065   (interactive)
3066   (wl-summary-check-target-mark)
3067   (let ((wl-save-dir
3068          (wl-read-directory-name "Save to directory: "
3069                                  wl-temporary-file-directory))
3070         number)
3071     (if (null (file-exists-p wl-save-dir))
3072         (make-directory wl-save-dir))
3073     (while (setq number (car wl-summary-buffer-target-mark-list))
3074       (wl-thread-jump-to-msg number)
3075       (wl-summary-save t wl-save-dir)
3076       (wl-summary-unmark))))
3077
3078 (defun wl-summary-target-mark-pick ()
3079   (interactive)
3080   (wl-summary-check-target-mark)
3081   (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
3082
3083 (defun wl-summary-update-persistent-mark (&optional number flags)
3084   "Synch up persistent mark of current line with msgdb's.
3085 Return non-nil if the mark is updated"
3086   (interactive)
3087   (prog1
3088       (when wl-summary-buffer-persistent-mark-column
3089         (save-excursion
3090           (move-to-column wl-summary-buffer-persistent-mark-column)
3091           (let ((inhibit-read-only t)
3092                 (buffer-read-only nil)
3093                 (mark (buffer-substring (- (point) 1) (point)))
3094                 (new-mark (wl-summary-persistent-mark number flags)))
3095             (prog1
3096                 (unless (string= new-mark mark)
3097                   (delete-backward-char 1)
3098                   (insert new-mark)
3099                   (wl-summary-set-message-modified)
3100                   t)
3101               (wl-summary-validate-persistent-mark (point-at-bol)
3102                                                    (point-at-eol))))))
3103     (when wl-summary-highlight
3104       (wl-highlight-summary-current-line))
3105     (set-buffer-modified-p nil)))
3106
3107 (defsubst wl-summary-mark-as-read-internal (inverse
3108                                             number-or-numbers
3109                                             no-folder-mark
3110                                             no-modeline-update)
3111   (save-excursion
3112     (let ((folder wl-summary-buffer-elmo-folder)
3113           unread-message number
3114           number-list)
3115       (setq number-list (cond ((numberp number-or-numbers)
3116                                (setq unread-message
3117                                      (elmo-message-flagged-p
3118                                       folder
3119                                       number-or-numbers
3120                                       'unread))
3121                                (list number-or-numbers))
3122                               ((and (not (null number-or-numbers))
3123                                     (listp number-or-numbers))
3124                                number-or-numbers)
3125                               ((setq number (wl-summary-message-number))
3126                                ;; interactive
3127                                (setq unread-message
3128                                      (elmo-message-flagged-p
3129                                       folder
3130                                       number
3131                                       'unread))
3132                                (list number))))
3133       (if (null number-list)
3134           (message "No message.")
3135         (if inverse
3136             (elmo-folder-set-flag folder number-list 'unread no-folder-mark)
3137           (elmo-folder-unset-flag folder number-list 'unread no-folder-mark))
3138         (when (and unread-message
3139                    (not inverse))
3140           (dolist (number number-list)
3141             (wl-summary-jump-to-msg number)
3142             (run-hooks 'wl-summary-unread-message-hook)))
3143         (unless no-modeline-update
3144           ;; Update unread numbers.
3145           (wl-summary-count-unread)
3146           (wl-summary-update-modeline)
3147           (wl-folder-update-unread
3148            (wl-summary-buffer-folder-name)
3149            wl-summary-buffer-unread-count))))))
3150
3151 (defun wl-summary-mark-as-read (&optional number-or-numbers
3152                                           no-folder-mark
3153                                           no-modeline-update)
3154   (interactive)
3155   (wl-summary-mark-as-read-internal nil
3156                                     number-or-numbers
3157                                     no-folder-mark
3158                                     no-modeline-update))
3159
3160 (defun wl-summary-mark-as-unread (&optional number-or-numbers
3161                                             no-folder-mark
3162                                             no-modeline-update)
3163   (interactive)
3164   (wl-summary-mark-as-read-internal 'inverse
3165                                     number-or-numbers
3166                                     no-folder-mark
3167                                     no-modeline-update))
3168
3169 (defsubst wl-summary-set-persistent-mark-internal (inverse
3170                                                    flag
3171                                                    &optional number-or-numbers
3172                                                    no-modeline-update
3173                                                    no-server
3174                                                    interactive)
3175   "Set persistent mark."
3176   (save-excursion
3177     (let ((folder wl-summary-buffer-elmo-folder)
3178           number number-list)
3179       (setq number-list (cond ((numberp number-or-numbers)
3180                                (list number-or-numbers))
3181                               ((and (not (null number-or-numbers))
3182                                     (listp number-or-numbers))
3183                                number-or-numbers)
3184                               ((setq number (wl-summary-message-number))
3185                                ;; interactive
3186                                (list number))))
3187       (if (null number-list)
3188           (message "No message.")
3189         ;; XXX Only the first element of the list is checked.
3190         (if (elmo-message-flag-available-p folder (car number-list) flag)
3191             (progn
3192               (if inverse
3193                   (elmo-folder-unset-flag folder number-list flag no-server)
3194                 (elmo-folder-set-flag folder number-list flag no-server))
3195               (unless no-modeline-update
3196                 ;; Update unread numbers.
3197                 ;; should elmo-flag-mark-as-read return unread numbers?
3198                 (wl-summary-count-unread)
3199                 (wl-summary-update-modeline)
3200                 (wl-folder-update-unread
3201                  (wl-summary-buffer-folder-name)
3202                  wl-summary-buffer-unread-count)))
3203           (if interactive
3204               (error "Flag `%s' is not available in this folder" flag)))))))
3205
3206 (defun wl-summary-unset-persistent-mark (&optional flag
3207                                                    number-or-numbers
3208                                                    no-modeline-update
3209                                                    no-server)
3210   "Unset persistent mark."
3211   (interactive)
3212   (when (interactive-p)
3213     (let ((completion-ignore-case t))
3214       (setq flag (intern (downcase
3215                           (completing-read
3216                            "Mark name: "
3217                            (mapcar (lambda (flag)
3218                                      (list (capitalize (symbol-name flag))))
3219                                    (wl-summary-get-available-flags))
3220                            nil
3221                            'require-match))))))
3222   (wl-summary-set-persistent-mark-internal 'inverse
3223                                            flag
3224                                            number-or-numbers
3225                                            no-modeline-update
3226                                            no-server
3227                                            (interactive-p)))
3228
3229 (defun wl-summary-set-persistent-mark (&optional flag
3230                                                  number-or-numbers
3231                                                  no-modeline-update
3232                                                  no-server)
3233   "Set persistent mark."
3234   (interactive)
3235   (when (interactive-p)
3236     (let ((completion-ignore-case t))
3237       (setq flag (intern (downcase
3238                           (completing-read
3239                            "Mark name: "
3240                            (mapcar (lambda (flag)
3241                                      (list (capitalize (symbol-name flag))))
3242                                    (wl-summary-get-available-flags))
3243                            nil
3244                            'require-match))))))
3245   (wl-summary-set-persistent-mark-internal nil
3246                                            flag
3247                                            number-or-numbers
3248                                            no-modeline-update
3249                                            no-server
3250                                            (interactive-p)))
3251
3252 (defun wl-summary-toggle-persistent-mark (&optional force)
3253   "Toggle persistent mark."
3254   (interactive "P")
3255   (let ((completion-ignore-case t)
3256         flag)
3257     (setq flag (intern (downcase
3258                         (completing-read
3259                          "Mark name: "
3260                          (mapcar (lambda (flag)
3261                                    (list (capitalize (symbol-name flag))))
3262                                  (wl-summary-get-available-flags))
3263                          nil
3264                          'require-match))))
3265     (if (and (elmo-message-flagged-p wl-summary-buffer-elmo-folder
3266                                      (wl-summary-message-number)
3267                                      flag)
3268              (not force))
3269         (wl-summary-unset-persistent-mark flag)
3270       (wl-summary-set-persistent-mark flag))))
3271
3272 (defun wl-summary-mark-as-answered (&optional number-or-numbers
3273                                               no-modeline-update)
3274   (interactive)
3275   (wl-summary-set-persistent-mark-internal
3276    (and (interactive-p)
3277         (elmo-message-flagged-p wl-summary-buffer-elmo-folder
3278                                 (wl-summary-message-number)
3279                                 'answered))
3280    'answered
3281    number-or-numbers
3282    no-modeline-update
3283    nil
3284    (interactive-p)))
3285
3286 (defun wl-summary-mark-as-unanswered (&optional number-or-numbers
3287                                                 no-modeline-update)
3288   (wl-summary-set-persistent-mark-internal
3289    'inverse
3290    'answered
3291    number-or-numbers
3292    no-modeline-update))
3293
3294 (defun wl-summary-decide-flag (folder number)
3295   (let ((flags (elmo-get-global-flags (elmo-message-flags
3296                                        folder number)))
3297         (completion-ignore-case t)
3298         new-flags)
3299     (setq new-flags
3300           (delq nil
3301                 (mapcar
3302                  (lambda (flag)
3303                    (and (> (length flag) 0)
3304                         (intern (downcase flag))))
3305                  (wl-completing-read-multiple
3306                   "Flags: "
3307                   (mapcar (lambda (flag)
3308                             (list (capitalize (symbol-name flag))))
3309                           elmo-global-flags)
3310                   nil nil (mapconcat (lambda (flag)
3311                                        (capitalize (symbol-name flag)))
3312                                      flags
3313                                      ",")))))
3314     (dolist (flag new-flags)
3315       (unless (memq flag elmo-global-flags)
3316         (when (elmo-local-flag-p flag)
3317           (error "Cannot treat `%s'." flag))
3318         (unless (elmo-flag-valid-p flag)
3319           (error "Invalid char in `%s'" flag))
3320         (if (y-or-n-p (format "Flag `%s' is not registered yet. Register?"
3321                               (capitalize (symbol-name flag))))
3322             (setq elmo-global-flags (append
3323                                      elmo-global-flags
3324                                      (list flag)))
3325           (error "Stopped"))))
3326     new-flags))
3327
3328 (defsubst wl-summary-set-flags-internal (&optional
3329                                         number-or-numbers
3330                                         flags
3331                                         local
3332                                         remove-all)
3333   (save-excursion
3334     (let ((folder wl-summary-buffer-elmo-folder)
3335           number number-list)
3336       (setq number-list (cond ((numberp number-or-numbers)
3337                                (list number-or-numbers))
3338                               ((and (not (null number-or-numbers))
3339                                     (listp number-or-numbers))
3340                                number-or-numbers)
3341                               ((setq number (wl-summary-message-number))
3342                                ;; interactive
3343                                (list number))))
3344       (if remove-all
3345           (setq flags nil)
3346         (unless flags
3347           (setq flags (wl-summary-decide-flag folder (car number-list)))))
3348       (if (null number-list)
3349           (message "No message.")
3350         (dolist (number number-list)
3351           (elmo-message-set-global-flags folder number flags local)))
3352       flags)))
3353
3354 (defun wl-summary-set-flags (&optional remove)
3355   (interactive "P")
3356   (wl-summary-set-flags-internal nil nil nil remove))
3357
3358 (defun wl-summary-mark-as-important (&optional prompt)
3359   (interactive "P")
3360   (if prompt
3361       (wl-summary-set-flags-internal)
3362     (wl-summary-set-persistent-mark-internal
3363      (and (interactive-p)
3364           (elmo-message-flagged-p wl-summary-buffer-elmo-folder
3365                                   (wl-summary-message-number)
3366                                   'important))
3367      'important
3368      nil nil nil (interactive-p))))
3369
3370 ;;; Summary line.
3371 (defvar wl-summary-line-formatter nil)
3372
3373 (defun wl-summary-view-old-p ()
3374   "Return non-nil when summary view cache has old format."
3375   (save-excursion
3376     (goto-char (point-min))
3377     (and wl-summary-buffer-number-list
3378          (not (re-search-forward "\r-?[0-9]+" (point-at-eol) t)))))
3379
3380 (defun wl-summary-line-format-changed-p ()
3381   "Return non-nil when summary line format is changed."
3382   (not (string=
3383         wl-summary-buffer-line-format
3384         (or (elmo-object-load (expand-file-name
3385                                wl-summary-line-format-file
3386                                (elmo-folder-msgdb-path
3387                                 wl-summary-buffer-elmo-folder))
3388                               wl-summary-buffer-mime-charset)
3389             wl-summary-buffer-line-format))))
3390
3391 (defun wl-summary-line-format-save ()
3392   "Save current summary line format."
3393   (elmo-object-save
3394    (expand-file-name wl-summary-line-format-file
3395                      (elmo-folder-msgdb-path
3396                       wl-summary-buffer-elmo-folder))
3397    wl-summary-buffer-line-format
3398    wl-summary-buffer-mime-charset))
3399
3400 (defun wl-summary-line-number ()
3401   (wl-set-string-width
3402    (- wl-summary-buffer-number-column)
3403    (number-to-string
3404     (elmo-message-entity-number wl-message-entity))))
3405
3406 (defun wl-summary-line-year ()
3407   (aref wl-datevec 0))
3408 (defun wl-summary-line-month ()
3409   (format "%02d" (aref wl-datevec 1)))
3410 (defun wl-summary-line-day ()
3411   (format "%02d" (aref wl-datevec 2)))
3412 (defun wl-summary-line-day-of-week ()
3413   (condition-case nil
3414       (elmo-date-get-week (aref wl-datevec 0)
3415                           (aref wl-datevec 1)
3416                           (aref wl-datevec 2))
3417     (error "??")))
3418 (defun wl-summary-line-hour ()
3419   (format "%02d" (aref wl-datevec 3)))
3420 (defun wl-summary-line-minute ()
3421   (format "%02d" (aref wl-datevec 4)))
3422
3423 (defun wl-summary-line-size ()
3424   (let ((size (elmo-message-entity-field wl-message-entity 'size)))
3425     (if size
3426         (cond
3427          ((<= 1 (/ size 1048576))
3428           (format "%.0fM" (/ size 1048576.0)))
3429          ((<= 1 (/ size 1024))
3430           (format "%.0fK" (/ size 1024.0)))
3431          (t (format "%dB" size)))
3432       "")))
3433
3434 (defun wl-summary-line-subject ()
3435   (let (no-parent subject parent-raw-subject parent-subject)
3436     (if (string= wl-thr-indent-string "")
3437         (setq no-parent t)) ; no parent
3438     (setq subject
3439           (elmo-delete-char ?\n
3440                             (or (elmo-message-entity-field
3441                                  wl-message-entity
3442                                  'subject t)
3443                                 wl-summary-no-subject-message)))
3444     (setq parent-raw-subject
3445           (elmo-message-entity-field wl-parent-message-entity
3446                                      'subject t))
3447     (setq parent-subject
3448           (if parent-raw-subject
3449               (elmo-delete-char ?\n parent-raw-subject)))
3450     (if (or no-parent
3451             (null parent-subject)
3452             (not (wl-summary-subject-equal
3453                   subject parent-subject)))
3454         (funcall wl-summary-subject-function subject)
3455       "")))
3456
3457 (defun wl-summary-line-from ()
3458   (elmo-delete-char ?\n
3459                     (funcall wl-summary-from-function
3460                              (elmo-message-entity-field
3461                               wl-message-entity
3462                               'from t))))
3463
3464 (defun wl-summary-line-list-info ()
3465   (let ((list-info (wl-summary-get-list-info wl-message-entity)))
3466     (if (car list-info)
3467         (format (if (cdr list-info) "(%s %05.0f)" "(%s)")
3468                 (car list-info) (cdr list-info))
3469       "")))
3470
3471 (defun wl-summary-line-list-count ()
3472   (let ((ml-count (cdr (wl-summary-get-list-info wl-message-entity))))
3473     (if ml-count
3474         (format "%.0f" ml-count)
3475       "")))
3476
3477 (defun wl-summary-line-attached ()
3478   (let ((content-type (elmo-message-entity-field
3479                        wl-message-entity 'content-type))
3480         (case-fold-search t))
3481     (if (and content-type
3482              (string-match "multipart/mixed" content-type))
3483         "@"
3484       "")))
3485
3486 ;;; For future use.
3487 ;;(defun wl-summary-line-cached ()
3488 ;;  (if (elmo-message-cached-p wl-summary-buffer-elmo-folder
3489 ;;                           (elmo-message-entity-number wl-message-entity))
3490 ;;      " "
3491 ;;    "u"))
3492
3493 (defun wl-summary-create-line (wl-message-entity
3494                                wl-parent-message-entity
3495                                wl-temp-mark
3496                                wl-flags
3497                                wl-cached
3498                                &optional
3499                                wl-thr-children-number
3500                                wl-thr-indent-string
3501                                wl-thr-linked)
3502   "Create a summary line."
3503   (let ((wl-mime-charset wl-summary-buffer-mime-charset)
3504         (wl-persistent-mark (wl-summary-persistent-mark-string
3505                              wl-summary-buffer-elmo-folder
3506                              wl-flags
3507                              wl-cached))
3508         (elmo-mime-charset wl-summary-buffer-mime-charset)
3509         (elmo-lang wl-summary-buffer-weekday-name-lang)
3510         (wl-datevec (or (ignore-errors (timezone-fix-time
3511                                         (elmo-message-entity-field
3512                                          wl-message-entity
3513                                          'date)
3514                                         nil
3515                                         wl-summary-fix-timezone))
3516                         (make-vector 5 0)))
3517         (entity wl-message-entity) ; backward compatibility.
3518         line mark)
3519     (if (and wl-thr-indent-string
3520              wl-summary-indent-length-limit
3521              (< wl-summary-indent-length-limit
3522                 (string-width wl-thr-indent-string)))
3523         (setq wl-thr-indent-string (wl-set-string-width
3524                                     wl-summary-indent-length-limit
3525                                     wl-thr-indent-string)))
3526     (setq line (funcall wl-summary-buffer-line-formatter))
3527     (if wl-summary-width (setq line
3528                                (wl-set-string-width
3529                                 (- wl-summary-width 1) line nil
3530                                 'ignore-invalid)))
3531     (setq line (concat line
3532                        "\r"
3533                        (number-to-string
3534                         (elmo-message-entity-number
3535                          wl-message-entity))))
3536     (wl-summary-validate-persistent-mark-string line)
3537     (if wl-summary-highlight
3538         (wl-highlight-summary-line-string
3539          (elmo-message-entity-number wl-message-entity)
3540          line
3541          wl-flags
3542          wl-temp-mark
3543          wl-thr-indent-string))
3544     line))
3545
3546 (defsubst wl-summary-proc-wday (wday-str year month mday)
3547   (save-match-data
3548     (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
3549         (wl-match-string 1 wday-str)
3550       (elmo-date-get-week year month mday))))
3551
3552 (defvar wl-summary-move-spec-alist
3553   '((new . ((t . nil)
3554             (p . new)
3555             (p . unread)
3556             (p . digest)))
3557     (unread . ((t . nil)
3558                (p . unread)
3559                (p . digest)))))
3560
3561 (defsubst wl-summary-next-message (num direction hereto)
3562   (if wl-summary-buffer-next-message-function
3563       (funcall wl-summary-buffer-next-message-function num direction hereto)
3564     (let ((cur-spec (cdr (assq wl-summary-move-order
3565                                wl-summary-move-spec-alist)))
3566           (nums (memq num (if (eq direction 'up)
3567                               (reverse wl-summary-buffer-number-list)
3568                             wl-summary-buffer-number-list)))
3569           flagged-list nums2)
3570       (unless hereto (setq nums (cdr nums)))
3571       (setq nums2 nums)
3572       (if cur-spec
3573           (catch 'done
3574             (while cur-spec
3575               (setq nums nums2)
3576               (cond ((eq (car (car cur-spec)) 'p)
3577                      (if (setq flagged-list
3578                                (elmo-folder-list-flagged
3579                                 wl-summary-buffer-elmo-folder
3580                                 (cdr (car cur-spec)) t))
3581                          (while nums
3582                            (if (and (memq (car nums) flagged-list)
3583                                     (elmo-message-accessible-p
3584                                      wl-summary-buffer-elmo-folder
3585                                      (car nums)))
3586                                (throw 'done (car nums)))
3587                            (setq nums (cdr nums)))))
3588                     ((eq (car (car cur-spec)) 't)
3589                      (if wl-summary-buffer-target-mark-list
3590                          (while nums
3591                            (if (memq (car nums)
3592                                      wl-summary-buffer-target-mark-list)
3593                                (throw 'done (car nums)))
3594                            (setq nums (cdr nums))))))
3595               (setq cur-spec (cdr cur-spec))))
3596         (car nums)))))
3597
3598 (defsubst wl-summary-cursor-move (direction hereto)
3599   (when (and (eq direction 'up)
3600              (eobp))
3601     (forward-line -1)
3602     (setq hereto t))
3603   (let (num)
3604     (when (setq num (wl-summary-next-message (wl-summary-message-number)
3605                                              direction hereto))
3606       (if (numberp num)
3607           (wl-thread-jump-to-msg num))
3608       t)))
3609 ;;
3610 ;; Goto unread or global flag message
3611 ;; returns t if next message exists in this folder.
3612 (defun wl-summary-cursor-down (&optional hereto)
3613   (interactive "P")
3614   (wl-summary-cursor-move 'down hereto))
3615
3616 (defun wl-summary-cursor-up (&optional hereto)
3617   (interactive "P")
3618   (wl-summary-cursor-move 'up hereto))
3619
3620 (defun wl-summary-save-view-cache ()
3621   (save-excursion
3622     (let* ((dir (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder))
3623            (cache (expand-file-name wl-summary-cache-file dir))
3624            (view (expand-file-name wl-summary-view-file dir))
3625            (save-view wl-summary-buffer-view)
3626            (mark-list (copy-sequence wl-summary-buffer-target-mark-list))
3627            (temp-list (copy-sequence wl-summary-buffer-temp-mark-list))
3628            (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
3629            (temp-column wl-summary-buffer-temp-mark-column)
3630            (charset wl-summary-buffer-mime-charset))
3631       (when dir
3632         (if (file-directory-p dir)
3633             (); ok.
3634           (if (file-exists-p dir)
3635               (error "File %s already exists" dir)
3636             (elmo-make-directory dir)))
3637         (if (eq save-view 'thread)
3638             (wl-thread-save-entity dir))
3639         (when wl-summary-check-line-format
3640           (wl-summary-line-format-save))
3641         (unwind-protect
3642             (progn
3643               (when (file-writable-p cache)
3644                 (copy-to-buffer tmp-buffer (point-min) (point-max))
3645                 (with-current-buffer tmp-buffer
3646                   (widen)
3647                   (make-local-variable 'wl-summary-highlight)
3648                   (setq wl-summary-highlight nil
3649                         wl-summary-buffer-target-mark-list mark-list
3650                         wl-summary-buffer-temp-mark-list temp-list
3651                         wl-summary-buffer-temp-mark-column temp-column)
3652                   (wl-summary-delete-all-temp-marks 'no-msg 'force)
3653                   (encode-coding-region
3654                    (point-min) (point-max)
3655                    (or (and wl-on-mule
3656                             ;; one in mcs-ltn1(apel<10.4) cannot take 2 arg.
3657                             (mime-charset-to-coding-system charset 'LF))
3658                        ;; Mule 2 doesn't have `*ctext*unix'.
3659                        (mime-charset-to-coding-system charset)))
3660                   (write-region-as-binary (point-min)(point-max)
3661                                           cache nil 'no-msg)))
3662               (when (file-writable-p view) ; 'thread or 'sequence
3663                 (with-temp-buffer
3664                   (prin1 save-view (current-buffer))
3665                   (princ "\n" (current-buffer))
3666                   (write-region (point-min) (point-max) view nil 'no-msg))))
3667           ;; kill tmp buffer.
3668           (kill-buffer tmp-buffer))))))
3669
3670 (defsubst wl-summary-get-sync-range (folder)
3671   (intern (or (and
3672                (elmo-folder-plugged-p folder)
3673                (wl-get-assoc-list-value
3674                 wl-folder-sync-range-alist
3675                 (elmo-folder-name-internal folder)
3676                 'function))
3677               wl-default-sync-range)))
3678
3679 ;; redefined for wl-summary-sync-update
3680 (defun wl-summary-input-range (folder)
3681   "returns update or all or rescan."
3682   ;; for the case when parts are expanded in the bottom of the folder
3683   (let ((input-range-list '("no-sync"
3684                             "first:"
3685                             "last:"
3686                             "cache-status"
3687                             "mark"
3688                             "rescan"
3689                             "rescan-noscore"
3690                             "rescan-thread"
3691                             "update"
3692                             "update-entirely"
3693                             "all"
3694                             "all-entirely"))
3695         (default (or (wl-get-assoc-list-value
3696                       wl-folder-sync-range-alist
3697                       folder
3698                       'function)
3699                      wl-default-sync-range))
3700         range)
3701     (setq range
3702           (completing-read (format "Range (%s): " default)
3703                            (mapcar
3704                             (function (lambda (x) (cons x x)))
3705                             input-range-list)))
3706     (if (string= range "")
3707         default
3708       range)))
3709
3710 (defun wl-summary-toggle-disp-folder (&optional arg)
3711   (interactive)
3712   (let ((cur-buf (current-buffer))
3713         (summary-win (get-buffer-window (current-buffer)))
3714         fld-buf fld-win)
3715     (cond
3716      ((eq arg 'on)
3717       (setq wl-summary-buffer-disp-folder t)
3718       ;; hide your folder window
3719       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
3720           (if (setq fld-win (get-buffer-window fld-buf))
3721               (delete-window fld-win))))
3722      ((eq arg 'off)
3723       (setq wl-summary-buffer-disp-folder nil)
3724       ;; hide your wl-message window!
3725       (when (buffer-live-p wl-message-buffer)
3726         (wl-message-select-buffer wl-message-buffer)
3727         (delete-window))
3728       (select-window (get-buffer-window cur-buf))
3729       ;; display wl-folder window!!
3730       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
3731           (if (setq fld-win (get-buffer-window fld-buf))
3732               ;; folder win is already displayed.
3733               (select-window fld-win)
3734             ;; folder win is not displayed.
3735             (switch-to-buffer fld-buf))
3736         ;; no folder buf
3737         (wl-folder))
3738       ;; temporarily delete summary-win.
3739       (if summary-win
3740           (delete-window summary-win))
3741       (split-window-horizontally wl-folder-window-width)
3742       (other-window 1)
3743       (switch-to-buffer cur-buf))
3744      (t
3745       (if (setq fld-buf (get-buffer wl-folder-buffer-name))
3746           (if (setq fld-win (get-buffer-window fld-buf))
3747               (setq wl-summary-buffer-disp-folder nil)
3748             (setq wl-summary-buffer-disp-folder t)))
3749       (if (not wl-summary-buffer-disp-folder)
3750           ;; hide message window
3751           (let ((mes-win (and wl-message-buffer
3752                               (get-buffer-window wl-message-buffer)))
3753                 (wl-stay-folder-window t))
3754             (if mes-win (delete-window mes-win))
3755             ;; hide your folder window
3756             (if (setq fld-buf (get-buffer wl-folder-buffer-name))
3757                 (if (setq fld-win (get-buffer-window fld-buf))
3758                     (progn
3759                       (delete-window (get-buffer-window cur-buf))
3760                       (select-window fld-win)
3761                       (switch-to-buffer cur-buf))))
3762             (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
3763             ;; resume message window.
3764             (when mes-win
3765               (wl-message-select-buffer wl-message-buffer)
3766               (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
3767               (select-window (get-buffer-window cur-buf))))
3768         ;; hide message window
3769         (let ((wl-stay-folder-window t)
3770               (mes-win (and wl-message-buffer
3771                             (get-buffer-window wl-message-buffer))))
3772           (if mes-win (delete-window mes-win))
3773           (select-window (get-buffer-window cur-buf))
3774           ;; display wl-folder window!!
3775           (if (setq fld-buf (get-buffer wl-folder-buffer-name))
3776               (if (setq fld-win (get-buffer-window fld-buf))
3777                   ;; folder win is already displayed.
3778                   (select-window fld-win)
3779                 ;; folder win is not displayed...occupy all.
3780                 (switch-to-buffer fld-buf))
3781             ;; no folder buf
3782             (wl-folder))
3783           (split-window-horizontally wl-folder-window-width)
3784           (other-window 1)
3785           (switch-to-buffer cur-buf)
3786           ;; resume message window.
3787           (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
3788           (when mes-win
3789             (wl-message-select-buffer wl-message-buffer)
3790             (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
3791             (select-window (get-buffer-window cur-buf))))))))
3792   (run-hooks 'wl-summary-toggle-disp-folder-hook))
3793
3794 (defun wl-summary-toggle-disp-msg (&optional arg)
3795   (interactive)
3796   (let ((cur-buf (current-buffer))
3797         fld-buf fld-win
3798         summary-win)
3799     (cond
3800      ((eq arg 'on)
3801       (setq wl-summary-buffer-disp-msg t)
3802       (save-excursion
3803         ;; hide your folder window
3804         (if (and (not wl-stay-folder-window)
3805                  (setq fld-buf (get-buffer wl-folder-buffer-name)))
3806             (if (setq fld-win (get-buffer-window fld-buf))
3807                 (unless (one-window-p fld-win)
3808                   (delete-window fld-win))))))
3809      ((eq arg 'off)
3810       (wl-delete-all-overlays)
3811       (setq wl-summary-buffer-disp-msg nil)
3812       (save-excursion
3813         (when (buffer-live-p wl-message-buffer)
3814           (wl-message-select-buffer wl-message-buffer)
3815           (delete-window)
3816           (and (get-buffer-window cur-buf)
3817                (select-window (get-buffer-window cur-buf))))
3818         (run-hooks 'wl-summary-toggle-disp-off-hook)))
3819      (t
3820       (if (and wl-message-buffer
3821                (get-buffer-window wl-message-buffer)) ; already displayed
3822           (setq wl-summary-buffer-disp-msg nil)
3823         (setq wl-summary-buffer-disp-msg t))
3824       (if wl-summary-buffer-disp-msg
3825           (progn
3826             (wl-summary-redisplay)
3827 ;;; hide your folder window
3828 ;;;         (setq fld-buf (get-buffer wl-folder-buffer-name))
3829 ;;;         (if (setq fld-win (get-buffer-window fld-buf))
3830 ;;;             (delete-window fld-win)))
3831             (run-hooks 'wl-summary-toggle-disp-on-hook))
3832         (wl-delete-all-overlays)
3833         (save-excursion
3834           (wl-message-select-buffer wl-message-buffer)
3835           (delete-window)
3836           (select-window (get-buffer-window cur-buf))
3837           (setq wl-message-buffer nil)
3838           (run-hooks 'wl-summary-toggle-disp-off-hook))
3839 ;;;     (switch-to-buffer cur-buf)
3840         )))
3841     (run-hooks 'wl-summary-buffer-window-scroll-functions)))
3842
3843 (defun wl-summary-enter-handler (&optional arg)
3844   "A command for `enter' key in the summary.
3845 Basically, it shows next line of the message.
3846 If optional argument ARG is specified, behave as followed.
3847 If ARG is number, jump to the message.
3848 Otherwise it shows previous line of the message."
3849   (interactive "P")
3850   (cond ((numberp arg)
3851          (unless (wl-thread-jump-to-msg arg)
3852            (message "Message (#%d) was not found." arg)))
3853         (arg
3854          (wl-summary-prev-line-content))
3855         (t
3856          (wl-summary-next-line-content))))
3857
3858 (defun wl-summary-next-line-content ()
3859   "Show next line of the message."
3860   (interactive)
3861   (let ((cur-buf (current-buffer)))
3862     (wl-summary-toggle-disp-msg 'on)
3863     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3864       (set-buffer cur-buf)
3865       (wl-message-next-page 1))))
3866
3867 (defun wl-summary-prev-line-content ()
3868   (interactive)
3869   (let ((cur-buf (current-buffer)))
3870     (wl-summary-toggle-disp-msg 'on)
3871     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3872       (set-buffer cur-buf)
3873       (wl-message-prev-page 1))))
3874
3875 (defun wl-summary-next-page ()
3876   (interactive)
3877   (let ((cur-buf (current-buffer)))
3878     (wl-summary-toggle-disp-msg 'on)
3879     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3880       (set-buffer cur-buf)
3881       (wl-message-next-page))))
3882
3883 (defun wl-summary-prev-page ()
3884   (interactive)
3885   (let ((cur-buf (current-buffer)))
3886     (wl-summary-toggle-disp-msg 'on)
3887     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
3888       (set-buffer cur-buf)
3889       (wl-message-prev-page))))
3890
3891 (defsubst wl-summary-no-mime-p (folder)
3892   (wl-string-match-member (elmo-folder-name-internal folder)
3893                           wl-summary-no-mime-folder-list))
3894
3895 (defun wl-summary-set-message-buffer-or-redisplay (&rest args)
3896   "Set message buffer.
3897 If message is not displayed yet, display it.
3898 Return t if message exists."
3899   (let ((folder wl-summary-buffer-elmo-folder)
3900         (number (wl-summary-message-number))
3901         cur-folder cur-number message-last-pos)
3902     (when (buffer-live-p wl-message-buffer)
3903       (save-window-excursion
3904         (setq wl-current-summary-buffer (current-buffer))
3905         (wl-message-select-buffer wl-message-buffer)
3906         (setq cur-folder wl-message-buffer-cur-folder)
3907         (setq cur-number wl-message-buffer-cur-number)))
3908     (if (and (string= (elmo-folder-name-internal folder) (or cur-folder ""))
3909              (eq number (or cur-number 0)))
3910         (progn
3911           (set-buffer wl-message-buffer)
3912           t)
3913       (wl-summary-redisplay-internal folder number)
3914       (when (buffer-live-p wl-message-buffer)
3915         (set-buffer wl-message-buffer))
3916       nil)))
3917
3918 (defun wl-summary-target-mark-forward (&optional arg)
3919   (interactive "P")
3920   (wl-summary-check-target-mark)
3921   (let ((mlist (nreverse (copy-sequence wl-summary-buffer-target-mark-list)))
3922         (summary-buf (current-buffer))
3923         (wl-draft-forward t)
3924         start-point
3925         draft-buf)
3926     (wl-summary-jump-to-msg (car mlist))
3927     (wl-summary-forward t)
3928     (setq start-point (point))
3929     (setq draft-buf (current-buffer))
3930     (setq mlist (cdr mlist))
3931     (save-window-excursion
3932       (when mlist
3933         (while mlist
3934           (set-buffer summary-buf)
3935           (wl-summary-jump-to-msg (car mlist))
3936           (wl-summary-redisplay)
3937           (set-buffer draft-buf)
3938           (goto-char (point-max))
3939           (wl-draft-insert-message)
3940           (setq mlist (cdr mlist)))
3941         (wl-draft-body-goto-top)
3942         (wl-draft-enclose-digest-region (point) (point-max)))
3943       (goto-char start-point)
3944       (save-excursion
3945         (set-buffer summary-buf)
3946         (wl-summary-delete-all-target-marks)))
3947     (run-hooks 'wl-mail-setup-hook)))
3948
3949 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
3950   (interactive "P")
3951   (wl-summary-check-target-mark)
3952   (let ((mlist (nreverse (copy-sequence wl-summary-buffer-target-mark-list)))
3953         (summary-buf (current-buffer))
3954         change-major-mode-hook
3955         start-point
3956         draft-buf)
3957     (wl-summary-jump-to-msg (car mlist))
3958     (when (wl-summary-reply arg t)
3959       (goto-char (point-max))
3960       (setq start-point (point-marker))
3961       (setq draft-buf (current-buffer))
3962       (save-window-excursion
3963         (while mlist
3964           (set-buffer summary-buf)
3965           (delete-other-windows)
3966           (wl-summary-jump-to-msg (car mlist))
3967           (wl-summary-redisplay)
3968           (set-buffer draft-buf)
3969           (goto-char (point-max))
3970           (wl-draft-yank-original)
3971           (setq mlist (cdr mlist)))
3972         (goto-char start-point)
3973         (save-excursion
3974           (set-buffer summary-buf)
3975           (wl-summary-delete-all-target-marks)))
3976       (wl-draft-reply-position wl-draft-reply-default-position)
3977       (run-hooks 'wl-mail-setup-hook))))
3978
3979 (defun wl-summary-reply-with-citation (&optional arg)
3980   (interactive "P")
3981   (when (wl-summary-reply arg t)
3982     (goto-char (point-max))
3983     (wl-draft-yank-original)
3984     (wl-draft-reply-position wl-draft-reply-default-position)
3985     (run-hooks 'wl-mail-setup-hook)))
3986
3987 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
3988   (interactive)
3989   (let* ((original (wl-summary-message-number))
3990          (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
3991          (entity (elmo-message-entity wl-summary-buffer-elmo-folder msgid))
3992          msg otherfld schar
3993          (errmsg (format "No message with id \"%s\" in the folder." msgid)))
3994     (if (setq msg (elmo-message-entity-number entity))
3995         (progn
3996           (wl-thread-jump-to-msg msg)
3997           t)
3998       ;; for XEmacs!
3999       (if (and elmo-use-database
4000                (setq errmsg
4001                      (format
4002                       "No message with id \"%s\" in the database." msgid))
4003                (setq otherfld (elmo-database-msgid-get msgid)))
4004           (if (cdr (wl-summary-jump-to-msg-internal
4005                     (car otherfld) (nth 1 otherfld) 'no-sync))
4006               t ; succeed.
4007             ;; Back to original.
4008             (wl-summary-jump-to-msg-internal
4009              (wl-summary-buffer-folder-name) original 'no-sync))
4010         (cond ((eq wl-summary-search-via-nntp 'confirm)
4011                (require 'elmo-nntp)
4012                (message "Search message in nntp server \"%s\" <y/n/s(elect)>? "
4013                         elmo-nntp-default-server)
4014                (setq schar (let ((cursor-in-echo-area t)) (read-char)))
4015                (cond ((eq schar ?y)
4016                       (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4017                      ((eq schar ?s)
4018                       (wl-summary-jump-to-msg-by-message-id-via-nntp
4019                        msgid
4020                        (read-from-minibuffer "NNTP Server: ")))
4021                      (t
4022                       (message "%s" errmsg)
4023                       nil)))
4024               ((or (eq wl-summary-search-via-nntp 'force)
4025                    (and
4026                     (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
4027                         'nntp)
4028                     wl-summary-search-via-nntp))
4029                (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4030               (t
4031                (message "%s" errmsg)
4032                nil))))))
4033
4034 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4035   (interactive)
4036   (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4037          newsgroups folder ret
4038          user server port type spec)
4039     (if server-spec
4040         (if (string-match "^-" server-spec)
4041             (setq spec (wl-folder-get-elmo-folder server-spec)
4042                   user (elmo-net-folder-user-internal spec)
4043                   server (elmo-net-folder-server-internal spec)
4044                   port (elmo-net-folder-port-internal spec)
4045                   type (elmo-net-folder-stream-type-internal spec))
4046           (setq server server-spec)))
4047     (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4048                      msgid
4049                      (or server elmo-nntp-default-server)
4050                      (or user elmo-nntp-default-user)
4051                      (or port elmo-nntp-default-port)
4052                      (or type elmo-nntp-default-stream-type)))
4053       (setq newsgroups (elmo-nntp-parse-newsgroups ret))
4054       (setq folder (concat "-" (car newsgroups)
4055                            (elmo-nntp-folder-postfix user server port type)))
4056       (catch 'found
4057         (while newsgroups
4058           (if (wl-folder-entity-exists-p (car newsgroups)
4059                                          wl-folder-newsgroups-hashtb)
4060               (throw 'found
4061                      (setq folder (concat "-" (car newsgroups)
4062                                           (elmo-nntp-folder-postfix
4063                                            user server port type)))))
4064           (setq newsgroups (cdr newsgroups)))))
4065     (if ret
4066         (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4067       (message "No message id \"%s\" in nntp server \"%s\"."
4068                msgid (or server elmo-nntp-default-server))
4069       nil)))
4070
4071 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4072   (let (wl-auto-select-first entity)
4073     (if (or (string= folder (wl-summary-buffer-folder-name))
4074             (y-or-n-p
4075              (format
4076               "Message was found in the folder \"%s\". Jump to it? "
4077               folder)))
4078         (progn
4079           (unwind-protect
4080               (wl-summary-goto-folder-subr
4081                folder scan-type nil nil t)
4082             (if msgid
4083                 (setq msg
4084                       (elmo-message-entity-number
4085                        (elmo-message-entity
4086                         wl-summary-buffer-elmo-folder
4087                         msgid))))
4088             (setq entity (wl-folder-search-entity-by-name folder
4089                                                           wl-folder-entity
4090                                                           'folder))
4091             (if entity
4092                 (wl-folder-set-current-entity-id
4093                  (wl-folder-get-entity-id entity))))
4094           (if (null msg)
4095               (message "Message was not found currently in this folder.")
4096             (setq msg (and (wl-thread-jump-to-msg msg) msg)))
4097           (cons folder msg)))))
4098
4099 (defun wl-summary-jump-to-parent-message (arg)
4100   (interactive "P")
4101   (let ((cur-buf (current-buffer))
4102         (disp-msg wl-summary-buffer-disp-msg)
4103         (number (wl-summary-message-number))
4104         (regexp "\\(<[^<>]*>\\)[ \t]*$")
4105         (i -1) ;; xxx
4106         msg-id msg-num ref-list ref irt)
4107     (if (null number)
4108         (message "No message.")
4109       (when (eq wl-summary-buffer-view 'thread)
4110         (cond ((and arg (not (numberp arg)))
4111                (setq msg-num
4112                      (wl-thread-entity-get-number
4113                       (wl-thread-entity-get-top-entity
4114                        (wl-thread-get-entity number)))))
4115               ((and arg (numberp arg))
4116                (setq i 0)
4117                (setq msg-num number)
4118                (while (< i arg)
4119                  (setq msg-num
4120                        (wl-thread-entity-get-number
4121                         (wl-thread-entity-get-parent-entity
4122                          (wl-thread-get-entity msg-num))))
4123                  (setq i (1+ i))))
4124               (t (setq msg-num
4125                        (wl-thread-entity-get-number
4126                         (wl-thread-entity-get-parent-entity
4127                          (wl-thread-get-entity number)))))))
4128       (when (null msg-num)
4129         (wl-summary-set-message-buffer-or-redisplay)
4130         (set-buffer (wl-message-get-original-buffer))
4131         (message "Searching parent message...")
4132         (setq ref (std11-field-body "References")
4133               irt (std11-field-body "In-Reply-To"))
4134         (cond
4135          ((and arg (not (numberp arg)) ref (not (string= ref ""))
4136                (string-match regexp ref))
4137           ;; The first message of the thread.
4138           (setq msg-id (wl-match-string 1 ref)))
4139          ;; "In-Reply-To:" has only one msg-id.
4140          ((and (null arg) irt (not (string= irt ""))
4141                (string-match regexp irt))
4142           (setq msg-id (wl-match-string 1 irt)))
4143          ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
4144                (string-match regexp ref))
4145           ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
4146           (while (string-match regexp ref)
4147             (setq ref-list
4148                   (append (list
4149                            (wl-match-string 1 ref))
4150                           ref-list))
4151             (setq ref (substring ref (match-end 0)))
4152             (setq i (1+ i)))
4153           (setq msg-id
4154                 (if (null arg) (nth 0 ref-list) ;; previous
4155                   (if (<= arg i) (nth (1- arg) ref-list)
4156                     (nth i ref-list))))))
4157         (set-buffer cur-buf)
4158         (or disp-msg (wl-summary-toggle-disp-msg 'off)))
4159       (cond ((and (null msg-id) (null msg-num))
4160              (message "No parent message!")
4161              nil)
4162             ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
4163              (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
4164              (message "Searching parent message...done")
4165              t)
4166             ((and msg-num (wl-summary-jump-to-msg msg-num))
4167              (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
4168              (message "Searching parent message...done")
4169              t)
4170             (t ; failed.
4171              (message "Parent message was not found.")
4172              nil)))))
4173
4174 (defun wl-summary-reply (&optional arg without-setup-hook)
4175   "Reply to current message. Default is \"wide\" reply.
4176 Reply to author if invoked with ARG."
4177   (interactive "P")
4178   (let ((folder wl-summary-buffer-elmo-folder)
4179         (number (wl-summary-message-number))
4180         (summary-buf (current-buffer))
4181         (winconf (current-window-configuration))
4182         mes-buf)
4183     (when number
4184       (save-excursion
4185         (wl-summary-set-message-buffer-or-redisplay))
4186       (wl-message-select-buffer wl-message-buffer)
4187       (condition-case err
4188           (when (setq mes-buf (wl-message-get-original-buffer))
4189             (wl-draft-reply mes-buf arg summary-buf number)
4190             (wl-draft-reply-position wl-draft-reply-default-position)
4191             (unless without-setup-hook
4192               (run-hooks 'wl-mail-setup-hook)))
4193         (error (set-window-configuration winconf)
4194                (signal (car err)(cdr err))))
4195       (with-current-buffer summary-buf (run-hooks 'wl-summary-reply-hook))
4196       t)))
4197
4198 (defun wl-summary-write ()
4199   "Write a new draft from Summary."
4200   (interactive)
4201   (wl-draft (list (cons 'To ""))
4202             nil nil nil nil (wl-summary-buffer-folder-name))
4203   (run-hooks 'wl-mail-setup-hook)
4204   (mail-position-on-field "To"))
4205
4206 (defvar wl-summary-write-current-folder-functions
4207   '(wl-folder-get-newsgroups
4208     wl-folder-guess-mailing-list-by-refile-rule
4209     wl-folder-guess-mailing-list-by-folder-name)
4210   "Newsgroups or Mailing List address guess functions list.
4211 Call from `wl-summary-write-current-folder'.
4212 When guess function return nil, challenge next guess-function.")
4213
4214 (defun wl-summary-write-current-folder (&optional folder)
4215   "Write message to current FOLDER's newsgroup or mailing-list.
4216 Use function list is `wl-summary-write-current-folder-functions'."
4217   (interactive)
4218   ;; default FOLDER is current buffer folder
4219   (setq folder (or folder (wl-summary-buffer-folder-name)))
4220   (let ((func-list wl-summary-write-current-folder-functions)
4221         guess-list guess-func)
4222     (while func-list
4223       (setq guess-list (funcall (car func-list) folder))
4224       (if (null guess-list)
4225           (setq func-list (cdr func-list))
4226         (setq guess-func (car func-list))
4227         (setq func-list nil)))
4228     (if (null guess-func)
4229         (wl-summary-write)
4230       (unless (or (stringp (nth 0 guess-list))
4231                   (stringp (nth 1 guess-list))
4232                   (stringp (nth 2 guess-list)))
4233         (error "Invalid value return guess function `%s'"
4234                (symbol-name guess-func)))
4235       (wl-draft (list (cons 'To (nth 0 guess-list))
4236                       (cons 'Cc (nth 1 guess-list))
4237                       (cons 'Newsgroups (nth 2 guess-list)))
4238                 nil nil nil nil folder)
4239       (run-hooks 'wl-mail-setup-hook)
4240       (mail-position-on-field "Subject"))))
4241
4242 (defun wl-summary-forward (&optional without-setup-hook)
4243   ""
4244   (interactive)
4245   (let ((folder wl-summary-buffer-elmo-folder)
4246         (number (wl-summary-message-number))
4247         (summary-buf (current-buffer))
4248         (wl-draft-forward t)
4249         entity subject num)
4250     (if (null number)
4251         (message "No message.")
4252       (if (and (elmo-message-use-cache-p folder number)
4253                (eq (elmo-file-cache-status
4254                     (elmo-file-cache-get
4255                      (elmo-message-field folder number 'message-id)))
4256                    'section))
4257           ;; Reload.
4258           (wl-summary-redisplay-internal nil nil 'force-reload)
4259         (wl-summary-redisplay-internal folder number))
4260       (wl-message-select-buffer wl-message-buffer)
4261       (setq subject (with-current-buffer
4262                         wl-message-buffer-original-buffer
4263                       (std11-field-body "Subject")))
4264       (wl-draft-forward subject summary-buf number)
4265       (with-current-buffer summary-buf (run-hooks 'wl-summary-forward-hook))
4266       (unless without-setup-hook
4267         (run-hooks 'wl-mail-setup-hook)))))
4268
4269 (defun wl-summary-click (e)
4270   (interactive "e")
4271   (mouse-set-point e)
4272   (wl-summary-read))
4273
4274 (defun wl-summary-read ()
4275   "Proceed reading message in the summary buffer."
4276   (interactive)
4277   (let ((cur-buf (current-buffer)))
4278     (wl-summary-toggle-disp-msg 'on)
4279     (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4280       (set-buffer cur-buf)
4281       (if (wl-message-next-page)
4282           (wl-summary-down t)))))
4283
4284 (defsubst wl-summary-cursor-move-surface (downward interactive)
4285   (if wl-summary-move-direction-toggle
4286       (setq wl-summary-move-direction-downward downward))
4287   (let ((start (point))
4288         (skip-tmark-regexp (wl-regexp-opt wl-summary-skip-mark-list))
4289         (skip t)
4290         (column (current-column))
4291         goto-next next-entity finfo)
4292     (beginning-of-line)
4293     (while (and skip
4294                 (not (if downward (eobp) (bobp))))
4295       (if downward
4296           (forward-line 1)
4297         (forward-line -1))
4298       (setq skip (or (string-match skip-tmark-regexp
4299                                    (wl-summary-temp-mark))
4300                      (not (and (wl-summary-message-number)
4301                                (elmo-message-accessible-p
4302                                 wl-summary-buffer-elmo-folder
4303                                 (wl-summary-message-number)))))))
4304     (if (if downward (eobp) (and (bobp) skip)) (setq goto-next t))
4305     (if (or (eobp) (and (bobp) skip))
4306         (goto-char start))
4307     (move-to-column column)
4308
4309     (if (not goto-next)
4310         (if wl-summary-buffer-disp-msg
4311             (wl-summary-redisplay))
4312       (if interactive
4313           (cond
4314            ((and (not downward) wl-summary-buffer-prev-folder-function)
4315             (funcall wl-summary-buffer-prev-folder-function))
4316            ((and downward wl-summary-buffer-next-folder-function)
4317             (funcall wl-summary-buffer-next-folder-function))
4318            (t
4319             (when wl-auto-select-next
4320               (setq next-entity
4321                     (if downward
4322                         (wl-summary-get-next-folder)
4323                       (wl-summary-get-prev-folder)))
4324               (if next-entity
4325                   (setq finfo (wl-folder-get-entity-info next-entity))))
4326             (wl-ask-folder
4327              '(lambda () (wl-summary-next-folder-or-exit next-entity))
4328              (format
4329               "No more messages. Type SPC to go to %s."
4330               (wl-summary-entity-info-msg next-entity finfo)))))))))
4331
4332 (defun wl-summary-prev (&optional interactive)
4333   (interactive)
4334   (wl-summary-cursor-move-surface nil (or interactive (interactive-p))))
4335
4336 (defun wl-summary-next (&optional interactive)
4337   (interactive)
4338   (wl-summary-cursor-move-surface t (or interactive (interactive-p))))
4339
4340 (defun wl-summary-up (&optional interactive skip-no-unread)
4341   ""
4342   (interactive)
4343   (if wl-summary-move-direction-toggle
4344       (setq wl-summary-move-direction-downward nil))
4345   (if (wl-summary-cursor-up)
4346       (if wl-summary-buffer-disp-msg
4347           (wl-summary-redisplay))
4348     (if (or interactive
4349             (interactive-p))
4350         (if wl-summary-buffer-prev-folder-function
4351             (funcall wl-summary-buffer-prev-folder-function)
4352           (let (next-entity finfo)
4353             (when wl-auto-select-next
4354               (progn
4355                 (setq next-entity (wl-summary-get-prev-unread-folder))
4356                 (if next-entity
4357                     (setq finfo (wl-folder-get-entity-info next-entity)))))
4358             (if (and skip-no-unread
4359                      (eq wl-auto-select-next 'skip-no-unread))
4360                 (wl-summary-next-folder-or-exit next-entity t)
4361               (wl-ask-folder
4362                '(lambda () (wl-summary-next-folder-or-exit next-entity t))
4363                (format
4364                 "No more unread messages. Type SPC to go to %s."
4365                 (wl-summary-entity-info-msg next-entity finfo)))))))))
4366
4367 (defun wl-summary-get-prev-folder ()
4368   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4369         last-entity cur-id)
4370     (when folder-buf
4371       (setq cur-id (save-excursion (set-buffer folder-buf)
4372                                    wl-folder-buffer-cur-entity-id))
4373       (wl-folder-get-prev-folder cur-id))))
4374
4375 (defun wl-summary-get-next-folder ()
4376   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4377         cur-id)
4378     (when folder-buf
4379       (setq cur-id (save-excursion (set-buffer folder-buf)
4380                                    wl-folder-buffer-cur-entity-id))
4381       (wl-folder-get-next-folder cur-id))))
4382
4383 (defun wl-summary-get-next-unread-folder ()
4384   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4385         cur-id)
4386     (when folder-buf
4387       (setq cur-id (save-excursion (set-buffer folder-buf)
4388                                    wl-folder-buffer-cur-entity-id))
4389       (wl-folder-get-next-folder cur-id 'unread))))
4390
4391 (defun wl-summary-get-prev-unread-folder ()
4392   (let ((folder-buf (get-buffer wl-folder-buffer-name))
4393         cur-id)
4394     (when folder-buf
4395       (setq cur-id (save-excursion (set-buffer folder-buf)
4396                                    wl-folder-buffer-cur-entity-id))
4397       (wl-folder-get-prev-folder cur-id 'unread))))
4398
4399 (defun wl-summary-down (&optional interactive skip-no-unread)
4400   (interactive)
4401   (if wl-summary-move-direction-toggle
4402       (setq wl-summary-move-direction-downward t))
4403   (if (wl-summary-cursor-down)
4404       (if wl-summary-buffer-disp-msg
4405           (wl-summary-redisplay))
4406     (if (or interactive
4407             (interactive-p))
4408         (if wl-summary-buffer-next-folder-function
4409             (funcall wl-summary-buffer-next-folder-function)
4410           (let (next-entity finfo)
4411             (when wl-auto-select-next
4412               (setq next-entity (wl-summary-get-next-unread-folder)))
4413             (if next-entity
4414                 (setq finfo (wl-folder-get-entity-info next-entity)))
4415             (if (and skip-no-unread
4416                      (eq wl-auto-select-next 'skip-no-unread))
4417                 (wl-summary-next-folder-or-exit next-entity)
4418               (wl-ask-folder
4419                '(lambda () (wl-summary-next-folder-or-exit next-entity))
4420                (format
4421                 "No more unread messages. Type SPC to go to %s."
4422                 (wl-summary-entity-info-msg next-entity finfo)))))))))
4423
4424 (defun wl-summary-goto-last-displayed-msg ()
4425   (interactive)
4426   (unless wl-summary-buffer-last-displayed-msg
4427     (setq wl-summary-buffer-last-displayed-msg
4428           wl-summary-buffer-current-msg))
4429   (if wl-summary-buffer-last-displayed-msg
4430       (progn
4431         (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
4432         (if wl-summary-buffer-disp-msg
4433             (wl-summary-redisplay)))
4434     (message "No last message.")))
4435
4436 (defun wl-summary-message-display-type ()
4437   (when (and wl-summary-buffer-disp-msg
4438              (buffer-live-p wl-message-buffer)
4439              wl-summary-buffer-current-msg
4440              (wl-summary-message-number)
4441              (= (wl-summary-message-number) wl-summary-buffer-current-msg))
4442     (wl-message-buffer-display-type wl-message-buffer)))
4443
4444 (defun wl-summary-buffer-display-mime-mode ()
4445   (or (wl-message-display-type-property (wl-summary-message-display-type)
4446                                         :mime)
4447       wl-summary-buffer-display-mime-mode))
4448
4449 (defun wl-summary-buffer-display-header-mode ()
4450   (or (wl-message-display-type-property (wl-summary-message-display-type)
4451                                         :header)
4452       wl-summary-buffer-display-header-mode))
4453
4454 (defun wl-summary-toggle-mime (&optional arg)
4455   "Toggle MIME decoding.
4456 If ARG is non-nil, ask coding-system to display the message in the current
4457 MIME analysis mode.
4458
4459 If ARG is numeric number, decode message as following:
4460 1: Enable MIME analysis.
4461 2: Enable MIME analysis only for headers.
4462 3: Disable MIME analysis."
4463   (interactive "P")
4464   (let ((mime-mode (wl-summary-buffer-display-mime-mode))
4465         (elmo-mime-display-as-is-coding-system
4466          elmo-mime-display-as-is-coding-system))
4467     (if (and (consp arg) (> (prefix-numeric-value arg) 4))
4468         (progn
4469           (setq wl-summary-buffer-display-mime-mode mime-mode)
4470           (wl-summary-update-modeline))
4471       (cond
4472        ((numberp arg)
4473         (setq mime-mode (case arg
4474                           (1 'mime)
4475                           (2 'header-only)
4476                           (3 'as-is)
4477 ;;;                       (4 'decode-only)
4478                           (5 'no-merge))))
4479        (arg
4480         ;; Specify coding-system (doesn't change the MIME mode).
4481         (setq elmo-mime-display-as-is-coding-system
4482               (if (and arg
4483                        (not (wl-message-mime-analysis-p
4484                              (wl-summary-message-display-type))))
4485                   (or (read-coding-system "Coding system: ")
4486                       elmo-mime-display-as-is-coding-system)
4487                 elmo-mime-display-as-is-coding-system)))
4488        (t
4489         ;; Change the MIME mode.
4490         (setq mime-mode (or (cadr (memq mime-mode
4491                                         wl-summary-display-mime-mode-list))
4492                             (car wl-summary-display-mime-mode-list)))))
4493       (wl-summary-redisplay-internal nil nil arg mime-mode))
4494     (message "MIME decoding: %s%s"
4495              (upcase (symbol-name mime-mode))
4496              (if (and (not (eq mime-mode 'mime))
4497                       (not (eq elmo-mime-display-as-is-coding-system
4498                                wl-cs-autoconv)))
4499                  (concat " ("
4500                          (symbol-name elmo-mime-display-as-is-coding-system)
4501                          ")")
4502                ""))))
4503
4504 (defun wl-summary-redisplay (&optional arg)
4505   "Redisplay message."
4506   (interactive "P")
4507   (apply #'wl-summary-redisplay-internal nil nil arg
4508          (unless (and (consp arg) (> (prefix-numeric-value arg) 4))
4509            (list wl-summary-buffer-display-mime-mode
4510                  wl-summary-buffer-display-header-mode))))
4511
4512 (defun wl-summary-toggle-all-header (&optional arg)
4513   "Toggle displaying message with all header."
4514   (interactive "P")
4515   (let ((header-mode (wl-summary-buffer-display-header-mode)))
4516     (if (and (consp arg) (> (prefix-numeric-value arg) 4))
4517         (setq wl-summary-buffer-display-header-mode header-mode)
4518       (wl-summary-redisplay-internal
4519        nil nil arg nil
4520        (if (eq header-mode 'all) 'partial 'all)))))
4521
4522 (defun wl-summary-redisplay-internal (&optional folder number force-reload
4523                                                 mime-mode header-mode)
4524   (let* ((folder (or folder wl-summary-buffer-elmo-folder))
4525          (num (or number (wl-summary-message-number)))
4526          (wl-mime-charset      wl-summary-buffer-mime-charset)
4527          (default-mime-charset wl-summary-buffer-mime-charset)
4528          fld-buf fld-win thr-entity
4529          (elmo-message-fetch-confirm (or elmo-message-fetch-confirm
4530                                          (and force-reload
4531                                               elmo-message-fetch-threshold))))
4532     (if (and wl-thread-open-reading-thread
4533              (eq wl-summary-buffer-view 'thread)
4534              (not (wl-thread-entity-get-opened
4535                    (setq thr-entity (wl-thread-get-entity
4536                                      num))))
4537              (wl-thread-entity-get-children thr-entity))
4538         (wl-thread-force-open))
4539     (if num
4540         (progn
4541           (setq wl-summary-buffer-disp-msg t)
4542           (setq wl-summary-buffer-last-displayed-msg
4543                 wl-summary-buffer-current-msg)
4544           ;; hide folder window
4545           (if (and (not wl-stay-folder-window)
4546                    (setq fld-buf (get-buffer wl-folder-buffer-name)))
4547               (if (setq fld-win (get-buffer-window fld-buf))
4548                   (delete-window fld-win)))
4549           (setq wl-current-summary-buffer (current-buffer))
4550           (wl-message-redisplay folder num
4551                                 (wl-message-make-display-type
4552                                  (or mime-mode
4553                                      (wl-summary-buffer-display-mime-mode))
4554                                  (or header-mode
4555                                      (wl-summary-buffer-display-header-mode)))
4556                                 (or force-reload
4557                                     (string= (elmo-folder-name-internal folder)
4558                                              wl-draft-folder)))
4559           (when (elmo-message-use-cache-p folder num)
4560             (elmo-message-set-cached folder num t))
4561           (ignore-errors
4562             (if (elmo-message-flagged-p wl-summary-buffer-elmo-folder
4563                                         num
4564                                         'unread)
4565                 (wl-summary-mark-as-read num)
4566               (wl-summary-count-unread)
4567               (wl-summary-update-modeline)
4568               (wl-folder-update-unread
4569                (wl-summary-buffer-folder-name)
4570                wl-summary-buffer-unread-count)))
4571           (setq wl-summary-buffer-current-msg num)
4572           (when wl-summary-recenter
4573             (recenter (/ (- (window-height) 2) 2))
4574             (if (not wl-summary-indent-length-limit)
4575                 (wl-horizontal-recenter)))
4576           (wl-highlight-summary-displaying)
4577           (wl-message-buffer-prefetch-next
4578            folder num
4579            (min (or wl-message-buffer-prefetch-depth 0)
4580                 (1- wl-message-buffer-cache-size))
4581            (current-buffer)
4582            wl-summary-buffer-mime-charset)
4583           (run-hooks 'wl-summary-redisplay-hook))
4584       (message "No message to display."))))
4585
4586 (defun wl-summary-jump-to-current-message ()
4587   "Jump into Message buffer."
4588   (interactive)
4589   (let (message-buf message-win)
4590     (if (setq message-buf wl-message-buffer)
4591         (if (setq message-win (get-buffer-window message-buf))
4592             (select-window message-win)
4593           (wl-message-select-buffer wl-message-buffer))
4594       (wl-summary-redisplay)
4595       (wl-message-select-buffer wl-message-buffer))))
4596
4597 (defun wl-summary-cancel-message ()
4598   "Cancel an article on news."
4599   (interactive)
4600   (if (null (wl-summary-message-number))
4601       (message "No message.")
4602     (let ((summary-buf (current-buffer))
4603           message-buf)
4604       (wl-summary-set-message-buffer-or-redisplay)
4605       (if (setq message-buf (wl-message-get-original-buffer))
4606           (set-buffer message-buf))
4607       (unless (wl-message-news-p)
4608         (set-buffer summary-buf)
4609         (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
4610                      'nntp)
4611                  (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
4612             (progn
4613               (wl-summary-redisplay t)
4614               (wl-summary-supersedes-message))
4615           (error "This is not a news article; supersedes is impossible")))
4616       (when (yes-or-no-p "Do you really want to cancel this article? ")
4617         (let (from newsgroups message-id distribution buf)
4618           (save-excursion
4619             (setq from (std11-field-body "from")
4620                   newsgroups (std11-field-body "newsgroups")
4621                   message-id (std11-field-body "message-id")
4622                   distribution (std11-field-body "distribution"))
4623             ;; Make sure that this article was written by the user.
4624             (unless (wl-address-user-mail-address-p
4625                      (wl-address-header-extract-address
4626                       (car (wl-parse-addresses from))))
4627               (error "This article is not yours"))
4628             ;; Make control message.
4629             (setq buf (set-buffer (get-buffer-create " *message cancel*")))
4630             (setq wl-draft-buffer-cur-summary-buffer summary-buf)
4631             (buffer-disable-undo (current-buffer))
4632             (erase-buffer)
4633             (insert "Newsgroups: " newsgroups "\n"
4634                     "From: " (wl-address-header-extract-address
4635                               wl-from) "\n"
4636                               "Subject: cmsg cancel " message-id "\n"
4637                               "Control: cancel " message-id "\n"
4638                               (if distribution
4639                                   (concat "Distribution: " distribution "\n")
4640                                 "")
4641                               mail-header-separator "\n"
4642                               wl-summary-cancel-message)
4643             (message "Canceling your message...")
4644             (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
4645             (message "Canceling your message...done")))))))
4646
4647 (defun wl-summary-supersedes-message ()
4648   "Supersede current message."
4649   (interactive)
4650   (wl-summary-toggle-disp-msg 'off)
4651   (let ((summary-buf (current-buffer))
4652         message-buf from)
4653     (wl-summary-set-message-buffer-or-redisplay)
4654     (if (setq message-buf (wl-message-get-original-buffer))
4655         (set-buffer message-buf))
4656     (unless (wl-message-news-p)
4657       (set-buffer summary-buf)
4658       (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
4659                    'nntp)
4660                (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
4661           (progn
4662             (wl-summary-redisplay t)
4663             (wl-summary-supersedes-message))
4664         (error "This is not a news article; supersedes is impossible")))
4665     (save-excursion
4666       (setq from (std11-field-body "from"))
4667       ;; Make sure that this article was written by the user.
4668       (unless (wl-address-user-mail-address-p
4669                (wl-address-header-extract-address
4670                 (car (wl-parse-addresses from))))
4671         (error "This article is not yours"))
4672       (let* ((message-id (std11-field-body "message-id"))
4673              (followup-to (std11-field-body "followup-to"))
4674              (mail-default-headers
4675               (concat mail-default-headers
4676                       "Supersedes: " message-id "\n"
4677                       (and followup-to
4678                            (concat "Followup-To: " followup-to "\n")))))
4679         (if message-buf (set-buffer message-buf))
4680         (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
4681
4682 (defun wl-summary-save (&optional arg wl-save-dir)
4683   "Save current message to disk."
4684   (interactive)
4685   (let ((filename)
4686         (num (wl-summary-message-number)))
4687     (unless wl-save-dir
4688       (setq wl-save-dir wl-temporary-file-directory))
4689     (if num
4690         (save-excursion
4691           (setq filename (expand-file-name
4692                           (concat (int-to-string num)
4693                                   wl-summary-save-file-suffix)
4694                           wl-save-dir))
4695           (when (or (null arg)
4696                     (file-exists-p filename))
4697             (setq filename (read-file-name "Save to file: " filename)))
4698           (wl-summary-set-message-buffer-or-redisplay)
4699           (set-buffer (wl-message-get-original-buffer))
4700           (when (or arg
4701                     (not (file-exists-p filename))
4702                     (y-or-n-p "File already exists.  override it? "))
4703             (write-region-as-binary (point-min) (point-max) filename)))
4704       (message "No message to save."))
4705     num))
4706
4707 (defun wl-summary-save-region (beg end)
4708   (interactive "r")
4709   (save-excursion
4710     (save-restriction
4711       (wl-summary-narrow-to-region beg end)
4712       (goto-char (point-min))
4713       (let ((wl-save-dir
4714              (wl-read-directory-name "Save to directory: "
4715                                      wl-temporary-file-directory)))
4716         (if (null (file-exists-p wl-save-dir))
4717             (make-directory wl-save-dir))
4718         (if (eq wl-summary-buffer-view 'thread)
4719             (progn
4720               (while (not (eobp))
4721                 (let* ((number (wl-summary-message-number))
4722                        (entity (wl-thread-get-entity number)))
4723                   (if (wl-thread-entity-get-opened entity)
4724                       (wl-summary-save t wl-save-dir)
4725                     ;; closed
4726                     (wl-summary-save t wl-save-dir))
4727                   (forward-line 1))))
4728           (while (not (eobp))
4729             (wl-summary-save t wl-save-dir)
4730             (forward-line 1)))))))
4731
4732 ;; mew-summary-pipe-message()
4733 (defun wl-summary-pipe-message (prefix command)
4734   "Send this message via pipe."
4735   (interactive (list current-prefix-arg nil))
4736   (if (null (wl-summary-message-number))
4737       (message "No message.")
4738     (setq command (read-string "Shell command on message: "
4739                                wl-summary-shell-command-last))
4740     (if (y-or-n-p "Send this message to pipe? ")
4741         (wl-summary-pipe-message-subr prefix command))))
4742
4743 (defun wl-summary-target-mark-pipe (prefix command)
4744   "Send each marked messages via pipe."
4745   (interactive (list current-prefix-arg nil))
4746   (if (null wl-summary-buffer-target-mark-list)
4747       (message "No marked message.")
4748     (setq command (read-string "Shell command on each marked message: "
4749                                wl-summary-shell-command-last))
4750     (when (y-or-n-p "Send each marked message to pipe? ")
4751       (while (car wl-summary-buffer-target-mark-list)
4752         (let ((num (car wl-summary-buffer-target-mark-list)))
4753           (wl-thread-jump-to-msg num)
4754           (wl-summary-pipe-message-subr prefix command)
4755           (wl-summary-unmark))))))
4756
4757 (defun wl-summary-pipe-message-subr (prefix command)
4758   (save-excursion
4759     (wl-summary-set-message-buffer-or-redisplay)
4760     (set-buffer (wl-message-get-original-buffer))
4761     (if (string= command "")
4762         (setq command wl-summary-shell-command-last))
4763     (goto-char (point-min)) ; perhaps this line won't be necessary
4764     (if prefix
4765         (search-forward "\n\n"))
4766     (shell-command-on-region (point) (point-max) command nil)
4767     (setq wl-summary-shell-command-last command)))
4768
4769 (defun wl-summary-print-message (&optional arg)
4770   (interactive "P")
4771   (if (null (wl-summary-message-number))
4772       (message "No message.")
4773     (save-excursion
4774       (wl-summary-set-message-buffer-or-redisplay)
4775       (if (or (not (interactive-p))
4776               (y-or-n-p "Print ok? "))
4777           (progn
4778             (let ((buffer (generate-new-buffer " *print*")))
4779               (copy-to-buffer buffer (point-min) (point-max))
4780               (set-buffer buffer)
4781               (funcall wl-print-buffer-function)
4782               (kill-buffer buffer)))
4783         (message "")))))
4784
4785 (defun wl-summary-print-message-with-ps-print (&optional filename)
4786   "Print message via ps-print."
4787   (interactive)
4788   (if (null (wl-summary-message-number))
4789       (message "No message.")
4790     (setq filename (ps-print-preprint current-prefix-arg))
4791     (if (or (not (interactive-p))
4792             (y-or-n-p "Print ok? "))
4793         (let ((summary-buffer (current-buffer))
4794               wl-break-pages)
4795           (save-excursion
4796             (wl-summary-set-message-buffer-or-redisplay)
4797             (let* ((buffer (generate-new-buffer " *print*"))
4798                    (entity (progn
4799                              (set-buffer summary-buffer)
4800                              (elmo-message-entity
4801                               wl-summary-buffer-elmo-folder
4802                               (wl-summary-message-number))))
4803                    (wl-ps-subject
4804                     (and entity
4805                          (or (elmo-message-entity-field entity 'subject t)
4806                              "")))
4807                    (wl-ps-from
4808                     (and entity
4809                          (or (elmo-message-entity-field entity 'from t) "")))
4810                    (wl-ps-date
4811                     (and entity
4812                          (or (elmo-message-entity-field entity 'date) ""))))
4813               (run-hooks 'wl-ps-preprint-hook)
4814               (set-buffer wl-message-buffer)
4815               (copy-to-buffer buffer (point-min) (point-max))
4816               (set-buffer buffer)
4817               (unwind-protect
4818                   (let ((ps-left-header
4819                          (list (concat "(" wl-ps-subject ")")
4820                                (concat "(" wl-ps-from ")")))
4821                         (ps-right-header
4822                          (list "/pagenumberstring load"
4823                                (concat "(" wl-ps-date ")"))))
4824                     (run-hooks 'wl-ps-print-hook)
4825                     (funcall wl-ps-print-buffer-function filename))
4826                 (kill-buffer buffer)))))
4827       (message ""))))
4828
4829 (if (featurep 'ps-print) ; ps-print is available.
4830     (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
4831
4832 (defun wl-summary-target-mark-print ()
4833   (interactive)
4834   (wl-summary-check-target-mark)
4835   (when (y-or-n-p "Print all marked messages. OK? ")
4836     (while (car wl-summary-buffer-target-mark-list)
4837       (let ((num (car wl-summary-buffer-target-mark-list)))
4838         (wl-thread-jump-to-msg num)
4839         (wl-summary-print-message)
4840         (wl-summary-unmark)))))
4841
4842 (defun wl-summary-folder-info-update ()
4843   (wl-folder-set-folder-updated
4844    (elmo-string (wl-summary-buffer-folder-name))
4845    (list 0
4846          wl-summary-buffer-unread-count
4847          (elmo-folder-length
4848           wl-summary-buffer-elmo-folder))))
4849
4850 (defun wl-summary-get-original-buffer ()
4851   "Get original buffer for the current summary."
4852   (save-excursion
4853     (wl-summary-set-message-buffer-or-redisplay)
4854     (wl-message-get-original-buffer)))
4855
4856 (defun wl-summary-pack-number (&optional arg)
4857   (interactive "P")
4858   (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
4859   (let (wl-use-scoring)
4860     (wl-summary-rescan nil nil nil t)))
4861
4862 (defun wl-summary-target-mark-uudecode ()
4863   (interactive)
4864   (wl-summary-check-target-mark)
4865   (let ((mlist (reverse wl-summary-buffer-target-mark-list))
4866         (summary-buf (current-buffer))
4867         (tmp-buf (get-buffer-create "*WL UUENCODE*"))
4868         orig-buf i k filename rc errmsg)
4869     (setq i 1)
4870     (setq k (length mlist))
4871     (set-buffer tmp-buf)
4872     (erase-buffer)
4873     (save-window-excursion
4874       (while mlist
4875         (set-buffer summary-buf)
4876         (wl-summary-jump-to-msg (car mlist))
4877         (wl-summary-redisplay)
4878         (set-buffer (setq orig-buf (wl-summary-get-original-buffer)))
4879         (goto-char (point-min))
4880         (cond ((= i 1) ; first
4881                (if (setq filename (wl-message-uu-substring
4882                                    orig-buf tmp-buf t
4883                                    (= i k)))
4884                    nil
4885                  (error "Can't find begin line")))
4886               ((< i k)
4887                (wl-message-uu-substring orig-buf tmp-buf))
4888               (t ; last
4889                (wl-message-uu-substring orig-buf tmp-buf nil t)))
4890         (setq i (1+ i))
4891         (setq mlist (cdr mlist)))
4892       (set-buffer tmp-buf)
4893       (message "Exec %s..." wl-prog-uudecode)
4894       (unwind-protect
4895           (let ((decode-dir wl-temporary-file-directory))
4896             (if (not wl-prog-uudecode-no-stdout-option)
4897                 (setq filename (read-file-name "Save to file: "
4898                                                (expand-file-name
4899                                                 (elmo-safe-filename filename)
4900                                                 wl-temporary-file-directory)))
4901               (setq decode-dir
4902                     (wl-read-directory-name "Save to directory: "
4903                                             wl-temporary-file-directory))
4904               (setq filename (expand-file-name filename decode-dir)))
4905             (if (file-exists-p filename)
4906                 (or (yes-or-no-p (format "File %s exists. Save anyway? "
4907                                          filename))
4908                     (error "")))
4909             (elmo-bind-directory
4910              decode-dir
4911              (setq rc
4912                    (as-binary-process
4913                     (apply 'call-process-region (point-min) (point-max)
4914                            wl-prog-uudecode t (current-buffer) nil
4915                            wl-prog-uudecode-arg))))
4916             (when (not (= 0 rc))
4917               (setq errmsg (buffer-substring (point-min)(point-max)))
4918               (error "Uudecode error: %s" errmsg))
4919             (if (not wl-prog-uudecode-no-stdout-option)
4920                 (let (file-name-handler-alist) ;; void jka-compr
4921                   (as-binary-output-file
4922                    (write-region (point-min) (point-max)
4923                                  filename nil 'no-msg))))
4924             (save-excursion
4925               (set-buffer summary-buf)
4926               (wl-summary-delete-all-target-marks))
4927             (if (file-exists-p filename)
4928                 (message "Saved as %s" filename)))
4929         (kill-buffer tmp-buf)))))
4930
4931 ;; Someday
4932 ;; (defun wl-summary-drop-unsync ()
4933 ;;   "Drop all unsync messages."
4934 ;;   (interactive)
4935 ;;   (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
4936 ;;       (error "You cannot drop unsync messages in this folder"))
4937 ;;   (if (or (not (interactive-p))
4938 ;;        (y-or-n-p "Drop all unsync messages? "))
4939 ;;       (let* ((folder-list (elmo-folder-get-primitive-folder-list
4940 ;;                         (wl-summary-buffer-folder-name)))
4941 ;;           (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
4942 ;;           (sum 0)
4943 ;;           (multi-num 0)
4944 ;;           pair)
4945 ;;      (message "Dropping...")
4946 ;;      (while folder-list
4947 ;;        (setq pair (elmo-folder-message-numbers (car folder-list)))
4948 ;;        (when is-multi ;; dirty hack...
4949 ;;          (incf multi-num)
4950 ;;          (setcar pair (+ (* multi-num elmo-multi-divide-number)
4951 ;;                          (car pair))))
4952 ;;        (elmo-msgdb-set-number-alist
4953 ;;         (wl-summary-buffer-msgdb)
4954 ;;         (nconc
4955 ;;          (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
4956 ;;          (list (cons (car pair) nil))))
4957 ;;        (setq sum (+ sum (cdr pair)))
4958 ;;        (setq folder-list (cdr folder-list)))
4959 ;;      (wl-summary-set-message-modified)
4960 ;;      (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
4961 ;;                                    (list 0
4962 ;;                                          (+ wl-summary-buffer-unread-count
4963 ;;                                             wl-summary-buffer-new-count)
4964 ;;                                          sum))
4965 ;;      (message "Dropping...done"))))
4966
4967 (defun wl-summary-default-get-next-msg (msg)
4968   (or (wl-summary-next-message msg
4969                                (if wl-summary-move-direction-downward 'down
4970                                  'up)
4971                                nil)
4972       (cadr (memq msg (if wl-summary-move-direction-downward
4973                           wl-summary-buffer-number-list
4974                         (reverse wl-summary-buffer-number-list))))))
4975
4976 (defun wl-summary-save-current-message ()
4977   "Save current message for `wl-summary-yank-saved-message'."
4978   (interactive)
4979   (let ((number (wl-summary-message-number)))
4980     (setq wl-summary-buffer-saved-message number)
4981     (and number (message "No: %s is saved." number))))
4982
4983 (defun wl-summary-yank-saved-message ()
4984   "Set current message as a parent of the saved message."
4985   (interactive)
4986   (if wl-summary-buffer-saved-message
4987       (let ((number (wl-summary-message-number)))
4988         (if (eq wl-summary-buffer-saved-message number)
4989             (message "Cannot set itself as a parent.")
4990           (save-excursion
4991             (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
4992             (wl-thread-set-parent number)
4993             (wl-summary-set-thread-modified))
4994           (setq  wl-summary-buffer-saved-message nil)))
4995     (message "There's no saved message.")))
4996
4997 (defun wl-summary-toggle-header-narrowing ()
4998   "Toggle message header narrowing."
4999   (interactive)
5000   (when wl-message-use-header-narrowing
5001     (save-selected-window
5002       (let* ((mbuf wl-message-buffer)
5003              (mwin (when mbuf (get-buffer-window mbuf)))
5004              (wpos (when mwin (window-start mwin))))
5005         (when mbuf
5006           (set-buffer mbuf)
5007           (wl-message-header-narrowing-toggle)
5008           (and wpos (set-window-start mwin wpos)))))))
5009
5010 (require 'product)
5011 (product-provide (provide 'wl-summary) (require 'wl-version))
5012
5013 ;;; wl-summary.el ends here