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