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