wl/wl-summary.el

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