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