1 ;;; wl-summary.el -- Summary mode for Wanderlust.
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>
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
14 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
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)
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.
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.
42 (require 'wl-highlight)
45 (condition-case nil (require 'timezone) (error nil))
46 (condition-case nil (require 'easymenu) (error nil))
49 (condition-case nil (require 'ps-print) (error nil))
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))
61 (defvar dragdrop-drop-functions)
62 (defvar scrollbar-height)
63 (defvar mail-reply-buffer)
65 (defvar wl-summary-buffer-name "Summary")
66 (defvar wl-summary-mode-map nil)
67 (defvar wl-current-summary-buffer nil)
69 ;; (defvar wl-summary-buffer-msgdb nil) obsolete.
70 ;; (defvar wl-summary-buffer-folder-name nil) obsolete.
71 (defvar wl-summary-buffer-elmo-folder nil)
73 (defmacro wl-summary-buffer-folder-name ()
74 (` (and wl-summary-buffer-elmo-folder
75 (elmo-folder-name-internal wl-summary-buffer-elmo-folder))))
77 (defmacro wl-summary-buffer-msgdb ()
78 (` (and wl-summary-buffer-elmo-folder
79 (elmo-folder-msgdb wl-summary-buffer-elmo-folder))))
81 (defvar wl-summary-buffer-folder-indicator nil)
82 (defvar wl-summary-buffer-disp-msg nil)
83 (defvar wl-summary-buffer-disp-folder nil)
84 (defvar wl-summary-buffer-refile-list nil)
85 (defvar wl-summary-buffer-delete-list nil)
86 (defvar wl-summary-buffer-last-displayed-msg nil)
87 (defvar wl-summary-buffer-current-msg nil)
88 (defvar wl-summary-buffer-unread-status " (0 new/0 unread)")
89 (defvar wl-summary-buffer-unread-count 0)
90 (defvar wl-summary-buffer-new-count 0)
91 (defvar wl-summary-buffer-mime-charset nil)
92 (defvar wl-summary-buffer-weekday-name-lang nil)
93 (defvar wl-summary-buffer-thread-indent-set-alist nil)
94 (defvar wl-summary-buffer-message-redisplay-func nil)
95 (defvar wl-summary-buffer-view 'thread)
96 (defvar wl-summary-buffer-message-modified nil)
97 (defvar wl-summary-buffer-mark-modified nil)
98 (defvar wl-summary-buffer-thread-modified nil)
99 (defvar wl-summary-buffer-number-column nil)
100 (defvar wl-summary-buffer-number-regexp nil)
101 (defvar wl-summary-buffer-persistent nil)
102 (defvar wl-summary-buffer-thread-nodes nil)
103 (defvar wl-summary-buffer-target-mark-list nil)
104 (defvar wl-summary-buffer-copy-list nil)
105 (defvar wl-summary-buffer-prev-refile-destination nil)
106 (defvar wl-summary-buffer-prev-copy-destination nil)
107 (defvar wl-summary-buffer-saved-message nil)
108 (defvar wl-summary-buffer-prev-folder-func nil)
109 (defvar wl-summary-buffer-next-folder-func nil)
110 (defvar wl-summary-buffer-exit-func nil)
111 (defvar wl-thread-indent-level-internal nil)
112 (defvar wl-thread-have-younger-brother-str-internal nil)
113 (defvar wl-thread-youngest-child-str-internal nil)
114 (defvar wl-thread-vertical-str-internal nil)
115 (defvar wl-thread-horizontal-str-internal nil)
116 (defvar wl-thread-space-str-internal nil)
117 (defvar wl-summary-last-visited-folder nil)
118 (defvar wl-read-folder-hist nil)
119 (defvar wl-summary-scored nil)
120 (defvar wl-crosspost-alist-modified nil)
121 (defvar wl-summary-alike-hashtb nil)
122 (defvar wl-summary-search-buf-name " *wl-search-subject*")
123 (defvar wl-summary-delayed-update nil)
124 (defvar wl-summary-search-buf-folder-name nil)
126 (defvar wl-summary-get-petname-func 'wl-address-get-petname-1)
128 (defvar wl-summary-message-regexp "^ *\\([0-9]+\\)")
130 (defvar wl-summary-shell-command-last "")
132 (defvar wl-ps-preprint-hook nil)
133 (defvar wl-ps-print-hook nil)
135 (make-variable-buffer-local 'wl-summary-buffer-elmo-folder)
136 (make-variable-buffer-local 'wl-summary-search-buf-folder-name)
137 (make-variable-buffer-local 'wl-summary-buffer-disp-msg)
138 (make-variable-buffer-local 'wl-summary-buffer-disp-folder)
139 (make-variable-buffer-local 'wl-summary-buffer-refile-list)
140 (make-variable-buffer-local 'wl-summary-buffer-copy-list)
141 (make-variable-buffer-local 'wl-summary-buffer-target-mark-list)
142 (make-variable-buffer-local 'wl-summary-buffer-delete-list)
143 (make-variable-buffer-local 'wl-summary-buffer-folder-indicator)
144 (make-variable-buffer-local 'wl-summary-buffer-last-displayed-msg)
145 (make-variable-buffer-local 'wl-summary-buffer-unread-status)
146 (make-variable-buffer-local 'wl-summary-buffer-unread-count)
147 (make-variable-buffer-local 'wl-summary-buffer-new-count)
148 (make-variable-buffer-local 'wl-summary-buffer-mime-charset)
149 (make-variable-buffer-local 'wl-summary-buffer-weekday-name-lang)
150 (make-variable-buffer-local 'wl-summary-buffer-thread-indent-set)
151 (make-variable-buffer-local 'wl-summary-buffer-view)
152 (make-variable-buffer-local 'wl-summary-buffer-message-modified)
153 (make-variable-buffer-local 'wl-summary-buffer-mark-modified)
154 (make-variable-buffer-local 'wl-summary-buffer-thread-modified)
155 (make-variable-buffer-local 'wl-summary-buffer-number-column)
156 (make-variable-buffer-local 'wl-summary-buffer-number-regexp)
157 (make-variable-buffer-local 'wl-summary-buffer-persistent)
158 (make-variable-buffer-local 'wl-summary-buffer-thread-nodes)
159 (make-variable-buffer-local 'wl-summary-buffer-prev-refile-destination)
160 (make-variable-buffer-local 'wl-summary-buffer-saved-message)
161 (make-variable-buffer-local 'wl-summary-scored)
162 (make-variable-buffer-local 'wl-summary-default-score)
163 (make-variable-buffer-local 'wl-summary-move-direction-downward)
164 (make-variable-buffer-local 'wl-summary-important-above)
165 (make-variable-buffer-local 'wl-summary-target-above)
166 (make-variable-buffer-local 'wl-summary-mark-below)
167 (make-variable-buffer-local 'wl-summary-expunge-below)
168 (make-variable-buffer-local 'wl-thread-indent-level-internal)
169 (make-variable-buffer-local 'wl-thread-have-younger-brother-str-internal)
170 (make-variable-buffer-local 'wl-thread-youngest-child-str-internal)
171 (make-variable-buffer-local 'wl-thread-vertical-str-internal)
172 (make-variable-buffer-local 'wl-thread-horizontal-str-internal)
173 (make-variable-buffer-local 'wl-thread-space-str-internal)
174 (make-variable-buffer-local 'wl-summary-buffer-prev-folder-func)
175 (make-variable-buffer-local 'wl-summary-buffer-next-folder-func)
176 (make-variable-buffer-local 'wl-summary-buffer-exit-func)
178 ;; internal functions (dummy)
179 (unless (fboundp 'wl-summary-append-message-func-internal)
180 (defun wl-summary-append-message-func-internal (entity overview
182 &optional force-insert)))
183 (unless (fboundp 'wl-summary-from-func-internal)
184 (defun wl-summary-from-func-internal (from)
186 (unless (fboundp 'wl-summary-subject-func-internal)
187 (defun wl-summary-subject-func-internal (subject)
189 (unless (fboundp 'wl-summary-subject-filter-func-internal)
190 (defun wl-summary-subject-filter-func-internal (subject)
193 (defmacro wl-summary-sticky-buffer-name (name)
194 (` (concat wl-summary-buffer-name ":" (, name))))
196 (defun wl-summary-default-subject (subject-string)
197 (if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string)
198 (substring subject-string (match-end 0))
201 (eval-when-compile (defvar-maybe entity nil)) ; silence byte compiler.
202 (defun wl-summary-default-from (from)
205 (and (eq major-mode 'wl-summary-mode)
206 (stringp wl-summary-showto-folder-regexp)
207 (string-match wl-summary-showto-folder-regexp
208 (wl-summary-buffer-folder-name))
209 (wl-address-user-mail-address-p from)
211 ((and (setq tos (elmo-msgdb-overview-entity-get-to entity))
212 (not (string= "" tos)))
221 (funcall wl-summary-get-petname-func to)
223 (std11-extract-address-components to))
226 (wl-parse-addresses tos)
228 ((setq ng (elmo-msgdb-overview-entity-get-extra-field
229 entity "newsgroups"))
230 (setq retval (concat "Ng:" ng)))))
232 (setq retval (or (funcall wl-summary-get-petname-func from)
233 (car (std11-extract-address-components from))
238 (defun wl-summary-simple-from (string)
240 (or (funcall wl-summary-get-petname-func string)
241 (car (std11-extract-address-components string))
245 (defvar wl-summary-mode-menu-spec
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]
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]
269 ["By Number" wl-summary-sort-by-number t]
270 ["By Date" wl-summary-sort-by-date t]
271 ["By From" wl-summary-sort-by-from t]
272 ["By Subject" wl-summary-sort-by-subject t])
275 ["Mark as read" wl-summary-mark-as-read t]
276 ["Mark as important" wl-summary-mark-as-important t]
277 ["Mark as unread" wl-summary-mark-as-unread t]
278 ["Set delete mark" wl-summary-delete t]
279 ["Set refile mark" wl-summary-refile t]
280 ["Set copy mark" wl-summary-copy t]
281 ["Prefetch" wl-summary-prefetch t]
282 ["Set target mark" wl-summary-target-mark t]
283 ["Unmark" wl-summary-unmark t]
284 ["Save" wl-summary-save t]
285 ["Cancel posted news" wl-summary-cancel-message t]
286 ["Supersedes message" wl-summary-supersedes-message t]
287 ["Resend bounced mail" wl-summary-resend-bounced-mail t]
288 ["Resend message" wl-summary-resend-message t]
289 ["Enter the message" wl-summary-jump-to-current-message t]
290 ["Pipe message" wl-summary-pipe-message t]
291 ["Print message" wl-summary-print-message t])
293 ["Open or Close" wl-thread-open-close (eq wl-summary-buffer-view 'thread)]
294 ["Open all" wl-thread-open-all (eq wl-summary-buffer-view 'thread)]
295 ["Close all" wl-thread-close-all (eq wl-summary-buffer-view 'thread)]
296 ["Mark as read" wl-thread-mark-as-read (eq wl-summary-buffer-view 'thread)]
297 ["Mark as important" wl-thread-mark-as-important (eq wl-summary-buffer-view 'thread)]
298 ["Mark as unread" wl-thread-mark-as-unread (eq wl-summary-buffer-view 'thread)]
299 ["Set delete mark" wl-thread-delete (eq wl-summary-buffer-view 'thread)]
300 ["Set refile mark" wl-thread-refile (eq wl-summary-buffer-view 'thread)]
301 ["Set copy mark" wl-thread-copy (eq wl-summary-buffer-view 'thread)]
302 ["Prefetch" wl-thread-prefetch (eq wl-summary-buffer-view 'thread)]
303 ["Set target mark" wl-thread-target-mark (eq wl-summary-buffer-view 'thread)]
304 ["Unmark" wl-thread-unmark (eq wl-summary-buffer-view 'thread)]
305 ["Save" wl-thread-save (eq wl-summary-buffer-view 'thread)]
306 ["Execute" wl-thread-exec (eq wl-summary-buffer-view 'thread)])
308 ["Mark as read" wl-summary-mark-as-read-region t]
309 ["Mark as important" wl-summary-mark-as-important-region t]
310 ["Mark as unread" wl-summary-mark-as-unread-region t]
311 ["Set delete mark" wl-summary-delete-region t]
312 ["Set refile mark" wl-summary-refile-region t]
313 ["Set copy mark" wl-summary-copy-region t]
314 ["Prefetch" wl-summary-prefetch-region t]
315 ["Set target mark" wl-summary-target-mark-region t]
316 ["Unmark" wl-summary-unmark-region t]
317 ["Save" wl-summary-save-region t]
318 ["Execute" wl-summary-exec-region t])
320 ["Mark as read" wl-summary-target-mark-mark-as-read t]
321 ["Mark as important" wl-summary-target-mark-mark-as-important t]
322 ["Mark as unread" wl-summary-target-mark-mark-as-unread t]
323 ["Set delete mark" wl-summary-target-mark-delete t]
324 ["Set refile mark" wl-summary-target-mark-refile t]
325 ["Set copy mark" wl-summary-target-mark-copy t]
326 ["Prefetch" wl-summary-target-mark-prefetch t]
327 ["Save" wl-summary-target-mark-save t]
328 ["Reply with citation" wl-summary-target-mark-reply-with-citation t]
329 ["Forward" wl-summary-target-mark-forward t]
330 ["uudecode" wl-summary-target-mark-uudecode t])
332 ["Switch current score file" wl-score-change-score-file t]
333 ["Edit current score file" wl-score-edit-current-scores t]
334 ["Edit score file" wl-score-edit-file t]
335 ["Set mark below" wl-score-set-mark-below t]
336 ["Set expunge below" wl-score-set-expunge-below t]
337 ["Rescore buffer" wl-summary-rescore t]
338 ["Increase score" wl-summary-increase-score t]
339 ["Lower score" wl-summary-lower-score t])
342 ["Write a message" wl-summary-write t]
343 ["Reply" wl-summary-reply t]
344 ["Reply with citation" wl-summary-reply-with-citation t]
345 ["Forward" wl-summary-forward t])
347 ["Toggle Plug Status" wl-toggle-plugged t]
348 ["Change Plug Status" wl-plugged-change t]
350 ["Exit Current Folder" wl-summary-exit t]))
353 (defun wl-summary-setup-mouse ()
354 (define-key wl-summary-mode-map 'button4 'wl-summary-prev)
355 (define-key wl-summary-mode-map 'button5 'wl-summary-next)
356 (define-key wl-summary-mode-map [(shift button4)]
358 (define-key wl-summary-mode-map [(shift button5)]
360 (define-key wl-summary-mode-map 'button2 'wl-summary-click))
362 (defun wl-summary-setup-mouse ())
363 (defun wl-summary-setup-mouse ()
364 (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev)
365 (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next)
366 (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up)
367 (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down)
368 (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click))))
370 (if wl-summary-mode-map
372 (setq wl-summary-mode-map (make-sparse-keymap))
373 (define-key wl-summary-mode-map " " 'wl-summary-read)
374 (define-key wl-summary-mode-map "." 'wl-summary-redisplay)
375 (define-key wl-summary-mode-map "<" 'wl-summary-display-top)
376 (define-key wl-summary-mode-map ">" 'wl-summary-display-bottom)
377 (define-key wl-summary-mode-map "\177" 'wl-summary-prev-page)
379 (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page))
380 (define-key wl-summary-mode-map "\r" 'wl-summary-next-line-content)
381 (define-key wl-summary-mode-map "\C-m" 'wl-summary-next-line-content)
382 (define-key wl-summary-mode-map "/" 'wl-thread-open-close)
383 (define-key wl-summary-mode-map "[" 'wl-thread-open-all)
384 (define-key wl-summary-mode-map "]" 'wl-thread-close-all)
385 (define-key wl-summary-mode-map "-" 'wl-summary-prev-line-content)
386 (define-key wl-summary-mode-map "\e\r" 'wl-summary-prev-line-content)
387 (define-key wl-summary-mode-map "g" 'wl-summary-goto-folder)
388 (define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all)
389 ; (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync)
391 (define-key wl-summary-mode-map "a" 'wl-summary-reply)
392 (define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation)
393 (define-key wl-summary-mode-map "C" 'wl-summary-cancel-message)
394 (define-key wl-summary-mode-map "E" 'wl-summary-reedit)
395 (define-key wl-summary-mode-map "\eE" 'wl-summary-resend-bounced-mail)
396 (define-key wl-summary-mode-map "f" 'wl-summary-forward)
397 (define-key wl-summary-mode-map "$" 'wl-summary-mark-as-important)
398 (define-key wl-summary-mode-map "@" 'wl-summary-edit-addresses)
400 (define-key wl-summary-mode-map "y" 'wl-summary-save)
401 (define-key wl-summary-mode-map "n" 'wl-summary-next)
402 (define-key wl-summary-mode-map "p" 'wl-summary-prev)
403 (define-key wl-summary-mode-map "N" 'wl-summary-down)
404 (define-key wl-summary-mode-map "P" 'wl-summary-up)
405 ;;;(define-key wl-summary-mode-map "w" 'wl-draft)
406 (define-key wl-summary-mode-map "w" 'wl-summary-write)
407 (define-key wl-summary-mode-map "W" 'wl-summary-write-current-folder)
408 ;;;(define-key wl-summary-mode-map "e" 'wl-draft-open-file)
409 (define-key wl-summary-mode-map "e" 'wl-summary-save)
410 (define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
411 (define-key wl-summary-mode-map "H" 'wl-summary-redisplay-all-header)
412 (define-key wl-summary-mode-map "M" 'wl-summary-redisplay-no-mime)
413 (define-key wl-summary-mode-map "B" 'wl-summary-burst)
414 (define-key wl-summary-mode-map "Z" 'wl-status-update)
415 (define-key wl-summary-mode-map "#" 'wl-summary-print-message)
416 (define-key wl-summary-mode-map "|" 'wl-summary-pipe-message)
417 (define-key wl-summary-mode-map "q" 'wl-summary-exit)
418 (define-key wl-summary-mode-map "Q" 'wl-summary-force-exit)
420 (define-key wl-summary-mode-map "j" 'wl-summary-jump-to-current-message)
421 (define-key wl-summary-mode-map "J" 'wl-thread-jump-to-msg)
422 (define-key wl-summary-mode-map "I" 'wl-summary-incorporate)
423 (define-key wl-summary-mode-map "\M-j" 'wl-summary-jump-to-msg-by-message-id)
424 (define-key wl-summary-mode-map "^" 'wl-summary-jump-to-parent-message)
425 (define-key wl-summary-mode-map "!" 'wl-summary-mark-as-unread)
427 (define-key wl-summary-mode-map "s" 'wl-summary-sync)
428 (define-key wl-summary-mode-map "S" 'wl-summary-sort)
429 (define-key wl-summary-mode-map "\M-s" 'wl-summary-stick)
430 (define-key wl-summary-mode-map "T" 'wl-summary-toggle-thread)
432 (define-key wl-summary-mode-map "l" 'wl-summary-toggle-disp-folder)
433 (define-key wl-summary-mode-map "v" 'wl-summary-toggle-disp-msg)
434 (define-key wl-summary-mode-map "V" 'wl-summary-virtual)
436 (define-key wl-summary-mode-map "\C-i" 'wl-summary-goto-last-displayed-msg)
437 (define-key wl-summary-mode-map "?" 'wl-summary-pick)
438 (define-key wl-summary-mode-map "\ee" 'wl-summary-expire)
441 (define-key wl-summary-mode-map "\ew" 'wl-summary-save-current-message)
442 (define-key wl-summary-mode-map "\C-y" 'wl-summary-yank-saved-message)
445 (define-key wl-summary-mode-map "R" 'wl-summary-mark-as-read)
446 (define-key wl-summary-mode-map "i" 'wl-summary-prefetch)
447 (define-key wl-summary-mode-map "x" 'wl-summary-exec)
448 (define-key wl-summary-mode-map "*" 'wl-summary-target-mark)
449 (define-key wl-summary-mode-map "o" 'wl-summary-refile)
450 (define-key wl-summary-mode-map "O" 'wl-summary-copy)
451 (define-key wl-summary-mode-map "\M-o" 'wl-summary-refile-prev-destination)
452 ; (define-key wl-summary-mode-map "\M-O" 'wl-summary-copy-prev-destination)
453 (define-key wl-summary-mode-map "\C-o" 'wl-summary-auto-refile)
454 (define-key wl-summary-mode-map "d" 'wl-summary-delete)
455 (define-key wl-summary-mode-map "u" 'wl-summary-unmark)
456 (define-key wl-summary-mode-map "U" 'wl-summary-unmark-all)
459 (define-key wl-summary-mode-map "t" (make-sparse-keymap))
460 (define-key wl-summary-mode-map "tR" 'wl-thread-mark-as-read)
461 (define-key wl-summary-mode-map "ti" 'wl-thread-prefetch)
462 (define-key wl-summary-mode-map "tx" 'wl-thread-exec)
463 (define-key wl-summary-mode-map "t*" 'wl-thread-target-mark)
464 (define-key wl-summary-mode-map "to" 'wl-thread-refile)
465 (define-key wl-summary-mode-map "tO" 'wl-thread-copy)
466 (define-key wl-summary-mode-map "td" 'wl-thread-delete)
467 (define-key wl-summary-mode-map "tu" 'wl-thread-unmark)
468 (define-key wl-summary-mode-map "t!" 'wl-thread-mark-as-unread)
469 (define-key wl-summary-mode-map "t$" 'wl-thread-mark-as-important)
470 (define-key wl-summary-mode-map "ty" 'wl-thread-save)
471 (define-key wl-summary-mode-map "ts" 'wl-thread-set-parent)
473 ;; target-mark commands
474 (define-key wl-summary-mode-map "m" (make-sparse-keymap))
475 (define-key wl-summary-mode-map "mi" 'wl-summary-target-mark-prefetch)
476 (define-key wl-summary-mode-map "mR" 'wl-summary-target-mark-mark-as-read)
477 (define-key wl-summary-mode-map "mo" 'wl-summary-target-mark-refile)
478 (define-key wl-summary-mode-map "mO" 'wl-summary-target-mark-copy)
479 (define-key wl-summary-mode-map "md" 'wl-summary-target-mark-delete)
480 (define-key wl-summary-mode-map "my" 'wl-summary-target-mark-save)
481 (define-key wl-summary-mode-map "m!" 'wl-summary-target-mark-mark-as-unread)
482 (define-key wl-summary-mode-map "m$" 'wl-summary-target-mark-mark-as-important)
483 (define-key wl-summary-mode-map "mu" 'wl-summary-delete-all-temp-marks)
484 (define-key wl-summary-mode-map "mU" 'wl-summary-target-mark-uudecode)
485 (define-key wl-summary-mode-map "ma" 'wl-summary-target-mark-all)
486 (define-key wl-summary-mode-map "mt" 'wl-summary-target-mark-thread)
487 (define-key wl-summary-mode-map "mA" 'wl-summary-target-mark-reply-with-citation)
488 (define-key wl-summary-mode-map "mf" 'wl-summary-target-mark-forward)
489 (define-key wl-summary-mode-map "m?" 'wl-summary-target-mark-pick)
492 (define-key wl-summary-mode-map "r" (make-sparse-keymap))
493 (define-key wl-summary-mode-map "rR" 'wl-summary-mark-as-read-region)
494 (define-key wl-summary-mode-map "ri" 'wl-summary-prefetch-region)
495 (define-key wl-summary-mode-map "rx" 'wl-summary-exec-region)
496 (define-key wl-summary-mode-map "mr" 'wl-summary-target-mark-region)
497 (define-key wl-summary-mode-map "r*" 'wl-summary-target-mark-region)
498 (define-key wl-summary-mode-map "ro" 'wl-summary-refile-region)
499 (define-key wl-summary-mode-map "rO" 'wl-summary-copy-region)
500 (define-key wl-summary-mode-map "rd" 'wl-summary-delete-region)
501 (define-key wl-summary-mode-map "ru" 'wl-summary-unmark-region)
502 (define-key wl-summary-mode-map "r!" 'wl-summary-mark-as-unread-region)
503 (define-key wl-summary-mode-map "r$" 'wl-summary-mark-as-important-region)
504 (define-key wl-summary-mode-map "ry" 'wl-summary-save-region)
507 (define-key wl-summary-mode-map "K" 'wl-summary-increase-score)
508 (define-key wl-summary-mode-map "L" 'wl-summary-lower-score)
509 (define-key wl-summary-mode-map "h" (make-sparse-keymap))
510 (define-key wl-summary-mode-map "hR" 'wl-summary-rescore)
511 (define-key wl-summary-mode-map "hc" 'wl-score-change-score-file)
512 (define-key wl-summary-mode-map "he" 'wl-score-edit-current-scores)
513 (define-key wl-summary-mode-map "hf" 'wl-score-edit-file)
514 (define-key wl-summary-mode-map "hF" 'wl-score-flush-cache)
515 (define-key wl-summary-mode-map "hm" 'wl-score-set-mark-below)
516 (define-key wl-summary-mode-map "hx" 'wl-score-set-expunge-below)
518 (define-key wl-summary-mode-map "\M-t" 'wl-toggle-plugged)
519 (define-key wl-summary-mode-map "\C-t" 'wl-plugged-change)
521 (wl-summary-setup-mouse)
525 "Menu used in Summary mode."
526 wl-summary-mode-menu-spec))
528 (defun wl-status-update ()
532 (defun wl-summary-display-top ()
534 (goto-char (point-min))
535 (if wl-summary-buffer-disp-msg
536 (wl-summary-redisplay)))
538 (defun wl-summary-display-bottom ()
540 (goto-char (point-max))
542 (if wl-summary-buffer-disp-msg
543 (wl-summary-redisplay)))
545 (defun wl-summary-collect-unread (mark-alist &optional folder)
548 (setq mark (cadr (car mark-alist)))
550 (or (string= mark wl-summary-new-mark)
551 (string= mark wl-summary-unread-uncached-mark)
552 (string= mark wl-summary-unread-cached-mark))
553 (setq ret-val (cons (car (car mark-alist)) ret-val)))
554 (setq mark-alist (cdr mark-alist)))
557 (defun wl-summary-count-unread (mark-alist)
562 (setq mark (cadr (car mark-alist)))
565 ((string= mark wl-summary-new-mark)
566 (setq new (+ 1 new)))
567 ((or (string= mark wl-summary-unread-uncached-mark)
568 (string= mark wl-summary-unread-cached-mark))
569 (setq unread (+ 1 unread)))))
570 (setq mark-alist (cdr mark-alist)))
571 (if (eq major-mode 'wl-summary-mode)
572 (setq wl-summary-buffer-new-count new
573 wl-summary-buffer-unread-count unread))
576 (defun wl-summary-reedit (&optional arg)
577 "Re-edit current message.
578 If ARG is non-nil, Supersedes message"
581 (wl-summary-supersedes-message)
582 (if (string= (wl-summary-buffer-folder-name) wl-draft-folder)
583 (if (wl-summary-message-number)
585 (wl-draft-reedit (wl-summary-message-number))
586 (if (wl-message-news-p)
587 (mail-position-on-field "Newsgroups")
588 (mail-position-on-field "To"))
589 (delete-other-windows)))
591 (let ((mmelmo-force-fetch-entire-message t))
592 (if (null (wl-summary-message-number))
593 (message "No message.")
594 (set-buffer (wl-summary-get-original-buffer))
595 (wl-draft-edit-string (buffer-substring (point-min)
598 (defun wl-summary-resend-bounced-mail ()
599 "Re-mail the current message.
600 This only makes sense if the current message is a bounce message which
601 contains some mail you have written but has been bounced back to
605 (let ((mmelmo-force-fetch-entire-message t))
606 (wl-summary-set-message-buffer-or-redisplay)
607 (set-buffer (wl-message-get-original-buffer))
608 (goto-char (point-min))
609 (let ((case-fold-search nil))
613 (concat "^\\($\\|[Cc]ontent-[Tt]ype:[ \t]+multipart/report\\)") nil t)
615 (re-search-forward "boundary=\"\\([^\"]+\\)\"" nil t))
616 (let ((boundary (buffer-substring (match-beginning 1) (match-end 1)))
619 ((and (setq start (re-search-forward
620 (concat "^--" boundary "\n"
621 "[Cc]ontent-[Tt]ype:[ \t]+"
622 "\\(message/rfc822\\|text/rfc822-headers\\)\n"
623 "\\(.+\n\\)*\n") nil t))
625 (concat "\n\\(--" boundary "\\)--\n") nil t))
626 (wl-draft-edit-string (buffer-substring start (match-beginning 1))))
628 (message "Seems no message/rfc822 part.")))))
629 ((let ((case-fold-search t))
630 (re-search-forward wl-rejected-letter-start nil t))
631 (skip-chars-forward " \t\n")
632 (wl-draft-edit-string (buffer-substring (point) (point-max))))
634 (message "Does not appear to be a rejected letter.")))))))
636 (defun wl-summary-resend-message (address)
637 "Resend the current message to ADDRESS."
638 (interactive "sResend message to: ")
639 (if (or (null address) (string-match "^[ \t]*$" address))
640 (message "No address specified.")
641 (message "Resending message to %s..." address)
643 (let ((mmelmo-force-fetch-entire-message t))
644 (wl-summary-set-message-buffer-or-redisplay)
645 ;; We first set up a normal mail buffer.
646 (set-buffer (get-buffer-create " *wl-draft-resend*"))
647 (buffer-disable-undo (current-buffer))
649 (setq wl-sent-message-via nil)
650 ;; Insert our usual headers.
651 (wl-draft-insert-from-field)
652 (wl-draft-insert-date-field)
653 (insert "to: " address "\n")
654 (goto-char (point-min))
655 ;; Rename them all to "Resent-*".
656 (while (re-search-forward "^[A-Za-z]" nil t)
661 (delete-region (point) (point-max))
663 ;; Insert the message to be resent.
664 (insert-buffer-substring (wl-message-get-original-buffer))
665 (goto-char (point-min))
666 (search-forward "\n\n")
669 (narrow-to-region beg (point))
670 (wl-draft-delete-fields wl-ignored-resent-headers)
671 (goto-char (point-max)))
672 (insert mail-header-separator)
673 ;; Rename all old ("Previous-")Resent headers.
674 (while (re-search-backward "^\\(Previous-\\)*Resent-" beg t)
676 (insert "Previous-"))
677 ;; Quote any "From " lines at the beginning.
679 (when (looking-at "From ")
680 (replace-match "X-From-Line: ")))
682 (wl-draft-dispatch-message)
683 (kill-buffer (current-buffer)))
684 (message "Resending message to %s...done" address))))
686 (defun wl-summary-buffer-set-folder (folder)
688 (setq folder (wl-folder-get-elmo-folder folder)))
689 (setq wl-summary-buffer-elmo-folder folder)
690 (setq wl-summary-buffer-folder-indicator
691 (if (memq 'modeline wl-use-folder-petname)
692 (wl-folder-get-petname (elmo-folder-name-internal folder))
693 (elmo-folder-name-internal folder)))
694 (make-local-variable 'wl-message-buffer)
695 (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value
696 wl-folder-mime-charset-alist
697 (elmo-folder-name-internal folder))
699 (setq wl-summary-buffer-weekday-name-lang
700 (or (wl-get-assoc-list-value
701 wl-folder-weekday-name-lang-alist
702 (elmo-folder-name-internal folder))
703 wl-summary-weekday-name-lang))
704 (setq wl-summary-buffer-thread-indent-set
705 (wl-get-assoc-list-value
706 wl-folder-thread-indent-set-alist
707 (elmo-folder-name-internal folder)))
708 (setq wl-summary-buffer-persistent
709 (wl-folder-persistent-p (elmo-folder-name-internal folder)))
710 (elmo-folder-set-persistent-internal folder wl-summary-buffer-persistent)
712 wl-thread-indent-level-internal
713 (or (nth 0 wl-summary-buffer-thread-indent-set)
714 wl-thread-indent-level)
715 wl-thread-have-younger-brother-str-internal
716 (or (nth 1 wl-summary-buffer-thread-indent-set)
717 wl-thread-have-younger-brother-str)
718 wl-thread-youngest-child-str-internal
719 (or (nth 2 wl-summary-buffer-thread-indent-set)
720 wl-thread-youngest-child-str)
721 wl-thread-vertical-str-internal
722 (or (nth 3 wl-summary-buffer-thread-indent-set)
723 wl-thread-vertical-str)
724 wl-thread-horizontal-str-internal
725 (or (nth 4 wl-summary-buffer-thread-indent-set)
726 wl-thread-horizontal-str)
727 wl-thread-space-str-internal
728 (or (nth 5 wl-summary-buffer-thread-indent-set)
729 wl-thread-space-str))
730 (setq wl-thread-indent-regexp
732 (regexp-quote wl-thread-have-younger-brother-str-internal) "\\|"
733 (regexp-quote wl-thread-youngest-child-str-internal) "\\|"
734 (regexp-quote wl-thread-vertical-str-internal) "\\|"
735 (regexp-quote wl-thread-horizontal-str-internal) "\\|"
736 (regexp-quote wl-thread-space-str-internal)))
737 (run-hooks 'wl-summary-buffer-set-folder-hook))
739 (defun wl-summary-mode ()
740 "Major mode for reading threaded messages.
741 See Info under Wanderlust for full documentation.
744 \\{wl-summary-mode-map}
746 Entering Folder mode calls the value of `wl-summary-mode-hook'."
748 (unless (interactive-p) (kill-all-local-variables))
749 (setq major-mode 'wl-summary-mode)
750 (setq mode-name "Summary")
751 (use-local-map wl-summary-mode-map)
752 ;;;(setq default-directory (or wl-tmp-dir (expand-file-name "~/")))
753 (setq buffer-read-only t)
754 (setq truncate-lines t)
755 ;;;(make-local-variable 'tab-width)
756 ;;;(setq tab-width 1)
757 (buffer-disable-undo (current-buffer))
758 (wl-mode-line-buffer-identification '("Wanderlust: "
759 wl-summary-buffer-folder-indicator
760 wl-summary-buffer-unread-status))
761 (easy-menu-add wl-summary-mode-menu)
762 ;; This hook may contain the function `wl-setup-summary' for reasons
763 ;; of system internal to accord facilities for the Emacs variants.
764 (run-hooks 'wl-summary-mode-hook))
766 (defun wl-summary-overview-entity-compare-by-date (x y)
767 "Compare entity X and Y by date."
770 (timezone-make-date-sortable
771 (elmo-msgdb-overview-entity-get-date x))
772 (timezone-make-date-sortable
773 (elmo-msgdb-overview-entity-get-date y)))
774 (error))) ;; ignore error.
776 (defun wl-summary-overview-entity-compare-by-number (x y)
777 "Compare entity X and Y by number."
779 (elmo-msgdb-overview-entity-get-number x)
780 (elmo-msgdb-overview-entity-get-number y)))
782 (defun wl-summary-overview-entity-compare-by-from (x y)
783 "Compare entity X and Y by from."
785 (wl-address-header-extract-address
786 (or (elmo-msgdb-overview-entity-get-from-no-decode x)
787 wl-summary-no-from-message))
788 (wl-address-header-extract-address
789 (or (elmo-msgdb-overview-entity-get-from-no-decode y)
790 wl-summary-no-from-message))))
792 (defun wl-summary-overview-entity-compare-by-subject (x y)
793 "Compare entity X and Y by subject."
794 (string< (elmo-msgdb-overview-entity-get-subject-no-decode x)
795 (elmo-msgdb-overview-entity-get-subject-no-decode y)))
797 (defun wl-summary-sort-by-date ()
799 (wl-summary-rescan "date"))
800 (defun wl-summary-sort-by-number ()
802 (wl-summary-rescan "number"))
803 (defun wl-summary-sort-by-subject ()
805 (wl-summary-rescan "subject"))
806 (defun wl-summary-sort-by-from ()
808 (wl-summary-rescan "from"))
810 (defun wl-summary-rescan (&optional sort-by)
811 "Rescan current folder without updating."
813 (let* ((cur-buf (current-buffer))
814 (msgdb (wl-summary-buffer-msgdb))
815 (overview (elmo-msgdb-get-overview msgdb))
816 (number-alist (elmo-msgdb-get-number-alist msgdb))
817 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
818 (elmo-mime-charset wl-summary-buffer-mime-charset)
822 (inhibit-read-only t)
823 (buffer-read-only nil)
825 (fset 'wl-summary-append-message-func-internal
826 (wl-summary-get-append-message-func))
827 (wl-summary-buffer-number-column-detect nil)
829 (message "Re-scanning...")
831 (setq num (length overview))
833 (message "Sorting by %s..." sort-by)
836 (intern (format "wl-summary-overview-entity-compare-by-%s"
838 (message "Sorting by %s...done" sort-by)
839 (elmo-msgdb-set-overview (wl-summary-buffer-msgdb)
843 (setq wl-thread-entity-hashtb (elmo-make-hash (* (length overview) 2)))
844 (setq wl-thread-entity-list nil)
845 (setq wl-thread-entities nil)
846 (setq wl-summary-buffer-target-mark-list nil)
847 (setq wl-summary-buffer-refile-list nil)
848 (setq wl-summary-buffer-delete-list nil)
849 (setq wl-summary-delayed-update nil)
850 (elmo-kill-buffer wl-summary-search-buf-name)
851 (message "Constructing summary structure...")
853 (setq entity (car curp))
854 (wl-summary-append-message-func-internal entity overview mark-alist
856 (setq curp (cdr curp))
857 (when (> num elmo-display-progress-threshold)
859 (if (or (zerop (% i 5)) (= i num))
860 (elmo-display-progress
861 'wl-summary-rescan "Constructing summary structure..."
862 (/ (* i 100) num)))))
863 (when wl-summary-delayed-update
864 (while wl-summary-delayed-update
865 (message "Parent (%d) of message %d is no entity"
866 (caar wl-summary-delayed-update)
867 (elmo-msgdb-overview-entity-get-number
868 (cdar wl-summary-delayed-update)))
869 (wl-summary-append-message-func-internal
870 (cdar wl-summary-delayed-update)
871 overview mark-alist nil t)
872 (setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
873 (message "Constructing summary structure...done")
875 (when (eq wl-summary-buffer-view 'thread)
876 (message "Inserting thread...")
877 (wl-thread-insert-top)
878 (message "Inserting thread...done"))
880 (setq wl-summary-scored nil)
881 (wl-summary-score-headers nil msgdb
882 (wl-summary-rescore-msgs number-alist)
884 (when (and wl-summary-scored
885 (setq expunged (wl-summary-score-update-all-lines)))
886 (message "%d message(s) are expunged by scoring." (length expunged))))
887 (wl-summary-set-message-modified)
888 (wl-summary-count-unread
889 (elmo-msgdb-get-mark-alist
890 (elmo-folder-msgdb-internal wl-summary-buffer-elmo-folder)))
891 (wl-summary-update-modeline)
892 (goto-char (point-max))
894 (set-buffer-modified-p nil)))
896 (defun wl-summary-next-folder-or-exit (&optional next-entity upward)
900 (wl-summary-toggle-disp-msg 'off)
903 (wl-summary-goto-folder-subr next-entity
909 (wl-folder-set-current-entity-id (wl-folder-get-entity-id next-entity))
910 (if (and (eq retval 'more-next)
911 (memq wl-auto-select-next '(unread skip-no-unread))
912 (memq this-command wl-summary-next-no-unread-command))
915 t (eq wl-auto-select-next 'skip-no-unread))
916 (goto-char (point-max))
919 t (eq wl-auto-select-next 'skip-no-unread))))))
922 (defun wl-summary-entity-info-msg (entity finfo)
925 (elmo-replace-in-string
926 (if (memq 'ask-folder wl-use-folder-petname)
927 (wl-folder-get-petname entity)
930 (if (null (car finfo))
933 " (%d new/%d unread)"
939 (defun wl-summary-set-message-modified ()
940 (elmo-folder-set-message-modified-internal
941 wl-summary-buffer-elmo-folder t)
942 (setq wl-summary-buffer-message-modified t))
943 (defun wl-summary-message-modified-p ()
944 wl-summary-buffer-message-modified)
945 (defun wl-summary-set-mark-modified ()
946 (elmo-folder-set-mark-modified-internal
947 wl-summary-buffer-elmo-folder t)
948 (setq wl-summary-buffer-mark-modified t))
949 (defun wl-summary-mark-modified-p ()
950 wl-summary-buffer-mark-modified)
951 (defun wl-summary-set-thread-modified ()
952 (setq wl-summary-buffer-thread-modified t))
953 (defun wl-summary-thread-modified-p ()
954 wl-summary-buffer-thread-modified)
956 (defsubst wl-summary-cleanup-temp-marks (&optional sticky)
957 (if (or wl-summary-buffer-refile-list
958 wl-summary-buffer-copy-list
959 wl-summary-buffer-delete-list)
960 (if (y-or-n-p "Marks remain to be executed. Execute them? ")
963 (if (or wl-summary-buffer-refile-list
964 wl-summary-buffer-copy-list
965 wl-summary-buffer-delete-list)
966 (error "Some execution was failed")))
969 (wl-summary-delete-all-refile-marks)
970 (wl-summary-delete-all-copy-marks)
971 (wl-summary-delete-all-delete-marks)))
972 (if wl-summary-buffer-target-mark-list
974 (wl-summary-delete-all-target-marks)
975 (setq wl-summary-buffer-target-mark-list nil)))
976 (wl-summary-delete-all-temp-marks-on-buffer sticky)
977 (setq wl-summary-scored nil))
979 ;; a subroutine for wl-summary-exit/wl-save-status
980 ;; Note that folder is not commited here.
981 (defun wl-summary-save-view (&optional sticky)
982 ;; already in summary buffer.
983 (when wl-summary-buffer-persistent
984 ;; save the current summary buffer view.
985 (if (and wl-summary-cache-use
986 (or (wl-summary-message-modified-p)
987 (wl-summary-mark-modified-p)
988 (wl-summary-thread-modified-p)))
989 (wl-summary-save-view-cache))))
991 (defun wl-summary-force-exit ()
992 "Exit current summary. Buffer is deleted even the buffer is sticky."
994 (wl-summary-exit 'force-exit))
996 (defun wl-summary-exit (&optional force-exit)
997 "Exit current summary. if FORCE-EXIT, exits even the summary is sticky."
999 (let ((summary-buf (current-buffer))
1000 (sticky (wl-summary-sticky-p))
1002 message-buf message-win
1003 folder-buf folder-win)
1004 (if wl-summary-buffer-exit-func
1005 (funcall wl-summary-buffer-exit-func)
1006 (wl-summary-cleanup-temp-marks sticky)
1008 ;; save summary status
1012 (elmo-folder-close wl-summary-buffer-elmo-folder)
1013 (elmo-folder-commit wl-summary-buffer-elmo-folder)
1014 (elmo-folder-check wl-summary-buffer-elmo-folder))
1015 (wl-summary-save-view sticky)
1016 (if wl-use-scoring (wl-score-save)))
1017 ;; for sticky summary
1018 (wl-delete-all-overlays)
1019 (setq wl-summary-buffer-disp-msg nil)
1020 (elmo-kill-buffer wl-summary-search-buf-name)
1021 ;; delete message window if displayed.
1022 (if (and wl-message-buffer (get-buffer-window wl-message-buffer))
1023 (delete-window (get-buffer-window wl-message-buffer)))
1024 (if (setq folder-buf (get-buffer wl-folder-buffer-name))
1025 (if (setq folder-win (get-buffer-window folder-buf))
1026 ;; folder win is already displayed.
1027 (select-window folder-win)
1028 ;; folder win is not displayed.
1029 (switch-to-buffer folder-buf))
1030 ;; currently no folder buffer
1032 (and wl-folder-move-cur-folder
1033 wl-folder-buffer-cur-point
1034 (goto-char wl-folder-buffer-cur-point))
1035 (setq wl-folder-buffer-cur-path nil)
1036 (setq wl-folder-buffer-cur-entity-id nil)
1037 (wl-delete-all-overlays)
1038 (if wl-summary-exit-next-move
1039 (wl-folder-next-unsync t)
1040 (beginning-of-line))
1041 (if (setq summary-win (get-buffer-window summary-buf))
1042 (delete-window summary-win))
1046 (set-buffer summary-buf)
1047 (kill-buffer summary-buf)))
1048 (run-hooks 'wl-summary-exit-hook)))))
1050 (defun wl-summary-sync-force-update (&optional unset-cursor)
1052 (wl-summary-sync-update unset-cursor))
1054 (defsubst wl-summary-sync-all-init ()
1055 (wl-summary-cleanup-temp-marks)
1057 (wl-summary-set-message-modified)
1058 (wl-summary-set-mark-modified)
1059 (setq wl-thread-entity-hashtb (elmo-make-hash
1060 (* (length (elmo-msgdb-get-number-alist
1061 (wl-summary-buffer-msgdb))) 2)))
1062 (setq wl-thread-entity-list nil)
1063 (setq wl-thread-entities nil)
1064 (setq wl-summary-buffer-target-mark-list nil)
1065 (setq wl-summary-buffer-refile-list nil)
1066 (setq wl-summary-buffer-copy-list nil)
1067 (setq wl-summary-buffer-delete-list nil)
1068 (wl-summary-buffer-number-column-detect nil))
1070 (defun wl-summary-sync (&optional unset-cursor force-range)
1072 (let* ((folder wl-summary-buffer-elmo-folder)
1073 (inhibit-read-only t)
1074 (buffer-read-only nil)
1075 (msgdb-dir (elmo-folder-msgdb-path folder))
1076 (range (or force-range (wl-summary-input-range
1077 (elmo-folder-name-internal folder)))))
1078 (cond ((string= range "rescan")
1079 (let ((msg (wl-summary-message-number)))
1081 (and msg (wl-summary-jump-to-msg msg))))
1082 ((string= range "rescan-noscore")
1083 (let ((msg (wl-summary-message-number))
1086 (and msg (wl-summary-jump-to-msg msg))))
1087 ((or (string-match "last:" range)
1088 (string-match "first:" range))
1089 (wl-summary-goto-folder-subr
1090 (wl-folder-get-elmo-folder (concat "/" range "/"
1091 (elmo-folder-name-internal
1093 'force-update nil nil t))
1095 (wl-summary-sync-update unset-cursor
1096 (string= range "all"))))))
1098 (defvar wl-summary-edit-addresses-candidate-fields
1099 ;; First element becomes default.
1100 '("from" "to" "cc"))
1102 (defun wl-summary-edit-addresses-collect-candidate-fields (mime-charset)
1103 (let ((fields wl-summary-edit-addresses-candidate-fields)
1104 body candidates components)
1107 (mapconcat 'identity (elmo-multiple-field-body (car fields))
1109 (setq body (wl-parse-addresses body))
1110 (if body (setq candidates (append candidates body)))
1111 (setq fields (cdr fields)))
1112 (setq candidates (elmo-uniq-list candidates))
1114 (elmo-set-buffer-multibyte default-enable-multibyte-characters)
1117 (setq components (std11-extract-address-components x))
1118 (cons (nth 1 components)
1119 (and (car components)
1120 (eword-decode-string
1121 (decode-mime-charset-string
1126 (defun wl-summary-edit-addresses-subr (the-email name-in-addr)
1127 ;; returns nil if there's no change.
1128 (if (elmo-get-hash-val (downcase the-email) wl-address-petname-hash)
1130 (message (format "'%s' already exists. (e)dit/(d)elete/(c)ancel?"
1132 (while (not (or (eq (setq char (read-char)) ?\r)
1139 "Please answer `e' or `d' or `c'. (e)dit/(d)elete/(c)ancel?"))
1146 (wl-address-petname-add-or-change
1148 (elmo-get-hash-val the-email wl-address-petname-hash)
1149 (wl-address-header-extract-realname
1151 (let ((completion-ignore-case t) comp)
1153 (try-completion the-email wl-address-completion-list))
1154 (if (equal comp t) the-email comp))
1155 wl-address-completion-list))) t)
1159 (if (y-or-n-p (format "Delete '%s'? "
1162 (wl-address-petname-delete the-email)
1169 (wl-address-petname-add-or-change
1170 the-email name-in-addr name-in-addr)
1173 (defun wl-summary-edit-addresses (&optional addr-str)
1174 "Edit address book interactively.
1175 Optional argument ADDR-STR is used as a target address if specified."
1176 (interactive (if current-prefix-arg
1177 (list (read-from-minibuffer "Target address: "))))
1178 (if (null (wl-summary-message-number))
1179 (message "No message.")
1181 (wl-summary-set-message-buffer-or-redisplay)
1182 (let* ((charset wl-summary-buffer-mime-charset)
1184 (with-current-buffer (wl-message-get-original-buffer)
1185 (wl-summary-edit-addresses-collect-candidate-fields
1187 address pair result)
1189 (setq address addr-str)
1191 (setq address (car (car candidates)))
1194 (format "Target address (%s): " address)
1196 (function (lambda (x) (cons (car x) (car x))))
1198 nil nil nil nil address))))
1200 (setq pair (assoc address candidates))
1202 (setq pair (cons address nil)))
1203 (when (setq result (wl-summary-edit-addresses-subr (car pair) (cdr pair)))
1206 (setq address (assoc (car pair) wl-address-list))
1208 (message "%s, %s, <%s> is %s."
1213 ;;; i'd like to update summary-buffer, but...
1214 ;;; (wl-summary-rescan)
1215 (run-hooks 'wl-summary-edit-addresses-hook))))))
1217 (defun wl-summary-incorporate (&optional arg)
1218 "Check and prefetch all uncached messages.
1219 If ARG is non-nil, checking is omitted."
1223 (wl-summary-sync-force-update)))
1224 (wl-summary-prefetch-region (point-min) (point-max)
1225 wl-summary-incorporate-marks))
1227 (defun wl-summary-prefetch-msg (number &optional arg)
1228 "Returns status-mark. if skipped, returns nil."
1229 ;; prefetching procedure.
1231 (let* ((msgdb (wl-summary-buffer-msgdb))
1232 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1233 (number-alist (elmo-msgdb-get-number-alist msgdb))
1234 (message-id (cdr (assq number number-alist)))
1235 (ov (assoc message-id
1236 (elmo-msgdb-get-overview msgdb)))
1238 (size (elmo-msgdb-overview-entity-get-size ov))
1239 (inhibit-read-only t)
1240 (buffer-read-only nil)
1241 (force-read (and size
1242 (or (null wl-prefetch-threshold)
1243 (< size wl-prefetch-threshold))))
1246 (null (elmo-file-cache-exists-p message-id)))
1249 (when (and size (not force-read) wl-prefetch-confirm)
1255 "Message from %s has %d bytes. Prefetch it? "
1259 (wl-set-string-width
1261 (wl-summary-from-func-internal
1262 (eword-decode-string
1266 (elmo-msgdb-overview-entity-get-from ov)
1269 (message "")) ; flush.
1270 (setq mark (cadr (assq number mark-alist)))
1274 (if (and (null (elmo-folder-plugged-p
1275 wl-summary-buffer-elmo-folder))
1276 elmo-enable-disconnected-operation)
1277 (progn;; append-queue for offline
1278 (elmo-dop-prefetch-msgs
1279 wl-summary-buffer-elmo-folder (list number))
1284 wl-summary-unread-uncached-mark)
1285 wl-summary-unread-cached-mark)
1286 ((string= mark wl-summary-new-mark)
1287 (setq wl-summary-buffer-new-count
1288 (- wl-summary-buffer-new-count 1))
1289 (setq wl-summary-buffer-unread-count
1290 (+ wl-summary-buffer-unread-count 1))
1291 wl-summary-unread-cached-mark)
1293 (string= mark wl-summary-read-uncached-mark))
1294 (setq wl-summary-buffer-unread-count
1295 (+ wl-summary-buffer-unread-count 1))
1296 wl-summary-unread-cached-mark)
1299 (elmo-message-encache
1300 wl-summary-buffer-elmo-folder
1305 wl-summary-unread-uncached-mark)
1306 wl-summary-unread-cached-mark)
1307 ((string= mark wl-summary-new-mark)
1308 (setq wl-summary-buffer-new-count
1309 (- wl-summary-buffer-new-count 1))
1310 (setq wl-summary-buffer-unread-count
1311 (+ wl-summary-buffer-unread-count 1))
1312 wl-summary-unread-cached-mark)
1313 ((string= mark wl-summary-read-uncached-mark)
1316 (setq mark-alist (elmo-msgdb-mark-set
1317 mark-alist number new-mark))
1318 (or new-mark (setq new-mark " "))
1319 (elmo-msgdb-set-mark-alist msgdb mark-alist)
1320 (wl-summary-set-mark-modified)
1321 (wl-summary-update-modeline)
1322 (wl-folder-update-unread
1323 (wl-summary-buffer-folder-name)
1324 (+ wl-summary-buffer-unread-count
1325 wl-summary-buffer-new-count)))
1328 ;;(defvar wl-summary-message-uncached-marks
1329 ;; (list wl-summary-new-mark
1330 ;; wl-summary-unread-uncached-mark
1331 ;; wl-summary-read-uncached-mark))
1333 (defun wl-summary-prefetch-region (beg end &optional prefetch-marks)
1341 (setq start-pos (point))
1343 (narrow-to-region beg end)
1344 ;; collect prefetch targets.
1345 (message "Collecting marks...")
1346 (goto-char (point-min))
1349 (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
1350 (setq mark (wl-match-buffer 2))
1351 (setq msg (string-to-int (wl-match-buffer 1)))
1352 (if (or (and (null prefetch-marks)
1354 (null (elmo-file-cache-exists-p
1356 (elmo-msgdb-get-number-alist
1357 (wl-summary-buffer-msgdb)))))))
1358 (member mark prefetch-marks))
1359 (setq targets (nconc targets (list msg))))
1360 (setq entity (wl-thread-get-entity msg))
1361 (if (or (not (eq wl-summary-buffer-view 'thread))
1362 (wl-thread-entity-get-opened entity))
1363 (); opened. no hidden children.
1364 ;; hidden children!!
1365 (setq targets (nconc
1367 (wl-thread-get-children-msgs-uncached
1368 msg prefetch-marks)))))
1370 (setq length (length targets))
1371 (message "Prefetching...")
1373 (setq mark (if (not (wl-thread-entity-parent-invisible-p
1374 (wl-thread-get-entity (car targets))))
1376 (wl-summary-jump-to-msg (car targets))
1377 (wl-summary-prefetch))
1378 (wl-summary-prefetch-msg (car targets))))
1379 (if (if prefetch-marks
1380 (string= mark wl-summary-unread-cached-mark)
1381 (or (string= mark wl-summary-unread-cached-mark)
1382 (string= mark " ")))
1383 (message "Prefetching... %d/%d message(s)"
1384 (setq count (+ 1 count)) length))
1388 (goto-char start-pos)
1389 (if (pos-visible-in-window-p pos)
1393 (setq targets (cdr targets)))
1394 (message "Prefetched %d/%d message(s)" count length)
1395 (cons count length)))))
1397 (defun wl-summary-prefetch (&optional arg)
1398 "Prefetch current message."
1403 (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
1404 (goto-char (match-beginning 2))
1405 (let ((inhibit-read-only t)
1406 (buffer-read-only nil)
1408 (setq mark (wl-summary-prefetch-msg
1409 (string-to-int (wl-match-buffer 1)) arg))
1411 (delete-region (match-beginning 2)
1414 (if wl-summary-highlight
1415 (wl-highlight-summary-current-line)))
1416 (set-buffer-modified-p nil)
1419 (defun wl-summary-delete-all-status-marks-on-buffer ()
1422 (goto-char (point-min))
1423 (let ((inhibit-read-only t)
1424 (buffer-read-only nil)
1425 (case-fold-search nil))
1426 (while (re-search-forward
1427 (concat "^" wl-summary-buffer-number-regexp ".\\(.\\)") nil t)
1428 (delete-region (match-beginning 1) (match-end 1))
1431 (defun wl-summary-delete-marks-on-buffer (marks)
1433 (wl-summary-unmark (pop marks))))
1435 (defun wl-summary-delete-copy-marks-on-buffer (copies)
1436 (wl-summary-delete-marks-on-buffer copies))
1438 (defun wl-summary-delete-all-refile-marks ()
1439 (let ((marks wl-summary-buffer-refile-list))
1441 (wl-summary-unmark (car (pop marks))))))
1443 (defun wl-summary-delete-all-copy-marks ()
1444 (let ((marks wl-summary-buffer-copy-list))
1446 (wl-summary-unmark (car (pop marks))))))
1448 (defun wl-summary-delete-all-delete-marks ()
1449 (wl-summary-delete-marks-on-buffer wl-summary-buffer-delete-list))
1451 (defun wl-summary-delete-all-target-marks ()
1452 (wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list))
1454 (defun wl-summary-delete-all-temp-marks-on-buffer (&optional sticky)
1455 ;; for summary view cache saving.
1458 (goto-char (point-min))
1459 (let ((inhibit-read-only t)
1460 (buffer-read-only nil)
1461 (case-fold-search nil)
1462 (regexp (concat "^" wl-summary-buffer-number-regexp "\\([^ ]\\)" )))
1463 (while (re-search-forward regexp nil t)
1464 (delete-region (match-beginning 1) (match-end 1))
1466 (if (and sticky wl-summary-highlight)
1467 (wl-highlight-summary-current-line))))))
1469 (defun wl-summary-delete-all-marks (mark-alist mark)
1470 "Delete all MARKs in MARK-ALIST."
1471 (let ((malist mark-alist)
1472 (ret-val mark-alist)
1475 (setq entity (car malist))
1476 (if (string= (cadr entity) mark)
1477 ;; delete this entity
1478 (setq ret-val (delete entity ret-val)))
1479 (setq malist (cdr malist)))
1482 ;; Does not work correctly...
1483 (defun wl-summary-mark-as-read-region (beg end)
1487 (narrow-to-region beg end)
1489 ;;; (save-excursion (goto-char end)
1490 ;;; (end-of-line) (point)))
1491 (goto-char (point-min))
1492 (if (eq wl-summary-buffer-view 'thread)
1495 (let* ((number (wl-summary-message-number))
1496 (entity (wl-thread-get-entity number))
1498 (if (wl-thread-entity-get-opened entity)
1499 ;; opened...mark line.
1500 ;; Crossposts are not processed
1501 (wl-summary-mark-as-read t)
1503 (wl-summary-mark-as-read t) ; mark itself.
1504 (setq children (wl-thread-get-children-msgs number))
1506 (wl-summary-mark-as-read t nil nil (car children))
1507 (setq children (cdr children))))
1510 (wl-summary-mark-as-read t)
1511 (forward-line 1)))))
1512 (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1513 (wl-summary-update-modeline))
1515 (defun wl-summary-mark-as-unread-region (beg end)
1519 (narrow-to-region beg end)
1521 ;;; (save-excursion (goto-char end)
1522 ;;; (end-of-line) (point)))
1523 (goto-char (point-min))
1524 (if (eq wl-summary-buffer-view 'thread)
1527 (let* ((number (wl-summary-message-number))
1528 (entity (wl-thread-get-entity number))
1530 (if (wl-thread-entity-get-opened entity)
1531 ;; opened...mark line.
1532 ;; Crossposts are not processed
1533 (wl-summary-mark-as-unread)
1535 (wl-summary-mark-as-unread) ; mark itself.
1537 (delq number (wl-thread-get-children-msgs number)))
1539 (wl-summary-mark-as-unread (car children))
1540 (setq children (cdr children))))
1543 (wl-summary-mark-as-unread)
1544 (forward-line 1)))))
1545 (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1546 (wl-summary-update-modeline))
1548 (defun wl-summary-mark-as-important-region (beg end)
1552 (narrow-to-region beg end);(save-excursion (goto-char end)
1553 ; (end-of-line) (point)))
1554 (goto-char (point-min))
1555 (if (eq wl-summary-buffer-view 'thread)
1558 (let* ((number (wl-summary-message-number))
1559 (entity (wl-thread-get-entity number))
1561 (if (wl-thread-entity-get-opened entity)
1562 ;; opened...mark line.
1563 ;; Crossposts are not processed
1564 (wl-summary-mark-as-important)
1566 (wl-summary-mark-as-important) ; mark itself.
1568 (delq number (wl-thread-get-children-msgs number)))
1570 (wl-thread-msg-mark-as-important (car children))
1571 (setq children (cdr children))))
1574 (wl-summary-mark-as-important)
1575 (forward-line 1)))))
1576 (wl-summary-count-unread (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1577 (wl-summary-update-modeline))
1579 (defun wl-summary-mark-as-read-all ()
1581 (if (or (not (interactive-p))
1582 (y-or-n-p "Mark all messages as read? "))
1583 (let* ((folder wl-summary-buffer-elmo-folder)
1584 (cur-buf (current-buffer))
1585 (msgdb (wl-summary-buffer-msgdb))
1586 ;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
1587 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1589 (inhibit-read-only t)
1590 (buffer-read-only nil)
1591 (case-fold-search nil)
1593 (message "Setting all msgs as read...")
1594 (elmo-folder-mark-as-read folder (wl-summary-collect-unread mark-alist))
1596 (goto-char (point-min))
1597 (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9 ]\\)" nil t)
1598 (setq msg (string-to-int (wl-match-buffer 1)))
1599 (setq mark (wl-match-buffer 2))
1600 (when (and (not (string= mark wl-summary-important-mark))
1601 (not (string= mark wl-summary-read-uncached-mark)))
1602 (delete-region (match-beginning 2) (match-end 2))
1603 (if (or (not (elmo-message-use-cache-p folder msg))
1604 (string= mark wl-summary-unread-cached-mark))
1608 (elmo-msgdb-mark-set
1611 ;;; Use msg instead of (cdr (assq msg number-alist)).
1612 ;;; (cdr (assq msg number-alist))
1614 ;; New mark and unread-uncached mark
1615 (insert wl-summary-read-uncached-mark)
1617 (elmo-msgdb-mark-set mark-alist
1619 ;;; (cdr (assq msg number-alist))
1620 wl-summary-read-uncached-mark)))
1621 (if wl-summary-highlight
1622 (wl-highlight-summary-current-line nil nil t)))))
1623 (setq mark-alist (wl-summary-set-as-read-mark-alist mark-alist))
1624 (wl-summary-set-mark-modified)
1625 (set-buffer cur-buf); why is this needed???
1626 (elmo-msgdb-set-mark-alist msgdb mark-alist)
1627 (wl-folder-update-unread (wl-summary-buffer-folder-name) 0)
1628 (setq wl-summary-buffer-unread-count 0)
1629 (setq wl-summary-buffer-new-count 0)
1630 (wl-summary-update-modeline)
1631 (message "Setting all msgs as read...done")
1632 (set-buffer-modified-p nil))))
1634 (defun wl-summary-delete-cache ()
1635 "Delete cache of current message."
1638 (let* ((inhibit-read-only t)
1639 (buffer-read-only nil)
1640 (folder wl-summary-buffer-elmo-folder)
1641 (msgdb (wl-summary-buffer-msgdb))
1642 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1643 (number-alist (elmo-msgdb-get-number-alist msgdb))
1644 (case-fold-search nil)
1645 mark number unread new-mark)
1646 ;;; (re-search-backward "^ *[0-9]+..[0-9]+/[0-9]+" nil t) ; set cursor line
1648 (when (looking-at "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)")
1650 (setq mark (wl-match-buffer 2))
1652 ((or (string= mark wl-summary-new-mark)
1653 (string= mark wl-summary-unread-uncached-mark)
1654 (string= mark wl-summary-important-mark))
1657 ((string= mark wl-summary-unread-cached-mark)
1658 (setq new-mark wl-summary-unread-uncached-mark))
1660 (setq new-mark wl-summary-read-uncached-mark)))
1662 (setq number (string-to-int (wl-match-buffer 1)))
1663 (delete-region (match-beginning 2) (match-end 2))
1664 (goto-char (match-beginning 2))
1666 (elmo-file-cache-delete
1667 (elmo-message-field wl-summary-buffer-elmo-folder
1671 (elmo-msgdb-mark-set mark-alist number new-mark))
1672 (elmo-msgdb-set-mark-alist msgdb mark-alist)
1673 (wl-summary-set-mark-modified)
1674 (if wl-summary-highlight
1675 (wl-highlight-summary-current-line nil nil t))
1676 (set-buffer-modified-p nil)))))))
1678 (defun wl-summary-resume-cache-status ()
1679 "Resume the cache status of all messages in the current folder."
1681 (let* ((folder wl-summary-buffer-elmo-folder)
1682 (cur-buf (current-buffer))
1683 (msgdb (wl-summary-buffer-msgdb))
1684 (number-alist (elmo-msgdb-get-number-alist msgdb))
1685 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1686 (inhibit-read-only t)
1687 (buffer-read-only nil)
1688 (case-fold-search nil)
1689 msg mark msgid set-mark)
1690 (message "Resuming cache status...")
1692 (goto-char (point-min))
1693 (while (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" nil t)
1694 (setq msg (string-to-int
1695 (wl-match-buffer 1)))
1696 (setq mark (wl-match-buffer 2))
1697 (setq msgid (cdr (assq msg number-alist)))
1699 (if (elmo-file-cache-exists-p msgid)
1701 (string= mark wl-summary-unread-uncached-mark) ; U -> !
1702 (string= mark wl-summary-new-mark) ; N -> !
1704 (setq set-mark wl-summary-unread-cached-mark)
1705 (if (string= mark wl-summary-read-uncached-mark) ; u -> ' '
1706 (setq set-mark " ")))
1707 (if (string= mark " ")
1708 (setq set-mark wl-summary-read-uncached-mark) ;' ' -> u
1709 (if (string= mark wl-summary-unread-cached-mark)
1710 (setq set-mark wl-summary-unread-uncached-mark) ; ! -> U
1713 (delete-region (match-beginning 2) (match-end 2))
1716 (elmo-msgdb-mark-set
1717 mark-alist msg ; msgid
1718 (if (string= set-mark " ") nil set-mark)))
1719 (if wl-summary-highlight
1720 (wl-highlight-summary-current-line))))
1721 (wl-summary-set-mark-modified)
1722 (set-buffer cur-buf); why is this needed???
1723 (elmo-msgdb-set-mark-alist msgdb mark-alist)
1724 (wl-summary-count-unread mark-alist)
1725 (wl-summary-update-modeline)
1726 (message "Resuming cache status...done")
1727 (set-buffer-modified-p nil))))
1729 (defun wl-summary-resume-marks-and-highlight ()
1730 (let* ((msgdb (wl-summary-buffer-msgdb))
1731 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1732 ;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
1733 (count (count-lines (point-min)(point-max)))
1735 msg-num percent smark)
1737 (goto-char (point-min))
1738 (message "Resuming all marks...")
1740 (setq msg-num (wl-summary-message-number))
1741 (setq smark (car (cdr (assq msg-num mark-alist))))
1742 (if (looking-at (format "^ *%s \\( \\)" msg-num))
1744 (goto-char (match-end 1))
1745 (delete-region (match-beginning 1) (match-end 1))
1746 (insert (or smark " "))))
1747 (wl-highlight-summary-current-line smark)
1748 (when (> count elmo-display-progress-threshold)
1750 (setq percent (/ (* i 100) count))
1751 (elmo-display-progress
1752 'wl-summary-resume-marks-and-highlight "Resuming all marks..."
1755 (message "Resuming all marks...done")))
1757 (defun wl-summary-resume-marks ()
1758 (let* ((msgdb (wl-summary-buffer-msgdb))
1759 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
1760 (number-alist (elmo-msgdb-get-number-alist msgdb))
1761 (count (length mark-alist))
1763 entity msg-num percent)
1765 (message "Resuming all marks...")
1767 (setq entity (car mark-alist))
1768 (if (setq msg-num (car (rassoc (car entity) number-alist)))
1770 ;;; (goto-char (point-min))
1771 (if (re-search-forward (format "^ *%s \\( \\)" msg-num) nil t)
1773 (delete-region (match-beginning 1) (match-end 1))
1774 (insert (or (cadr entity)
1776 (if (re-search-backward (format "^ *%s \\( \\)" msg-num) nil t)
1778 (goto-char (match-end 1))
1779 (delete-region (match-beginning 1) (match-end 1))
1780 (insert (or (cadr entity)
1782 (when (> count elmo-display-progress-threshold)
1784 (setq percent (/ (* i 100) count))
1785 (elmo-display-progress
1786 'wl-summary-resume-marks "Resuming all marks..."
1788 (setq mark-alist (cdr mark-alist)))
1789 (message "Resuming all marks...done"))))
1791 (defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info)
1794 (let ((inhibit-read-only t)
1795 (buffer-read-only nil)
1800 (elmo-kill-buffer wl-summary-search-buf-name)
1802 (if (eq wl-summary-buffer-view 'thread)
1804 ;; don't use wl-append(nconc), because list is broken. ...why?
1807 (wl-thread-delete-message (car msgs))))
1808 (setq update-list (delq (car msgs) update-list)))
1809 (goto-char (point-min))
1810 (if (re-search-forward (format "^ *%d[^0-9]\\([^0-9]\\).*$"
1813 (delete-region (match-beginning 0) (match-end 0))
1814 (delete-char 1) ; delete '\n'
1816 (when (and deleting-info
1817 (> len elmo-display-progress-threshold))
1819 (if (or (zerop (% i 5)) (= i len))
1820 (elmo-display-progress
1821 'wl-summary-delete-messages-on-buffer deleting-info
1822 (/ (* i 100) len))))
1823 (setq msgs (cdr msgs)))
1824 (when (eq wl-summary-buffer-view 'thread)
1825 (wl-thread-update-line-msgs (elmo-uniq-list update-list)
1826 (unless deleting-info 'no-msg))
1827 (wl-thread-cleanup-symbols msgs2))
1828 (wl-summary-count-unread
1829 (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
1830 (wl-summary-update-modeline)
1831 (wl-folder-update-unread
1832 (wl-summary-buffer-folder-name)
1833 (+ wl-summary-buffer-unread-count wl-summary-buffer-new-count)))))
1835 (defun wl-summary-set-as-read-mark-alist (mark-alist)
1836 (let ((marks (list (cons wl-summary-unread-cached-mark
1838 (cons wl-summary-unread-uncached-mark
1839 wl-summary-read-uncached-mark)
1840 (cons wl-summary-new-mark
1841 wl-summary-read-uncached-mark)))
1842 (ret-val mark-alist)
1845 (setq entity (car mark-alist))
1846 (when (setq pair (assoc (cadr entity) marks))
1847 (if (elmo-message-use-cache-p wl-summary-buffer-elmo-folder
1850 (setcar (cdr entity) (cdr pair))
1851 (setq ret-val (delete entity ret-val)))
1852 (setq ret-val (delete entity ret-val))))
1853 (setq mark-alist (cdr mark-alist)))
1856 (defun wl-summary-set-status-marks (mark-alist before after)
1857 "Set the BEFORE marks to AFTER."
1858 (let ((ret-val mark-alist)
1861 (setq entity (car mark-alist))
1862 (when (string= (cadr entity) before)
1864 (setcar (cdr entity) after)
1865 (setq ret-val (delete entity ret-val))))
1866 (setq mark-alist (cdr mark-alist)))
1869 (defun wl-summary-set-status-marks-on-buffer (before after)
1870 "Set the MARKS marks on buffer."
1873 (goto-char (point-min))
1874 (let ((inhibit-read-only t)
1875 (buffer-read-only nil)
1876 (regexp (concat "^" wl-summary-buffer-number-regexp ".\\(\\%s\\)")))
1877 (while (re-search-forward
1878 (format regexp (regexp-quote before)) nil t)
1879 (delete-region (match-beginning 1) (match-end 1))
1881 (if wl-summary-highlight
1882 (wl-highlight-summary-current-line))))))
1884 (defun wl-summary-get-delete-folder (folder)
1885 (if (string= folder wl-trash-folder)
1887 (let* ((type (or (wl-get-assoc-list-value wl-delete-folder-alist folder)
1889 (cond ((stringp type)
1891 ((or (equal type 'remove) (equal type 'null))
1893 (t;; (equal type 'trash)
1894 wl-trash-folder)))))
1896 (defun wl-summary-delete-important-msgs-from-list (delete-list
1898 (let ((dlist delete-list))
1900 (if (string= wl-summary-important-mark
1901 (car (cdr (assq (car dlist) mark-alist))))
1902 (setq delete-list (delete (car dlist) delete-list)))
1903 (setq dlist (cdr dlist)))
1906 (defun wl-summary-delete-canceled-msgs-from-list (delete-list msgdb)
1907 (let ((dlist delete-list))
1909 (if (null (cdr (assq (car dlist) (cadr msgdb))))
1910 (setq delete-list (delete (car dlist) delete-list)))
1911 (setq dlist (cdr dlist)))
1914 (defun wl-summary-get-append-message-func ()
1915 (if (eq wl-summary-buffer-view 'thread)
1916 'wl-summary-insert-thread-entity
1917 ;;; 'wl-summary-insert-thread
1918 'wl-summary-insert-summary))
1920 (defun wl-summary-sort ()
1922 (let ((sort-by (let ((input-range-list '("number" "date" "subject" "from"))
1927 (format "Sort by (%s): " default)
1929 (function (lambda (x) (cons x x)))
1934 (if (not (member sort-by '("number" "date" "subject" "from")))
1935 (error "Sort by %s is not implemented" sort-by))
1936 (wl-summary-rescan sort-by)))
1938 (defun wl-summary-sync-marks ()
1939 "Update marks in summary."
1941 (let ((last-progress 0)
1943 mark-alist unread-marks importants unreads
1944 importants-in-db unreads-in-db diff diffs
1945 mes num-ma progress)
1946 ;; synchronize marks.
1947 (when (not (eq (elmo-folder-type-internal
1948 wl-summary-buffer-elmo-folder)
1950 (message "Updating marks...")
1951 (setq unread-marks (list wl-summary-unread-cached-mark
1952 wl-summary-unread-uncached-mark
1953 wl-summary-new-mark)
1954 mark-alist (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb))
1955 num-ma (length mark-alist)
1956 importants (elmo-folder-list-importants
1957 wl-summary-buffer-elmo-folder
1958 wl-summary-important-mark)
1959 unreads (elmo-folder-list-unreads
1960 wl-summary-buffer-elmo-folder
1963 (if (string= (cadr (car mark-alist))
1964 wl-summary-important-mark)
1965 (setq importants-in-db (cons (car (car mark-alist))
1967 (if (member (cadr (car mark-alist)) unread-marks)
1968 (setq unreads-in-db (cons (car (car mark-alist))
1970 (setq mark-alist (cdr mark-alist))
1971 (when (> num-ma elmo-display-progress-threshold)
1973 progress (/ (* i 100) num-ma))
1974 (if (not (eq progress last-progress))
1975 (elmo-display-progress 'wl-summary-sync-marks
1978 (setq last-progress progress)))
1979 (setq diff (elmo-list-diff importants importants-in-db))
1980 (setq diffs (cadr diff)) ; important-deletes
1981 (setq mes (format "Updated (-%d" (length diffs)))
1983 (wl-summary-mark-as-important (car diffs)
1984 wl-summary-important-mark
1986 (setq diffs (cdr diffs)))
1987 (setq diffs (car diff)) ; important-appends
1988 (setq mes (concat mes (format "/+%d) important," (length diffs))))
1990 (wl-summary-mark-as-important (car diffs) " " 'no-server)
1991 (setq diffs (cdr diffs)))
1992 (setq diff (elmo-list-diff unreads unreads-in-db))
1993 (setq diffs (cadr diff))
1994 (setq mes (concat mes (format "(-%d" (length diffs))))
1996 (wl-summary-mark-as-read t 'no-server nil (car diffs))
1997 (setq diffs (cdr diffs)))
1998 (setq diffs (car diff)) ; unread-appends
1999 (setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs))))
2001 (wl-summary-mark-as-unread (car diffs) 'no-server 'no-modeline)
2002 (setq diffs (cdr diffs)))
2003 (if (interactive-p) (message mes)))))
2005 (defun wl-summary-confirm-appends (appends)
2006 (let ((len (length appends))
2008 (if (> len wl-summary-update-confirm-threshold)
2009 (if (y-or-n-p (format "Too many messages(%d). Continue? " len))
2011 (setq in wl-summary-update-confirm-threshold)
2014 (setq in (read-from-minibuffer "Update number: "
2016 in (string-to-int in))
2019 (if (y-or-n-p (format "%d messages are disappeared. OK? "
2020 (max (- len in) 0)))
2022 (nthcdr (max (- len in) 0) appends))
2025 (defun wl-summary-sync-update (&optional unset-cursor sync-all)
2026 "Update the summary view to the newest folder status."
2028 (let* ((folder wl-summary-buffer-elmo-folder)
2029 (case-fold-search nil)
2030 (elmo-mime-charset wl-summary-buffer-mime-charset)
2031 (inhibit-read-only t)
2032 (buffer-read-only nil)
2034 overview number-alist mark-alist
2035 curp num i new-msgdb
2036 append-list delete-list crossed
2037 update-thread update-top-list
2038 expunged mes sync-result)
2039 (unless wl-summary-buffer-elmo-folder
2040 (error "(Internal error) Folder is not set:%s" (buffer-name
2042 (fset 'wl-summary-append-message-func-internal
2043 (wl-summary-get-append-message-func))
2044 ;; Flush pending append operations (disconnected operation).
2046 ;;(wl-summary-flush-pending-append-operations seen-list))
2047 (goto-char (point-max))
2048 (wl-folder-confirm-existence folder 'force)
2049 (setq sync-result (elmo-folder-synchronize
2052 wl-summary-unread-uncached-mark
2053 wl-summary-unread-cached-mark
2054 wl-summary-read-uncached-mark
2055 wl-summary-important-mark
2057 (setq new-msgdb (nth 0 sync-result))
2058 (setq delete-list (nth 1 sync-result))
2059 (setq crossed (nth 2 sync-result))
2060 (if (or (and sync-all sync-result)
2064 (if sync-all (wl-summary-sync-all-init))
2066 ; (elmo-nntp-max-number-precedes-list-active-p))
2067 ;; XXX this does not work correctly in rare case.
2069 ; (wl-summary-delete-canceled-msgs-from-list
2071 ; (wl-summary-buffer-msgdb))))
2073 (wl-summary-delete-messages-on-buffer delete-list "Deleting...")
2074 (message "Deleting...done"))
2075 (wl-summary-set-status-marks-on-buffer
2077 wl-summary-unread-uncached-mark)
2078 (setq append-list (elmo-msgdb-get-overview new-msgdb))
2079 (setq curp append-list)
2080 (setq num (length curp))
2083 ;; set these value for append-message-func
2084 (setq overview (elmo-msgdb-get-overview
2085 (elmo-folder-msgdb-internal
2087 (setq number-alist (elmo-msgdb-get-number-alist
2088 (elmo-folder-msgdb-internal
2090 (setq mark-alist (elmo-msgdb-get-mark-alist
2091 (elmo-folder-msgdb-internal
2093 (setq wl-summary-delayed-update nil)
2094 (elmo-kill-buffer wl-summary-search-buf-name)
2096 (setq entity (car curp))
2097 (when (setq update-thread
2098 (wl-summary-append-message-func-internal
2099 entity overview mark-alist
2101 (wl-append update-top-list update-thread))
2102 (if elmo-use-database
2103 (elmo-database-msgid-put
2104 (car entity) (elmo-folder-name-internal folder)
2105 (elmo-msgdb-overview-entity-get-number entity)))
2106 (setq curp (cdr curp))
2107 (when (> num elmo-display-progress-threshold)
2109 (if (or (zerop (% i 5)) (= i num))
2110 (elmo-display-progress
2111 'wl-summary-sync-update "Updating thread..."
2112 (/ (* i 100) num)))))
2113 (when wl-summary-delayed-update
2114 (while wl-summary-delayed-update
2115 (message "Parent (%d) of message %d is no entity"
2116 (caar wl-summary-delayed-update)
2117 (elmo-msgdb-overview-entity-get-number
2118 (cdar wl-summary-delayed-update)))
2119 (when (setq update-thread
2120 (wl-summary-append-message-func-internal
2121 (cdar wl-summary-delayed-update)
2122 overview mark-alist (not sync-all) t))
2123 (wl-append update-top-list update-thread))
2124 (setq wl-summary-delayed-update
2125 (cdr wl-summary-delayed-update))))
2126 (when (and (eq wl-summary-buffer-view 'thread)
2128 (wl-thread-update-indent-string-thread
2129 (elmo-uniq-list update-top-list)))
2130 (message "Updating thread...done"))
2131 (wl-summary-set-message-modified)
2132 (wl-summary-set-mark-modified)
2133 (when (and sync-all (eq wl-summary-buffer-view 'thread))
2134 (elmo-kill-buffer wl-summary-search-buf-name)
2135 (message "Inserting thread...")
2136 (setq wl-thread-entity-cur 0)
2137 (wl-thread-insert-top)
2138 (message "Inserting thread...done"))
2139 (if elmo-use-database
2140 (elmo-database-close))
2141 (run-hooks 'wl-summary-sync-updated-hook)
2142 (setq mes (format "Updated (-%d/+%d) message(s)"
2143 (length delete-list) num)))
2145 "No updates for \"%s\"" (elmo-folder-name-internal folder))))
2146 ;; synchronize marks.
2147 (if wl-summary-auto-sync-marks
2148 (wl-summary-sync-marks))
2150 (when wl-use-scoring
2151 (setq wl-summary-scored nil)
2152 (wl-summary-score-headers nil (wl-summary-buffer-msgdb)
2154 (wl-summary-rescore-msgs number-alist))
2156 (when (and wl-summary-scored
2157 (setq expunged (wl-summary-score-update-all-lines)))
2158 (setq mes (concat mes
2159 (format " (%d expunged)"
2160 (length expunged))))))
2161 (if (and crossed (> crossed 0))
2165 (format " (%d crosspost)" crossed))
2166 (format "%d crosspost message(s)" crossed)))
2167 (and mes (setq mes (concat mes "."))))
2168 ;; Update Folder mode
2169 (wl-folder-set-folder-updated
2170 (elmo-folder-name-internal folder)
2172 (wl-summary-count-unread
2173 (elmo-msgdb-get-mark-alist
2174 (elmo-folder-msgdb-internal folder)))
2175 (elmo-folder-messages folder)))
2176 (wl-summary-update-modeline)
2177 (wl-summary-buffer-number-column-detect t)
2179 (unless unset-cursor
2180 (goto-char (point-min))
2181 (if (not (wl-summary-cursor-down t))
2183 (goto-char (point-max))
2185 (if (and wl-summary-highlight
2186 (not (get-text-property (point) 'face)))
2190 wl-summary-partial-highlight-above-lines
2191 wl-summary-highlight-partial-threshold)))
2192 (wl-highlight-summary (point) (point-max))))))
2193 (wl-delete-all-overlays)
2194 (set-buffer-modified-p nil)
2195 (if mes (message "%s" mes))))
2197 (defun wl-summary-set-score-mark (mark)
2200 (let ((inhibit-read-only t)
2201 (buffer-read-only nil)
2204 (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
2205 (setq msg-num (string-to-int (wl-match-buffer 1)))
2206 (setq cur-mark (wl-match-buffer 2))
2207 (when (member cur-mark (list " "
2208 wl-summary-score-below-mark
2209 wl-summary-score-over-mark))
2210 (goto-char (match-end 1))
2211 (delete-region (match-beginning 2) (match-end 2))
2213 (if wl-summary-highlight
2214 (wl-highlight-summary-current-line nil nil t))
2215 (set-buffer-modified-p nil))))))
2217 (defun wl-summary-get-score-mark (msg-num)
2218 (let ((score (cdr (assq msg-num wl-summary-scored))))
2220 (cond ((< score wl-summary-default-score)
2222 ((> score wl-summary-default-score)
2225 (defun wl-summary-update-modeline ()
2226 (setq wl-summary-buffer-unread-status
2227 (format " {%s}(%d new/%d unread)"
2228 (if (eq wl-summary-buffer-view 'thread)
2230 wl-summary-buffer-new-count
2231 (+ wl-summary-buffer-new-count
2232 wl-summary-buffer-unread-count))))
2234 (defsubst wl-summary-jump-to-msg (&optional number)
2236 (let ((num (or number
2238 (read-from-minibuffer "Jump to Message(No.): ")))))
2239 (setq num (int-to-string num))
2240 (if (re-search-forward (concat "^[ \t]*" num "[^0-9]") nil t)
2244 (if (re-search-backward (concat "^[ \t]*" num "[^0-9]") nil t)
2250 (defun wl-summary-highlight-msgs (msgs)
2252 (let ((len (length msgs))
2254 (message "Hilighting...")
2257 (if (wl-summary-jump-to-msg (car msgs))
2258 (wl-highlight-summary-current-line))
2259 (setq msgs (cdr msgs))
2260 (when (> len elmo-display-progress-threshold)
2262 (if (or (zerop (% i 5)) (= i len))
2263 (elmo-display-progress
2264 'wl-summary-highlight-msgs "Highlighting..."
2265 (/ (* i 100) len)))))
2266 (message "Highlighting...done"))))
2268 (defun wl-summary-message-number ()
2271 (if (looking-at "^ *\\([0-9]+\\)")
2272 (string-to-int (wl-match-buffer 1))
2275 (defun wl-summary-move (src dsts-msgs)
2276 (let* ((dsts (car dsts-msgs)) ; (+foo +bar)
2277 ;;; (msgs (cdr dsts-msgs)) ; (1 2 3)
2278 ;;; (msgdb (wl-summary-buffer-msgdb))
2282 (setq dsts (cdr dsts)))))
2284 (defun wl-summary-flush-pending-append-operations (&optional seen-list)
2285 "Execute append operations that are done while offline status."
2286 (when (and (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
2287 elmo-enable-disconnected-operation)
2288 (let* ((resumed-list (elmo-dop-append-list-load
2289 wl-summary-buffer-elmo-folder t))
2290 (append-list (elmo-dop-append-list-load
2291 wl-summary-buffer-elmo-folder))
2292 (appends (append resumed-list append-list))
2293 (number-alist (elmo-msgdb-get-number-alist
2294 (wl-summary-buffer-msgdb)))
2298 (if (setq pair (rassoc (car appends) number-alist))
2299 (setq dels (append dels (list (car pair)))))
2300 (setq appends (cdr appends)))
2303 (elmo-msgdb-add-msgs-to-seen-list
2305 (wl-summary-buffer-msgdb)
2306 (list wl-summary-unread-cached-mark
2307 wl-summary-unread-uncached-mark
2308 wl-summary-new-mark)
2310 (message "Resuming summary status...")
2311 (elmo-msgdb-delete-msgs wl-summary-buffer-elmo-folder
2313 (wl-summary-delete-messages-on-buffer dels)
2314 (message "Resuming summary status...done"))
2315 ;; delete resume-file
2316 (elmo-dop-append-list-save wl-summary-buffer-elmo-folder nil t)
2318 (elmo-dop-flush-pending-append-operations
2319 wl-summary-buffer-elmo-folder append-list)))))
2322 (defun wl-summary-delete-all-msgs ()
2324 (let ((cur-buf (current-buffer))
2325 (dels (elmo-folder-list-messages wl-summary-buffer-elmo-folder)))
2326 (set-buffer cur-buf)
2328 (message "No message to delete.")
2329 (if (y-or-n-p (format "%s has %d message(s). Delete all? "
2330 (wl-summary-buffer-folder-name)
2333 (message "Deleting...")
2334 (elmo-folder-delete-messages
2335 wl-summary-buffer-elmo-folder dels)
2336 (elmo-msgdb-delete-msgs wl-summary-buffer-elmo-folder
2339 ;;; (elmo-msgdb-save (wl-summary-buffer-folder-name) nil)
2340 (wl-summary-set-message-modified)
2341 (wl-summary-set-mark-modified)
2342 (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
2345 ;;; (setq wl-thread-top-entity '(nil t nil nil))
2346 (setq wl-summary-buffer-unread-count 0)
2347 (setq wl-summary-buffer-new-count 0)
2348 (wl-summary-update-modeline)
2349 (set-buffer cur-buf)
2350 (let ((inhibit-read-only t)
2351 (buffer-read-only nil))
2353 ;;; (if wl-summary-cache-use (wl-summary-save-view-cache))
2354 (message "Deleting...done")
2358 (defun wl-summary-toggle-thread (&optional arg)
2359 "Toggle thread status (T)hread and (S)equential.
2360 If ARG, without confirm."
2363 (y-or-n-p (format "Toggle threading? (y=%s): "
2364 (if (eq wl-summary-buffer-view 'thread)
2365 "\"off\"" "\"on\""))))
2366 (if (eq wl-summary-buffer-view 'thread)
2367 (setq wl-summary-buffer-view 'sequence)
2368 (setq wl-summary-buffer-view 'thread))
2369 (wl-summary-update-modeline)
2370 (force-mode-line-update)
2371 (wl-summary-rescan)))
2373 (defun wl-summary-load-file-object (filename)
2374 "Load lisp object from dir."
2376 (let ((tmp-buffer (get-buffer-create " *wl-summary-load-file-object*"))
2377 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
2378 insert-file-contents-post-hook
2380 (if (not (file-readable-p filename))
2382 (set-buffer tmp-buffer)
2383 (as-binary-input-file (insert-file-contents filename))
2386 (read (current-buffer))
2387 (error (error "Reading failed")))))
2388 (kill-buffer tmp-buffer)
2391 (defun wl-summary-goto-folder (&optional arg)
2393 (wl-summary-goto-folder-subr nil nil nil arg t))
2395 (defun wl-summary-goto-last-visited-folder ()
2398 (wl-folder-search-entity-by-name wl-summary-last-visited-folder
2401 (if entity (wl-folder-set-current-entity-id
2402 (wl-folder-get-entity-id entity))))
2403 (wl-summary-goto-folder-subr wl-summary-last-visited-folder nil nil nil t))
2405 (defun wl-summary-sticky-p (&optional folder)
2407 (get-buffer (wl-summary-sticky-buffer-name
2408 (elmo-folder-name-internal folder)))
2409 (not (string= wl-summary-buffer-name (buffer-name)))))
2411 (defun wl-summary-always-sticky-folder-p (folder)
2412 (or (eq t wl-summary-always-sticky-folder-list)
2413 (wl-string-match-member
2414 (elmo-folder-name-internal folder)
2415 wl-summary-always-sticky-folder-list)))
2417 (defun wl-summary-stick (&optional force)
2418 "Make current summary buffer sticky."
2420 (if (wl-summary-sticky-p)
2421 (message "Current summary buffer is already sticky.")
2422 (when (or force (y-or-n-p "Stick current summary buffer? "))
2423 (wl-summary-toggle-disp-msg 'off)
2424 (wl-summary-switch-to-clone-buffer
2425 (wl-summary-sticky-buffer-name
2426 (wl-summary-buffer-folder-name)))
2428 ;;; (rename-buffer (wl-summary-sticky-buffer-name
2429 ;;; (wl-summary-buffer-folder-name))))
2430 (message "Folder `%s' is now sticky." (wl-summary-buffer-folder-name)))))
2432 (defun wl-summary-switch-to-clone-buffer (buffer-name)
2433 (let ((cur-buf (current-buffer))
2434 (msg (wl-summary-message-number))
2435 (buf (get-buffer-create buffer-name))
2436 (folder wl-summary-buffer-elmo-folder)
2438 (append '(wl-summary-buffer-view
2439 wl-summary-buffer-refile-list
2440 wl-summary-buffer-delete-list
2441 wl-summary-buffer-copy-list
2442 wl-summary-buffer-target-mark-list
2443 wl-summary-buffer-elmo-folder
2444 wl-summary-buffer-number-column
2445 wl-summary-buffer-number-regexp
2446 wl-summary-buffer-message-modified
2447 wl-summary-buffer-mark-modified
2448 wl-summary-buffer-thread-modified)
2449 (and (eq wl-summary-buffer-view 'thread)
2450 '(wl-thread-entity-hashtb
2452 wl-thread-entity-list))
2455 wl-summary-default-score
2456 wl-summary-important-above
2457 wl-summary-temp-above
2458 wl-summary-mark-below
2459 wl-summary-expunge-below))
2460 (and (featurep 'wl-score)
2461 '(wl-current-score-file
2465 (wl-summary-buffer-set-folder folder)
2466 (let ((buffer-read-only nil))
2467 (insert-buffer cur-buf))
2468 (set-buffer-modified-p nil)
2469 (while copy-variables
2470 (set (car copy-variables)
2472 (set-buffer cur-buf)
2473 (symbol-value (car copy-variables))))
2474 (setq copy-variables (cdr copy-variables)))
2475 (switch-to-buffer buf)
2476 (kill-buffer cur-buf)
2477 (wl-summary-count-unread
2478 (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
2479 (wl-summary-update-modeline)
2481 (if (eq wl-summary-buffer-view 'thread)
2482 (wl-thread-jump-to-msg msg)
2483 (wl-summary-jump-to-msg msg))
2484 (goto-char (point-max))
2485 (beginning-of-line))))
2487 (defun wl-summary-get-buffer (folder)
2489 (get-buffer (wl-summary-sticky-buffer-name folder)))
2490 (get-buffer wl-summary-buffer-name)))
2492 (defun wl-summary-get-buffer-create (name &optional force-sticky)
2495 (wl-summary-sticky-buffer-name name))
2496 (or (get-buffer (wl-summary-sticky-buffer-name name))
2497 (get-buffer-create wl-summary-buffer-name))))
2499 (defun wl-summary-goto-folder-subr (&optional name scan-type other-window
2500 sticky interactive scoring)
2501 "Display target folder on summary."
2503 (let* ((keep-cursor (memq this-command
2504 wl-summary-keep-cursor-command))
2505 (name (or name (wl-summary-read-folder wl-default-folder)))
2506 (cur-fld wl-summary-buffer-elmo-folder)
2507 folder buf mes hilit reuse-buf
2509 (if (string= name "")
2510 (setq name wl-default-folder))
2511 (setq folder (wl-folder-get-elmo-folder name))
2512 (when (and (not (string=
2514 (elmo-folder-name-internal cur-fld))
2515 (elmo-folder-name-internal folder))) ; folder is moved.
2516 (eq major-mode 'wl-summary-mode)) ; called in summary.
2517 (setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name))
2518 (wl-summary-cleanup-temp-marks (wl-summary-sticky-p))
2519 (wl-summary-save-view 'keep) ; keep current buffer, anyway.
2520 (elmo-folder-commit wl-summary-buffer-elmo-folder))
2521 (setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder)
2526 (string= (elmo-folder-name-internal folder)
2527 (wl-summary-buffer-folder-name))))
2531 (switch-to-buffer buf)
2534 (delete-other-windows))
2536 (unless (eq major-mode 'wl-summary-mode)
2538 (wl-summary-buffer-set-folder folder)
2539 (setq wl-summary-buffer-disp-msg nil)
2540 (setq wl-summary-buffer-last-displayed-msg nil)
2541 (setq wl-summary-buffer-current-msg nil)
2542 (let ((case-fold-search nil)
2543 (inhibit-read-only t)
2544 (buffer-read-only nil))
2546 ;; resume summary cache
2547 (if wl-summary-cache-use
2548 (let* ((dir (elmo-folder-msgdb-path folder))
2549 (cache (expand-file-name wl-summary-cache-file dir))
2550 (view (expand-file-name wl-summary-view-file dir)))
2551 (when (file-exists-p cache)
2552 (as-binary-input-file
2553 (insert-file-contents cache))
2554 (elmo-set-buffer-multibyte
2555 default-enable-multibyte-characters)
2556 (decode-mime-charset-region
2557 (point-min)(point-max)
2558 wl-summary-buffer-mime-charset))
2559 (when (file-exists-p view)
2560 (setq wl-summary-buffer-view
2561 (wl-summary-load-file-object view)))
2562 (if (eq wl-summary-buffer-view 'thread)
2563 (wl-thread-resume-entity folder))))
2565 (elmo-folder-open folder)
2566 (wl-summary-count-unread
2567 (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
2568 (wl-summary-update-modeline)))
2569 (wl-summary-buffer-number-column-detect t)
2570 (wl-summary-toggle-disp-msg 'on)
2571 (unless (and reuse-buf keep-cursor)
2572 (setq hilit wl-summary-highlight)
2574 (let ((wl-summary-highlight (if reuse-buf wl-summary-highlight))
2576 (if (or scoring interactive) wl-use-scoring)))
2577 (if (and (not scan-type)
2580 (setq scan-type (wl-summary-get-sync-range folder)))
2583 (wl-summary-sync 'unset-cursor))
2584 ((eq scan-type 'all)
2585 (wl-summary-sync 'unset-cursor "all"))
2586 ((eq scan-type 'no-sync))
2587 ((or (eq scan-type 'force-update)
2588 (eq scan-type 'update))
2589 (setq mes (wl-summary-sync-force-update 'unset-cursor)))))
2591 (switch-to-buffer buf)
2593 ;; stick always-sticky-folder
2594 (when (wl-summary-always-sticky-folder-p folder)
2595 (or (wl-summary-sticky-p) (wl-summary-stick t)))
2596 (run-hooks 'wl-summary-prepared-pre-hook)
2597 (set-buffer-modified-p nil)
2598 (goto-char (point-min))
2599 (if (wl-summary-cursor-down t)
2600 (let ((unreadp (wl-thread-next-mark-p
2601 (wl-thread-entity-get-mark
2602 (wl-summary-message-number))
2603 wl-summary-move-order)))
2604 (cond ((and wl-auto-select-first unreadp)
2605 (setq retval 'disp-msg))
2607 (setq retval 'more-next))))
2608 (goto-char (point-max))
2609 (if (elmo-folder-plugged-p folder)
2612 (setq retval 'more-next))
2613 (setq wl-summary-highlight hilit)
2614 (if (and wl-summary-highlight
2616 (if (and wl-summary-highlight-partial-threshold
2617 (> (count-lines (point-min) (point-max))
2618 wl-summary-highlight-partial-threshold))
2623 wl-summary-partial-highlight-above-lines
2624 wl-summary-highlight-partial-threshold)))
2625 (wl-highlight-summary (point) (point-max)))
2626 (wl-highlight-summary (point-min) (point-max))))
2627 (if (eq retval 'disp-msg)
2628 (wl-summary-redisplay))
2629 (if mes (message "%s" mes))
2630 (if (and interactive wl-summary-recenter)
2631 (recenter (/ (- (window-height) 2) 2))))))
2632 ;; set current entity-id
2633 (if (and (not folder)
2635 (wl-folder-search-entity-by-name (elmo-folder-name-internal
2639 ;; entity-id is unknown.
2640 (wl-folder-set-current-entity-id
2641 (wl-folder-get-entity-id entity)))
2643 (run-hooks 'wl-summary-prepared-hook)
2644 (set-buffer-modified-p nil))
2647 (defun wl-summary-summary-line-already-exists-p (parent-number buffer)
2650 (goto-char (point-max))
2652 (when (re-search-backward (format "^ *%s..../..\(.*\)..:.. "
2653 parent-number) nil t)
2654 (goto-char (match-end 0))
2655 (while (string-match wl-thread-indent-regexp
2657 (char-after (point))))
2658 (setq depth (+ 1 depth))
2660 (/ depth wl-thread-indent-level-internal))))
2662 (defun wl-summary-goto-bottom-of-current-thread ()
2663 (if (re-search-forward (concat "^" wl-summary-buffer-number-regexp
2664 "..../..\(.*\)..:.. [[<]") nil t)
2666 (goto-char (point-max))))
2668 (defun wl-summary-goto-top-of-current-thread ()
2669 (wl-summary-jump-to-msg
2670 (wl-thread-entity-get-number
2671 (wl-thread-entity-get-top-entity (wl-thread-get-entity
2672 (wl-summary-message-number))))))
2674 (defun wl-summary-goto-bottom-of-sub-thread (&optional depth)
2676 (let ((depth (or depth
2677 (wl-thread-get-depth-of-current-line))))
2679 (while (and (not (eobp))
2680 (>= (wl-thread-get-depth-of-current-line)
2683 (beginning-of-line)))
2685 (defun wl-summary-insert-line (line)
2686 "Insert LINE in the Summary."
2687 (if wl-use-highlight-mouse-line
2688 ;; remove 'mouse-face of current line.
2690 (save-excursion (beginning-of-line)(point))
2691 (save-excursion (end-of-line)(point))
2694 (if wl-use-highlight-mouse-line
2695 ;; remove 'mouse-face of current line.
2697 (save-excursion (beginning-of-line)(point))
2698 (save-excursion (end-of-line)(point))
2700 (condition-case nil ; it's dangerous, so ignore error.
2701 (run-hooks 'wl-summary-line-inserted-hook)
2703 (message "Error in wl-summary-line-inserted-hook"))))
2705 (defun wl-summary-insert-summary (entity database mark-alist dummy &optional dummy)
2706 (let ((overview-entity entity)
2708 (setq msg (elmo-msgdb-overview-entity-get-number entity))
2709 (when (setq summary-line
2710 (wl-summary-overview-create-summary-line
2711 msg entity nil 0 mark-alist))
2712 (let ((inhibit-read-only t)
2714 (goto-char (point-max))
2715 (wl-summary-insert-line summary-line)))))
2717 (defun wl-summary-default-subject-filter (subject)
2718 (let ((case-fold-search t))
2719 (setq subject (elmo-replace-in-string subject "[ \t]*\\(re\\|was\\):" ""))
2720 (setq subject (elmo-replace-in-string subject "[ \t]" ""))
2721 (elmo-replace-in-string subject "^\\[.*\\]" "")))
2723 (defun wl-summary-subject-equal (subject1 subject2)
2724 (string= (wl-summary-subject-filter-func-internal subject1)
2725 (wl-summary-subject-filter-func-internal subject2)))
2727 (defmacro wl-summary-put-alike (alike)
2728 (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
2730 wl-summary-alike-hashtb)))
2732 (defmacro wl-summary-get-alike ()
2733 (` (elmo-get-hash-val (format "#%d" (wl-count-lines))
2734 wl-summary-alike-hashtb)))
2736 (defun wl-summary-insert-headers (overview func mime-decode)
2737 (let (ov this last alike)
2738 (buffer-disable-undo (current-buffer))
2739 (make-local-variable 'wl-summary-alike-hashtb)
2740 (setq wl-summary-alike-hashtb (elmo-make-hash (* (length overview) 2)))
2742 (elmo-set-buffer-multibyte default-enable-multibyte-characters))
2743 (while (setq ov (pop overview))
2744 (setq this (funcall func ov))
2745 (and this (setq this (std11-unfold-string this)))
2746 (if (equal last this)
2747 (wl-append alike (list ov))
2749 (wl-summary-put-alike alike)
2751 (setq alike (list ov)
2754 (wl-summary-put-alike alike)
2757 (decode-mime-charset-region (point-min) (point-max)
2759 (when (eq mime-decode 'mime)
2760 (eword-decode-region (point-min) (point-max))))
2761 (run-hooks 'wl-summary-insert-headers-hook)))
2763 (defun wl-summary-search-by-subject (entity overview)
2764 (let ((buf (get-buffer-create wl-summary-search-buf-name))
2765 (folder-name (wl-summary-buffer-folder-name))
2766 match founds found-entity)
2769 (let ((case-fold-search t))
2770 (when (or (not (string= wl-summary-search-buf-folder-name folder-name))
2771 (zerop (buffer-size)))
2772 (setq wl-summary-search-buf-folder-name folder-name)
2773 (wl-summary-insert-headers
2777 (wl-summary-subject-filter-func-internal
2778 (elmo-msgdb-overview-entity-get-subject-no-decode x))))
2780 (setq match (wl-summary-subject-filter-func-internal
2781 (elmo-msgdb-overview-entity-get-subject entity)))
2782 (if (string= match "")
2784 (goto-char (point-max))
2785 (while (and (not founds)
2786 (not (= (point) (point-min)))
2787 (search-backward match nil t))
2788 ;; check exactly match
2792 (setq found-entity (wl-summary-get-alike))
2793 (if (and found-entity
2794 ;; Is founded entity myself or children?
2796 (elmo-msgdb-overview-entity-get-id entity)
2797 (elmo-msgdb-overview-entity-get-id (car found-entity))))
2798 (not (wl-thread-descendant-p
2799 (elmo-msgdb-overview-entity-get-number entity)
2800 (elmo-msgdb-overview-entity-get-number (car found-entity)))))
2801 ;; return matching entity
2802 (setq founds found-entity))))
2806 (defun wl-summary-insert-thread-entity (entity overview mark-alist update
2807 &optional force-insert)
2808 (let (update-list entity-stack)
2810 (let* ((this-id (elmo-msgdb-overview-entity-get-id entity))
2812 (elmo-msgdb-overview-get-parent-entity entity overview));; temp
2813 ;;; (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
2814 (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
2815 (case-fold-search t)
2816 msg overview2 cur-entity linked retval delayed-entity)
2817 (setq msg (elmo-msgdb-overview-entity-get-number entity))
2818 (if (and parent-number
2819 (not (wl-thread-get-entity parent-number))
2821 ;; parent is exists in overview, but not exists in wl-thread-entities
2823 (wl-append wl-summary-delayed-update
2824 (list (cons parent-number entity)))
2825 (setq entity nil)) ;; exit loop
2826 ;; Search parent by subject.
2827 (when (and (null parent-number)
2828 wl-summary-search-parent-by-subject-regexp
2829 (string-match wl-summary-search-parent-by-subject-regexp
2830 (elmo-msgdb-overview-entity-get-subject entity)))
2831 (let ((found (wl-summary-search-by-subject entity overview)))
2833 (not (member found wl-summary-delayed-update)))
2834 (setq parent-entity found)
2836 (elmo-msgdb-overview-entity-get-number parent-entity))
2838 ;; If subject is change, divide thread.
2839 (if (and parent-number
2840 wl-summary-divide-thread-when-subject-changed
2841 (not (wl-summary-subject-equal
2842 (or (elmo-msgdb-overview-entity-get-subject
2844 (or (elmo-msgdb-overview-entity-get-subject
2845 parent-entity) ""))))
2846 (setq parent-number nil))
2849 (wl-thread-insert-message entity overview mark-alist
2850 msg parent-number update linked))
2852 (wl-append update-list (list retval)))
2853 (setq entity nil) ; exit loop
2854 (while (setq delayed-entity (assq msg wl-summary-delayed-update))
2855 (setq wl-summary-delayed-update
2856 (delete delayed-entity wl-summary-delayed-update))
2857 ;; update delayed message
2858 (wl-append entity-stack (list (cdr delayed-entity)))))
2859 (if (and (not entity)
2861 (setq entity (pop entity-stack)))))
2864 (defun wl-summary-update-thread (entity
2870 (this-id (elmo-msgdb-overview-entity-get-id entity))
2871 (overview-entity entity)
2872 (parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
2873 (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
2874 summary-line msg subject-differ)
2876 ((or (not parent-id)
2877 (string= this-id parent-id))
2878 (goto-char (point-max))
2879 (beginning-of-line))
2880 ;; parent already exists in buffer.
2881 ((setq depth (or (wl-summary-summary-line-already-exists-p
2882 parent-number (current-buffer)) -1))
2883 (setq depth (+ 1 depth))
2884 (wl-thread-goto-bottom-of-sub-thread)))
2885 (if (and (setq msg (elmo-msgdb-overview-entity-get-number entity)))
2886 (if (setq summary-line
2887 (wl-summary-overview-create-summary-line
2888 msg entity parent-entity depth mark-alist
2889 (wl-thread-maybe-get-children-num msg)
2891 (let ((inhibit-read-only t)
2892 (buffer-read-only nil))
2893 (wl-summary-insert-line summary-line))))))
2895 (defun wl-summary-mark-as-unread (&optional number
2901 (inhibit-read-only t)
2902 (buffer-read-only nil)
2903 (folder wl-summary-buffer-elmo-folder)
2904 (msgdb (wl-summary-buffer-msgdb))
2905 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
2906 ;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
2907 new-mark visible mark)
2910 (setq visible (wl-summary-jump-to-msg number))
2911 (unless (setq mark (cadr (assq number mark-alist)))
2916 (if (null (wl-summary-message-number))
2917 (message "No message.")
2920 (re-search-backward (concat "^" wl-summary-buffer-number-regexp
2921 "..../..")) ; set cursor line
2922 (beginning-of-line)))
2923 (if (or (and (not visible)
2924 ;; already exists in msgdb.
2925 (assq number (elmo-msgdb-get-number-alist msgdb)))
2927 (format (concat "^ *\\("
2928 (if number (int-to-string number)
2930 "\\)[^0-9]\\(%s\\|%s\\)")
2931 wl-summary-read-uncached-mark
2934 (setq number (or number (string-to-int (wl-match-buffer 1))))
2935 (setq mark (or mark (elmo-match-buffer 2)))
2937 (setq new-mark (if (string= mark
2938 wl-summary-read-uncached-mark)
2939 wl-summary-unread-uncached-mark
2940 (if (elmo-message-use-cache-p folder number)
2941 wl-summary-unread-mark
2942 wl-summary-unread-uncached-mark))))
2944 (unless no-server-update
2946 (unless (elmo-folder-unmark-read folder (list number))
2947 (error "Setting mark failed"))))
2949 (delete-region (match-beginning 2) (match-end 2))
2952 (elmo-msgdb-mark-set mark-alist
2955 (elmo-msgdb-set-mark-alist msgdb mark-alist)
2956 (unless no-modeline-update
2957 (setq wl-summary-buffer-unread-count
2958 (+ 1 wl-summary-buffer-unread-count))
2959 (wl-summary-update-modeline)
2960 (wl-folder-update-unread
2961 (wl-summary-buffer-folder-name)
2962 (+ wl-summary-buffer-unread-count
2963 wl-summary-buffer-new-count)))
2964 (wl-summary-set-mark-modified)
2965 (if (and visible wl-summary-highlight)
2966 (wl-highlight-summary-current-line))))))
2967 (set-buffer-modified-p nil))
2969 (defun wl-summary-delete (&optional number)
2970 "Mark Delete mark 'D'.
2971 If optional argument NUMBER is specified, mark message specified by NUMBER."
2973 (let* ((buffer-num (wl-summary-message-number))
2974 (msg-num (or number buffer-num))
2977 (when (null msg-num)
2979 (message "No message."))
2981 (when (setq mark (wl-summary-get-mark msg-num))
2982 (when (wl-summary-reserve-temp-mark-p mark)
2984 (error "Already marked as `%s'" mark))
2986 (wl-summary-unmark msg-num))
2987 (if (or (interactive-p)
2988 (eq number buffer-num))
2989 (wl-summary-mark-line "D"))
2990 (setq wl-summary-buffer-delete-list
2991 (cons msg-num wl-summary-buffer-delete-list))
2993 (if (eq wl-summary-move-direction-downward nil)
2998 (defun wl-summary-remove-destination ()
3000 (let ((inhibit-read-only t)
3001 (buffer-read-only nil)
3002 (buf (current-buffer))
3008 (setq rs (next-single-property-change sol 'wl-summary-destination
3010 (setq re (next-single-property-change rs 'wl-summary-destination
3012 (put-text-property rs re 'wl-summary-destination nil)
3013 (put-text-property rs re 'invisible nil)
3015 (delete-char (- eol re)))))
3017 (defun wl-summary-check-mark (msg mark)
3018 (let ((check-func (cond ((string= mark "o")
3019 'wl-summary-msg-marked-as-refiled)
3021 'wl-summary-msg-marked-as-copied)
3023 'wl-summary-msg-marked-as-deleted)
3025 'wl-summary-msg-marked-as-target))))
3027 (funcall check-func msg))))
3029 (defun wl-summary-mark-collect (mark &optional begin end)
3033 (narrow-to-region (or begin (point-min))
3034 (or end (point-max)))
3035 (goto-char (point-min))
3037 (if (eq wl-summary-buffer-view 'thread)
3040 (let* ((number (wl-summary-message-number))
3041 (entity (wl-thread-get-entity number))
3043 ;; opened...only myself is checked.
3044 (if (wl-summary-check-mark number mark)
3045 (wl-append msglist (list number)))
3046 (unless (wl-thread-entity-get-opened entity)
3047 ;; closed...children is also checked.
3048 (if (setq result (wl-thread-get-children-msgs-with-mark
3051 (wl-append msglist result)))
3053 (elmo-uniq-list msglist))
3054 (let* ((case-fold-search nil)
3055 (re (format (concat wl-summary-message-regexp "%s")
3056 (regexp-quote mark))))
3057 (while (re-search-forward re nil t)
3058 (setq msglist (cons (wl-summary-message-number) msglist)))
3059 (nreverse msglist)))))))
3061 (defun wl-summary-exec ()
3063 (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list)
3064 (reverse wl-summary-buffer-delete-list)
3065 (mapcar 'car wl-summary-buffer-copy-list)))
3067 (defun wl-summary-exec-region (beg end)
3069 (message "Collecting marks ...")
3074 (goto-char (1- end))
3077 (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end)
3078 (wl-summary-mark-collect "D" beg end)
3079 (wl-summary-mark-collect "O" beg end))))
3081 (defun wl-summary-exec-subr (moves dels copies)
3082 (if (not (or moves dels copies))
3083 (message "No marks")
3085 (let ((del-fld (wl-summary-get-delete-folder
3086 (wl-summary-buffer-folder-name)))
3088 (unread-marks (list wl-summary-unread-cached-mark
3089 wl-summary-unread-uncached-mark
3090 wl-summary-new-mark))
3091 (refiles (append moves dels))
3096 (copy-len (length copies))
3098 dst-msgs ; loop counter
3100 (message "Executing ...")
3102 (when (not (assq (car dels) wl-summary-buffer-refile-list))
3103 (wl-append wl-summary-buffer-refile-list
3104 (list (cons (car dels) del-fld)))
3105 (setq wl-summary-buffer-delete-list
3106 (delete (car dels) wl-summary-buffer-delete-list)))
3107 (setq dels (cdr dels)))
3109 (setq refile-len (length refiles))
3111 (wl-inverse-alist refiles wl-summary-buffer-refile-list))
3112 (goto-char start) ; avoid moving cursor to
3117 (setq result (elmo-folder-move-messages
3118 wl-summary-buffer-elmo-folder
3119 (cdr (car dst-msgs))
3120 (wl-folder-get-elmo-folder
3121 (car (car dst-msgs)))
3122 (wl-summary-buffer-msgdb)
3125 (not (null (cdr dst-msgs)))
3130 (if result ; succeeded.
3133 (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
3134 ;; update refile-alist.
3135 (setq wl-summary-buffer-refile-list
3136 (wl-delete-associations (cdr (car dst-msgs))
3137 wl-summary-buffer-refile-list)))
3138 (setq refile-failures
3139 (+ refile-failures (length (cdr (car dst-msgs))))))
3140 (setq refile-executed (+ refile-executed (length (cdr (car dst-msgs)))))
3141 (setq dst-msgs (cdr dst-msgs)))
3144 (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
3148 (setq result (elmo-folder-move-messages
3149 (wl-summary-buffer-folder-name)
3150 (cdr (car dst-msgs))
3151 (car (car dst-msgs))
3152 (wl-summary-buffer-msgdb)
3155 (not (null (cdr dst-msgs)))
3156 t ; t is no-delete (copy)
3160 (if result ; succeeded.
3163 (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
3164 ;; update copy-alist
3165 (setq wl-summary-buffer-copy-list
3166 (wl-delete-associations (cdr (car dst-msgs))
3167 wl-summary-buffer-copy-list)))
3169 (+ copy-failures (length (cdr (car dst-msgs))))))
3170 (setq copy-executed (+ copy-executed (length (cdr (car dst-msgs)))))
3171 (setq dst-msgs (cdr dst-msgs)))
3173 (wl-summary-folder-info-update)
3174 (wl-summary-set-message-modified)
3175 (wl-summary-set-mark-modified)
3176 (run-hooks 'wl-summary-exec-hook)
3177 (set-buffer-modified-p nil)
3178 (message (concat "Executing ... done"
3179 (if (> refile-failures 0)
3180 (format " (%d refiling failed)" refile-failures)
3182 (if (> copy-failures 0)
3183 (format " (%d copying failed)" copy-failures)
3187 (defun wl-summary-read-folder (default &optional purpose ignore-error
3189 (let ((fld (completing-read
3190 (format "Folder name %s(%s): " (or purpose "")
3192 (or wl-folder-completion-func
3193 (if (memq 'read-folder wl-use-folder-petname)
3194 (wl-folder-get-entity-with-petname)
3195 wl-folder-entity-hashtb))
3196 nil nil (or init wl-default-spec)
3197 'wl-read-folder-hist)))
3198 (if (or (string= fld wl-default-spec)
3201 (setq fld (elmo-string (wl-folder-get-realname fld)))
3202 (if (string-match "\n" fld)
3203 (error "Not supported folder name: %s" fld))
3207 (wl-folder-confirm-existence
3208 (wl-folder-get-elmo-folder
3211 (wl-folder-confirm-existence (wl-folder-get-elmo-folder
3215 (defun wl-summary-print-destination (msg-num folder)
3216 "Print refile destination on line."
3217 (wl-summary-remove-destination)
3218 (let ((inhibit-read-only t)
3219 (folder (copy-sequence folder))
3220 (buffer-read-only nil)
3222 (setq len (string-width folder))
3229 (setq c (+ c (char-width (following-char)))))
3230 (and (> c len) (setq folder (concat " " folder)))
3232 (put-text-property rs re 'invisible t)
3233 (put-text-property rs re 'wl-summary-destination t)
3235 (wl-highlight-refile-destination-string folder)
3237 (set-buffer-modified-p nil))))
3241 (defun wl-summary-print-destination (msg-num &optional folder))
3242 (defun wl-summary-remove-destination ()))
3244 (defsubst wl-summary-get-mark (number)
3245 "Return a temporal mark of message specified by NUMBER."
3246 (or (and (memq number wl-summary-buffer-delete-list) "D")
3247 (and (assq number wl-summary-buffer-copy-list) "O")
3248 (and (assq number wl-summary-buffer-refile-list) "o")
3249 (and (memq number wl-summary-buffer-target-mark-list) "*")))
3251 (defsubst wl-summary-reserve-temp-mark-p (mark)
3252 "Return t if temporal MARK should be reserved."
3253 (member mark wl-summary-reserve-mark-list))
3255 (defun wl-summary-refile (&optional dst number)
3256 "Put refile mark on current line message.
3257 If optional argument DST is specified, put mark without asking
3259 If optional argument NUMBER is specified, mark message specified by NUMBER.
3261 If folder is read-only, message should be copied.
3262 See `wl-refile-policy-alist' for more details."
3264 (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
3265 (wl-summary-buffer-folder-name))))
3266 (cond ((eq policy 'copy)
3268 (call-interactively 'wl-summary-copy)
3269 (wl-summary-copy dst number)))
3271 (wl-summary-refile-subr 'refile (interactive-p) dst number)))))
3273 (defun wl-summary-copy (&optional dst number)
3274 "Put copy mark on current line message.
3275 If optional argument DST is specified, put mark without asking
3277 If optional argument NUMBER is specified, mark message specified by NUMBER."
3279 (wl-summary-refile-subr 'copy (interactive-p) dst number))
3281 (defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number)
3283 (let* ((buffer-num (wl-summary-message-number))
3284 (msg-num (or number buffer-num))
3286 (elmo-message-field wl-summary-buffer-elmo-folder
3287 msg-num 'message-id)))
3288 (entity (and msg-num
3289 (elmo-msgdb-overview-get-entity
3290 msg-num (wl-summary-buffer-msgdb))))
3292 (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3293 folder mark already tmp-folder)
3298 (message "Cannot refile."))
3300 (when (null msg-num)
3302 (message "No message."))
3304 (when (setq mark (wl-summary-get-mark msg-num))
3305 (when (wl-summary-reserve-temp-mark-p mark)
3307 (error "Already marked as `%s'" mark))
3309 (setq folder (and msg-num
3310 (or dst (wl-summary-read-folder
3311 (or (wl-refile-guess entity) wl-trash-folder)
3312 (format "for %s" copy-or-refile)))))
3313 ;; Cache folder hack by okada@opaopa.org
3314 (if (and (eq (elmo-folder-type-internal
3315 (wl-folder-get-elmo-folder
3316 (wl-folder-get-realname folder))) 'cache)
3317 (not (string= folder
3320 (elmo-cache-get-path-subr
3321 (elmo-msgid-to-cache msgid)))))))
3323 (setq folder tmp-folder)
3324 (message "Force refile to %s." folder)))
3325 (if (string= folder (wl-summary-buffer-folder-name))
3326 (error "Same folder"))
3327 (if (or (string= folder wl-queue-folder)
3328 (string= folder wl-draft-folder))
3329 (error "Don't %s messages to %s" copy-or-refile folder))
3330 ;; learn for refile.
3331 (if (eq copy-or-refile 'refile)
3332 (wl-refile-learn entity folder))
3333 (wl-summary-unmark msg-num)
3334 (set variable (append
3335 (symbol-value variable)
3336 (list (cons msg-num folder))))
3337 (when (or interactive
3338 (eq number buffer-num))
3339 (wl-summary-mark-line (if (eq copy-or-refile 'refile)
3341 ;; print refile destination
3342 (wl-summary-print-destination msg-num folder))
3344 (if (eq wl-summary-move-direction-downward nil)
3347 (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile)))
3348 (setq wl-summary-buffer-prev-refile-destination folder)
3351 (defun wl-summary-refile-prev-destination ()
3352 "Refile message to previously refiled destination."
3354 (wl-summary-refile wl-summary-buffer-prev-refile-destination
3355 (wl-summary-message-number))
3356 (if (eq wl-summary-move-direction-downward nil)
3360 (defun wl-summary-copy-prev-destination ()
3361 "Refile message to previously refiled destination."
3363 (wl-summary-copy wl-summary-buffer-prev-copy-destination
3364 (wl-summary-message-number))
3365 (if (eq wl-summary-move-direction-downward nil)
3369 (defsubst wl-summary-no-auto-refile-message-p (msg mark-alist)
3370 (member (cadr (assq msg mark-alist)) wl-summary-auto-refile-skip-marks))
3372 (defun wl-summary-auto-refile (&optional open-all)
3373 "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
3375 (message "Marking...")
3377 (if (and (eq wl-summary-buffer-view 'thread)
3379 (wl-thread-open-all))
3380 (let* ((spec (wl-summary-buffer-folder-name))
3381 (overview (elmo-msgdb-get-overview
3382 (wl-summary-buffer-msgdb)))
3383 (mark-alist (elmo-msgdb-get-mark-alist
3384 (wl-summary-buffer-msgdb)))
3387 number dst thr-entity)
3390 (setq number (wl-summary-message-number))
3391 (when (and (not (wl-summary-no-auto-refile-message-p number
3394 (wl-folder-get-realname
3395 (wl-refile-guess-by-rule
3396 (elmo-msgdb-overview-get-entity
3397 number (wl-summary-buffer-msgdb)))))
3398 (not (equal dst spec)))
3399 (when (not (member dst checked-dsts))
3400 (wl-folder-confirm-existence (wl-folder-get-elmo-folder dst))
3401 (setq checked-dsts (cons dst checked-dsts)))
3402 (if (wl-summary-refile dst number)
3404 (message "Marking...%d message(s)." count))
3405 (if (eq wl-summary-buffer-view 'thread)
3406 ;; process invisible children.
3407 (unless (wl-thread-entity-get-opened
3408 (setq thr-entity (wl-thread-get-entity number)))
3413 (wl-summary-no-auto-refile-message-p
3415 (wl-thread-entity-get-descendant thr-entity))))
3417 (when (and (setq dst
3418 (wl-refile-guess-by-rule
3419 (elmo-msgdb-overview-get-entity
3420 (car messages) (wl-summary-buffer-msgdb))))
3421 (not (equal dst spec)))
3422 (if (wl-summary-refile dst (car messages))
3424 (message "Marking...%d message(s)." count))
3425 (setq messages (cdr messages))))))
3428 (message "No message was marked.")
3429 (message "Marked %d message(s)." count)))))
3431 (defun wl-summary-unmark (&optional number)
3432 "Unmark marks (temporary, refile, copy, delete)of current line.
3433 If optional argument NUMBER is specified, unmark message specified by NUMBER."
3437 (let ((inhibit-read-only t)
3438 (buffer-read-only nil)
3444 (setq visible (wl-summary-jump-to-msg number))
3446 ;; Delete mark on buffer.
3448 (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)"))
3449 (goto-char (match-end 2))
3451 (setq number (string-to-int (wl-match-buffer 1))))
3452 (setq cur-mark (wl-match-buffer 2))
3453 (if (string= cur-mark " ")
3455 (delete-region (match-beginning 2) (match-end 2))
3456 (if (setq score-mark (wl-summary-get-score-mark number))
3459 (if (or (string= cur-mark "o")
3460 (string= cur-mark "O"))
3461 (wl-summary-remove-destination))
3462 (if wl-summary-highlight
3463 (wl-highlight-summary-current-line nil nil score-mark))
3464 (set-buffer-modified-p nil))
3465 ;; Remove from temporary mark structure.
3467 (wl-summary-delete-mark number)))))
3469 (defun wl-summary-msg-marked-as-target (msg)
3470 (if (memq msg wl-summary-buffer-target-mark-list)
3473 (defun wl-summary-msg-marked-as-copied (msg)
3474 (assq msg wl-summary-buffer-copy-list))
3476 (defun wl-summary-msg-marked-as-deleted (msg)
3477 (if (memq msg wl-summary-buffer-delete-list)
3480 (defun wl-summary-msg-marked-as-refiled (msg)
3481 (assq msg wl-summary-buffer-refile-list))
3483 (defun wl-summary-target-mark (&optional number)
3484 "Put target mark '*' on current message.
3485 If optional argument NUMBER is specified, mark message specified by NUMBER."
3487 (let* ((buffer-num (wl-summary-message-number))
3488 (msg-num (or number buffer-num))
3491 (when (null msg-num)
3493 (message "No message."))
3495 (when (setq mark (wl-summary-get-mark msg-num))
3496 (when (wl-summary-reserve-temp-mark-p mark)
3498 (error "Already marked as `%s'" mark))
3500 (wl-summary-unmark msg-num))
3501 (if (or (interactive-p)
3502 (eq number buffer-num))
3503 (wl-summary-mark-line "*"))
3504 (setq wl-summary-buffer-target-mark-list
3505 (cons msg-num wl-summary-buffer-target-mark-list))
3507 (if (eq wl-summary-move-direction-downward nil)
3513 (defun wl-summary-refile-region (beg end)
3514 "Put copy mark on messages in the region specified by BEG and END."
3516 (wl-summary-refile-region-subr "refile" beg end))
3518 (defun wl-summary-copy-region (beg end)
3519 "Put copy mark on messages in the region specified by BEG and END."
3521 (wl-summary-refile-region-subr "copy" beg end))
3523 (defun wl-summary-refile-region-subr (copy-or-refile beg end)
3527 ;; guess by first msg
3528 (let* ((msgid (cdr (assq (wl-summary-message-number)
3529 (elmo-msgdb-get-number-alist
3530 (wl-summary-buffer-msgdb)))))
3531 (function (intern (format "wl-summary-%s" copy-or-refile)))
3532 (entity (assoc msgid (elmo-msgdb-get-overview
3533 (wl-summary-buffer-msgdb))))
3536 (setq folder (wl-summary-read-folder (wl-refile-guess entity)
3539 (narrow-to-region beg end)
3540 (if (eq wl-summary-buffer-view 'thread)
3543 (let* ((number (wl-summary-message-number))
3544 (entity (wl-thread-get-entity number))
3546 (if (wl-thread-entity-get-opened entity)
3547 ;; opened...refile line.
3548 (funcall function folder number)
3550 (setq children (wl-thread-get-children-msgs number))
3552 (funcall function folder (pop children))))
3555 (funcall function folder (wl-summary-message-number))
3556 (forward-line 1)))))))
3558 (defun wl-summary-unmark-region (beg end)
3562 (narrow-to-region beg end)
3563 (goto-char (point-min))
3564 (if (eq wl-summary-buffer-view 'thread)
3567 (let* ((number (wl-summary-message-number))
3568 (entity (wl-thread-get-entity number)))
3569 (if (wl-thread-entity-get-opened entity)
3570 ;; opened...unmark line.
3573 (wl-summary-delete-marks-on-buffer
3574 (wl-thread-get-children-msgs number))))
3578 (forward-line 1))))))
3580 (defun wl-summary-mark-region-subr (function beg end)
3583 (narrow-to-region beg end)
3584 (goto-char (point-min))
3585 (if (eq wl-summary-buffer-view 'thread)
3588 (let* ((number (wl-summary-message-number))
3589 (entity (wl-thread-get-entity number))
3590 (wl-summary-move-direction-downward t)
3592 (if (wl-thread-entity-get-opened entity)
3593 ;; opened...delete line.
3594 (funcall function number)
3596 (setq children (wl-thread-get-children-msgs number))
3598 (funcall function (pop children))))
3601 (funcall function (wl-summary-message-number))
3602 (forward-line 1))))))
3604 (defun wl-summary-delete-region (beg end)
3606 (wl-summary-mark-region-subr 'wl-summary-delete beg end))
3608 (defun wl-summary-target-mark-region (beg end)
3610 (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
3612 (defun wl-summary-target-mark-all ()
3614 (wl-summary-target-mark-region (point-min) (point-max))
3615 (setq wl-summary-buffer-target-mark-list
3617 (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))))
3619 (defun wl-summary-delete-all-mark (mark)
3620 (goto-char (point-min))
3621 (let ((case-fold-search nil))
3622 (while (re-search-forward (format "^ *[0-9]+%s"
3623 (regexp-quote mark)) nil t)
3624 (wl-summary-unmark))
3625 (cond ((string= mark "*")
3626 (setq wl-summary-buffer-target-mark-list nil))
3628 (setq wl-summary-buffer-delete-list nil))
3630 (setq wl-summary-buffer-copy-list nil))
3632 (setq wl-summary-buffer-refile-list nil)))))
3634 (defun wl-summary-unmark-all ()
3635 "Unmark all according to what you input."
3637 (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
3641 (setq cur-mark (char-to-string (car unmarks)))
3642 (wl-summary-delete-all-mark cur-mark)
3643 (setq unmarks (cdr unmarks))))))
3645 (defun wl-summary-target-mark-thread ()
3649 (wl-summary-goto-top-of-current-thread)
3650 (wl-thread-force-open)
3653 (wl-summary-goto-bottom-of-current-thread)
3654 ;;; (forward-line -1)
3657 (wl-summary-target-mark-region beg end)))
3659 (defun wl-summary-target-mark-msgs (msgs)
3661 (if (eq wl-summary-buffer-view 'thread)
3662 (wl-thread-jump-to-msg (car msgs))
3663 (wl-summary-jump-to-msg (car msgs)))
3664 (wl-summary-target-mark (wl-summary-message-number))
3665 (setq msgs (cdr msgs))))
3667 (defun wl-summary-pick (&optional from-list delete-marks)
3669 (let ((result (elmo-msgdb-search
3670 wl-summary-buffer-elmo-folder
3671 (elmo-read-search-condition wl-summary-pick-field-default)
3672 (wl-summary-buffer-msgdb))))
3674 (let ((mlist wl-summary-buffer-target-mark-list))
3676 (when (wl-summary-jump-to-msg (car mlist))
3677 (wl-summary-unmark))
3678 (setq mlist (cdr mlist)))
3679 (setq wl-summary-buffer-target-mark-list nil)))
3681 (setq result (elmo-list-filter from-list result)))
3682 (message "%d message(s) are picked." (length result))
3684 (message "No message was picked.")
3685 (wl-summary-target-mark-msgs result))))
3687 (defun wl-summary-unvirtual ()
3688 "Exit from current virtual folder."
3691 (elmo-folder-type-internal wl-summary-buffer-elmo-folder))
3692 (wl-summary-goto-folder-subr
3693 (elmo-folder-name-internal
3694 (elmo-filter-folder-target-internal
3695 wl-summary-buffer-elmo-folder))
3697 (error "This folder is not filtered")))
3699 (defun wl-summary-virtual (&optional arg)
3700 "Goto virtual folder.
3701 If ARG, exit virtual folder."
3704 (wl-summary-unvirtual)
3705 (wl-summary-goto-folder-subr (concat "/"
3706 (elmo-read-search-condition
3707 wl-summary-pick-field-default)
3709 (wl-summary-buffer-folder-name))
3710 'update nil nil t)))
3712 (defun wl-summary-delete-all-temp-marks ()
3715 (goto-char (point-min))
3716 (message "Unmarking...")
3720 (message "Unmarking...done")
3721 (setq wl-summary-buffer-target-mark-list nil)
3722 (setq wl-summary-buffer-delete-list nil)
3723 (setq wl-summary-buffer-refile-list nil)
3724 (setq wl-summary-buffer-copy-list nil)))
3726 (defun wl-summary-delete-mark (number)
3727 "Delete temporary mark of the message specified by NUMBER."
3729 ((memq number wl-summary-buffer-target-mark-list)
3730 (setq wl-summary-buffer-target-mark-list
3731 (delq number wl-summary-buffer-target-mark-list)))
3732 ((memq number wl-summary-buffer-delete-list)
3733 (setq wl-summary-buffer-delete-list
3734 (delq number wl-summary-buffer-delete-list)))
3738 ((setq pair (assq number wl-summary-buffer-copy-list))
3739 (setq wl-summary-buffer-copy-list
3740 (delq pair wl-summary-buffer-copy-list)))
3741 ((setq pair (assq number wl-summary-buffer-refile-list))
3742 (setq wl-summary-buffer-refile-list
3743 (delq pair wl-summary-buffer-refile-list))))))))
3745 (defun wl-summary-mark-line (mark)
3746 "Put MARK on current line. Return message number."
3749 (let ((inhibit-read-only t)
3750 (buffer-read-only nil)
3753 (when (looking-at "^ *\\([0-9]+\\)\\([^0-9]\\)")
3754 (setq msg-num (string-to-int (wl-match-buffer 1)))
3755 (setq cur-mark (wl-match-buffer 2))
3756 (goto-char (match-end 1))
3757 (delete-region (match-beginning 2) (match-end 2))
3758 ;;; (wl-summary-delete-mark msg-num)
3760 (if wl-summary-highlight
3761 (wl-highlight-summary-current-line nil nil t))
3762 (set-buffer-modified-p nil)
3765 (defun wl-summary-target-mark-delete ()
3768 (goto-char (point-min))
3769 (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3771 (while (re-search-forward regexp nil t)
3772 (let (wl-summary-buffer-disp-msg)
3773 (when (setq number (wl-summary-message-number))
3774 (wl-summary-delete number)
3775 (setq wl-summary-buffer-target-mark-list
3776 (delq number wl-summary-buffer-target-mark-list)))))
3777 (setq mlist wl-summary-buffer-target-mark-list)
3779 (wl-append wl-summary-buffer-delete-list (list (car mlist)))
3780 (setq wl-summary-buffer-target-mark-list
3781 (delq (car mlist) wl-summary-buffer-target-mark-list))
3782 (setq mlist (cdr mlist))))))
3784 (defun wl-summary-target-mark-prefetch ()
3787 (let* ((mlist (nreverse wl-summary-buffer-target-mark-list))
3788 (inhibit-read-only t)
3789 (buffer-read-only nil)
3791 (length (length mlist))
3796 (setq new-mark (wl-summary-prefetch-msg (car mlist)))
3799 (message "Prefetching... %d/%d message(s)"
3800 (setq count (+ 1 count)) length)
3801 (when (wl-summary-jump-to-msg (car mlist))
3804 (when (looking-at "^ *[0-9]+[^0-9]\\([^0-9]\\)")
3805 (delete-region (match-beginning 1) (match-end 1)))
3806 (goto-char (match-beginning 1))
3808 (if wl-summary-highlight
3809 (wl-highlight-summary-current-line))
3813 (setq skipped (cons (car mlist) skipped)))
3814 (setq mlist (cdr mlist)))
3815 (setq wl-summary-buffer-target-mark-list skipped)
3816 (message "Prefetching... %d/%d message(s)." count length)
3817 (set-buffer-modified-p nil))))
3819 (defun wl-summary-target-mark-refile-subr (copy-or-refile)
3821 (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
3823 (intern (format "wl-summary-%s" copy-or-refile)))
3824 regexp number msgid entity folder mlist)
3826 (goto-char (point-min))
3827 (setq regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3828 ;; guess by first mark
3829 (when (re-search-forward regexp nil t)
3830 (setq msgid (cdr (assq (setq number (wl-summary-message-number))
3831 (elmo-msgdb-get-number-alist
3832 (wl-summary-buffer-msgdb))))
3834 (elmo-msgdb-get-overview
3835 (wl-summary-buffer-msgdb))))
3837 (error "Cannot %s" copy-or-refile))
3839 (setq folder (wl-summary-read-folder
3840 (wl-refile-guess entity)
3841 (format "for %s" copy-or-refile)))
3844 (setq wl-summary-buffer-target-mark-list
3845 (delq number wl-summary-buffer-target-mark-list)))
3846 (while (re-search-forward regexp nil t)
3847 (let (wl-summary-buffer-disp-msg)
3848 (when (setq number (wl-summary-message-number))
3849 (funcall function folder number)
3850 (setq wl-summary-buffer-target-mark-list
3851 (delq number wl-summary-buffer-target-mark-list)))))
3852 ;; process invisible messages.
3853 (setq mlist wl-summary-buffer-target-mark-list)
3856 (append (symbol-value variable)
3857 (list (cons (car mlist) folder))))
3858 (setq wl-summary-buffer-target-mark-list
3859 (delq (car mlist) wl-summary-buffer-target-mark-list))
3860 (setq mlist (cdr mlist)))))))
3862 (defun wl-summary-target-mark-copy ()
3864 (wl-summary-target-mark-refile-subr "copy"))
3866 (defun wl-summary-target-mark-refile ()
3868 (wl-summary-target-mark-refile-subr "refile"))
3870 (defun wl-summary-target-mark-mark-as-read ()
3873 (goto-char (point-min))
3874 (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3875 (inhibit-read-only t)
3876 (buffer-read-only nil)
3878 (while (re-search-forward regexp nil t)
3879 (let (wl-summary-buffer-disp-msg)
3880 ;; delete target-mark from buffer.
3881 (delete-region (match-beginning 1) (match-end 1))
3883 (setq number (wl-summary-mark-as-read t))
3884 (if wl-summary-highlight
3885 (wl-highlight-summary-current-line))
3887 (setq wl-summary-buffer-target-mark-list
3888 (delq number wl-summary-buffer-target-mark-list)))))
3889 (setq mlist wl-summary-buffer-target-mark-list)
3891 (wl-summary-mark-as-read t nil nil (car mlist))
3892 (setq wl-summary-buffer-target-mark-list
3893 (delq (car mlist) wl-summary-buffer-target-mark-list))
3894 (setq mlist (cdr mlist)))
3895 (wl-summary-count-unread
3896 (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
3897 (wl-summary-update-modeline))))
3899 (defun wl-summary-target-mark-mark-as-unread ()
3902 (goto-char (point-min))
3903 (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3904 (inhibit-read-only t)
3905 (buffer-read-only nil)
3907 (while (re-search-forward regexp nil t)
3908 (let (wl-summary-buffer-disp-msg)
3909 ;; delete target-mark from buffer.
3910 (delete-region (match-beginning 1) (match-end 1))
3912 (setq number (wl-summary-mark-as-unread))
3913 (if wl-summary-highlight
3914 (wl-highlight-summary-current-line))
3916 (setq wl-summary-buffer-target-mark-list
3917 (delq number wl-summary-buffer-target-mark-list)))))
3918 (setq mlist wl-summary-buffer-target-mark-list)
3920 (wl-summary-mark-as-unread (car mlist))
3921 ;;; (wl-thread-msg-mark-as-unread (car mlist))
3922 (setq wl-summary-buffer-target-mark-list
3923 (delq (car mlist) wl-summary-buffer-target-mark-list))
3924 (setq mlist (cdr mlist)))
3925 (wl-summary-count-unread
3926 (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
3927 (wl-summary-update-modeline))))
3929 (defun wl-summary-target-mark-mark-as-important ()
3932 (goto-char (point-min))
3933 (let ((regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3934 (inhibit-read-only t)
3935 (buffer-read-only nil)
3937 (while (re-search-forward regexp nil t)
3938 (let (wl-summary-buffer-disp-msg)
3939 ;; delete target-mark from buffer.
3940 (delete-region (match-beginning 1) (match-end 1))
3942 (setq number (wl-summary-mark-as-important))
3943 (if wl-summary-highlight
3944 (wl-highlight-summary-current-line))
3946 (setq wl-summary-buffer-target-mark-list
3947 (delq number wl-summary-buffer-target-mark-list)))))
3948 (setq mlist wl-summary-buffer-target-mark-list)
3950 (wl-summary-mark-as-important (car mlist))
3951 (wl-thread-msg-mark-as-important (car mlist))
3952 (setq wl-summary-buffer-target-mark-list
3953 (delq (car mlist) wl-summary-buffer-target-mark-list))
3954 (setq mlist (cdr mlist)))
3955 (wl-summary-count-unread
3956 (elmo-msgdb-get-mark-alist (wl-summary-buffer-msgdb)))
3957 (wl-summary-update-modeline))))
3959 (defun wl-summary-target-mark-save ()
3962 (goto-char (point-min))
3964 (wl-read-directory-name "Save to directory: " wl-tmp-dir))
3965 (regexp (concat "^" wl-summary-buffer-number-regexp "\\(\\*\\)"))
3967 (if (null (file-exists-p wl-save-dir))
3968 (make-directory wl-save-dir))
3969 (while (re-search-forward regexp nil t)
3970 (let (wl-summary-buffer-disp-msg)
3971 (setq number (wl-summary-save t wl-save-dir))
3974 (setq wl-summary-buffer-target-mark-list
3975 (delq number wl-summary-buffer-target-mark-list))))))))
3977 (defun wl-summary-target-mark-pick ()
3979 (wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
3981 (defun wl-summary-mark-as-read (&optional notcrosses
3982 leave-server-side-mark-untouched
3989 (inhibit-read-only t)
3990 (buffer-read-only nil)
3991 (folder wl-summary-buffer-elmo-folder)
3992 (msgdb (wl-summary-buffer-msgdb))
3993 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
3994 ;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
3995 (case-fold-search nil)
3996 mark stat visible uncached new-mark marked)
3999 (setq visible (wl-summary-jump-to-msg number))
4000 (setq mark (cadr (assq number mark-alist))))
4003 (if (or (not visible)
4005 (format "^ *\\([0-9]+\\)[^0-9]\\(%s\\|%s\\|%s\\|%s\\).*$"
4006 (regexp-quote wl-summary-read-uncached-mark)
4007 (regexp-quote wl-summary-unread-uncached-mark)
4008 (regexp-quote wl-summary-unread-cached-mark)
4009 (regexp-quote wl-summary-new-mark))))
4011 (setq mark (or mark (wl-match-buffer 2)))
4014 ((string= mark wl-summary-new-mark) ; N
4017 ((string= mark wl-summary-unread-uncached-mark) ; U
4020 ((string= mark wl-summary-unread-cached-mark) ; !
4021 (setq stat 'unread))
4023 ;; no need to mark server.
4024 (setq leave-server-side-mark-untouched t))))
4025 (setq number (or number (string-to-int (wl-match-buffer 1))))
4026 ;; set server side mark...
4027 (setq new-mark (if (and uncached
4028 (if (elmo-message-use-cache-p folder number)
4029 (not (elmo-folder-local-p folder)))
4031 wl-summary-read-uncached-mark
4033 (if (not leave-server-side-mark-untouched)
4035 (setq marked (elmo-folder-mark-as-read
4038 (if (or leave-server-side-mark-untouched
4041 (cond ((eq stat 'unread)
4042 (setq wl-summary-buffer-unread-count
4043 (1- wl-summary-buffer-unread-count)))
4045 (setq wl-summary-buffer-new-count
4046 (1- wl-summary-buffer-new-count))))
4047 (wl-summary-update-modeline)
4048 (wl-folder-update-unread
4049 (wl-summary-buffer-folder-name)
4050 (+ wl-summary-buffer-unread-count
4051 wl-summary-buffer-new-count))
4052 (when (or stat cached)
4054 (goto-char (match-end 2))
4055 (delete-region (match-beginning 2) (match-end 2))
4056 (insert (or new-mark " ")))
4058 (elmo-msgdb-mark-set mark-alist number new-mark))
4059 (elmo-msgdb-set-mark-alist msgdb mark-alist)
4060 (wl-summary-set-mark-modified))
4061 (if (and visible wl-summary-highlight)
4062 (wl-highlight-summary-current-line nil nil t))
4063 (if (not notcrosses)
4064 (wl-summary-set-crosspost
4065 wl-summary-buffer-elmo-folder
4067 (if mark (message "Warning: Changing mark failed.")))))
4068 (set-buffer-modified-p nil)
4070 (run-hooks 'wl-summary-unread-message-hook))
4071 number ;return value
4074 (defun wl-summary-mark-as-important (&optional number
4078 (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
4080 (error "Cannot process mark in this folder"))
4083 (inhibit-read-only t)
4084 (buffer-read-only nil)
4085 (folder wl-summary-buffer-elmo-folder)
4086 (msgdb (wl-summary-buffer-msgdb))
4087 (mark-alist (elmo-msgdb-get-mark-alist msgdb))
4088 (number-alist (elmo-msgdb-get-number-alist msgdb))
4092 (setq visible (wl-summary-jump-to-msg number))
4093 (setq mark (or mark (cadr (assq number mark-alist)))))
4096 (if (null (wl-summary-message-number))
4098 (message "No message.")
4102 (re-search-backward (concat "^" wl-summary-buffer-number-regexp
4103 "..../..") nil t)) ; set cursor line
4106 (if (re-search-forward "^ *\\([0-9]+\\)[^0-9]\\([^0-9]\\)" eol t)
4108 (setq number (or number (string-to-int (wl-match-buffer 1))))
4109 (setq mark (or mark (wl-match-buffer 2)))
4110 (setq message-id (elmo-message-field
4111 wl-summary-buffer-elmo-folder
4114 (if (string= mark wl-summary-important-mark)
4117 (unless no-server-update
4118 (elmo-folder-unmark-important folder (list number))
4119 (elmo-msgdb-global-mark-delete message-id))
4120 ;; Remove cache if local folder.
4122 (if (and (elmo-folder-local-p folder)
4124 (elmo-folder-type-internal folder))))
4125 (elmo-file-cache-delete
4126 (elmo-file-cache-get-path message-id))))
4128 (delete-region (match-beginning 2) (match-end 2))
4131 (elmo-msgdb-mark-set mark-alist
4135 (unless no-server-update
4136 (elmo-folder-mark-as-important folder (list number)))
4138 (delete-region (match-beginning 2) (match-end 2))
4139 (insert wl-summary-important-mark))
4141 (elmo-msgdb-mark-set mark-alist
4142 (string-to-int (wl-match-buffer 1))
4143 wl-summary-important-mark))
4144 ;; Force cache message!!
4145 (elmo-message-encache folder number)
4146 (unless no-server-update
4147 (elmo-msgdb-global-mark-set message-id
4148 wl-summary-important-mark)))
4149 (elmo-msgdb-set-mark-alist msgdb mark-alist)
4150 (wl-summary-set-mark-modified)))
4151 (if (and visible wl-summary-highlight)
4152 (wl-highlight-summary-current-line nil nil t))))
4153 (set-buffer-modified-p nil)
4156 (defsubst wl-summary-format-date (date-string)
4158 (let ((datevec (timezone-fix-time date-string nil
4159 wl-summary-fix-timezone)))
4160 (format "%02d/%02d(%s)%02d:%02d"
4163 (elmo-date-get-week (aref datevec 0)
4168 (error "??/??(??)??:??")))
4170 (defun wl-summary-overview-create-summary-line (msg
4177 temp-mark thr-entity
4179 (let ((wl-mime-charset wl-summary-buffer-mime-charset)
4180 (elmo-mime-charset wl-summary-buffer-mime-charset)
4181 no-parent before-indent
4182 from subject parent-raw-subject parent-subject
4184 (elmo-lang wl-summary-buffer-weekday-name-lang)
4185 (children-num (if children-num (int-to-string children-num)))
4189 (setq thr-str (wl-thread-make-indent-string thr-entity))
4190 (setq linked (wl-thread-entity-get-linked thr-entity)))
4191 (if (string= thr-str "")
4192 (setq no-parent t)) ; no parent
4193 (if (and wl-summary-width
4194 wl-summary-indent-length-limit
4195 (< wl-summary-indent-length-limit
4196 (string-width thr-str)))
4197 (setq thr-str (wl-set-string-width
4198 wl-summary-indent-length-limit
4201 (wl-set-string-width
4203 (- wl-from-width (length children-num) 2)
4205 (elmo-delete-char ?\n
4206 (wl-summary-from-func-internal
4207 (elmo-msgdb-overview-entity-get-from entity)))))
4209 (elmo-delete-char ?\n
4210 (or (elmo-msgdb-overview-entity-get-subject
4212 wl-summary-no-subject-message)))
4213 (setq parent-raw-subject
4214 (elmo-msgdb-overview-entity-get-subject parent-entity))
4215 (setq parent-subject
4216 (if parent-raw-subject
4217 (elmo-delete-char ?\n parent-raw-subject)))
4218 (setq mark (or (cadr (assq msg mark-alist)) " "))
4224 wl-summary-buffer-number-column)
4229 (wl-summary-format-date
4230 (elmo-msgdb-overview-entity-get-date entity))
4231 (if thr-str thr-str "")))
4236 (concat "+" children-num ": " from)
4241 (null parent-subject)
4242 (not (wl-summary-subject-equal
4243 subject parent-subject)))
4244 (wl-summary-subject-func-internal subject) ""))
4245 (if (and (not wl-summary-width)
4246 wl-subject-length-limit)
4247 (truncate-string subject wl-subject-length-limit)
4249 (if wl-summary-width (setq line
4250 (wl-set-string-width
4251 (- wl-summary-width 1) line)))
4252 (if wl-summary-highlight
4253 (wl-highlight-summary-line-string line
4259 (defsubst wl-summary-buffer-number-column-detect (update)
4262 (goto-char (point-min))
4263 (setq wl-summary-buffer-number-column
4266 (setq end (if (re-search-forward "^ *[0-9]+[^0-9]" nil t)
4268 (- end (progn (beginning-of-line) (point)) 1))
4269 (wl-get-assoc-list-value wl-summary-number-column-alist
4270 (wl-summary-buffer-folder-name))
4271 wl-summary-default-number-column))
4272 (setq wl-summary-buffer-number-regexp
4273 (wl-repeat-string "." wl-summary-buffer-number-column)))))
4275 (defsubst wl-summary-proc-wday (wday-str year month mday)
4277 (if (string-match "\\([A-Z][a-z][a-z]\\).*" wday-str)
4278 (wl-match-string 1 wday-str)
4279 (elmo-date-get-week year month mday))))
4281 (defmacro wl-summary-cursor-move-regex ()
4282 (` (let ((mark-alist
4283 (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
4284 (cond ((eq wl-summary-move-order 'new)
4287 wl-summary-new-mark)
4289 wl-summary-unread-uncached-mark
4290 wl-summary-unread-cached-mark
4291 wl-summary-important-mark)))
4292 ((eq wl-summary-move-order 'unread)
4295 wl-summary-unread-uncached-mark
4296 wl-summary-unread-cached-mark
4297 wl-summary-new-mark)
4299 wl-summary-important-mark)))
4303 wl-summary-unread-uncached-mark
4304 wl-summary-unread-cached-mark
4306 wl-summary-important-mark))))
4307 (cond ((eq wl-summary-move-order 'unread)
4310 wl-summary-unread-cached-mark)
4312 wl-summary-important-mark)))
4316 wl-summary-unread-cached-mark
4317 wl-summary-important-mark)))))))
4321 (concat wl-summary-message-regexp
4323 (mapconcat 'regexp-quote
4327 wl-summary-message-regexp "\\*")))
4331 ;; Goto unread or important
4333 (defun wl-summary-cursor-up (&optional hereto)
4335 (if (and (not wl-summary-buffer-target-mark-list)
4336 (eq wl-summary-buffer-view 'thread))
4340 (wl-thread-jump-to-prev-unread hereto))
4343 (beginning-of-line))
4344 (let ((case-fold-search nil)
4346 (setq regex-list (wl-summary-cursor-move-regex))
4349 (when (re-search-backward
4354 (setq regex-list (cdr regex-list)))
4356 (throw 'done nil)))))
4359 ;; Goto unread or important
4360 ;; returns t if next message exists in this folder.
4361 (defun wl-summary-cursor-down (&optional hereto)
4363 (if (and (null wl-summary-buffer-target-mark-list)
4364 (eq wl-summary-buffer-view 'thread))
4365 (wl-thread-jump-to-next-unread hereto)
4369 (let ((case-fold-search nil)
4371 (setq regex-list (wl-summary-cursor-move-regex))
4374 (when (re-search-forward
4379 (setq regex-list (cdr regex-list)))
4381 (throw 'done nil)))))
4383 (defun wl-summary-save-view-cache ()
4385 (let* ((dir (elmo-folder-msgdb-path wl-summary-buffer-elmo-folder))
4386 (cache (expand-file-name wl-summary-cache-file dir))
4387 (view (expand-file-name wl-summary-view-file dir))
4388 (save-view wl-summary-buffer-view)
4389 (tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
4390 (charset wl-summary-buffer-mime-charset))
4391 (if (file-directory-p dir)
4393 (if (file-exists-p dir)
4394 (error "File %s already exists" dir)
4395 (elmo-make-directory dir)))
4396 (if (eq save-view 'thread)
4397 (wl-thread-save-entity dir))
4400 (when (file-writable-p cache)
4401 (copy-to-buffer tmp-buffer (point-min) (point-max))
4402 (with-current-buffer tmp-buffer
4404 (encode-mime-charset-region
4405 (point-min) (point-max) charset)
4406 (write-region-as-binary (point-min)(point-max)
4407 cache nil 'no-msg)))
4408 (when (file-writable-p view) ; 'thread or 'sequence
4410 (set-buffer tmp-buffer)
4412 (prin1 save-view tmp-buffer)
4413 (princ "\n" tmp-buffer)
4414 (write-region (point-min) (point-max) view nil 'no-msg))))
4416 (kill-buffer tmp-buffer)))))
4418 (defsubst wl-summary-get-sync-range (folder)
4420 (elmo-folder-plugged-p folder)
4421 (wl-get-assoc-list-value
4422 wl-folder-sync-range-alist
4423 (elmo-folder-name-internal folder)))
4424 wl-default-sync-range)))
4426 ;; redefined for wl-summary-sync-update
4427 (defun wl-summary-input-range (folder)
4428 "returns update or all or rescan."
4429 ;; for the case when parts are expanded in the bottom of the folder
4430 (let ((input-range-list '("update" "all" "rescan" "first:" "last:"
4432 (default (or (wl-get-assoc-list-value
4433 wl-folder-sync-range-alist
4435 wl-default-sync-range))
4438 (completing-read (format "Range (%s): " default)
4440 (function (lambda (x) (cons x x)))
4442 (if (string= range "")
4446 (defun wl-summary-toggle-disp-folder (&optional arg)
4448 (let ((cur-buf (current-buffer))
4449 (summary-win (get-buffer-window (current-buffer)))
4453 (setq wl-summary-buffer-disp-folder t)
4454 ;; hide your folder window
4455 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4456 (if (setq fld-win (get-buffer-window fld-buf))
4457 (delete-window fld-win))))
4459 (setq wl-summary-buffer-disp-folder nil)
4460 ;; hide your wl-message window!
4461 (when (buffer-live-p wl-message-buffer)
4462 (wl-message-select-buffer wl-message-buffer)
4464 (select-window (get-buffer-window cur-buf))
4465 ;; display wl-folder window!!
4466 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4467 (if (setq fld-win (get-buffer-window fld-buf))
4468 ;; folder win is already displayed.
4469 (select-window fld-win)
4470 ;; folder win is not displayed.
4471 (switch-to-buffer fld-buf))
4474 ;; temporarily delete summary-win.
4476 (delete-window summary-win))
4477 (split-window-horizontally wl-folder-window-width)
4479 (switch-to-buffer cur-buf))
4481 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4482 (if (setq fld-win (get-buffer-window fld-buf))
4483 (setq wl-summary-buffer-disp-folder nil)
4484 (setq wl-summary-buffer-disp-folder t)))
4485 (if (not wl-summary-buffer-disp-folder)
4486 ;; hide message window
4487 (let ((mes-win (and wl-message-buffer
4488 (get-buffer-window wl-message-buffer)))
4489 (wl-stay-folder-window t))
4490 (if mes-win (delete-window mes-win))
4491 ;; hide your folder window
4492 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4493 (if (setq fld-win (get-buffer-window fld-buf))
4495 (delete-window (get-buffer-window cur-buf))
4496 (select-window fld-win)
4497 (switch-to-buffer cur-buf))))
4498 (run-hooks 'wl-summary-toggle-disp-folder-off-hook)
4499 ;; resume message window.
4501 (wl-message-select-buffer wl-message-buffer)
4502 (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4503 (select-window (get-buffer-window cur-buf)))
4505 ;; hide message window
4506 (let ((wl-stay-folder-window t)
4507 (mes-win (and wl-message-buffer
4508 (get-buffer-window wl-message-buffer))))
4509 (if mes-win (delete-window mes-win))
4510 (select-window (get-buffer-window cur-buf))
4511 ;; display wl-folder window!!
4512 (if (setq fld-buf (get-buffer wl-folder-buffer-name))
4513 (if (setq fld-win (get-buffer-window fld-buf))
4514 ;; folder win is already displayed.
4515 (select-window fld-win)
4516 ;; folder win is not displayed...occupy all.
4517 (switch-to-buffer fld-buf))
4520 (split-window-horizontally wl-folder-window-width)
4522 (switch-to-buffer cur-buf)
4523 ;; resume message window.
4524 (run-hooks 'wl-summary-toggle-disp-folder-on-hook)
4526 (wl-message-select-buffer wl-message-buffer)
4527 (run-hooks 'wl-summary-toggle-disp-folder-message-resumed-hook)
4528 (select-window (get-buffer-window cur-buf))))
4530 (run-hooks 'wl-summary-toggle-disp-folder-hook))
4532 (defun wl-summary-toggle-disp-msg (&optional arg)
4534 (let ((cur-buf (current-buffer))
4539 (setq wl-summary-buffer-disp-msg t)
4541 ;; hide your folder window
4542 (if (and (not wl-stay-folder-window)
4543 (setq fld-buf (get-buffer wl-folder-buffer-name)))
4544 (if (setq fld-win (get-buffer-window fld-buf))
4545 (unless (one-window-p fld-win)
4546 (delete-window fld-win))))))
4548 (wl-delete-all-overlays)
4549 (setq wl-summary-buffer-disp-msg nil)
4551 (when (buffer-live-p wl-message-buffer)
4552 (wl-message-select-buffer wl-message-buffer)
4554 (and (get-buffer-window cur-buf)
4555 (select-window (get-buffer-window cur-buf))))
4556 (run-hooks 'wl-summary-toggle-disp-off-hook)))
4558 (if (and wl-message-buffer
4559 (get-buffer-window wl-message-buffer)) ; already displayed
4560 (setq wl-summary-buffer-disp-msg nil)
4561 (setq wl-summary-buffer-disp-msg t))
4562 (if wl-summary-buffer-disp-msg
4564 (wl-summary-redisplay)
4565 ;;; hide your folder window
4566 ;;; (setq fld-buf (get-buffer wl-folder-buffer-name))
4567 ;;; (if (setq fld-win (get-buffer-window fld-buf))
4568 ;;; (delete-window fld-win)))
4569 (run-hooks 'wl-summary-toggle-disp-on-hook))
4570 (wl-delete-all-overlays)
4572 (wl-message-select-buffer wl-message-buffer)
4574 (select-window (get-buffer-window cur-buf))
4575 (run-hooks 'wl-summary-toggle-disp-off-hook))
4576 ;;; (switch-to-buffer cur-buf)
4579 (defun wl-summary-next-line-content ()
4580 "Show next line of the message."
4582 (let ((cur-buf (current-buffer)))
4583 (wl-summary-toggle-disp-msg 'on)
4584 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4585 (set-buffer cur-buf)
4586 (wl-message-next-page 1))))
4588 (defun wl-summary-prev-line-content ()
4590 (let ((cur-buf (current-buffer)))
4591 (wl-summary-toggle-disp-msg 'on)
4592 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4593 (set-buffer cur-buf)
4594 (wl-message-prev-page 1))))
4596 (defun wl-summary-next-page ()
4598 (wl-message-next-page))
4600 (defun wl-summary-prev-page ()
4602 (wl-message-prev-page))
4604 (defsubst wl-summary-no-mime-p (folder)
4605 (wl-string-match-member (elmo-folder-name-internal folder)
4606 wl-summary-no-mime-folder-list))
4608 (defun wl-summary-set-message-buffer-or-redisplay (&rest args)
4609 "Set message buffer.
4610 If message is not displayed yet, display it.
4611 Return t if message exists."
4612 (let ((folder wl-summary-buffer-elmo-folder)
4613 (number (wl-summary-message-number))
4614 cur-folder cur-number message-last-pos)
4615 (when (buffer-live-p wl-message-buffer)
4616 (save-window-excursion
4617 (wl-message-select-buffer wl-message-buffer)
4618 (setq cur-folder wl-message-buffer-cur-folder)
4619 (setq cur-number wl-message-buffer-cur-number)))
4620 (if (and (string= (elmo-folder-name-internal folder) (or cur-folder ""))
4621 (eq number (or cur-number 0)))
4623 (set-buffer wl-message-buffer)
4625 (if (wl-summary-no-mime-p folder)
4626 (wl-summary-redisplay-no-mime folder number)
4627 (wl-summary-redisplay-internal folder number))
4628 (set-buffer wl-message-buffer)
4631 (defun wl-summary-target-mark-forward (&optional arg)
4633 (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4634 (summary-buf (current-buffer))
4635 (wl-draft-forward t)
4638 (wl-summary-jump-to-msg (car mlist))
4639 (wl-summary-forward t)
4640 (setq start-point (point))
4641 (setq draft-buf (current-buffer))
4642 (setq mlist (cdr mlist))
4643 (save-window-excursion
4646 (set-buffer summary-buf)
4647 (wl-summary-jump-to-msg (car mlist))
4648 (wl-summary-redisplay)
4649 (set-buffer draft-buf)
4650 (goto-char (point-max))
4651 (wl-draft-insert-message)
4652 (setq mlist (cdr mlist)))
4653 (wl-draft-body-goto-top)
4654 (wl-draft-enclose-digest-region (point) (point-max)))
4655 (goto-char start-point)
4657 (set-buffer summary-buf)
4658 (wl-summary-delete-all-temp-marks)))
4659 (run-hooks 'wl-mail-setup-hook)))
4661 (defun wl-summary-target-mark-reply-with-citation (&optional arg)
4663 (let ((mlist (nreverse wl-summary-buffer-target-mark-list))
4664 (summary-buf (current-buffer))
4665 change-major-mode-hook
4668 (wl-summary-jump-to-msg (car mlist))
4669 (wl-summary-reply arg t)
4670 (goto-char (point-max))
4671 (setq start-point (point))
4672 (setq draft-buf (current-buffer))
4673 (save-window-excursion
4675 (set-buffer summary-buf)
4676 (wl-summary-jump-to-msg (car mlist))
4677 (wl-summary-redisplay)
4678 (set-buffer draft-buf)
4679 (goto-char (point-max))
4680 (wl-draft-yank-original)
4681 (setq mlist (cdr mlist)))
4682 (goto-char start-point)
4684 (set-buffer summary-buf)
4685 (wl-summary-delete-all-temp-marks)))
4686 (run-hooks 'wl-mail-setup-hook)))
4688 (defun wl-summary-reply-with-citation (&optional arg)
4690 (when (wl-summary-reply arg t)
4691 (goto-char (point-max))
4692 (wl-draft-yank-original)
4693 (run-hooks 'wl-mail-setup-hook)))
4695 (defun wl-summary-jump-to-msg-by-message-id (&optional id)
4697 (let* ((original (wl-summary-message-number))
4698 (msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4699 (number-alist (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))
4702 (format "No message with id \"%s\" in the folder." msgid)))
4703 (if (setq msg (car (rassoc msgid number-alist)))
4704 ;;; (wl-summary-jump-to-msg-internal
4705 ;;; (wl-summary-buffer-folder-name) msg 'no-sync)
4707 (wl-thread-jump-to-msg msg)
4710 (if (and elmo-use-database
4713 "No message with id \"%s\" in the database." msgid))
4714 (setq otherfld (elmo-database-msgid-get msgid)))
4715 (if (cdr (wl-summary-jump-to-msg-internal
4716 (car otherfld) (nth 1 otherfld) 'no-sync))
4718 ;; Back to original.
4719 (wl-summary-jump-to-msg-internal
4720 (wl-summary-buffer-folder-name) original 'no-sync))
4721 (cond ((eq wl-summary-search-via-nntp 'confirm)
4722 (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
4723 elmo-default-nntp-server)
4724 (setq schar (read-char))
4725 (cond ((eq schar ?y)
4726 (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4728 (wl-summary-jump-to-msg-by-message-id-via-nntp
4730 (read-from-minibuffer "NNTP Server: ")))
4734 (wl-summary-search-via-nntp
4735 (wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
4740 (defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
4742 (let* ((msgid (elmo-string (or id (read-from-minibuffer "Message-ID: "))))
4743 newsgroups folder ret
4744 user server port type spec)
4746 (if (string-match "^-" server-spec)
4747 (setq spec (wl-folder-get-elmo-folder server-spec)
4748 user (elmo-net-folder-user-internal spec)
4749 server (elmo-net-folder-server-internal spec)
4750 port (elmo-net-folder-port-internal spec)
4751 type (elmo-net-folder-stream-type-internal spec))
4752 (setq server server-spec)))
4753 (when (setq ret (elmo-nntp-get-newsgroup-by-msgid
4755 (or server elmo-default-nntp-server)
4756 (or user elmo-default-nntp-user)
4757 (or port elmo-default-nntp-port)
4758 (or type elmo-default-nntp-stream-type)))
4759 (setq newsgroups (wl-parse-newsgroups ret))
4760 (setq folder (concat "-" (car newsgroups)
4761 (elmo-nntp-folder-postfix user server port type)))
4764 (if (wl-folder-entity-exists-p (car newsgroups)
4765 wl-folder-newsgroups-hashtb)
4767 (setq folder (concat "-" (car newsgroups)
4768 (elmo-nntp-folder-postfix
4769 user server port type)))))
4770 (setq newsgroups (cdr newsgroups)))))
4772 (wl-summary-jump-to-msg-internal folder nil 'update msgid)
4773 (message "No message id \"%s\" in nntp server \"%s\"."
4774 msgid (or server elmo-default-nntp-server))
4777 (defun wl-summary-jump-to-msg-internal (folder msg scan-type &optional msgid)
4778 (let (wl-auto-select-first entity)
4779 (if (or (string= folder (wl-summary-buffer-folder-name))
4782 "Message was found in the folder \"%s\". Jump to it? "
4786 (wl-summary-goto-folder-subr
4787 folder scan-type nil nil t)
4791 (elmo-msgdb-get-number-alist
4792 (wl-summary-buffer-msgdb))))))
4793 (setq entity (wl-folder-search-entity-by-name folder
4797 (wl-folder-set-current-entity-id
4798 (wl-folder-get-entity-id entity))))
4800 (message "Message was not found currently in this folder.")
4801 (setq msg (and (wl-thread-jump-to-msg msg) msg)))
4802 (cons folder msg)))))
4804 (defun wl-summary-jump-to-parent-message (arg)
4806 (let ((cur-buf (current-buffer))
4807 (number (wl-summary-message-number))
4808 (regexp "\\(<[^<>]*>\\)[ \t]*$")
4810 msg-id msg-num ref-list ref irt)
4812 (message "No message.")
4813 (when (eq wl-summary-buffer-view 'thread)
4814 (cond ((and arg (not (numberp arg)))
4816 (wl-thread-entity-get-number
4817 (wl-thread-entity-get-top-entity
4818 (wl-thread-get-entity number)))))
4819 ((and arg (numberp arg))
4821 (setq msg-num number)
4824 (wl-thread-entity-get-number
4825 (wl-thread-entity-get-parent-entity
4826 (wl-thread-get-entity msg-num))))
4829 (wl-thread-entity-get-number
4830 (wl-thread-entity-get-parent-entity
4831 (wl-thread-get-entity number)))))))
4832 (when (null msg-num)
4833 (wl-summary-set-message-buffer-or-redisplay)
4834 (set-buffer (wl-message-get-original-buffer))
4835 (message "Searching parent message...")
4836 (setq ref (std11-field-body "References")
4837 irt (std11-field-body "In-Reply-To"))
4839 ((and arg (not (numberp arg)) ref (not (string= ref ""))
4840 (string-match regexp ref))
4841 ;; The first message of the thread.
4842 (setq msg-id (wl-match-string 1 ref)))
4843 ;; "In-Reply-To:" has only one msg-id.
4844 ((and (null arg) irt (not (string= irt ""))
4845 (string-match regexp irt))
4846 (setq msg-id (wl-match-string 1 irt)))
4847 ((and (or (null arg) (numberp arg)) ref (not (string= ref ""))
4848 (string-match regexp ref))
4849 ;; "^" searching parent, "C-u 2 ^" looking for grandparent.
4850 (while (string-match regexp ref)
4853 (wl-match-string 1 ref))
4855 (setq ref (substring ref (match-end 0)))
4858 (if (null arg) (nth 0 ref-list) ;; previous
4859 (if (<= arg i) (nth (1- arg) ref-list)
4860 (nth i ref-list)))))))
4861 (set-buffer cur-buf)
4862 (cond ((and (null msg-id) (null msg-num))
4863 (message "No parent message!")
4865 ((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
4866 (wl-summary-redisplay)
4867 (message "Searching parent message...done")
4869 ((and msg-num (wl-summary-jump-to-msg msg-num))
4870 (wl-summary-redisplay)
4871 (message "Searching parent message...done")
4874 (message "Parent message was not found.")
4877 (defun wl-summary-reply (&optional arg without-setup-hook)
4878 "Reply to current message. Default is \"wide\" reply.
4879 Reply to author if invoked with ARG."
4881 (let ((folder wl-summary-buffer-elmo-folder)
4882 (number (wl-summary-message-number))
4883 (summary-buf (current-buffer))
4887 (wl-summary-redisplay-internal folder number))
4888 (setq mes-buf wl-message-buffer)
4889 (wl-message-select-buffer wl-message-buffer)
4890 (set-buffer mes-buf)
4891 (goto-char (point-min))
4892 (or wl-draft-use-frame
4893 (split-window-vertically))
4895 (when (setq mes-buf (wl-message-get-original-buffer))
4896 (wl-draft-reply mes-buf arg summary-buf)
4897 (unless without-setup-hook
4898 (run-hooks 'wl-mail-setup-hook)))
4901 (defun wl-summary-write ()
4902 "Write a new draft from Summary."
4904 (wl-draft nil nil nil nil nil
4905 nil nil nil nil nil nil (current-buffer))
4906 (run-hooks 'wl-mail-setup-hook)
4907 (mail-position-on-field "To"))
4909 (defvar wl-summary-write-current-folder-functions
4910 '(wl-folder-get-newsgroups
4911 wl-folder-guess-mailing-list-by-refile-rule
4912 wl-folder-guess-mailing-list-by-folder-name)
4913 "Newsgroups or Mailing List address guess functions list.
4914 Call from `wl-summary-write-current-folder'")
4916 (defun wl-summary-write-current-folder (&optional folder)
4917 "Write message to current FOLDER's newsgroup or mailing-list.
4918 Use function list is `wl-summary-write-current-folder-functions'."
4920 (let (newsgroups to cc)
4921 ;; default FOLDER is current buffer folder
4922 (setq folder (or folder (wl-summary-buffer-folder-name)))
4923 (let ((flist wl-summary-write-current-folder-functions)
4926 (setq guess-list (funcall (car flist) folder))
4927 (if (or (nth 0 guess-list) ; To:
4928 ;;; (nth 1 guess-list) ; Cc:
4929 (nth 2 guess-list)) ; Newsgroups:
4931 (setq flist (cdr flist))))
4934 (wl-draft (nth 0 guess-list) ; To:
4936 (nth 1 guess-list) ; Cc:
4938 (nth 2 guess-list)) ; Newsgroups:
4939 (run-hooks 'wl-mail-setup-hook))
4940 ;;; (error "%s is not newsgroup" folder)
4941 (error "Can't guess by folder %s" folder)))))
4943 (defun wl-summary-forward (&optional without-setup-hook)
4946 (let ((folder wl-summary-buffer-elmo-folder)
4947 (number (wl-summary-message-number))
4948 (summary-buf (current-buffer))
4949 (wl-draft-forward t)
4953 (message "No message.")
4954 (wl-summary-redisplay-internal nil nil 'force-reload)
4955 (setq mes-buf wl-message-buffer)
4956 (wl-message-select-buffer mes-buf)
4957 (or wl-draft-use-frame
4958 (split-window-vertically))
4960 ;; get original subject.
4963 (set-buffer summary-buf)
4965 (or (elmo-message-field folder number 'subject) ""))))
4966 (set-buffer mes-buf)
4967 (wl-draft-forward subject summary-buf)
4968 (unless without-setup-hook
4969 (run-hooks 'wl-mail-setup-hook)))))
4971 (defun wl-summary-click (e)
4976 (defun wl-summary-read ()
4977 "Proceed reading message in the summary buffer."
4979 (let ((cur-buf (current-buffer)))
4980 (wl-summary-toggle-disp-msg 'on)
4981 (when (wl-summary-set-message-buffer-or-redisplay 'ignore-original)
4982 (set-buffer cur-buf)
4983 (if (wl-message-next-page)
4984 (wl-summary-down t)))))
4986 (defun wl-summary-prev (&optional interactive)
4989 (if wl-summary-move-direction-toggle
4990 (setq wl-summary-move-direction-downward nil))
4991 (let ((skip-mark-regexp (mapconcat
4993 wl-summary-skip-mark-list ""))
4994 goto-next regex-list regex next-entity finfo)
4996 (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
4997 (setq regex (format "^%s[^%s]"
4998 wl-summary-buffer-number-regexp
5000 (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5001 wl-summary-buffer-number-regexp
5003 (regexp-quote wl-summary-unread-cached-mark)
5004 (regexp-quote wl-summary-important-mark))))
5005 (unless (re-search-backward regex nil t)
5010 (if wl-summary-buffer-disp-msg
5011 (wl-summary-redisplay)))
5012 (if (or interactive (interactive-p))
5013 (if wl-summary-buffer-prev-folder-func
5014 (funcall wl-summary-buffer-prev-folder-func)
5015 (when wl-auto-select-next
5016 (setq next-entity (wl-summary-get-prev-folder))
5018 (setq finfo (wl-folder-get-entity-info next-entity))))
5020 '(lambda () (wl-summary-next-folder-or-exit next-entity))
5022 "No more messages. Type SPC to go to %s."
5023 (wl-summary-entity-info-msg next-entity finfo))))))))
5025 (defun wl-summary-next (&optional interactive)
5028 (if wl-summary-move-direction-toggle
5029 (setq wl-summary-move-direction-downward t))
5030 (let ((skip-mark-regexp (mapconcat
5032 wl-summary-skip-mark-list ""))
5033 goto-next regex regex-list next-entity finfo)
5035 (if (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)
5036 (setq regex (format "^%s[^%s]"
5037 wl-summary-buffer-number-regexp
5039 (setq regex (format "^%s[^%s]\\(%s\\|%s\\| \\)"
5040 wl-summary-buffer-number-regexp
5042 (regexp-quote wl-summary-unread-cached-mark)
5043 (regexp-quote wl-summary-important-mark))))
5044 (unless (re-search-forward regex nil t)
5049 (if wl-summary-buffer-disp-msg
5050 (wl-summary-redisplay))
5051 (if (or interactive (interactive-p))
5052 (if wl-summary-buffer-next-folder-func
5053 (funcall wl-summary-buffer-next-folder-func)
5054 (when wl-auto-select-next
5055 (setq next-entity (wl-summary-get-next-folder))
5057 (setq finfo (wl-folder-get-entity-info next-entity))))
5059 '(lambda () (wl-summary-next-folder-or-exit next-entity))
5061 "No more messages. Type SPC to go to %s."
5062 (wl-summary-entity-info-msg next-entity finfo))))))))
5064 (defun wl-summary-up (&optional interactive skip-no-unread)
5067 (if wl-summary-move-direction-toggle
5068 (setq wl-summary-move-direction-downward nil))
5069 (if (wl-summary-cursor-up)
5070 (if wl-summary-buffer-disp-msg
5071 (wl-summary-redisplay))
5074 (if wl-summary-buffer-prev-folder-func
5075 (funcall wl-summary-buffer-prev-folder-func)
5076 (let (next-entity finfo)
5077 (when wl-auto-select-next
5079 (setq next-entity (wl-summary-get-prev-unread-folder))
5081 (setq finfo (wl-folder-get-entity-info next-entity)))))
5082 (if (and skip-no-unread
5083 (eq wl-auto-select-next 'skip-no-unread))
5084 (wl-summary-next-folder-or-exit next-entity t)
5086 '(lambda () (wl-summary-next-folder-or-exit next-entity t))
5088 "No more unread messages. Type SPC to go to %s."
5089 (wl-summary-entity-info-msg next-entity finfo)))))))))
5091 (defun wl-summary-get-prev-folder ()
5092 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5095 (setq cur-id (save-excursion (set-buffer folder-buf)
5096 wl-folder-buffer-cur-entity-id))
5097 (wl-folder-get-prev-folder cur-id))))
5099 (defun wl-summary-get-next-folder ()
5100 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5103 (setq cur-id (save-excursion (set-buffer folder-buf)
5104 wl-folder-buffer-cur-entity-id))
5105 (wl-folder-get-next-folder cur-id))))
5107 (defun wl-summary-get-next-unread-folder ()
5108 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5111 (setq cur-id (save-excursion (set-buffer folder-buf)
5112 wl-folder-buffer-cur-entity-id))
5113 (wl-folder-get-next-folder cur-id 'unread))))
5115 (defun wl-summary-get-prev-unread-folder ()
5116 (let ((folder-buf (get-buffer wl-folder-buffer-name))
5119 (setq cur-id (save-excursion (set-buffer folder-buf)
5120 wl-folder-buffer-cur-entity-id))
5121 (wl-folder-get-prev-folder cur-id 'unread))))
5123 (defun wl-summary-down (&optional interactive skip-no-unread)
5125 (if wl-summary-move-direction-toggle
5126 (setq wl-summary-move-direction-downward t))
5127 (if (wl-summary-cursor-down)
5128 (if wl-summary-buffer-disp-msg
5129 (wl-summary-redisplay))
5132 (if wl-summary-buffer-next-folder-func
5133 (funcall wl-summary-buffer-next-folder-func)
5134 (let (next-entity finfo)
5135 (when wl-auto-select-next
5136 (setq next-entity (wl-summary-get-next-unread-folder)))
5138 (setq finfo (wl-folder-get-entity-info next-entity)))
5139 (if (and skip-no-unread
5140 (eq wl-auto-select-next 'skip-no-unread))
5141 (wl-summary-next-folder-or-exit next-entity)
5143 '(lambda () (wl-summary-next-folder-or-exit next-entity))
5145 "No more unread messages. Type SPC to go to %s."
5146 (wl-summary-entity-info-msg next-entity finfo)))))))))
5148 (defun wl-summary-goto-last-displayed-msg ()
5150 (unless wl-summary-buffer-last-displayed-msg
5151 (setq wl-summary-buffer-last-displayed-msg
5152 wl-summary-buffer-current-msg))
5153 (if wl-summary-buffer-last-displayed-msg
5155 (wl-summary-jump-to-msg wl-summary-buffer-last-displayed-msg)
5156 (if wl-summary-buffer-disp-msg
5157 (wl-summary-redisplay)))
5158 (message "No last message.")))
5160 (defun wl-summary-redisplay (&optional arg)
5163 (wl-summary-no-mime-p wl-summary-buffer-elmo-folder))
5164 (wl-summary-redisplay-no-mime)
5165 (wl-summary-redisplay-internal nil nil arg)))
5167 (defsubst wl-summary-redisplay-internal (&optional folder number force-reload)
5169 (let* ((msgdb (wl-summary-buffer-msgdb))
5170 (folder (or folder wl-summary-buffer-elmo-folder))
5171 (num (or number (wl-summary-message-number)))
5172 (wl-mime-charset wl-summary-buffer-mime-charset)
5173 (default-mime-charset wl-summary-buffer-mime-charset)
5174 fld-buf fld-win thr-entity)
5175 (if (and wl-thread-open-reading-thread
5176 (eq wl-summary-buffer-view 'thread)
5177 (not (wl-thread-entity-get-opened
5178 (setq thr-entity (wl-thread-get-entity
5180 (wl-thread-entity-get-children thr-entity))
5181 (wl-thread-force-open))
5184 (setq wl-summary-buffer-disp-msg t)
5185 (setq wl-summary-buffer-last-displayed-msg
5186 wl-summary-buffer-current-msg)
5187 ;; hide folder window
5188 (if (and (not wl-stay-folder-window)
5189 (setq fld-buf (get-buffer wl-folder-buffer-name)))
5190 (if (setq fld-win (get-buffer-window fld-buf))
5191 (delete-window fld-win)))
5192 (setq wl-current-summary-buffer (current-buffer))
5193 (wl-summary-mark-as-read
5195 ;; not fetched, then change server-mark.
5196 (if (wl-message-redisplay folder num 'mime force-reload)
5198 ;; plugged, then leave server-mark.
5201 (elmo-folder-local-p
5202 wl-summary-buffer-elmo-folder))
5203 (elmo-folder-plugged-p
5204 wl-summary-buffer-elmo-folder))
5208 'cached ; cached by reading.
5210 (setq wl-summary-buffer-current-msg num)
5211 (when wl-summary-recenter
5212 (recenter (/ (- (window-height) 2) 2))
5213 (if (not wl-summary-width)
5214 (wl-horizontal-recenter)))
5215 (wl-highlight-summary-displaying)
5216 (wl-message-buffer-prefetch-next folder num (current-buffer)
5217 wl-summary-buffer-mime-charset)
5218 (run-hooks 'wl-summary-redisplay-hook))
5219 (message "No message to display."))))
5221 (defun wl-summary-redisplay-no-mime (&optional folder number)
5223 (let* ((fld (or folder wl-summary-buffer-elmo-folder))
5224 (num (or number (wl-summary-message-number)))
5228 (setq wl-summary-buffer-disp-msg t)
5229 (setq wl-summary-buffer-last-displayed-msg
5230 wl-summary-buffer-current-msg)
5231 (setq wl-current-summary-buffer (current-buffer))
5232 (wl-message-redisplay fld num 'as-is)
5233 (wl-summary-mark-as-read nil nil t)
5234 (setq wl-summary-buffer-current-msg num)
5235 (when wl-summary-recenter
5236 (recenter (/ (- (window-height) 2) 2))
5237 (if (not wl-summary-width)
5238 (wl-horizontal-recenter)))
5239 (wl-highlight-summary-displaying)
5240 (run-hooks 'wl-summary-redisplay-hook))
5241 (message "No message to display.")
5242 (wl-ask-folder 'wl-summary-exit
5243 "No more messages. Type SPC to go to folder mode."))))
5245 (defun wl-summary-redisplay-all-header (&optional folder number)
5247 (let* ((fld (or folder wl-summary-buffer-elmo-folder))
5248 (num (or number (wl-summary-message-number)))
5249 (wl-mime-charset wl-summary-buffer-mime-charset)
5250 (default-mime-charset wl-summary-buffer-mime-charset))
5253 (setq wl-summary-buffer-disp-msg t)
5254 (setq wl-summary-buffer-last-displayed-msg
5255 wl-summary-buffer-current-msg)
5256 (setq wl-current-summary-buffer (current-buffer))
5257 (if (wl-message-redisplay fld num 'all-header); t if displayed.
5258 (wl-summary-mark-as-read nil nil t))
5259 (setq wl-summary-buffer-current-msg num)
5260 (when wl-summary-recenter
5261 (recenter (/ (- (window-height) 2) 2))
5262 (if (not wl-summary-width)
5263 (wl-horizontal-recenter)))
5264 (wl-highlight-summary-displaying)
5265 (run-hooks 'wl-summary-redisplay-hook))
5266 (message "No message to display."))))
5268 (defun wl-summary-jump-to-current-message ()
5270 (let (message-buf message-win)
5271 (if (setq message-buf wl-message-buffer)
5272 (if (setq message-win (get-buffer-window message-buf))
5273 (select-window message-win)
5274 (wl-message-select-buffer wl-message-buffer))
5275 (wl-summary-redisplay)
5276 (wl-message-select-buffer wl-message-buffer))
5277 (goto-char (point-min))))
5279 (defun wl-summary-cancel-message ()
5280 "Cancel an article on news."
5282 (if (null (wl-summary-message-number))
5283 (message "No message.")
5284 (let ((summary-buf (current-buffer))
5286 (wl-summary-set-message-buffer-or-redisplay)
5287 (if (setq message-buf (wl-message-get-original-buffer))
5288 (set-buffer message-buf))
5289 (unless (wl-message-news-p)
5290 (set-buffer summary-buf)
5291 (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
5293 (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5295 (wl-summary-redisplay t)
5296 (wl-summary-supersedes-message))
5297 (error "This is not a news article; supersedes is impossible")))
5298 (when (yes-or-no-p "Do you really want to cancel this article? ")
5299 (let (from newsgroups message-id distribution buf)
5301 (setq from (std11-field-body "from")
5302 newsgroups (std11-field-body "newsgroups")
5303 message-id (std11-field-body "message-id")
5304 distribution (std11-field-body "distribution"))
5305 ;; Make sure that this article was written by the user.
5306 (unless (wl-address-user-mail-address-p
5307 (wl-address-header-extract-address
5308 (car (wl-parse-addresses from))))
5309 (error "This article is not yours"))
5310 ;; Make control message.
5311 (setq buf (set-buffer (get-buffer-create " *message cancel*")))
5312 (setq wl-draft-buffer-cur-summary-buffer summary-buf)
5313 (buffer-disable-undo (current-buffer))
5315 (insert "Newsgroups: " newsgroups "\n"
5316 "From: " (wl-address-header-extract-address
5318 "Subject: cmsg cancel " message-id "\n"
5319 "Control: cancel " message-id "\n"
5321 (concat "Distribution: " distribution "\n")
5323 mail-header-separator "\n"
5324 wl-summary-cancel-message)
5325 (message "Canceling your message...")
5326 (wl-draft-raw-send t t) ; kill when done, force-pre-hooks.
5327 (message "Canceling your message...done")))))))
5329 (defun wl-summary-supersedes-message ()
5330 "Supersede current message."
5332 (let ((summary-buf (current-buffer))
5333 (mmelmo-force-fetch-entire-message t)
5335 (wl-summary-set-message-buffer-or-redisplay)
5336 (if (setq message-buf (wl-message-get-original-buffer))
5337 (set-buffer message-buf))
5338 (unless (wl-message-news-p)
5339 (set-buffer summary-buf)
5340 (if (and (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
5342 (y-or-n-p "Cannot get Newsgroups. Fetch again? "))
5344 (wl-summary-redisplay t)
5345 (wl-summary-supersedes-message))
5346 (error "This is not a news article; supersedes is impossible")))
5348 (setq from (std11-field-body "from"))
5349 ;; Make sure that this article was written by the user.
5350 (unless (wl-address-user-mail-address-p
5351 (wl-address-header-extract-address
5352 (car (wl-parse-addresses from))))
5353 (error "This article is not yours"))
5354 (let* ((message-id (std11-field-body "message-id"))
5355 (followup-to (std11-field-body "followup-to"))
5356 (mail-default-headers
5357 (concat mail-default-headers
5358 "Supersedes: " message-id "\n"
5360 (concat "Followup-To: " followup-to "\n")))))
5361 (set-buffer (wl-message-get-original-buffer))
5362 (wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
5364 (defun wl-summary-save (&optional arg wl-save-dir)
5367 (num (wl-summary-message-number))
5368 (mmelmo-force-fetch-entire-message t))
5369 (if (null wl-save-dir)
5370 (setq wl-save-dir wl-tmp-dir))
5373 (setq filename (expand-file-name
5377 (null (file-exists-p filename))))
5379 (read-file-name "Save to file: " filename)))
5381 (wl-summary-set-message-buffer-or-redisplay)
5382 (set-buffer (wl-message-get-original-buffer))
5383 (if (and (null arg) (file-exists-p filename))
5384 (if (y-or-n-p "File already exists. override it? ")
5385 (write-region (point-min) (point-max) filename))
5386 (write-region (point-min) (point-max) filename)))
5387 (message "No message to save."))
5390 (defun wl-summary-save-region (beg end)
5394 (narrow-to-region beg end)
5395 (goto-char (point-min))
5397 (wl-read-directory-name "Save to directory: " wl-tmp-dir)))
5398 (if (null (file-exists-p wl-save-dir))
5399 (make-directory wl-save-dir))
5400 (if (eq wl-summary-buffer-view 'thread)
5403 (let* ((number (wl-summary-message-number))
5404 (entity (wl-thread-get-entity number)))
5405 (if (wl-thread-entity-get-opened entity)
5406 (wl-summary-save t wl-save-dir)
5408 (wl-summary-save t wl-save-dir))
5411 (wl-summary-save t wl-save-dir)
5412 (forward-line 1)))))))
5414 ;; mew-summary-pipe-message()
5415 (defun wl-summary-pipe-message (prefix command)
5416 "Send this message via pipe."
5417 (interactive (list current-prefix-arg nil))
5418 (if (null (wl-summary-message-number))
5419 (message "No message.")
5420 (setq command (read-string "Shell command on message: "
5421 wl-summary-shell-command-last))
5422 (if (y-or-n-p "Send this message to pipe? ")
5424 (wl-summary-set-message-buffer-or-redisplay)
5425 (set-buffer (wl-message-get-original-buffer))
5426 (if (string= command "")
5427 (setq command wl-summary-shell-command-last))
5428 (goto-char (point-min)) ; perhaps this line won't be necessary
5430 (search-forward "\n\n"))
5431 (shell-command-on-region (point) (point-max) command nil)
5432 (setq wl-summary-shell-command-last command)))))
5434 (defun wl-summary-print-message (&optional arg)
5436 (if (null (wl-summary-message-number))
5437 (message "No message.")
5439 (wl-summary-set-message-buffer-or-redisplay)
5440 (if (or (not (interactive-p))
5441 (y-or-n-p "Print ok? "))
5443 (let ((buffer (generate-new-buffer " *print*")))
5444 (copy-to-buffer buffer (point-min) (point-max))
5446 (funcall wl-print-buffer-func)
5447 (kill-buffer buffer)))
5450 (defun wl-summary-print-message-with-ps-print (&optional filename)
5452 (if (null (wl-summary-message-number))
5453 (message "No message.")
5454 (setq filename (ps-print-preprint current-prefix-arg))
5455 (if (or (not (interactive-p))
5456 (y-or-n-p "Print ok? "))
5457 (let ((summary-buffer (current-buffer))
5460 (wl-summary-set-message-buffer-or-redisplay)
5461 ;; (wl-summary-redisplay-internal)
5462 (let* ((buffer (generate-new-buffer " *print*"))
5464 (set-buffer summary-buffer)
5466 (wl-summary-message-number)
5467 (elmo-msgdb-get-number-alist
5468 (wl-summary-buffer-msgdb))))
5469 (elmo-msgdb-get-overview
5470 (wl-summary-buffer-msgdb)))))
5473 (or (elmo-msgdb-overview-entity-get-subject entity)
5477 (or (elmo-msgdb-overview-entity-get-from entity) "")))
5480 (or (elmo-msgdb-overview-entity-get-date entity) ""))))
5481 (run-hooks 'wl-ps-preprint-hook)
5482 (set-buffer wl-message-buffer)
5483 (copy-to-buffer buffer (point-min) (point-max))
5486 (let ((ps-left-header
5487 (list (concat "(" wl-ps-subject ")")
5488 (concat "(" wl-ps-from ")")))
5490 (list "/pagenumberstring load"
5491 (concat "(" wl-ps-date ")"))))
5492 (run-hooks 'wl-ps-print-hook)
5493 (funcall wl-ps-print-buffer-func filename))
5494 (kill-buffer buffer)))))
5497 (if (featurep 'ps-print) ; ps-print is available.
5498 (fset 'wl-summary-print-message 'wl-summary-print-message-with-ps-print))
5500 (defun wl-summary-folder-info-update ()
5501 (let ((folder (elmo-string (wl-summary-buffer-folder-name)))
5502 (num-db (elmo-msgdb-get-number-alist
5503 (wl-summary-buffer-msgdb))))
5504 (wl-folder-set-folder-updated folder
5506 (+ wl-summary-buffer-unread-count
5507 wl-summary-buffer-new-count)
5510 (defun wl-summary-get-original-buffer ()
5511 "Get original buffer for the current summary."
5513 (wl-summary-set-message-buffer-or-redisplay)
5514 (wl-message-get-original-buffer)))
5516 ;; This function will be needless in the future.
5517 ;; (After when Newsgroups: field is saved in msgdb)
5518 (defun wl-summary-get-newsgroups ()
5519 (let ((folder-list (elmo-folder-get-primitive-list
5520 wl-summary-buffer-elmo-folder))
5523 (when (eq (elmo-folder-type-internal (car folder-list)) 'nntp)
5524 (wl-append ng-list (list (elmo-nntp-folder-group-internal
5525 (car folder-list)))))
5526 (setq folder-list (cdr folder-list)))
5529 ;; This function will be moved to elmo in the future.
5530 ;; (After when Newsgroups: field is saved in msgdb)
5531 (defun wl-summary-set-crosspost (folder number)
5533 (when (eq (elmo-folder-type-internal folder) 'nntp)
5534 (with-current-buffer (wl-summary-get-original-buffer)
5535 (setq newsgroups (std11-field-body "newsgroups")))
5537 (let* ((ng-list (wl-summary-get-newsgroups)) ;; for multi folder
5538 crosspost-newsgroups)
5539 (when (setq crosspost-newsgroups
5540 (elmo-list-delete ng-list
5541 (wl-parse-newsgroups newsgroups t)))
5542 (elmo-crosspost-message-set
5543 (elmo-message-field folder number 'message-id)
5544 crosspost-newsgroups)
5545 (setq wl-crosspost-alist-modified t)))))))
5547 (defun wl-summary-is-crosspost-folder (folder-list groups)
5548 "Returns newsgroup string list of FOLDER-LIST which are contained in GROUPS."
5549 (let (group crosses)
5551 (if (and (eq (elmo-folder-type-internal (car folder-list)) 'nntp)
5552 (member (setq group (elmo-nntp-folder-group-internal
5553 (car folder-list))) groups))
5554 (wl-append crosses (list group)))
5555 (setq folder-list (cdr folder-list)))
5558 (defun wl-crosspost-alist-load ()
5559 (setq elmo-crosspost-message-alist (elmo-crosspost-alist-load))
5560 (setq wl-crosspost-alist-modified nil))
5562 (defun wl-crosspost-alist-save ()
5563 (when wl-crosspost-alist-modified
5564 ;; delete non-exists newsgroups
5565 (let ((alist elmo-crosspost-message-alist)
5571 (not (intern-soft x wl-folder-newsgroups-hashtb)))
5572 (nth 1 (car alist))))
5574 (setcar (cdar alist) newsgroups)
5575 (setq elmo-crosspost-message-alist
5576 (delete (car alist) elmo-crosspost-message-alist)))
5577 (setq alist (cdr alist)))
5578 (elmo-crosspost-alist-save elmo-crosspost-message-alist)
5579 (setq wl-crosspost-alist-modified nil))))
5581 (defun wl-summary-pack-number (&optional arg)
5583 (elmo-folder-pack-numbers wl-summary-buffer-elmo-folder)
5584 (let (wl-use-scoring)
5585 (wl-summary-rescan)))
5587 (defun wl-summary-target-mark-uudecode ()
5589 (let ((mlist (reverse wl-summary-buffer-target-mark-list))
5590 (summary-buf (current-buffer))
5591 (tmp-buf (get-buffer-create "*WL UUENCODE*"))
5592 orig-buf i k filename rc errmsg)
5594 (setq k (length mlist))
5595 (set-buffer tmp-buf)
5597 (save-window-excursion
5599 (set-buffer summary-buf)
5600 (wl-summary-jump-to-msg (car mlist))
5601 (wl-summary-redisplay)
5602 (set-buffer (setq orig-buf (wl-summary-get-original-buffer)))
5603 (goto-char (point-min))
5604 (cond ((= i 1) ; first
5605 (if (setq filename (wl-message-uu-substring
5609 (error "Can't find begin line")))
5611 (wl-message-uu-substring orig-buf tmp-buf))
5613 (wl-message-uu-substring orig-buf tmp-buf nil t)))
5615 (setq mlist (cdr mlist)))
5616 (set-buffer tmp-buf)
5617 (message "Exec %s..." wl-prog-uudecode)
5619 (let ((decode-dir wl-tmp-dir))
5620 (if (not wl-prog-uudecode-no-stdout-option)
5621 (setq filename (read-file-name "Save to file: "
5623 (elmo-safe-filename filename)
5626 (wl-read-directory-name "Save to directory: "
5628 (setq filename (expand-file-name filename decode-dir)))
5629 (if (file-exists-p filename)
5630 (or (yes-or-no-p (format "File %s exists. Save anyway? "
5633 (elmo-bind-directory
5637 (apply 'call-process-region (point-min) (point-max)
5638 wl-prog-uudecode t (current-buffer) nil
5639 wl-prog-uudecode-arg))))
5640 (when (not (= 0 rc))
5641 (setq errmsg (buffer-substring (point-min)(point-max)))
5642 (error "Uudecode error: %s" errmsg))
5643 (if (not wl-prog-uudecode-no-stdout-option)
5644 (let (file-name-handler-alist) ;; void jka-compr
5645 (as-binary-output-file
5646 (write-region (point-min) (point-max)
5647 filename nil 'no-msg))))
5649 (set-buffer summary-buf)
5650 (wl-summary-delete-all-temp-marks))
5651 (if (file-exists-p filename)
5652 (message "Saved as %s" filename)))
5653 (kill-buffer tmp-buf)))))
5656 ;; (defun wl-summary-drop-unsync ()
5657 ;; "Drop all unsync messages."
5659 ;; (if (elmo-folder-pipe-p (wl-summary-buffer-folder-name))
5660 ;; (error "You cannot drop unsync messages in this folder"))
5661 ;; (if (or (not (interactive-p))
5662 ;; (y-or-n-p "Drop all unsync messages? "))
5663 ;; (let* ((folder-list (elmo-folder-get-primitive-folder-list
5664 ;; (wl-summary-buffer-folder-name)))
5665 ;; (is-multi (elmo-multi-p (wl-summary-buffer-folder-name)))
5669 ;; (message "Dropping...")
5670 ;; (while folder-list
5671 ;; (setq pair (elmo-folder-message-numbers (car folder-list)))
5672 ;; (when is-multi ;; dirty hack...
5674 ;; (setcar pair (+ (* multi-num elmo-multi-divide-number)
5676 ;; (elmo-msgdb-set-number-alist
5677 ;; (wl-summary-buffer-msgdb)
5679 ;; (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb))
5680 ;; (list (cons (car pair) nil))))
5681 ;; (setq sum (+ sum (cdr pair)))
5682 ;; (setq folder-list (cdr folder-list)))
5683 ;; (wl-summary-set-message-modified)
5684 ;; (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
5686 ;; (+ wl-summary-buffer-unread-count
5687 ;; wl-summary-buffer-new-count)
5689 ;; (message "Dropping...done"))))
5691 (defun wl-summary-default-get-next-msg (msg)
5693 (if (and (not wl-summary-buffer-target-mark-list)
5694 (eq wl-summary-buffer-view 'thread)
5695 (if (eq wl-summary-move-direction-downward nil)
5696 (setq next (wl-thread-get-prev-unread msg))
5697 (setq next (wl-thread-get-next-unread msg))))
5700 (wl-summary-jump-to-msg msg)
5701 (let (wl-summary-buffer-disp-msg)
5702 (if (eq wl-summary-move-direction-downward nil)
5703 (unless (wl-summary-cursor-up)
5705 (unless (wl-summary-cursor-down)
5707 (wl-summary-message-number))))))
5709 (defun wl-summary-save-current-message ()
5710 "Save current message for `wl-summary-yank-saved-message'."
5712 (let ((number (wl-summary-message-number)))
5713 (setq wl-summary-buffer-saved-message number)
5714 (and number (message "No: %s is saved." number))))
5716 (defun wl-summary-yank-saved-message ()
5717 "Set current message as a parent of the saved message."
5719 (if wl-summary-buffer-saved-message
5720 (let ((number (wl-summary-message-number)))
5721 (if (eq wl-summary-buffer-saved-message number)
5722 (message "Cannot set itself as a parent.")
5724 (wl-thread-jump-to-msg wl-summary-buffer-saved-message)
5725 (wl-thread-set-parent number)
5726 (wl-summary-set-thread-modified))
5727 (setq wl-summary-buffer-saved-message nil)))
5728 (message "There's no saved message.")))
5731 (product-provide (provide 'wl-summary) (require 'wl-version))
5733 ;;; wl-summary.el ends here