wl/wl-summary.el

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