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