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