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